/[wopi]/make_poll.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /make_poll.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Tue Apr 22 18:46:04 2003 UTC (20 years, 11 months ago) by dpavlin
Branch: MAIN
Changes since 1.1: +39 -148 lines
File MIME type: text/plain
moved editable content to outside files

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

  ViewVC Help
Powered by ViewVC 1.1.26