/[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.3 - (hide annotations)
Thu Apr 24 16:43:09 2003 UTC (21 years ago) by dpavlin
Branch: MAIN
Changes since 1.2: +20 -601 lines
File MIME type: text/plain
moved design to separate files, removed left-over from slides.pl

1 dpavlin 1.1 #!/usr/bin/perl -w
2     #
3    
4 dpavlin 1.2 use strict;
5    
6 dpavlin 1.1 use XML::Parser;
7 dpavlin 1.2 use Text::Iconv;
8    
9     # output charset
10     my $charset='ISO-8859-2';
11 dpavlin 1.1
12 dpavlin 1.2 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 dpavlin 1.1
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 dpavlin 1.2 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 dpavlin 1.1
86 dpavlin 1.2 my $html_header=suck_file("header.html");
87     my $html_separator=suck_file("separator.html");
88 dpavlin 1.3 my $html_next=suck_file("next.html");
89 dpavlin 1.2 my $html_footer=suck_file("footer.html");
90 dpavlin 1.1
91     #------------------------------------------------------------------
92    
93     sub php_header {
94     my ($page_nr,@sql_update) = @_;
95 dpavlin 1.3 my $out='<?php
96     include("common.php");
97 dpavlin 1.1 if (isset($update)) {
98     $member_id=id_decode($a);
99     ';
100     $out.=$php_addon[$page_nr-2] if (defined $php_addon[$page_nr-2]);
101     $out.='
102     $sql="update '.$dir.' set '.join(",\n",@sql_update).',
103     do_stranice=\'$PHP_SELF\'
104     where id=$id";
105     # print "<pre>$sql</pre>";
106     $result=pg_Exec($conn,fix_sql($sql));
107     } elseif($do_stranice != $PHP_SELF) {
108     Header("Location: $do_uri?a=$a");
109     exit;
110     }
111     ?>';
112     return $out;
113     }
114    
115     #------------------------------------------------------------------
116    
117     # first, define some constants
118 dpavlin 1.3 my $common_php = suck_file("common.php");
119 dpavlin 1.1
120     #------------------------------------------------------------------
121    
122 dpavlin 1.2 my $head_php=suck_file("head.php");
123 dpavlin 1.1
124     #------------------------------------------------------------------
125    
126 dpavlin 1.2 my $html_kraj=suck_file("thanks.html");
127 dpavlin 1.1
128     #------------------------------------------------------------------
129    
130     while (defined($ARGV[0]) and $ARGV[0] =~ /^-/) {
131     my $opt = shift;
132    
133     if ($opt eq '-h') {
134     print $Usage;
135     exit;
136     }
137     elsif ($opt eq '-d') {
138     $dir = shift;
139     }
140     elsif ($opt eq '-w') {
141     $dowarn = 1;
142     }
143     elsif ($opt eq '-mode') {
144     my $marg = shift;
145     if ($marg eq 'html') {
146     $dostyle = 0;
147     }
148     else {
149     die "Unrecognized mode: $marg\n$Usage";
150     }
151     }
152     else {
153     die "Unrecognized option: $opt\n$Usage";
154     }
155     } # End of option processing
156    
157     my $docfile = shift;
158    
159     die "No docfile provided:\n$Usage" unless defined $docfile;
160    
161     die "Can't read $docfile" unless -r $docfile;
162    
163     if (defined $dir) {
164     die "$dir isn't a directory" unless -d $dir;
165     }
166     else {
167     $docfile =~ m!([^/.]+)(?:\.[^/.]*)?$!;
168     $dir = $1;
169     if (-e $dir) {
170     die "$dir exists but isn't a directory"
171     unless -d $dir;
172     }
173     else {
174     mkdir $dir, 0755;
175     }
176     }
177    
178     my $in_slideshow = 0;
179     my $after_head = 0;
180    
181     my $Mode = 0;
182     my $Mode_level = 0;
183    
184     my $Text;
185     my $Markedup_Text;
186     my $Object;
187     my @Ostack = ();
188    
189     my $intext = 0;
190     my $closure;
191     my @closure_stack = ();
192    
193     my $style_link = '';
194    
195     my $index = 'index.html';
196     my @slidetitle;
197     my $body;
198     my $inlist = 0;
199    
200     my @Titles;
201    
202     my $header;
203    
204     my $prolog = "<html><head>\n";
205     $prolog .= "<!-- Generated by $0 on " . gmtime() . " GMT -->\n";
206    
207     my $page_number = 0;
208    
209     my $p = new XML::Parser(ErrorContext => 3,
210     Handlers => {Start => \&starthndl,
211     End => \&endhndl,
212     Char => \&text});
213     $p->parsefile($docfile);
214    
215     #----------------------------------------------------------
216    
217     # dump last php page....
218    
219     print "p[$page_nr] ";
220    
221     open(PAGE, ">$dir/$last_fn") or die "Couldn't open $last_fn for writing:\n$!";
222     print PAGE php_header($page_nr,@prelast_sql_update);
223     my $next_fn=sprintf("%02d.php",$page_nr);
224     $last_page=~s/##NEXTPAGE##/$next_fn/;
225     print PAGE $last_page;
226     close(PAGE);
227    
228     $page_nr++;
229     open(PAGE, ">$dir/$next_fn") or die "Couldn't open $next_fn for writing:\n$!";
230     print PAGE php_header($page_nr,@last_sql_update);
231 dpavlin 1.2 print PAGE "$html_header $html_kraj $html_footer";
232 dpavlin 1.1 close(PAGE);
233    
234     # dump sql structure
235    
236     open(SQL,">$dir/$dir.sql") || die "$dir.sql: $!";
237     print SQL "create table poslani ( member_id int4 not null, unesen timestamp default now() );\n";
238     print SQL "create table $dir (do_stranice text default null, ",join(",\n",@sql_create),");\n";
239     close(SQL);
240    
241 dpavlin 1.3 # dump common.php
242    
243     open(PHP,">$dir/common.php") || die "common.php: $!";
244     $common_php =~ s/##DB##/$dir/g;
245     my $db_name = $prefix.$dir;
246     $common_php =~ s/##DB_NAME##/$db_name/g;
247     $common_php =~ s/##PREFIX##/$prefix/g;
248     $common_php =~ s/##DB_USER##/$db_user/g;
249     $common_php =~ s/##PREFIX##/$prefix/g;
250     my $members_db = $prefix."members";
251     $common_php =~ s/##MEMBERS_DB##/$members_db/g;
252 dpavlin 1.1
253 dpavlin 1.3 print PHP $common_php;
254 dpavlin 1.1 close(PHP);
255    
256     open(PHP,">$dir/head.php") || die "head.php: $!";
257 dpavlin 1.3 my $max_page = $page_nr - 1;
258 dpavlin 1.2 $head_php=~ s/##MAXPAGE##/$max_page/;
259     $head_php=~ s/##TEXT##/Ispunili ste %02d%% ankete/;
260 dpavlin 1.1 print PHP $head_php;
261     close(PHP);
262    
263     ################
264     ## End of main
265     ################
266    
267     # return unique name of pitanje
268     sub new_pit {
269     my $out="p".$pitanje_nr.$p_suffix;
270     $curr_suffix=$p_suffix;
271     $p_suffix++;
272     return $out;
273     }
274    
275     # current pitanje
276     sub curr_pit {
277     return "p".$pitanje_nr.$curr_suffix;
278     }
279    
280     sub starthndl {
281     my ($xp, $el, %atts) = @_;
282    
283     # return unless ($in_slideshow or $el eq 'slideshow');
284    
285     unless ($in_slideshow) {
286     $in_slideshow = $xp->depth + 1;
287     return;
288     }
289    
290     if ($Mode) {
291    
292     if ($Mode eq 'pass') {
293     $Markedup_Text .= "\n" . $xp->recognized_string;
294     }
295     elsif ($Mode eq 'object') {
296     push(@Ostack, $Object);
297    
298     $Object = {_Atts => \%atts,
299     _Text => ''
300     };
301     bless $Object, "Slideobj::$el";
302     }
303    
304     # skip does nothing
305     return;
306     }
307    
308     unless ($after_head) {
309     if ($el eq 'head') {
310     $after_head = 1;
311     start_mode($xp, 'object');
312    
313     push(@closure_stack, $closure);
314     $closure =
315     sub {
316     my ($xp, $text) = @_;
317    
318     unless (defined $text) {
319    
320     $header = $Object;
321     }
322     };
323    
324     return;
325     }
326    
327     # die "The head element must be the first thing in the slideshow";
328     }
329    
330    
331     my $new_closure;
332    
333     my $subname = "Slideshow::$el";
334    
335     if (defined &$subname) {
336     no strict 'refs';
337    
338     &$subname($xp, $el, \%atts, \$new_closure);
339     }
340     else {
341     $body .= $xp->recognized_string;
342     $new_closure =
343     sub {
344     my ($xp, $text) = @_;
345    
346     if (defined $text) {
347     $body .= $text;
348     }
349     else {
350     $body .= "</$el>";
351     }
352     };
353     }
354    
355     push(@closure_stack, $closure);
356     $closure = $new_closure;
357     } # End starthndl
358    
359     sub endhndl {
360     my ($xp, $el) = @_;
361    
362     return unless $in_slideshow;
363    
364     my $lev = $xp->depth;
365    
366     if ($lev == $in_slideshow - 1) {
367     $in_slideshow = 0;
368     $xp->finish;
369     return;
370     }
371    
372     if ($Mode_level == $lev) {
373    
374     if ($Mode eq 'pass') {
375     &$closure($xp, $Markedup_Text)
376     if (defined $closure);
377     }
378    
379     $Mode = $Mode_level = 0;
380     }
381    
382     if ($Mode) {
383     if ($Mode eq 'pass') {
384     $Markedup_Text .= "</$el>";
385     }
386     elsif ($Mode eq 'object') {
387     my $this = $Object;
388     if (2 == keys %$this) {
389     $this = $this->{_Text};
390     }
391    
392     $Object = pop(@Ostack);
393    
394     my $slot = $Object->{$el};
395     if (defined $slot) {
396     if (ref($slot) eq 'ARRAY') {
397     push(@$slot, $this);
398     }
399     else {
400     $Object->{$el} = [$slot, $this];
401     }
402     }
403     else {
404     $Object->{$el} = $this;
405     }
406     }
407    
408     return;
409     }
410    
411     &$closure($xp)
412     if defined $closure;
413    
414     $closure = pop(@closure_stack);
415     } # End endhndl
416    
417     sub text {
418     my ($xp, $data) = @_;
419    
420     return unless $in_slideshow;
421    
422     if ($Mode ) {
423    
424     if ($Mode eq 'pass') {
425     my $safe = sgml_escape($data);
426    
427     $Text .= $safe;
428     $Markedup_Text .= $safe;
429     }
430     elsif ($Mode eq 'object') {
431     $Object->{_Text} .= $data
432     if $data =~ /\S/;
433     }
434    
435     return;
436     }
437    
438     &$closure($xp, sgml_escape($data))
439     if (defined $closure);
440    
441     } # End text
442    
443     sub start_mode {
444     my ($xp, $mode) = @_;
445    
446     if ($mode eq 'pass') {
447     $Text = '';
448     $Markedup_Text = '';
449     }
450     elsif ($mode eq 'object') {
451     $Object = {_Atts => undef,
452     _Text => undef
453     };
454     }
455    
456     $Mode = $mode;
457     $Mode_level = $xp->depth;
458     } # End start_mode
459    
460     sub sgml_escape {
461     my ($str) = @_;
462    
463     $str =~ s/\&/\&amp;/g;
464     $str =~ s/</\&lt;/g;
465     $str =~ s/>/\&gt;/g;
466    
467     $str;
468     } # End sgml_escape
469    
470     sub slidename {
471     my ($num) = @_;
472    
473     sprintf("slide%03d.html", $num);
474     } # End slidename
475    
476     ################################################################
477    
478     package Slideshow;
479    
480     sub page {
481     package main;
482    
483     my ($xp, $el, $attref, $ncref) = @_;
484    
485     $$ncref = sub {
486     my ($xp, $text) = @_;
487    
488     if (! defined $text) {
489    
490     print "p[$page_nr] ";
491    
492     if (defined $last_fn) {
493     # 01.php -> index.php
494     $last_fn="index.php" if ($last_fn eq "01.php");
495     open(PAGE, ">$dir/$last_fn") or die "Couldn't open $last_fn for writing:\n$!";
496     if ($page_nr == 2) {
497 dpavlin 1.3 print PAGE '<?php
498     include("common.php");
499 dpavlin 1.1 if (isset($do_stranice) && $do_stranice !="") {
500     Header("Location: $do_uri?a=$a");
501     exit;
502     }
503     $member_id=id_decode($a);
504     $sql="insert into '.$dir.' ( http_referer,remote_addr,user_agent, member_id ) values (\'$HTTP_REFERER\',\'$REMOTE_ADDR\',\'$HTTP_USER_AGENT\',$member_id)";
505    
506     # print "<pre>$sql</pre>";
507     $result=pg_Exec($conn,fix_sql($sql));
508     $lastoid=pg_getlastoid($result);
509     $result = pg_Exec($conn,fix_sql("select id from '.$dir.' where oid=$lastoid"));
510     $row=pg_fetch_row($result,0);
511     $id=$row[0];
512     ?>';
513    
514     } else {
515     print PAGE php_header($page_nr,@prelast_sql_update);
516     } # last_sql_update
517    
518    
519     my $next_fn=sprintf("%02d.php",$page_nr);
520     $last_page=~s/##NEXTPAGE##/$next_fn/;
521     print PAGE $last_page;
522     close(PAGE);
523    
524     }
525     @prelast_sql_update=@last_sql_update;
526     @last_sql_update=@sql_update;
527     @sql_update = ();
528    
529     $last_fn=sprintf("%02d.php",$page_nr);
530 dpavlin 1.3 $last_page="$html_header $body $html_next $html_footer";
531 dpavlin 1.1 # delete vars for next page
532     $page_nr++;
533     $body="";
534     }
535     }
536     } # page
537    
538     sub nr {
539     package main;
540    
541     my ($xp, $el, $attref, $ncref) = @_;
542    
543     $pitanje_tag="";
544    
545     $$ncref = sub {
546     my ($xp, $text) = @_;
547     if (defined($text)) {
548     $body.=$text;
549     chomp $text;
550     $pitanje_tag .= $text;
551     } else {
552     $pitanje_nr = $pitanje_tag;
553     $pitanje_nr =~ s/[^0-9a-zA-Z]//g;
554     print "$pitanje_nr ";
555     }
556     $p_suffix="";
557     };
558     } # nr
559    
560    
561     sub hr {
562     $body .= "<br></td></tr>$html_separator<tr><td></td><td><br>";
563     }
564    
565     sub br {
566     $body .= "<br>\n";
567     }
568    
569     sub pit {
570     package main;
571    
572     my ($xp, $el, $attref, $ncref) = @_;
573    
574     $body.="<p>";
575    
576     $$ncref = sub {
577     my ($xp, $text) = @_;
578    
579     if (defined $text) {
580 dpavlin 1.2 $body.=x($text);
581 dpavlin 1.1 } else {
582     $body.="</p>";
583     }
584     }
585     }
586    
587     sub podpit {
588     package main;
589    
590     my ($xp, $el, $attref, $ncref) = @_;
591    
592     $body.='<table width="100%" cellspacing="0" cellpadding="2" border="0">';
593     $$ncref = sub {
594     my ($xp, $text) = @_;
595    
596     if (defined $text) {
597 dpavlin 1.2 $body.=x($text);
598 dpavlin 1.1 } else {
599     $body.="</table>";
600     }
601     }
602     }
603    
604    
605     sub odg {
606     package main;
607    
608     my ($xp, $el, $attref, $ncref) = @_;
609    
610     $body .= "<p>";
611    
612     $$ncref = sub {
613     my ($xp, $text) = @_;
614    
615     if (defined $text) {
616 dpavlin 1.2 $body .= x($text);
617 dpavlin 1.1 } else {
618     $body .= "</p>";
619     }
620     }
621     }
622    
623     sub php {
624     package main;
625     my ($xp, $el, $attref, $ncref) = @_;
626    
627     $body.="<?php\n";
628    
629     $$ncref = sub {
630     my ($xp, $text) = @_;
631    
632     if (defined $text) {
633     $text=~s/ lt / < /g;
634     $text=~s/ le / <= /g;
635     $text=~s/ gt / > /g;
636     $text=~s/ ge / >= /g;
637 dpavlin 1.2 $body.=x($text);
638 dpavlin 1.1 } else {
639     $body.="\n?>\n";
640     }
641     }
642     }
643    
644     sub dropdown {
645     package main;
646    
647     my ($xp, $el, $attref, $ncref) = @_;
648    
649     my @dropdown_data;
650    
651     $$ncref = sub {
652     my ($xp, $text) = @_;
653    
654     if (defined $text) {
655     chomp $text;
656     $text=~s/^\s*//g;
657     $text=~s/^[\d\.\s]+//g;
658     $text=~s/\s*$//g;
659 dpavlin 1.2 push @dropdown_data,x($text) if ($text ne "");
660 dpavlin 1.1 } else {
661     my $opt;
662     my $id=1;
663     my $p=new_pit();
664     $body.="<select name=$p >\n";
665     $body.="<option value=null>-</option>\n";
666     foreach $opt (@dropdown_data) {
667     if (defined($opt) && $opt ne "") {
668     $body.="<option value=$id>$opt</option>\n";
669     $id++;
670     }
671     }
672     $body.="</select>\n";
673    
674     push @sql_create,"$p int4";
675     push @sql_update,"$p=\$$p";
676     }
677     }
678     }
679    
680     sub textbox {
681     package main;
682     my ($xp, $el, $attref, $ncref) = @_;
683    
684     $$ncref = sub {
685     my ($xp, $text) = @_;
686     my $size=$attref->{size};
687     $size = 25 if (! defined $size || $size == 0); # default
688     my $p=new_pit();
689 dpavlin 1.2 $body.="<input type=text name=$p size=".x($size)." >\n";
690 dpavlin 1.1 push @sql_create,"$p text";
691     push @sql_update,"$p='\$$p'";
692     }
693     }
694    
695     sub radiobuttons_tab {
696     package main;
697     my ($xp, $el, $attref, $ncref) = @_;
698    
699     $$ncref = sub {
700     my ($xp, $text) = @_;
701     if (! defined $text) {
702     my $nr=$attref->{nr};
703     my $p=new_pit();
704     for (my $i=1; $i<=$nr; $i++) {
705     $body.="<td><input type=radio name=$p value=$i></td> ";
706     }
707     push @sql_create,"$p int4";
708     push @sql_update,"$p=\$$p";
709     }
710     }
711     }
712    
713     sub radiobuttons {
714     package main;
715     my ($xp, $el, $attref, $ncref) = @_;
716    
717     my @radiobuttons_data;
718    
719     $$ncref = sub {
720     my ($xp, $text) = @_;
721    
722     if (defined $text) {
723     chomp $text;
724     $text=~s/^\s*//g;
725     $text=~s/^[\d\.\s]+//g;
726     $text=~s/\s*$//g;
727 dpavlin 1.2 push @radiobuttons_data,x($text) if ($text ne "");
728 dpavlin 1.1 } else {
729     my $opt;
730     my $p=new_pit();
731     my $id=1;
732     foreach $opt (@radiobuttons_data) {
733     if (defined($opt) && $opt ne "") {
734     $body.="<input type=radio name=$p value=$id> $opt<br>\n";
735     $id++;
736     }
737     }
738     push @sql_create,"$p int4";
739     push @sql_update,"$p=\$$p";
740     }
741     }
742     }
743     sub checkbox {
744     package main;
745     my ($xp, $el, $attref, $ncref) = @_;
746    
747     $$ncref = sub {
748     my ($xp, $text) = @_;
749     my $p=new_pit();
750     $body.="<input type=checkbox name=$p >\n";
751     push @sql_create,"$p text";
752     push @sql_update,"$p='\$$p'";
753     }
754     }
755    
756     sub checkboxes {
757     package main;
758    
759     my ($xp, $el, $attref, $ncref) = @_;
760    
761     my @checkboxes_data;
762    
763     $$ncref = sub {
764     my ($xp, $text) = @_;
765    
766    
767     if (defined $text) {
768     chomp $text;
769     $text=~s/^\s*//g;
770     $text=~s/^[\d\.\s]+//g;
771     $text=~s/\s*$//g;
772 dpavlin 1.2 push @checkboxes_data,x($text) if ($text ne "");
773 dpavlin 1.1 } else {
774     my $opt;
775     my $base_p=new_pit();
776     my $id=1;
777    
778     my $before=$attref->{before};
779     my $after=$attref->{after};
780     my $middle=$attref->{middle};
781     if (! $before && ! $after && ! $middle) {
782     $middle="&nbsp;";
783     $after="<br>";
784     }
785     my $hide_description=$attref->{hide_description};
786    
787     foreach $opt (@checkboxes_data) {
788     if (defined($opt) && $opt ne "") {
789     $p=$base_p."_".$id;
790     $id++;
791 dpavlin 1.2 $body .= x($before) if ($before);
792 dpavlin 1.1 $body.="<input type=checkbox name=$p>";
793 dpavlin 1.2 $body .= x($middle) if ($middle);
794 dpavlin 1.1 $body .= "$opt" if (! $hide_description);
795 dpavlin 1.2 $body .= x($after) if ($after);
796 dpavlin 1.1 $body.="\n";
797    
798     push @sql_create,"$p boolean";
799     push @sql_update,"$p=\$$p";
800     }
801     }
802     $php_addon[$page_nr].="fix_checkboxes($base_p,".($id-1).");";
803    
804     }
805     }
806     }
807    
808     #---------------------------------------------------------------

  ViewVC Help
Powered by ViewVC 1.1.26