/[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

Annotation of /make_poll.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Tue Apr 8 17:53:46 2003 UTC (20 years, 11 months ago) by dpavlin
Branch: MAIN
Branch point for: dbp
File MIME type: text/plain
Initial revision

1 dpavlin 1.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.">&nbsp;&nbsp;
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/\&/\&amp;/g;
675     $str =~ s/</\&lt;/g;
676     $str =~ s/>/\&gt;/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="&nbsp;";
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: ##

  ViewVC Help
Powered by ViewVC 1.1.26