Subversion Repositories Koakuma

Rev

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

Rev 2 Rev 3
Line 6... Line 6...
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} {
- 
 
 12 
	global components
- 
 
 13 
	foreach {name description version} $components {
- 
 
 14 
		eval $run
- 
 
 15 
	}
- 
 
 16 
}
- 
 
 17 
 
11 
proc crash {reason} {
 18 
proc crash {reason} {
12 
	global components KOAKUMA_VERSION
 19 
	global components KOAKUMA_VERSION
13 
	puts stderr "----- Start Koakuma Crash dump log -----"
 20 
	puts stderr "----- Start Koakuma Crash dump log -----"
14 
	puts stderr "Included components:"
 21 
	puts stderr "Included components:"
15 
	foreach {name description version} $components {
 22 
	loop_components {
16 
		puts stderr "	$name: $description, version $version"
 23 
		puts stderr "	$name: $description, version $version"
17 
	}
 24 
	}
18 
	puts stderr "Reason: $reason"
 25 
	puts stderr "Reason: $reason"
19 
	puts stderr "----- End Koakuma Crash dump log -----"
 26 
	puts stderr "----- End Koakuma Crash dump log -----"
20 
	puts	"Content-Type: text/html"
 27 
	puts	"Content-Type: text/html"
Line 34... Line 41...
34 
	puts	"	</body>"
 41 
	puts	"	</body>"
35 
	puts	"</html>"
 42 
	puts	"</html>"
36 
	exiting 1
 43 
	exiting 1
37 
}
 44 
}
38 
 
 45 
 
- 
 
 46 
if { ![info exists env(PATH_INFO)] } {
39 
foreach path [glob @@PREFIX@@/lib/koakuma/components/*.tcl] {
 47 
	puts "Status: 301 Moved Permanently"
- 
 
 48 
	puts "Location: $env(SCRIPT_NAME)/"
40 
	source "$path"
 49 
	puts ""
- 
 
 50 
	exiting 0
41 
}
 51 
}
42 
 
 52 
 
43 
proc start_html {title} {
 - 
 
44 
	puts	"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">"
 - 
 
45 
	puts	"<html>"
 53 
if { [catch {
46 
	puts	"	<head>"
 54 
	package require tdom
47 
	puts	"		<meta http-equiv=\"Content-Type\" content=\"text/html;charset=UTF-8\">"
 - 
 
48 
	puts	"		<title>$title - Koakuma</title>"
 - 
 
49 
	puts	"	</head>"
 55 
}] } {
50 
	puts	"	<body>"
 56 
	crash "Failed to load tDOM"
51 
}
 57 
}
- 
 
 58 
 
- 
 
 59 
if { [catch {
- 
 
 60 
	foreach path [glob @@PREFIX@@/lib/koakuma/component/*.tcl] {
- 
 
 61 
		source "$path"
- 
 
 62 
	}
- 
 
 63 
}] } {
- 
 
 64 
	crash "Could not load components"
- 
 
 65 
}
- 
 
 66 
 
- 
 
 67 
set toc ""
- 
 
 68 
set result ""
- 
 
 69 
set content ""
- 
 
 70 
 
- 
 
 71 
proc rputs {data} {
- 
 
 72 
	global result
- 
 
 73 
	if { "$result" == "" } {
- 
 
 74 
		set result "$data"
- 
 
 75 
	} else {
- 
 
 76 
		set result "$result\n$data"
- 
 
 77 
	}
- 
 
 78 
}
- 
 
 79 
 
- 
 
 80 
proc tputs {data} {
- 
 
 81 
	global content
- 
 
 82 
	if { "$content" == "" } {
- 
 
 83 
		set content "$data"
- 
 
 84 
	} else {
- 
 
 85 
		set content "$content\n$data"
- 
 
 86 
	}
- 
 
 87 
}
- 
 
 88 
 
- 
 
 89 
proc html_escape {data} {
- 
 
 90 
	return "[regsub -all {&} "[regsub -all {>} "[regsub -all {<} "$data" "&lt;"]" "&gt;"]" "&amp;"]"
- 
 
 91 
}
- 
 
 92 
 
- 
 
 93 
proc open_projects {} {
- 
 
 94 
	while 1 {
- 
 
 95 
		if { ![info exists "@@PREFIX@@/lib/koakuma/db/projects.lock"] } {
- 
 
 96 
			break
- 
 
 97 
		}
- 
 
 98 
		set fid [open "@@PREFIX@@/lib/koakuma/db/projects.lock" "w"]
- 
 
 99 
		if { ![info exists "/proc/[gets $fid line]"] } {
- 
 
 100 
			close $fid
- 
 
 101 
			break
- 
 
 102 
		}
- 
 
 103 
		after 10
- 
 
 104 
		close $fid
- 
 
 105 
	}
- 
 
 106 
	set fid [open "@@PREFIX@@/lib/koakuma/db/projects.lock" "w"]
- 
 
 107 
	puts $fid "[pid]"
- 
 
 108 
	close $fid
- 
 
 109 
}
- 
 
 110 
 
- 
 
 111 
proc scan_projects {run} {
- 
 
 112 
	set fid [open "@@PREFIX@@/lib/koakuma/db/projects.db" "r"]
- 
 
 113 
	set content ""
- 
 
 114 
	while { [gets $fid line] >= 0 } {
- 
 
 115 
		if { "$content" == "" } {
- 
 
 116 
			set content "$line"
- 
 
 117 
		} else {
- 
 
 118 
			set content "$content\n$line"
- 
 
 119 
		}
- 
 
 120 
	}
- 
 
 121 
	close $fid
- 
 
 122 
	set dom [dom parse "$content"]
- 
 
 123 
	set doc [$dom documentElement]
- 
 
 124 
	foreach elem [$doc selectNodes "/projects/project"] {
- 
 
 125 
		set name "[$elem selectNodes "string(name)"]"
- 
 
 126 
		set description "[$elem selectNodes "string(description)"]"
- 
 
 127 
		eval $run
- 
 
 128 
	}
- 
 
 129 
}
- 
 
 130 
 
- 
 
 131 
proc project_exists {projname} {
- 
 
 132 
	set desc ""
- 
 
 133 
	scan_projects {
- 
 
 134 
		upvar 1 desc desc
- 
 
 135 
		upvar 1 projname projname
- 
 
 136 
		if { "$name" == "$projname" } {
- 
 
 137 
			set desc "$description"
- 
 
 138 
			break
- 
 
 139 
		}
- 
 
 140 
	}
- 
 
 141 
	return "$desc"
- 
 
 142 
}
- 
 
 143 
 
- 
 
 144 
proc close_projects {} {
- 
 
 145 
	file delete "@@PREFIX@@/lib/koakuma/db/projects.lock"
- 
 
 146 
}
- 
 
 147 
 
- 
 
 148 
proc start_html {title has_toc} {
- 
 
 149 
	global toc
- 
 
 150 
	rputs	"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">"
- 
 
 151 
	rputs	"<html>"
- 
 
 152 
	rputs	"	<head>"
- 
 
 153 
	rputs	"		<meta http-equiv=\"Content-Type\" content=\"text/html;charset=UTF-8\">"
- 
 
 154 
	rputs	"		<title>$title - Koakuma</title>"
- 
 
 155 
	rputs	"		<link rel=\"stylesheet\" href=\"/static/style.css\">"
- 
 
 156 
	rputs	"	</head>"
- 
 
 157 
	rputs	"	<body>"
- 
 
 158 
	rputs	"		<a href=\"/koakuma\" id=\"gomain\">"
- 
 
 159 
	rputs	"			<img src=\"/static/koakuma.png\" alt=\"Koakuma by Kasuya Baian\" height=\"192px\">"
- 
 
 160 
	rputs	"		</a>"
- 
 
 161 
	rputs	"		<div id=\"space\"></div>"
- 
 
 162 
	rputs	"		<div id=\"title\">"
- 
 
 163 
	rputs	"			Koakuma"
- 
 
 164 
	rputs	"		</div>"
- 
 
 165 
	rputs	"		<div id=\"clearfix\"></div>"
- 
 
 166 
	if { "$has_toc" == "1" } {
- 
 
 167 
		rputs	"		<div id=\"toc\">"
- 
 
 168 
		rputs	"			<div id=\"toctitle\">TOC</div>"
- 
 
 169 
		foreach sect $toc {
- 
 
 170 
			if { "[string range "[regsub -all { } "$sect" "-"]" 0 0]" == "-" } {
- 
 
 171 
				rputs "<a class=\"shiftlink\" href=\"#TOC-[regsub {^-} "[regsub -all { } "$sect" "-"]" ""]\">[regsub {^-} "$sect" ""]</a><br>"
- 
 
 172 
			} else {
- 
 
 173 
				rputs "<a href=\"#TOC-[regsub -all { } "$sect" "-"]\">$sect</a><br>"
- 
 
 174 
			}
- 
 
 175 
		}
- 
 
 176 
		rputs	"		</div>"
- 
 
 177 
	}
- 
 
 178 
	if { "$has_toc" == "1" } {
- 
 
 179 
		rputs	"		<div id=\"doc\">"
- 
 
 180 
	} else {
- 
 
 181 
		rputs	"		<div id=\"doc-notoc\">"
- 
 
 182 
	}
- 
 
 183 
	rputs	"			<h1>$title</h1>"
- 
 
 184 
}
52 
proc end_html {} {
 185 
proc end_html {has_toc} {
- 
 
 186 
	global KOAKUMA_VERSION
- 
 
 187 
	rputs	"		</div>"
- 
 
 188 
	rputs	"		<hr>"
- 
 
 189 
	rputs	"		<i>Powered by <a href=\"http://nishi.boats/koakuma\">Koakuma</a> $KOAKUMA_VERSION</i>"
53 
	puts	"	</body>"
 190 
	rputs	"	</body>"
54 
	puts	"</html>"
 191 
	rputs	"</html>"
- 
 
 192 
}
- 
 
 193 
 
- 
 
 194 
proc add_toc {data} {
- 
 
 195 
	global toc
- 
 
 196 
	tputs	"<h2 id=\"TOC-[regsub -all { } "$data" "-"]\"><a href=\"#TOC-[regsub -all { } "$data" "-"]\">#</a> $data</h2>"
- 
 
 197 
	lappend toc "$data"
- 
 
 198 
}
- 
 
 199 
 
- 
 
 200 
proc add_toc2 {data} {
- 
 
 201 
	global toc
- 
 
 202 
	tputs	"<h3 id=\"TOC-[regsub -all { } "$data" "-"]\"><a href=\"#TOC-[regsub -all { } "$data" "-"]\">#</a> $data</h3>"
- 
 
 203 
	lappend toc "-$data"
- 
 
 204 
}
- 
 
 205 
 
- 
 
 206 
if { [catch {
- 
 
 207 
	set path "[regsub -all {/+} "$env(PATH_INFO)" "/"]"
- 
 
 208 
	rputs "Content-Type: text/html"
- 
 
 209 
	if { "$path" == "/" } {
- 
 
 210 
		add_toc "Tcl Information"
- 
 
 211 
		tputs	"<table border=\"0\">"
- 
 
 212 
		tputs	"	<tr>"
- 
 
 213 
		tputs	"		<th>"
- 
 
 214 
		tputs	"			Version"
- 
 
 215 
		tputs	"		</th>"
- 
 
 216 
		tputs	"		<td>"
- 
 
 217 
		tputs	"			$tcl_version"
- 
 
 218 
		tputs	"		</td>"
- 
 
 219 
		tputs	"	</tr>"
- 
 
 220 
		tputs	"	<tr>"
- 
 
 221 
		tputs	"		<th>"
- 
 
 222 
		tputs	"			Platform"
- 
 
 223 
		tputs	"		</th>"
- 
 
 224 
		tputs	"		<td>"
- 
 
 225 
		tputs	"			$tcl_platform(os)/$tcl_platform(machine) $tcl_platform(osVersion)"
- 
 
 226 
		tputs	"		</td>"
- 
 
 227 
		tputs	"	</tr>"
- 
 
 228 
		tputs	"</table>"
- 
 
 229 
		add_toc "Components"
- 
 
 230 
		loop_components {
- 
 
 231 
			if { [llength [info procs "${name}_info"]] > 0 } {
- 
 
 232 
				${name}_info
- 
 
 233 
			}
- 
 
 234 
		}
- 
 
 235 
		set has_projects 0
- 
 
 236 
		add_toc "Projects"
- 
 
 237 
		open_projects
- 
 
 238 
		scan_projects {
- 
 
 239 
			upvar 1 has_projects has_projects
- 
 
 240 
			if { "$has_projects" == "0" } {
- 
 
 241 
				set has_projects 1
- 
 
 242 
				tputs	"<table border=\"0\">"
- 
 
 243 
			}
- 
 
 244 
			tputs	"<tr>"
- 
 
 245 
			tputs	"	<th><a href=\"/koakuma/project/$name\">$name</a></th>"
- 
 
 246 
			tputs	"	<td>$description</td>"
- 
 
 247 
			tputs	"</tr>"
- 
 
 248 
		}
- 
 
 249 
		close_projects
- 
 
 250 
		if { "$has_projects" == "1" } {
- 
 
 251 
			tputs	"</table>"
- 
 
 252 
		} else {
- 
 
 253 
			tputs	"No projects have been added, yet."
- 
 
 254 
		}
- 
 
 255 
 
- 
 
 256 
		rputs ""
- 
 
 257 
		start_html "Main" 1
- 
 
 258 
		rputs "$content"
- 
 
 259 
		end_html 1
- 
 
 260 
	} elseif { [regexp {^/rpc.*$} "$path"] } {
- 
 
 261 
	} elseif { [regexp {^/project/[^/]+.*$} "$path"] } {
- 
 
 262 
		regexp {^/project/([^/]+).*$} "$path" -> projname
- 
 
 263 
		open_projects
- 
 
 264 
		set has_project [project_exists "$projname"]
- 
 
 265 
		close_projects
- 
 
 266
- 
 
 267 
		if { "$has_project" != "" } {
- 
 
 268 
			add_toc "Description"
- 
 
 269 
			tputs "[html_escape "$has_project"]"
- 
 
 270 
 
- 
 
 271 
			rputs ""
- 
 
 272 
			start_html "Project: $projname" 1
- 
 
 273 
			rputs "$content"
- 
 
 274 
			end_html 1
- 
 
 275 
		} else {
- 
 
 276 
			tputs "I could not find the project you were finding."
- 
 
 277 
 
- 
 
 278 
			rputs "Status: 404 Not Found"
- 
 
 279 
			rputs ""
- 
 
 280 
			start_html "Not Found" 0
- 
 
 281 
			rputs "$content"
- 
 
 282 
			end_html 0
- 
 
 283 
		}
- 
 
 284 
	} else {
- 
 
 285 
		tputs "I could not find the content you were finding."
- 
 
 286 
 
- 
 
 287 
		rputs "Status: 404 Not Found"
- 
 
 288 
		rputs ""
- 
 
 289 
		start_html "Not Found" 0
- 
 
 290 
		rputs "$content"
- 
 
 291 
		end_html 0
- 
 
 292 
	}
- 
 
 293 
}] } {
- 
 
 294 
	crash "Could not render the HTML"
- 
 
 295 
} else {
- 
 
 296 
	puts "$result"
55 
}
 297 
}
- 
 
 298 
exiting 0