| 1 |
#!/usr/bin/perl -w |
| 2 |
# |
| 3 |
|
| 4 |
use XML::Parser; |
| 5 |
|
| 6 |
use strict; |
| 7 |
|
| 8 |
$|=1; |
| 9 |
|
| 10 |
my $Usage =<<'End_of_Usage;'; |
| 11 |
slides [-h] [-d dir] [-mode mode] slide-doc |
| 12 |
|
| 13 |
Convert a slideshow document into html, with a separate html document |
| 14 |
for each slide and an index to all of them. |
| 15 |
|
| 16 |
-h Print this message and exit |
| 17 |
|
| 18 |
-w warn about unrecognized tags |
| 19 |
|
| 20 |
-d Use dir as directory into which to write html pages. Defaults |
| 21 |
to basename of supplied doc file. |
| 22 |
|
| 23 |
-mode Output mode. Choices are html, html-style. Default is |
| 24 |
html-style. |
| 25 |
|
| 26 |
End_of_Usage; |
| 27 |
|
| 28 |
my @Modes = qw(object pass skip); |
| 29 |
|
| 30 |
my $dir; |
| 31 |
my $dowarn = 1; |
| 32 |
my $dostyle = 0; |
| 33 |
|
| 34 |
my $pitanje_nr = 0; # curr. pitanje |
| 35 |
my $pitanje_tag = ""; # originalni oblik broja pitanja |
| 36 |
my $page_nr = 1; # prvo pitanje na strani |
| 37 |
|
| 38 |
my $p_suffix=""; # if more than one box per question |
| 39 |
|
| 40 |
my $curr_suffix=""; # trenutni suffix |
| 41 |
|
| 42 |
my @stack_pit; # stack pitanja (pitanje, suffix) |
| 43 |
|
| 44 |
my @sql_create = ("id serial", |
| 45 |
"http_referer character varying(500)", |
| 46 |
"remote_addr character varying(15)", |
| 47 |
"user_agent character varying(300)", |
| 48 |
"unesen timestamp DEFAULT now()", |
| 49 |
"member_id int4 NOT NULL" |
| 50 |
); |
| 51 |
my @sql_update; |
| 52 |
my @last_sql_update; |
| 53 |
my @prelast_sql_update; |
| 54 |
|
| 55 |
my @php_addon; # php code to add on page header |
| 56 |
|
| 57 |
my ($last_fn,$last_page); |
| 58 |
|
| 59 |
# this is unique prefix for this installation |
| 60 |
my $prefix="wopi_"; |
| 61 |
|
| 62 |
# this is usename in database |
| 63 |
my $db_user="dpavlin"; |
| 64 |
|
| 65 |
#------------------------------------------------------------------ |
| 66 |
|
| 67 |
my $html_header.=<<'End_of_header;'; |
| 68 |
<html> |
| 69 |
<head> |
| 70 |
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> |
| 71 |
<title>proof.anketa</title><link rel="STYLESHEET" type="text/css" href="../stil.css"> |
| 72 |
</head> |
| 73 |
|
| 74 |
<body background="../beki.gif" bgcolor="White" leftmargin=0 topmargin=0 marginwidth="0" marginheight="0"> |
| 75 |
|
| 76 |
<table width="460" cellspacing="0" cellpadding="0" border="0"> |
| 77 |
<tr> |
| 78 |
<td colspan="2"><img src="head.php" width=460 height=72 alt="" border="0"><br><br></td> |
| 79 |
</tr> |
| 80 |
<tr> |
| 81 |
<td><img src="../klir.gif" width=20 height=1 alt="" border="0"><br> |
| 82 |
</td> |
| 83 |
<td><img src="../klir.gif" width=332 height=1 alt="" border="0"><br> </td> |
| 84 |
</tr> |
| 85 |
<form method=post action="##NEXTPAGE##"> |
| 86 |
<input type=hidden name=a value="<?= $a ?>"> |
| 87 |
<input type=hidden name=id value="<?= $id ?>"> |
| 88 |
|
| 89 |
<tr> |
| 90 |
<td> </td> |
| 91 |
<td> |
| 92 |
End_of_header; |
| 93 |
|
| 94 |
#------------------------------------------------------------------ |
| 95 |
|
| 96 |
my $html_separator=<<'End_of_separator;'; |
| 97 |
<tr> |
| 98 |
<td></td> |
| 99 |
<td bgcolor="#006699"><img src="../klir.gif" width=1 height=1 alt="" border="0"><br></td> |
| 100 |
</tr> |
| 101 |
End_of_separator; |
| 102 |
|
| 103 |
#------------------------------------------------------------------ |
| 104 |
|
| 105 |
my $html_footer=<<'End_of_footer;'; |
| 106 |
</td> |
| 107 |
</tr> |
| 108 |
|
| 109 |
<tr> |
| 110 |
<td> </td> |
| 111 |
<td align="right"><br> |
| 112 |
<input type=submit name="update" value="dalje."> |
| 113 |
<br><br><br> |
| 114 |
</td> |
| 115 |
</tr> |
| 116 |
</table> |
| 117 |
|
| 118 |
</body> |
| 119 |
</html> |
| 120 |
End_of_footer; |
| 121 |
|
| 122 |
#------------------------------------------------------------------ |
| 123 |
|
| 124 |
sub php_header { |
| 125 |
my ($page_nr,@sql_update) = @_; |
| 126 |
my $out='<? |
| 127 |
include("common.inc"); |
| 128 |
if (isset($update)) { |
| 129 |
$member_id=id_decode($a); |
| 130 |
'; |
| 131 |
$out.=$php_addon[$page_nr-2] if (defined $php_addon[$page_nr-2]); |
| 132 |
$out.=' |
| 133 |
$sql="update '.$dir.' set '.join(",\n",@sql_update).', |
| 134 |
do_stranice=\'$PHP_SELF\' |
| 135 |
where id=$id"; |
| 136 |
# print "<pre>$sql</pre>"; |
| 137 |
$result=pg_Exec($conn,fix_sql($sql)); |
| 138 |
} elseif($do_stranice != $PHP_SELF) { |
| 139 |
Header("Location: $do_uri?a=$a"); |
| 140 |
exit; |
| 141 |
} |
| 142 |
?>'; |
| 143 |
return $out; |
| 144 |
} |
| 145 |
|
| 146 |
#------------------------------------------------------------------ |
| 147 |
|
| 148 |
# first, define some constants |
| 149 |
my $common_inc=' |
| 150 |
$PREFIX="'.$prefix.'"; |
| 151 |
$DB_USER="'.$db_user.'"; |
| 152 |
$MEMBERS_DB="'.$prefix.'_members"; |
| 153 |
'; |
| 154 |
|
| 155 |
# then append rest of text |
| 156 |
|
| 157 |
$common_inc.=<<'End_of_common;'; |
| 158 |
|
| 159 |
$conn = pg_connect("dbname=$PREFIX$db user=$DB_USER"); |
| 160 |
$result=pg_Exec($conn,"set datestyle = 'german'"); |
| 161 |
|
| 162 |
set_magic_quotes_runtime(1); |
| 163 |
|
| 164 |
// return number of true answers |
| 165 |
|
| 166 |
function fix_checkboxes($var,$nr) { |
| 167 |
for($i=1; $i<=$nr; $i++) { |
| 168 |
if (isset($GLOBALS[$var."_".$i])) { |
| 169 |
$GLOBALS[$var."_".$i]="true"; |
| 170 |
$nr++; |
| 171 |
} else { |
| 172 |
$GLOBALS[$var."_".$i]="false"; |
| 173 |
} |
| 174 |
} |
| 175 |
return $nr; |
| 176 |
|
| 177 |
} |
| 178 |
|
| 179 |
function checked($var) { |
| 180 |
if ($var == "true" || $var == "t") return 1; |
| 181 |
return 0; |
| 182 |
} |
| 183 |
|
| 184 |
function id_encode($id) { |
| 185 |
return md5($id).strtr($id,"1234567890","abcdef1234"); |
| 186 |
} |
| 187 |
|
| 188 |
function id_decode($eid) { |
| 189 |
$id=substr(strtr($eid,"abcdef1234","1234567890"),32); |
| 190 |
if (md5($id) == substr($eid,0,32)) { |
| 191 |
return $id; |
| 192 |
} else { |
| 193 |
return 0; |
| 194 |
} |
| 195 |
} |
| 196 |
|
| 197 |
function fix_sql($sql) { |
| 198 |
$sql=ereg_replace(",([ \t\n\r]*),",",null\\1,",$sql); |
| 199 |
$sql=ereg_replace(",([ \t\n\r]*),",",null\\1,",$sql); |
| 200 |
$sql=ereg_replace(",([ \t\n\r]*),",",null\\1,",$sql); |
| 201 |
$sql=ereg_replace("=([ \t\n\r,]+)","=null\\1",$sql); |
| 202 |
$sql=ereg_replace("=([ \t\n\r,]*)$","=null\\1",$sql); |
| 203 |
return $sql; |
| 204 |
} |
| 205 |
|
| 206 |
function get_answer($p) { |
| 207 |
global $conn,$id,$db; |
| 208 |
$result = pg_Exec ($conn,"select $p from $db where id=$id"); |
| 209 |
if ($result && pg_numrows($result) > 0) { |
| 210 |
$row=pg_fetch_row($result,0); |
| 211 |
if (isset($row[0]) && $row[0] != "") { |
| 212 |
$GLOBALS[$p]=$row[0]; |
| 213 |
return $row[0]; |
| 214 |
} |
| 215 |
} |
| 216 |
$GLOBALS[$p]=0; |
| 217 |
return 0; |
| 218 |
} |
| 219 |
|
| 220 |
function get_answers($p) { |
| 221 |
global $conn,$id,$db; |
| 222 |
$result = pg_Exec ($conn,"select $p from $db where id=$id"); |
| 223 |
if ($result && pg_numrows($result) > 0) { |
| 224 |
$row=pg_fetch_array($result,0); |
| 225 |
$pit=split(",",$p); |
| 226 |
while(list($key,$val) = each($row)) { |
| 227 |
$GLOBALS[$key]=$val; |
| 228 |
} |
| 229 |
} |
| 230 |
} |
| 231 |
function get_member($pitanja,$uvjet) { |
| 232 |
global $member_id; |
| 233 |
$p_conn = pg_connect("dbname=$MEMBERS_DB user=$DB_USER"); |
| 234 |
if ($uvjet == "") $uvjet="true"; |
| 235 |
$result=pg_Exec($p_conn,"select id,$pitanja from member |
| 236 |
where $uvjet and id = $member_id"); |
| 237 |
$numrows=pg_numrows($result); |
| 238 |
if ($numrows) { |
| 239 |
$row=pg_fetch_array($result,0); |
| 240 |
$pit=split(",",$pitanja); |
| 241 |
while(list($key,$val) = each($row)) { |
| 242 |
$GLOBALS["member_".$key]=$val; |
| 243 |
} |
| 244 |
} |
| 245 |
} |
| 246 |
|
| 247 |
if (isset($a) && !isset($id) && !isset($pid)) { |
| 248 |
global $conn,$db,$do_stranice; |
| 249 |
$pid=id_decode($a); |
| 250 |
$result = pg_Exec ($conn,"select id,do_stranice from $db where member_id=$pid"); |
| 251 |
if ($result && pg_numrows($result) > 0) { |
| 252 |
$row=pg_fetch_array($result,0); |
| 253 |
$id=$row[id]; |
| 254 |
$do_stranice=$row[do_stranice]; |
| 255 |
$do_uri="http://".$SERVER_NAME.":".$SERVER_PORT.$row[do_stranice]; |
| 256 |
} |
| 257 |
} |
| 258 |
|
| 259 |
End_of_common; |
| 260 |
|
| 261 |
#------------------------------------------------------------------ |
| 262 |
|
| 263 |
my $head_php.=<<'End_of_head;'; |
| 264 |
|
| 265 |
Header("Content-type: image/gif"); |
| 266 |
header ("Expires: Mon, 26 Jul 1997 05:00:00 GMT"); // Date in the past |
| 267 |
header ("Last-Modified: ".gmdate("D, d M Y H:i:s")." GMT"); // always modified |
| 268 |
header ("Cache-Control: no-cache, must-revalidate"); // HTTP/1.1 |
| 269 |
header ("Pragma: no-cache"); // HTTP/1.0 |
| 270 |
$string=implode($argv," "); |
| 271 |
$im = imagecreatefromgif("head.gif"); |
| 272 |
$red = ImageColorAllocate($im, 255, 0, 0); |
| 273 |
$black = ImageColorAllocate($im, 0, 0, 0); |
| 274 |
$px = (imagesx($im)-7.5*strlen($string))/2; |
| 275 |
if (! isset($pcnt)) { |
| 276 |
$pcnt=floor(substr(basename($HTTP_REFERER),0,2)/$max_page*100); |
| 277 |
} |
| 278 |
ImageTTFText($im, 6, 0, 10, 65, $black, dirname($PATH_TRANSLATED)."/head.ttf", "Ispunili ste ".sprintf("%02d",$pcnt)."% ankete"); |
| 279 |
$w=80; |
| 280 |
ImageRectangle($im,149,60,151+$w,66,$black); |
| 281 |
ImageFilledRectangle($im,150,61,150+floor($pcnt*$w/100),65,$red); |
| 282 |
ImageGif($im); |
| 283 |
ImageDestroy($im); |
| 284 |
|
| 285 |
End_of_head; |
| 286 |
|
| 287 |
#------------------------------------------------------------------ |
| 288 |
|
| 289 |
my $html_kraj=<<'End_of_kraj;'; |
| 290 |
<html> |
| 291 |
<head> |
| 292 |
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-2"> |
| 293 |
<title>wopi.poll</title><link rel="STYLESHEET" type="text/css" href="../stil.css"> |
| 294 |
</head> |
| 295 |
|
| 296 |
<body background="../beki.gif" bgcolor="White" leftmargin=0 topmargin=0 marginwidth="0" marginheight="0"> |
| 297 |
|
| 298 |
<table width="460" cellspacing="0" cellpadding="0" border="0"> |
| 299 |
<tr> |
| 300 |
<td colspan="2"><img src="head.php?pcnt=100" width=460 height=72 alt="" border="0"><br><br></td> |
| 301 |
</tr> |
| 302 |
<tr> |
| 303 |
<td><img src="../klir.gif" width=20 height=1 alt="" border="0"><br> |
| 304 |
</td> |
| 305 |
<td><img src="../klir.gif" width=332 height=1 alt="" border="0"><br> </td> |
| 306 |
</tr> |
| 307 |
<td><img src="../klir.gif" width=20 height=1 alt="" border="0"><br> |
| 308 |
</td> |
| 309 |
<td><img src="../klir.gif" width=332 height=1 alt="" border="0"><br> </td> |
| 310 |
</tr> |
| 311 |
<tr> |
| 312 |
<td> </td> |
| 313 |
<td><br> |
| 314 |
<p><b> |
| 315 |
Hvala vam na sudjelovanju u anketi! |
| 316 |
</b></p> |
| 317 |
<br><br> |
| 318 |
Zahvaljujemo se na va¹em vremenu. Nadamo se da æete i vi biti |
| 319 |
meðu sretnim dobitnicima. |
| 320 |
<br> |
| 321 |
<br> |
| 322 |
Do slijedeæe ankete i nagradne igre srdaèno vas pozdravljamo. |
| 323 |
<br> |
| 324 |
<br>Hvala. |
| 325 |
<br> |
| 326 |
<br> |
| 327 |
<a href="http://www.proof.hr"><tt>proof.</tt></a> |
| 328 |
</td> |
| 329 |
</tr> |
| 330 |
<tr> |
| 331 |
<td></td> |
| 332 |
<td bgcolor="#006699"><img src="../klir.gif" width=1 height=1 alt="" border="0"><br></td> |
| 333 |
</tr> |
| 334 |
<tr> |
| 335 |
<td align="right" valign="top"></td> |
| 336 |
<td> </td> |
| 337 |
<td align="right"><br> |
| 338 |
<br> |
| 339 |
</td> |
| 340 |
</tr> |
| 341 |
</table> |
| 342 |
|
| 343 |
</body> |
| 344 |
</html> |
| 345 |
End_of_kraj; |
| 346 |
|
| 347 |
#------------------------------------------------------------------ |
| 348 |
|
| 349 |
while (defined($ARGV[0]) and $ARGV[0] =~ /^-/) { |
| 350 |
my $opt = shift; |
| 351 |
|
| 352 |
if ($opt eq '-h') { |
| 353 |
print $Usage; |
| 354 |
exit; |
| 355 |
} |
| 356 |
elsif ($opt eq '-d') { |
| 357 |
$dir = shift; |
| 358 |
} |
| 359 |
elsif ($opt eq '-w') { |
| 360 |
$dowarn = 1; |
| 361 |
} |
| 362 |
elsif ($opt eq '-mode') { |
| 363 |
my $marg = shift; |
| 364 |
if ($marg eq 'html') { |
| 365 |
$dostyle = 0; |
| 366 |
} |
| 367 |
else { |
| 368 |
die "Unrecognized mode: $marg\n$Usage"; |
| 369 |
} |
| 370 |
} |
| 371 |
else { |
| 372 |
die "Unrecognized option: $opt\n$Usage"; |
| 373 |
} |
| 374 |
} # End of option processing |
| 375 |
|
| 376 |
my $docfile = shift; |
| 377 |
|
| 378 |
die "No docfile provided:\n$Usage" unless defined $docfile; |
| 379 |
|
| 380 |
die "Can't read $docfile" unless -r $docfile; |
| 381 |
|
| 382 |
if (defined $dir) { |
| 383 |
die "$dir isn't a directory" unless -d $dir; |
| 384 |
} |
| 385 |
else { |
| 386 |
$docfile =~ m!([^/.]+)(?:\.[^/.]*)?$!; |
| 387 |
$dir = $1; |
| 388 |
if (-e $dir) { |
| 389 |
die "$dir exists but isn't a directory" |
| 390 |
unless -d $dir; |
| 391 |
} |
| 392 |
else { |
| 393 |
mkdir $dir, 0755; |
| 394 |
} |
| 395 |
} |
| 396 |
|
| 397 |
my $in_slideshow = 0; |
| 398 |
my $after_head = 0; |
| 399 |
|
| 400 |
my $Mode = 0; |
| 401 |
my $Mode_level = 0; |
| 402 |
|
| 403 |
my $Text; |
| 404 |
my $Markedup_Text; |
| 405 |
my $Object; |
| 406 |
my @Ostack = (); |
| 407 |
|
| 408 |
my $intext = 0; |
| 409 |
my $closure; |
| 410 |
my @closure_stack = (); |
| 411 |
|
| 412 |
my $style_link = ''; |
| 413 |
|
| 414 |
my $index = 'index.html'; |
| 415 |
my @slidetitle; |
| 416 |
my $body; |
| 417 |
my $inlist = 0; |
| 418 |
|
| 419 |
my @Titles; |
| 420 |
|
| 421 |
my $header; |
| 422 |
|
| 423 |
my $prolog = "<html><head>\n"; |
| 424 |
$prolog .= "<!-- Generated by $0 on " . gmtime() . " GMT -->\n"; |
| 425 |
|
| 426 |
my $page_number = 0; |
| 427 |
|
| 428 |
my $p = new XML::Parser(ErrorContext => 3, |
| 429 |
Handlers => {Start => \&starthndl, |
| 430 |
End => \&endhndl, |
| 431 |
Char => \&text}); |
| 432 |
$p->parsefile($docfile); |
| 433 |
|
| 434 |
#---------------------------------------------------------- |
| 435 |
|
| 436 |
# dump last php page.... |
| 437 |
|
| 438 |
print "p[$page_nr] "; |
| 439 |
|
| 440 |
open(PAGE, ">$dir/$last_fn") or die "Couldn't open $last_fn for writing:\n$!"; |
| 441 |
print PAGE php_header($page_nr,@prelast_sql_update); |
| 442 |
my $next_fn=sprintf("%02d.php",$page_nr); |
| 443 |
$last_page=~s/##NEXTPAGE##/$next_fn/; |
| 444 |
print PAGE $last_page; |
| 445 |
close(PAGE); |
| 446 |
|
| 447 |
$page_nr++; |
| 448 |
open(PAGE, ">$dir/$next_fn") or die "Couldn't open $next_fn for writing:\n$!"; |
| 449 |
print PAGE php_header($page_nr,@last_sql_update); |
| 450 |
print PAGE $html_kraj; |
| 451 |
close(PAGE); |
| 452 |
|
| 453 |
# dump sql structure |
| 454 |
|
| 455 |
open(SQL,">$dir/$dir.sql") || die "$dir.sql: $!"; |
| 456 |
print SQL "create table poslani ( member_id int4 not null, unesen timestamp default now() );\n"; |
| 457 |
print SQL "create table $dir (do_stranice text default null, ",join(",\n",@sql_create),");\n"; |
| 458 |
close(SQL); |
| 459 |
|
| 460 |
# dump common.inc |
| 461 |
|
| 462 |
open(PHP,">$dir/common.inc") || die "common.inc: $!"; |
| 463 |
print PHP '<? $db="'.$dir.'";'; |
| 464 |
print PHP $common_inc; |
| 465 |
print PHP '?>'; |
| 466 |
close(PHP); |
| 467 |
|
| 468 |
open(PHP,">$dir/head.php") || die "head.php: $!"; |
| 469 |
print PHP '<? $max_page="'.($page_nr+1).'";'; |
| 470 |
print PHP $head_php; |
| 471 |
print PHP '?>'; |
| 472 |
close(PHP); |
| 473 |
|
| 474 |
################ |
| 475 |
## End of main |
| 476 |
################ |
| 477 |
|
| 478 |
# return unique name of pitanje |
| 479 |
sub new_pit { |
| 480 |
my $out="p".$pitanje_nr.$p_suffix; |
| 481 |
$curr_suffix=$p_suffix; |
| 482 |
$p_suffix++; |
| 483 |
return $out; |
| 484 |
} |
| 485 |
|
| 486 |
# current pitanje |
| 487 |
sub curr_pit { |
| 488 |
return "p".$pitanje_nr.$curr_suffix; |
| 489 |
} |
| 490 |
|
| 491 |
sub starthndl { |
| 492 |
my ($xp, $el, %atts) = @_; |
| 493 |
|
| 494 |
# return unless ($in_slideshow or $el eq 'slideshow'); |
| 495 |
|
| 496 |
unless ($in_slideshow) { |
| 497 |
$in_slideshow = $xp->depth + 1; |
| 498 |
return; |
| 499 |
} |
| 500 |
|
| 501 |
if ($Mode) { |
| 502 |
|
| 503 |
if ($Mode eq 'pass') { |
| 504 |
$Markedup_Text .= "\n" . $xp->recognized_string; |
| 505 |
} |
| 506 |
elsif ($Mode eq 'object') { |
| 507 |
push(@Ostack, $Object); |
| 508 |
|
| 509 |
$Object = {_Atts => \%atts, |
| 510 |
_Text => '' |
| 511 |
}; |
| 512 |
bless $Object, "Slideobj::$el"; |
| 513 |
} |
| 514 |
|
| 515 |
# skip does nothing |
| 516 |
return; |
| 517 |
} |
| 518 |
|
| 519 |
unless ($after_head) { |
| 520 |
if ($el eq 'head') { |
| 521 |
$after_head = 1; |
| 522 |
start_mode($xp, 'object'); |
| 523 |
|
| 524 |
push(@closure_stack, $closure); |
| 525 |
$closure = |
| 526 |
sub { |
| 527 |
my ($xp, $text) = @_; |
| 528 |
|
| 529 |
unless (defined $text) { |
| 530 |
|
| 531 |
$header = $Object; |
| 532 |
} |
| 533 |
}; |
| 534 |
|
| 535 |
return; |
| 536 |
} |
| 537 |
|
| 538 |
# die "The head element must be the first thing in the slideshow"; |
| 539 |
} |
| 540 |
|
| 541 |
|
| 542 |
my $new_closure; |
| 543 |
|
| 544 |
my $subname = "Slideshow::$el"; |
| 545 |
|
| 546 |
if (defined &$subname) { |
| 547 |
no strict 'refs'; |
| 548 |
|
| 549 |
&$subname($xp, $el, \%atts, \$new_closure); |
| 550 |
} |
| 551 |
else { |
| 552 |
$body .= $xp->recognized_string; |
| 553 |
$new_closure = |
| 554 |
sub { |
| 555 |
my ($xp, $text) = @_; |
| 556 |
|
| 557 |
if (defined $text) { |
| 558 |
$body .= $text; |
| 559 |
} |
| 560 |
else { |
| 561 |
$body .= "</$el>"; |
| 562 |
} |
| 563 |
}; |
| 564 |
} |
| 565 |
|
| 566 |
push(@closure_stack, $closure); |
| 567 |
$closure = $new_closure; |
| 568 |
} # End starthndl |
| 569 |
|
| 570 |
sub endhndl { |
| 571 |
my ($xp, $el) = @_; |
| 572 |
|
| 573 |
return unless $in_slideshow; |
| 574 |
|
| 575 |
my $lev = $xp->depth; |
| 576 |
|
| 577 |
if ($lev == $in_slideshow - 1) { |
| 578 |
$in_slideshow = 0; |
| 579 |
$xp->finish; |
| 580 |
return; |
| 581 |
} |
| 582 |
|
| 583 |
if ($Mode_level == $lev) { |
| 584 |
|
| 585 |
if ($Mode eq 'pass') { |
| 586 |
&$closure($xp, $Markedup_Text) |
| 587 |
if (defined $closure); |
| 588 |
} |
| 589 |
|
| 590 |
$Mode = $Mode_level = 0; |
| 591 |
} |
| 592 |
|
| 593 |
if ($Mode) { |
| 594 |
if ($Mode eq 'pass') { |
| 595 |
$Markedup_Text .= "</$el>"; |
| 596 |
} |
| 597 |
elsif ($Mode eq 'object') { |
| 598 |
my $this = $Object; |
| 599 |
if (2 == keys %$this) { |
| 600 |
$this = $this->{_Text}; |
| 601 |
} |
| 602 |
|
| 603 |
$Object = pop(@Ostack); |
| 604 |
|
| 605 |
my $slot = $Object->{$el}; |
| 606 |
if (defined $slot) { |
| 607 |
if (ref($slot) eq 'ARRAY') { |
| 608 |
push(@$slot, $this); |
| 609 |
} |
| 610 |
else { |
| 611 |
$Object->{$el} = [$slot, $this]; |
| 612 |
} |
| 613 |
} |
| 614 |
else { |
| 615 |
$Object->{$el} = $this; |
| 616 |
} |
| 617 |
} |
| 618 |
|
| 619 |
return; |
| 620 |
} |
| 621 |
|
| 622 |
&$closure($xp) |
| 623 |
if defined $closure; |
| 624 |
|
| 625 |
$closure = pop(@closure_stack); |
| 626 |
} # End endhndl |
| 627 |
|
| 628 |
sub text { |
| 629 |
my ($xp, $data) = @_; |
| 630 |
|
| 631 |
return unless $in_slideshow; |
| 632 |
|
| 633 |
if ($Mode ) { |
| 634 |
|
| 635 |
if ($Mode eq 'pass') { |
| 636 |
my $safe = sgml_escape($data); |
| 637 |
|
| 638 |
$Text .= $safe; |
| 639 |
$Markedup_Text .= $safe; |
| 640 |
} |
| 641 |
elsif ($Mode eq 'object') { |
| 642 |
$Object->{_Text} .= $data |
| 643 |
if $data =~ /\S/; |
| 644 |
} |
| 645 |
|
| 646 |
return; |
| 647 |
} |
| 648 |
|
| 649 |
&$closure($xp, sgml_escape($data)) |
| 650 |
if (defined $closure); |
| 651 |
|
| 652 |
} # End text |
| 653 |
|
| 654 |
sub start_mode { |
| 655 |
my ($xp, $mode) = @_; |
| 656 |
|
| 657 |
if ($mode eq 'pass') { |
| 658 |
$Text = ''; |
| 659 |
$Markedup_Text = ''; |
| 660 |
} |
| 661 |
elsif ($mode eq 'object') { |
| 662 |
$Object = {_Atts => undef, |
| 663 |
_Text => undef |
| 664 |
}; |
| 665 |
} |
| 666 |
|
| 667 |
$Mode = $mode; |
| 668 |
$Mode_level = $xp->depth; |
| 669 |
} # End start_mode |
| 670 |
|
| 671 |
sub sgml_escape { |
| 672 |
my ($str) = @_; |
| 673 |
|
| 674 |
$str =~ s/\&/\&/g; |
| 675 |
$str =~ s/</\</g; |
| 676 |
$str =~ s/>/\>/g; |
| 677 |
|
| 678 |
$str; |
| 679 |
} # End sgml_escape |
| 680 |
|
| 681 |
sub slidename { |
| 682 |
my ($num) = @_; |
| 683 |
|
| 684 |
sprintf("slide%03d.html", $num); |
| 685 |
} # End slidename |
| 686 |
|
| 687 |
################################################################ |
| 688 |
|
| 689 |
package Slideshow; |
| 690 |
|
| 691 |
sub page { |
| 692 |
package main; |
| 693 |
|
| 694 |
my ($xp, $el, $attref, $ncref) = @_; |
| 695 |
|
| 696 |
$$ncref = sub { |
| 697 |
my ($xp, $text) = @_; |
| 698 |
|
| 699 |
if (! defined $text) { |
| 700 |
|
| 701 |
print "p[$page_nr] "; |
| 702 |
|
| 703 |
if (defined $last_fn) { |
| 704 |
# 01.php -> index.php |
| 705 |
$last_fn="index.php" if ($last_fn eq "01.php"); |
| 706 |
open(PAGE, ">$dir/$last_fn") or die "Couldn't open $last_fn for writing:\n$!"; |
| 707 |
if ($page_nr == 2) { |
| 708 |
print PAGE '<? |
| 709 |
include("common.inc"); |
| 710 |
if (isset($do_stranice) && $do_stranice !="") { |
| 711 |
Header("Location: $do_uri?a=$a"); |
| 712 |
exit; |
| 713 |
} |
| 714 |
$member_id=id_decode($a); |
| 715 |
$sql="insert into '.$dir.' ( http_referer,remote_addr,user_agent, member_id ) values (\'$HTTP_REFERER\',\'$REMOTE_ADDR\',\'$HTTP_USER_AGENT\',$member_id)"; |
| 716 |
|
| 717 |
# print "<pre>$sql</pre>"; |
| 718 |
$result=pg_Exec($conn,fix_sql($sql)); |
| 719 |
$lastoid=pg_getlastoid($result); |
| 720 |
$result = pg_Exec($conn,fix_sql("select id from '.$dir.' where oid=$lastoid")); |
| 721 |
$row=pg_fetch_row($result,0); |
| 722 |
$id=$row[0]; |
| 723 |
?>'; |
| 724 |
|
| 725 |
} else { |
| 726 |
print PAGE php_header($page_nr,@prelast_sql_update); |
| 727 |
} # last_sql_update |
| 728 |
|
| 729 |
|
| 730 |
my $next_fn=sprintf("%02d.php",$page_nr); |
| 731 |
$last_page=~s/##NEXTPAGE##/$next_fn/; |
| 732 |
print PAGE $last_page; |
| 733 |
close(PAGE); |
| 734 |
|
| 735 |
} |
| 736 |
@prelast_sql_update=@last_sql_update; |
| 737 |
@last_sql_update=@sql_update; |
| 738 |
@sql_update = (); |
| 739 |
|
| 740 |
$last_fn=sprintf("%02d.php",$page_nr); |
| 741 |
$last_page="$html_header $body $html_footer"; |
| 742 |
# delete vars for next page |
| 743 |
$page_nr++; |
| 744 |
$body=""; |
| 745 |
} |
| 746 |
} |
| 747 |
} # page |
| 748 |
|
| 749 |
sub nr { |
| 750 |
package main; |
| 751 |
|
| 752 |
my ($xp, $el, $attref, $ncref) = @_; |
| 753 |
|
| 754 |
$pitanje_tag=""; |
| 755 |
|
| 756 |
$$ncref = sub { |
| 757 |
my ($xp, $text) = @_; |
| 758 |
if (defined($text)) { |
| 759 |
$body.=$text; |
| 760 |
chomp $text; |
| 761 |
$pitanje_tag .= $text; |
| 762 |
} else { |
| 763 |
$pitanje_nr = $pitanje_tag; |
| 764 |
$pitanje_nr =~ s/[^0-9a-zA-Z]//g; |
| 765 |
print "$pitanje_nr "; |
| 766 |
} |
| 767 |
$p_suffix=""; |
| 768 |
}; |
| 769 |
} # nr |
| 770 |
|
| 771 |
|
| 772 |
sub hr { |
| 773 |
$body .= "<br></td></tr>$html_separator<tr><td></td><td><br>"; |
| 774 |
} |
| 775 |
|
| 776 |
sub br { |
| 777 |
$body .= "<br>\n"; |
| 778 |
} |
| 779 |
|
| 780 |
sub pit { |
| 781 |
package main; |
| 782 |
|
| 783 |
my ($xp, $el, $attref, $ncref) = @_; |
| 784 |
|
| 785 |
$body.="<p>"; |
| 786 |
|
| 787 |
$$ncref = sub { |
| 788 |
my ($xp, $text) = @_; |
| 789 |
|
| 790 |
if (defined $text) { |
| 791 |
$body.=$text; |
| 792 |
} else { |
| 793 |
$body.="</p>"; |
| 794 |
} |
| 795 |
} |
| 796 |
} |
| 797 |
|
| 798 |
sub podpit { |
| 799 |
package main; |
| 800 |
|
| 801 |
my ($xp, $el, $attref, $ncref) = @_; |
| 802 |
|
| 803 |
$body.='<table width="100%" cellspacing="0" cellpadding="2" border="0">'; |
| 804 |
$$ncref = sub { |
| 805 |
my ($xp, $text) = @_; |
| 806 |
|
| 807 |
if (defined $text) { |
| 808 |
$body.=$text; |
| 809 |
} else { |
| 810 |
$body.="</table>"; |
| 811 |
} |
| 812 |
} |
| 813 |
} |
| 814 |
|
| 815 |
|
| 816 |
sub odg { |
| 817 |
package main; |
| 818 |
|
| 819 |
my ($xp, $el, $attref, $ncref) = @_; |
| 820 |
|
| 821 |
$body .= "<p>"; |
| 822 |
|
| 823 |
$$ncref = sub { |
| 824 |
my ($xp, $text) = @_; |
| 825 |
|
| 826 |
if (defined $text) { |
| 827 |
$body .= $text; |
| 828 |
} else { |
| 829 |
$body .= "</p>"; |
| 830 |
} |
| 831 |
} |
| 832 |
} |
| 833 |
|
| 834 |
sub php { |
| 835 |
package main; |
| 836 |
my ($xp, $el, $attref, $ncref) = @_; |
| 837 |
|
| 838 |
$body.="<?php\n"; |
| 839 |
|
| 840 |
$$ncref = sub { |
| 841 |
my ($xp, $text) = @_; |
| 842 |
|
| 843 |
if (defined $text) { |
| 844 |
$text=~s/ lt / < /g; |
| 845 |
$text=~s/ le / <= /g; |
| 846 |
$text=~s/ gt / > /g; |
| 847 |
$text=~s/ ge / >= /g; |
| 848 |
$body.=$text; |
| 849 |
} else { |
| 850 |
$body.="\n?>\n"; |
| 851 |
} |
| 852 |
} |
| 853 |
} |
| 854 |
|
| 855 |
sub dropdown { |
| 856 |
package main; |
| 857 |
|
| 858 |
my ($xp, $el, $attref, $ncref) = @_; |
| 859 |
|
| 860 |
my @dropdown_data; |
| 861 |
|
| 862 |
$$ncref = sub { |
| 863 |
my ($xp, $text) = @_; |
| 864 |
|
| 865 |
if (defined $text) { |
| 866 |
chomp $text; |
| 867 |
$text=~s/^\s*//g; |
| 868 |
$text=~s/^[\d\.\s]+//g; |
| 869 |
$text=~s/\s*$//g; |
| 870 |
push @dropdown_data,$text if ($text ne ""); |
| 871 |
} else { |
| 872 |
my $opt; |
| 873 |
my $id=1; |
| 874 |
my $p=new_pit(); |
| 875 |
$body.="<select name=$p >\n"; |
| 876 |
$body.="<option value=null>-</option>\n"; |
| 877 |
foreach $opt (@dropdown_data) { |
| 878 |
if (defined($opt) && $opt ne "") { |
| 879 |
$body.="<option value=$id>$opt</option>\n"; |
| 880 |
$id++; |
| 881 |
} |
| 882 |
} |
| 883 |
$body.="</select>\n"; |
| 884 |
|
| 885 |
push @sql_create,"$p int4"; |
| 886 |
push @sql_update,"$p=\$$p"; |
| 887 |
} |
| 888 |
} |
| 889 |
} |
| 890 |
|
| 891 |
sub textbox { |
| 892 |
package main; |
| 893 |
my ($xp, $el, $attref, $ncref) = @_; |
| 894 |
|
| 895 |
$$ncref = sub { |
| 896 |
my ($xp, $text) = @_; |
| 897 |
my $size=$attref->{size}; |
| 898 |
$size = 25 if (! defined $size || $size == 0); # default |
| 899 |
my $p=new_pit(); |
| 900 |
$body.="<input type=text name=$p size=$size >\n"; |
| 901 |
push @sql_create,"$p text"; |
| 902 |
push @sql_update,"$p='\$$p'"; |
| 903 |
} |
| 904 |
} |
| 905 |
|
| 906 |
sub radiobuttons_tab { |
| 907 |
package main; |
| 908 |
my ($xp, $el, $attref, $ncref) = @_; |
| 909 |
|
| 910 |
$$ncref = sub { |
| 911 |
my ($xp, $text) = @_; |
| 912 |
if (! defined $text) { |
| 913 |
my $nr=$attref->{nr}; |
| 914 |
my $p=new_pit(); |
| 915 |
for (my $i=1; $i<=$nr; $i++) { |
| 916 |
$body.="<td><input type=radio name=$p value=$i></td> "; |
| 917 |
} |
| 918 |
push @sql_create,"$p int4"; |
| 919 |
push @sql_update,"$p=\$$p"; |
| 920 |
} |
| 921 |
} |
| 922 |
} |
| 923 |
|
| 924 |
sub radiobuttons { |
| 925 |
package main; |
| 926 |
my ($xp, $el, $attref, $ncref) = @_; |
| 927 |
|
| 928 |
my @radiobuttons_data; |
| 929 |
|
| 930 |
$$ncref = sub { |
| 931 |
my ($xp, $text) = @_; |
| 932 |
|
| 933 |
if (defined $text) { |
| 934 |
chomp $text; |
| 935 |
$text=~s/^\s*//g; |
| 936 |
$text=~s/^[\d\.\s]+//g; |
| 937 |
$text=~s/\s*$//g; |
| 938 |
push @radiobuttons_data,$text if ($text ne ""); |
| 939 |
} else { |
| 940 |
my $opt; |
| 941 |
my $p=new_pit(); |
| 942 |
my $id=1; |
| 943 |
foreach $opt (@radiobuttons_data) { |
| 944 |
if (defined($opt) && $opt ne "") { |
| 945 |
$body.="<input type=radio name=$p value=$id> $opt<br>\n"; |
| 946 |
$id++; |
| 947 |
} |
| 948 |
} |
| 949 |
push @sql_create,"$p int4"; |
| 950 |
push @sql_update,"$p=\$$p"; |
| 951 |
} |
| 952 |
} |
| 953 |
} |
| 954 |
sub checkbox { |
| 955 |
package main; |
| 956 |
my ($xp, $el, $attref, $ncref) = @_; |
| 957 |
|
| 958 |
$$ncref = sub { |
| 959 |
my ($xp, $text) = @_; |
| 960 |
my $p=new_pit(); |
| 961 |
$body.="<input type=checkbox name=$p >\n"; |
| 962 |
push @sql_create,"$p text"; |
| 963 |
push @sql_update,"$p='\$$p'"; |
| 964 |
} |
| 965 |
} |
| 966 |
|
| 967 |
sub checkboxes { |
| 968 |
package main; |
| 969 |
|
| 970 |
my ($xp, $el, $attref, $ncref) = @_; |
| 971 |
|
| 972 |
my @checkboxes_data; |
| 973 |
|
| 974 |
$$ncref = sub { |
| 975 |
my ($xp, $text) = @_; |
| 976 |
|
| 977 |
|
| 978 |
if (defined $text) { |
| 979 |
chomp $text; |
| 980 |
$text=~s/^\s*//g; |
| 981 |
$text=~s/^[\d\.\s]+//g; |
| 982 |
$text=~s/\s*$//g; |
| 983 |
push @checkboxes_data,$text if ($text ne ""); |
| 984 |
} else { |
| 985 |
my $opt; |
| 986 |
my $base_p=new_pit(); |
| 987 |
my $id=1; |
| 988 |
|
| 989 |
my $before=$attref->{before}; |
| 990 |
my $after=$attref->{after}; |
| 991 |
my $middle=$attref->{middle}; |
| 992 |
if (! $before && ! $after && ! $middle) { |
| 993 |
$middle=" "; |
| 994 |
$after="<br>"; |
| 995 |
} |
| 996 |
my $hide_description=$attref->{hide_description}; |
| 997 |
|
| 998 |
foreach $opt (@checkboxes_data) { |
| 999 |
if (defined($opt) && $opt ne "") { |
| 1000 |
$p=$base_p."_".$id; |
| 1001 |
$id++; |
| 1002 |
$body .= $before if ($before); |
| 1003 |
$body.="<input type=checkbox name=$p>"; |
| 1004 |
$body .= $middle if ($middle); |
| 1005 |
$body .= "$opt" if (! $hide_description); |
| 1006 |
$body .= $after if ($after); |
| 1007 |
$body.="\n"; |
| 1008 |
|
| 1009 |
push @sql_create,"$p boolean"; |
| 1010 |
push @sql_update,"$p=\$$p"; |
| 1011 |
} |
| 1012 |
} |
| 1013 |
$php_addon[$page_nr].="fix_checkboxes($base_p,".($id-1).");"; |
| 1014 |
|
| 1015 |
} |
| 1016 |
} |
| 1017 |
} |
| 1018 |
|
| 1019 |
#--------------------------------------------------------------- |
| 1020 |
|
| 1021 |
sub slide { |
| 1022 |
package main; |
| 1023 |
|
| 1024 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1025 |
|
| 1026 |
my $prev = $page_number ? slidename($page_number) : $index; |
| 1027 |
$page_number++; |
| 1028 |
my $fn = slidename($page_number); |
| 1029 |
my $next = slidename($page_number + 1); |
| 1030 |
|
| 1031 |
open(SLIDE, ">$dir/$fn") or die "Couldn't open $fn for writing:\n$!"; |
| 1032 |
|
| 1033 |
print SLIDE $prolog; |
| 1034 |
|
| 1035 |
undef @slidetitle; |
| 1036 |
$body = ''; |
| 1037 |
$inlist = 0; |
| 1038 |
|
| 1039 |
$$ncref = |
| 1040 |
sub { |
| 1041 |
my ($xp, $text) = @_; |
| 1042 |
|
| 1043 |
if (defined $text) { |
| 1044 |
#ignore text at slide toplevel |
| 1045 |
} |
| 1046 |
else { |
| 1047 |
$Titles[$page_number] = $slidetitle[0]; |
| 1048 |
|
| 1049 |
print SLIDE "<title>$slidetitle[0]</title>\n"; |
| 1050 |
print SLIDE $style_link; |
| 1051 |
print SLIDE "</head>\n"; |
| 1052 |
|
| 1053 |
if ($dostyle) { |
| 1054 |
print SLIDE "<body>\n"; |
| 1055 |
} |
| 1056 |
else { |
| 1057 |
print SLIDE "<body background=\"back.gif\">\n"; |
| 1058 |
} |
| 1059 |
|
| 1060 |
my $navbar = "<table class=\"navbar\" width=\"100%\"><tr>\n"; |
| 1061 |
$navbar .= "<td align=\"left\"><a href=\"$prev\">Previous</td>\n"; |
| 1062 |
$navbar .= "<td align=\"left\"><a href=\"$index\">Index</td>\n"; |
| 1063 |
$navbar .= "<td align=\"right\"><a href=\"$next\">Next</td>\n"; |
| 1064 |
$navbar .= "</table>\n"; |
| 1065 |
|
| 1066 |
print SLIDE "$navbar<hr>\n"; |
| 1067 |
if ($dostyle) { |
| 1068 |
print SLIDE "<img class=\"logo\" src=\"logo.gif\">\n"; |
| 1069 |
print SLIDE "<h1 class=\"title\">$slidetitle[1]</h1>\n"; |
| 1070 |
} |
| 1071 |
else { |
| 1072 |
print SLIDE "<table width=\"100%\"><tr><td>\n"; |
| 1073 |
print SLIDE "<img src=\"logo.gif\">\n"; |
| 1074 |
print SLIDE "<td align=\"left\">"; |
| 1075 |
print SLIDE "<h1>"; |
| 1076 |
print SLIDE "<font size=\"7\" color=\"maroon\">$slidetitle[1]"; |
| 1077 |
print SLIDE "</font></h1>\n"; |
| 1078 |
print SLIDE "<tr><td colspan=\"2\">\n"; |
| 1079 |
print SLIDE "<table width=\"80%\"><tr><td>\n"; |
| 1080 |
print SLIDE "<font size=\"+2\">\n"; |
| 1081 |
} |
| 1082 |
print SLIDE $body; |
| 1083 |
|
| 1084 |
if ($inlist) { |
| 1085 |
print SLIDE "\n</$inlist>\n"; |
| 1086 |
} |
| 1087 |
|
| 1088 |
unless ($dostyle) { |
| 1089 |
print SLIDE "\n</font>\n"; |
| 1090 |
print SLIDE "\n</table></table>\n"; |
| 1091 |
} |
| 1092 |
|
| 1093 |
print SLIDE "\n<hr>\n$navbar"; |
| 1094 |
print SLIDE "</body>\n</html>\n"; |
| 1095 |
close(SLIDE); |
| 1096 |
} |
| 1097 |
}; |
| 1098 |
} # End slide |
| 1099 |
|
| 1100 |
sub title { |
| 1101 |
package main; |
| 1102 |
|
| 1103 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1104 |
|
| 1105 |
if ($xp->current_element eq 'slide') { |
| 1106 |
start_mode($xp, 'pass'); |
| 1107 |
|
| 1108 |
$$ncref = |
| 1109 |
sub { |
| 1110 |
$slidetitle[0] = $Text; |
| 1111 |
$slidetitle[1] = $Markedup_Text; |
| 1112 |
}; |
| 1113 |
} |
| 1114 |
} # End title |
| 1115 |
|
| 1116 |
sub point { |
| 1117 |
package main; |
| 1118 |
|
| 1119 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1120 |
|
| 1121 |
if ($inlist and $inlist ne 'ul') { |
| 1122 |
$body .= "\n</$inlist>\n"; |
| 1123 |
$inlist = 0; |
| 1124 |
} |
| 1125 |
|
| 1126 |
unless ($inlist) { |
| 1127 |
$body .= "\n<ul>\n"; |
| 1128 |
} |
| 1129 |
|
| 1130 |
$inlist = 0; |
| 1131 |
|
| 1132 |
if ($dostyle) { |
| 1133 |
$body .= "\n<li><div class=\"point\">"; |
| 1134 |
} |
| 1135 |
else { |
| 1136 |
$body .= "\n<li>"; |
| 1137 |
} |
| 1138 |
|
| 1139 |
$$ncref = |
| 1140 |
sub { |
| 1141 |
my ($xp, $text) = @_; |
| 1142 |
|
| 1143 |
if (defined $text) { |
| 1144 |
$text =~ s/\s+/ /g; |
| 1145 |
$body .= $text; |
| 1146 |
} |
| 1147 |
else { |
| 1148 |
if ($dostyle) { |
| 1149 |
$body .= "</div></li>"; |
| 1150 |
} |
| 1151 |
$body .= "\n</$inlist>\n" |
| 1152 |
if $inlist; |
| 1153 |
$inlist = 'ul'; |
| 1154 |
} |
| 1155 |
}; |
| 1156 |
|
| 1157 |
} # End point |
| 1158 |
|
| 1159 |
sub item { |
| 1160 |
package main; |
| 1161 |
|
| 1162 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1163 |
|
| 1164 |
if ($inlist and $inlist ne 'ul') { |
| 1165 |
$body .= "\n</$inlist>\n"; |
| 1166 |
$inlist = 0; |
| 1167 |
} |
| 1168 |
|
| 1169 |
unless ($inlist) { |
| 1170 |
$body .= "\n<ul>\n"; |
| 1171 |
} |
| 1172 |
|
| 1173 |
$inlist = 0; |
| 1174 |
|
| 1175 |
if ($dostyle) { |
| 1176 |
$body .= "\n<li><div class=\"item\">"; |
| 1177 |
} |
| 1178 |
else { |
| 1179 |
$body .= "\n<li><font face=\"monospace\">"; |
| 1180 |
} |
| 1181 |
|
| 1182 |
$$ncref = |
| 1183 |
sub { |
| 1184 |
my ($xp, $text) = @_; |
| 1185 |
|
| 1186 |
if (defined $text) { |
| 1187 |
$text =~ s/\s+/ /g; |
| 1188 |
$body .= $text; |
| 1189 |
} |
| 1190 |
else { |
| 1191 |
if ($dostyle) { |
| 1192 |
$body .= "</div></li>"; |
| 1193 |
} |
| 1194 |
else { |
| 1195 |
$body .= "</font>"; |
| 1196 |
} |
| 1197 |
$body .= "\n</$inlist>\n" |
| 1198 |
if $inlist; |
| 1199 |
$inlist = 'ul'; |
| 1200 |
} |
| 1201 |
}; |
| 1202 |
} # End item |
| 1203 |
|
| 1204 |
sub def { |
| 1205 |
package main; |
| 1206 |
|
| 1207 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1208 |
|
| 1209 |
if ($inlist and $inlist ne 'dl') { |
| 1210 |
$body .= "\n</$inlist>\n"; |
| 1211 |
$inlist = 0; |
| 1212 |
} |
| 1213 |
|
| 1214 |
unless ($inlist) { |
| 1215 |
$body .= "\n<dl>\n"; |
| 1216 |
} |
| 1217 |
|
| 1218 |
$inlist = 0; |
| 1219 |
|
| 1220 |
if ($dostyle) { |
| 1221 |
$body .= "<dt><span class=\"defterm\">"; |
| 1222 |
$body .= $attref->{term} ."</span></dt>\n"; |
| 1223 |
$body .= "<dd><div class=\"def\">\n"; |
| 1224 |
} |
| 1225 |
else { |
| 1226 |
$body .= "<dt><font face=\"monospace\" color=\"maroon\" style=\"bold\">"; |
| 1227 |
$body .= $attref->{term} . "</font></dt>\n"; |
| 1228 |
$body .= "<dd>"; |
| 1229 |
} |
| 1230 |
|
| 1231 |
$$ncref = |
| 1232 |
sub { |
| 1233 |
my ($xp, $text) = @_; |
| 1234 |
|
| 1235 |
if (defined $text) { |
| 1236 |
$text =~ s/\s+/ /g; |
| 1237 |
$body .= $text; |
| 1238 |
} |
| 1239 |
else { |
| 1240 |
if ($dostyle) { |
| 1241 |
$body .= "</div></dd>\n"; |
| 1242 |
} |
| 1243 |
$body .= "\n</$inlist>\n" |
| 1244 |
if $inlist; |
| 1245 |
$inlist = 'dl'; |
| 1246 |
} |
| 1247 |
}; |
| 1248 |
} # End def |
| 1249 |
|
| 1250 |
sub eg { |
| 1251 |
package main; |
| 1252 |
|
| 1253 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1254 |
|
| 1255 |
if ($dostyle) { |
| 1256 |
$body .= "<div class=\"eg\"><pre>"; |
| 1257 |
} |
| 1258 |
else { |
| 1259 |
$body .= "<table bgcolor=\"tan\" width=\"70%\"><tr><td>\n"; |
| 1260 |
$body .= "<font size=\"+1\"><pre>"; |
| 1261 |
} |
| 1262 |
|
| 1263 |
$$ncref = |
| 1264 |
sub { |
| 1265 |
my ($xp, $text) = @_; |
| 1266 |
|
| 1267 |
if (defined $text) { |
| 1268 |
$body .= $text; |
| 1269 |
} |
| 1270 |
else { |
| 1271 |
if ($dostyle) { |
| 1272 |
$body .= "</pre></div>\n"; |
| 1273 |
} |
| 1274 |
else { |
| 1275 |
$body .= "</pre></font></td></tr></table>\n" |
| 1276 |
} |
| 1277 |
} |
| 1278 |
}; |
| 1279 |
} # End eg |
| 1280 |
|
| 1281 |
sub key { |
| 1282 |
package main; |
| 1283 |
|
| 1284 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1285 |
|
| 1286 |
if ($dostyle) { |
| 1287 |
$body .= "<span class=\"key\">"; |
| 1288 |
} |
| 1289 |
else { |
| 1290 |
$body .= "<font face=\"monospace\" color=\"navy\">"; |
| 1291 |
} |
| 1292 |
|
| 1293 |
$$ncref = |
| 1294 |
sub { |
| 1295 |
my ($xp, $text) = @_; |
| 1296 |
|
| 1297 |
if (defined $text) { |
| 1298 |
$body .= $text; |
| 1299 |
} |
| 1300 |
else { |
| 1301 |
if ($dostyle) { |
| 1302 |
$body .= "</span>"; |
| 1303 |
} |
| 1304 |
else { |
| 1305 |
$body .= "</font>"; |
| 1306 |
} |
| 1307 |
} |
| 1308 |
}; |
| 1309 |
} # End key |
| 1310 |
|
| 1311 |
sub abstract { |
| 1312 |
package main; |
| 1313 |
|
| 1314 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1315 |
|
| 1316 |
if ($dostyle) { |
| 1317 |
$body .= "<span class=\"abstract\">"; |
| 1318 |
} |
| 1319 |
else { |
| 1320 |
$body .= "<font color=\"green\">"; |
| 1321 |
} |
| 1322 |
|
| 1323 |
$$ncref = |
| 1324 |
sub { |
| 1325 |
my ($xp, $text) = @_; |
| 1326 |
|
| 1327 |
if (defined $text) { |
| 1328 |
$body .= $text; |
| 1329 |
} |
| 1330 |
else { |
| 1331 |
if ($dostyle) { |
| 1332 |
$body .= "</span>"; |
| 1333 |
} |
| 1334 |
else { |
| 1335 |
$body .= "</font>"; |
| 1336 |
} |
| 1337 |
} |
| 1338 |
}; |
| 1339 |
} # End abstract |
| 1340 |
|
| 1341 |
sub screen { |
| 1342 |
package main; |
| 1343 |
|
| 1344 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1345 |
|
| 1346 |
if ($dostyle) { |
| 1347 |
$body .= "<pre class=\"screen\">\n"; |
| 1348 |
} |
| 1349 |
else { |
| 1350 |
$body .= "<table bgcolor=\"white\" border=\"1\" width=\"70%\"><tr><td>\n"; |
| 1351 |
$body .= "<font size=\"+1\"><pre>"; |
| 1352 |
} |
| 1353 |
|
| 1354 |
$$ncref = |
| 1355 |
sub { |
| 1356 |
my ($xp, $text) = @_; |
| 1357 |
|
| 1358 |
if (defined $text) { |
| 1359 |
$body .= $text; |
| 1360 |
} |
| 1361 |
else { |
| 1362 |
if ($dostyle) { |
| 1363 |
$body .= "</pre>\n"; |
| 1364 |
} |
| 1365 |
else { |
| 1366 |
$body .= "</pre></td></tr></table>\n"; |
| 1367 |
} |
| 1368 |
} |
| 1369 |
}; |
| 1370 |
} # End screen |
| 1371 |
|
| 1372 |
sub input { |
| 1373 |
package main; |
| 1374 |
|
| 1375 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1376 |
|
| 1377 |
if ($dostyle) { |
| 1378 |
$body .= "<span class=\"input\">"; |
| 1379 |
} |
| 1380 |
else { |
| 1381 |
$body .= "<b>"; |
| 1382 |
} |
| 1383 |
|
| 1384 |
$$ncref = |
| 1385 |
sub { |
| 1386 |
my ($xp, $text) = @_; |
| 1387 |
|
| 1388 |
if (defined $text) { |
| 1389 |
$body .= $text; |
| 1390 |
} |
| 1391 |
else { |
| 1392 |
if ($dostyle) { |
| 1393 |
$body .= "</span>"; |
| 1394 |
} |
| 1395 |
else { |
| 1396 |
$body .= "</b>"; |
| 1397 |
} |
| 1398 |
} |
| 1399 |
}; |
| 1400 |
} # End input |
| 1401 |
|
| 1402 |
sub group { |
| 1403 |
} # End group |
| 1404 |
|
| 1405 |
sub text { |
| 1406 |
package main; |
| 1407 |
|
| 1408 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1409 |
|
| 1410 |
$body .= "<p>\n"; |
| 1411 |
|
| 1412 |
$$ncref = |
| 1413 |
sub { |
| 1414 |
my ($xp, $text) = @_; |
| 1415 |
|
| 1416 |
if (defined $text) { |
| 1417 |
$text =~ s/\s+/ /g; |
| 1418 |
$body .= $text; |
| 1419 |
} |
| 1420 |
}; |
| 1421 |
} # End text |
| 1422 |
|
| 1423 |
sub book { |
| 1424 |
package main; |
| 1425 |
|
| 1426 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1427 |
|
| 1428 |
start_mode($xp, 'object'); |
| 1429 |
|
| 1430 |
$$ncref = |
| 1431 |
sub { |
| 1432 |
my ($xp) = @_; |
| 1433 |
|
| 1434 |
if ($dostyle) { |
| 1435 |
$body .= "<span class=\"booktitle\">"; |
| 1436 |
$body .= sgml_escape($Object->{title}); |
| 1437 |
$body .= "</span>\n"; |
| 1438 |
} |
| 1439 |
else { |
| 1440 |
$body .= "<cite>" . sgml_escape($Object->{title}) . "</cite>\n"; |
| 1441 |
} |
| 1442 |
}; |
| 1443 |
} |
| 1444 |
|
| 1445 |
sub aside { |
| 1446 |
package main; |
| 1447 |
|
| 1448 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1449 |
|
| 1450 |
if ($dostyle) { |
| 1451 |
$body .= "<span class=\"aside\">["; |
| 1452 |
} |
| 1453 |
else { |
| 1454 |
$body .= "<em>["; |
| 1455 |
} |
| 1456 |
|
| 1457 |
|
| 1458 |
$$ncref = |
| 1459 |
sub { |
| 1460 |
my ($xp, $text) = @_; |
| 1461 |
|
| 1462 |
if (defined $text) { |
| 1463 |
$body .= $text; |
| 1464 |
} |
| 1465 |
else { |
| 1466 |
if ($dostyle) { |
| 1467 |
$body .= "]</span>\n"; |
| 1468 |
} |
| 1469 |
else { |
| 1470 |
$body .= "]</em>"; |
| 1471 |
} |
| 1472 |
} |
| 1473 |
}; |
| 1474 |
} |
| 1475 |
|
| 1476 |
sub url { |
| 1477 |
package main; |
| 1478 |
|
| 1479 |
my ($xp, $el, $attref, $ncref) = @_; |
| 1480 |
|
| 1481 |
my $url=''; |
| 1482 |
|
| 1483 |
$$ncref = |
| 1484 |
sub { |
| 1485 |
my ($xp, $text) = @_; |
| 1486 |
|
| 1487 |
if (defined($text)) { |
| 1488 |
$url .= $text; |
| 1489 |
} |
| 1490 |
else { |
| 1491 |
$body .= "<a href=\"$url\">$url</a>"; |
| 1492 |
} |
| 1493 |
} |
| 1494 |
} |
| 1495 |
|
| 1496 |
## Local Variables: ## |
| 1497 |
## mode:perl ## |
| 1498 |
## End: ## |
Parent Directory
| 
Revision Log