Subversion Repositories Koakuma

Rev

Rev 5 | Rev 11 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 5 Rev 6
Line 1... Line 1...
1 
#!/usr/bin/env tclsh
 1 
#!/usr/bin/env tclsh
2 
# $Id$
 2 
# $Id: koakuma.cgi.in 6 2024-10-01 22:57:18Z nishi $
3 
 
 3 
 
4 
set KOAKUMA_VERSION "1.00"
 4 
set KOAKUMA_VERSION "1.00"
5 
set components ""
 5 
set components ""
6 
 
 6 
 
7 
proc exiting {code} {
 7 
proc exiting {code} {
8 
	exit $code
 8 
	exit $code
9 
}
 9 
}
10 
 
 10 
 
11 
proc loop_components {run} {
 11 
proc loop_components {run} {
12 
	global components
 12 
	global components
13 
	foreach {name description version} $components {
 13 
	foreach {name description version genre} $components {
14 
		eval $run
 14 
		eval $run
15 
	}
 15 
	}
16 
}
 16 
}
17 
 
 17 
 
18 
proc crash {reason} {
 18 
proc crash {reason} {
Line 51... Line 51...
51 
}
 51 
}
52 
 
 52 
 
53 
if { [catch {
 53 
if { [catch {
54 
	package require tdom
 54 
	package require tdom
55 
	dom createNodeCmd -tagName "rpc" elementNode rootXML
 55 
	dom createNodeCmd -tagName "rpc" elementNode rootXML
- 
 
 56 
	dom createNodeCmd -tagName "project" elementNode keyProject
56 
	dom createNodeCmd -tagName "version" -jsonType NONE elementNode keyVersion
 57 
	dom createNodeCmd -tagName "version" -jsonType NONE elementNode keyVersion
57 
	dom createNodeCmd -tagName "error" -jsonType NONE elementNode keyError
 58 
	dom createNodeCmd -tagName "error" -jsonType NONE elementNode keyError
- 
 
 59 
	dom createNodeCmd -tagName "name" -jsonType NONE elementNode keyName
- 
 
 60 
	dom createNodeCmd -tagName "description" -jsonType NONE elementNode keyDescription
- 
 
 61 
	dom createNodeCmd -tagName "vcs" -jsonType NONE elementNode keyVCS
- 
 
 62 
	dom createNodeCmd -tagName "url" -jsonType NONE elementNode keyURL
58 
	dom createNodeCmd -jsonType STRING textNode valueString
 63 
	dom createNodeCmd -jsonType STRING textNode valueString
59 
}] } {
 64 
}] } {
60 
	crash "Failed to load tDOM"
 65 
	crash "Failed to load tDOM"
61 
}
 66 
}
62 
 
 67 
 
Line 80... Line 85...
80 
 
 85 
 
81 
set toc ""
 86 
set toc ""
82 
set result ""
 87 
set result ""
83 
set content ""
 88 
set content ""
84 
 
 89 
 
- 
 
 90 
proc write_db {data} {
- 
 
 91 
	set fid [open "@@PREFIX@@/lib/koakuma/db/projects.db" "w"]
- 
 
 92 
	puts $fid "$data"
- 
 
 93 
	close $fid
- 
 
 94 
}
- 
 
 95 
 
- 
 
 96 
proc readall_db {} {
- 
 
 97 
	set data ""
- 
 
 98 
	set fid [open "@@PREFIX@@/lib/koakuma/db/projects.db" "r"]
- 
 
 99 
	while { [gets $fid line] >= 0 } {
- 
 
 100 
		if { "$data" == "" } {
- 
 
 101 
			set data "$line"
- 
 
 102 
		} else {
- 
 
 103 
			set data "$data\n$line"
- 
 
 104 
		}
- 
 
 105 
	}
- 
 
 106 
	close $fid
- 
 
 107 
	return "$data"
- 
 
 108 
}
- 
 
 109 
 
85 
proc rputs {data} {
 110 
proc rputs {data} {
86 
	global result
 111 
	global result
87 
	if { "$result" == "" } {
 112 
	if { "$result" == "" } {
88 
		set result "$data"
 113 
		set result "$data"
89 
	} else {
 114 
	} else {
Line 291... Line 316...
291 
					keyError {valueString "Bad JSON"}
 316 
					keyError {valueString "Bad JSON"}
292 
				}
 317 
				}
293 
			} else {
 318 
			} else {
294 
				set projname "[$clidoc selectNodes "string(/name)"]"
 319 
				set projname "[$clidoc selectNodes "string(/name)"]"
295 
				set projdescription "[$clidoc selectNodes "string(/description)"]"
 320 
				set projdescription "[$clidoc selectNodes "string(/description)"]"
296 
				set vcs "[$clidoc selectNodes "string(/vcs)"]"
 321 
				set projvcs "[$clidoc selectNodes "string(/vcs)"]"
297 
				set url "[$clidoc selectNodes "string(/url)"]"
 322 
				set url "[$clidoc selectNodes "string(/url)"]"
298 
				if { "$projname" == "" || "$projdescription" == "" || "$vcs" == "" || "$url" == "" } {
 323 
				if { "$projname" == "" || "$projdescription" == "" || "$projvcs" == "" || "$url" == "" } {
299 
					rputs "Status: 400 Bad Request"
 324 
					rputs "Status: 400 Bad Request"
300 
					$doc appendFromScript {
 325 
					$doc appendFromScript {
301 
						keyError {valueString "Required field missing"}
 326 
						keyError {valueString "Required field missing"}
302 
					}
 327 
					}
303 
				} else {
 328 
				} else {
304 
					set has_vcs 0
 329 
					set has_vcs 0
- 
 
 330 
					set has_name 0
305 
					loop_components {
 331 
					loop_components {
306 
						upvar 1 has_vcs has_vcs
 332 
						upvar 1 has_vcs has_vcs
307 
						upvar 1 vcs vcs
 333 
						upvar 1 projvcs projvcs
308 
						if { "$name" == "$vcs" } {
 334 
						if { "$name" == "$projvcs" && "$genre" == "VCS" } {
309 
							set has_vcs 1
 335 
							set has_vcs 1
310 
							break
 336 
							break
311 
						}
 337 
						}
312 
					}
 338 
					}
- 
 
 339 
					open_projects
- 
 
 340 
					scan_projects {
- 
 
 341 
						upvar 1 has_name has_name
- 
 
 342 
						upvar 1 projname projname
- 
 
 343 
						if { "$name" == "$projname" } {
- 
 
 344 
							set has_name 1
- 
 
 345 
							break
- 
 
 346 
						}
- 
 
 347 
					}
- 
 
 348 
					close_projects
313 
					if { $has_vcs == 0 } {
 349 
					if { $has_vcs == 0 } {
314 
						rputs "Status: 400 Bad Request"
 350 
						rputs "Status: 400 Bad Request"
315 
						$doc appendFromScript {
 351 
						$doc appendFromScript {
316 
							keyError {valueString "Not a valid VCS"}
 352 
							keyError {valueString "Not a valid VCS"}
317 
						}
 353 
						}
- 
 
 354 
					} elseif { $has_name == 1 } {
- 
 
 355 
						rputs "Status: 400 Bad Request"
- 
 
 356 
						$doc appendFromScript {
- 
 
 357 
							keyError {valueString "Project already exists"}
- 
 
 358 
						}
318 
					} else {
 359 
					} else {
319 
						open_projects
 360 
						open_projects
- 
 
 361 
						set xml "[readall_db]"
- 
 
 362 
						set xmldoc [dom parse "$xml"]
- 
 
 363 
						set root [$xmldoc documentElement]
- 
 
 364 
						$root appendFromScript {
- 
 
 365 
							keyProject {
- 
 
 366 
								keyName {valueString "$projname"}
- 
 
 367 
								keyDescription {valueString "$projdescription"}
- 
 
 368 
								keyVCS {valueString "$projvcs"}
- 
 
 369 
								keyURL {valueString "$url"}
- 
 
 370 
							}
- 
 
 371 
						}
- 
 
 372 
						write_db "[$xmldoc asXML]"
320 
						close_projects
 373 
						close_projects
321 
					}
 374 
					}
322 
				}
 375 
				}
323 
			}
 376 
			}
324 
			rputs ""
 377 
			rputs ""