/[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.14 - (show annotations)
Tue Oct 21 16:55:06 2003 UTC (20 years, 5 months ago) by dpavlin
Branch: MAIN
Changes since 1.13: +40 -9 lines
File MIME type: text/plain
added configuration options to specify header, separator, submit, footer and
thanks files for each poll individually

1 #!/usr/bin/perl -w
2 #
3 # Dobrica Pavlinusic <dpavlin@rot13.org>
4 #
5 # Originally made for proof. during April 2001; later released under GPL v2
6 #
7 # 2003-04-dd general cleanup in preparation of release
8
9 use strict;
10
11 use XML::Parser;
12 use common;
13 use Carp;
14
15 $|=1;
16
17 my $Usage =<<'End_of_Usage;';
18 I will write usage information here. I promise!
19 End_of_Usage;
20
21 my @Modes = qw(object pass skip);
22
23 my $poll;
24 my $dowarn = 1;
25
26 my $pitanje_nr = 0; # curr. pitanje
27 my $pitanje_tag = ""; # originalni oblik broja pitanja
28 my $page_nr = 1; # prvo pitanje na strani
29
30 my $p_suffix=""; # if more than one box per question
31
32 my $curr_suffix=""; # trenutni suffix
33
34 my @stack_pit; # stack pitanja (pitanje, suffix)
35
36 my @sql_create = ("id serial",
37 "http_referer character varying(500)",
38 "remote_addr character varying(15)",
39 "user_agent character varying(300)",
40 "unesen timestamp DEFAULT now()",
41 "member_id int4 NOT NULL"
42 );
43 my @sql_update;
44 my @last_sql_update;
45 my @prelast_sql_update;
46
47 my @php_addon; # php code to add on page header
48
49 my ($last_fn,$last_page);
50
51 # this is unique prefix for this installation
52 my $prefix="wopi_";
53
54 # this is usename in database
55 my $db_user="dpavlin";
56
57 # This option allows users to fill poll without using invitation URL.
58 # That also means it's unpossible for them to return to exiting poll
59 # because they don't have thair own unique ID. Howver, it enables simple
60 # polls to be conducted by just publishing URL to them.
61 my $without_invitation=0;
62
63 # This will remove numbers before answers. That enables you to have
64 # answers written like:
65 # 1.1 red
66 # 1.2 black
67 # and users will see just "red" and "black"
68 my $remove_nrs_in_answers=0;
69
70 # This defines files which will be included in various places to produce
71 # design. You could desing them using your faviourite html editor (vim :-)
72 # and then split them into separate files
73
74 my %include_files = (
75 # this file is included at top of each paAge
76 'header' => "header.html",
77 # this file is used to separate questions
78 'separator' => "separator.html",
79 # this file is used to show "submit" button, which under multi-page
80 # polls will also bring next page
81 'submit' => "next.html",
82 # this file is included at bottom of each page
83 'footer' => "footer.html",
84 # this file will be showen after poll is completed
85 'thanks' => "thanks.html"
86 );
87
88 my %html; # buffer for suck(_file)ed html files
89
90 #------------------------------------------------------------------
91
92 sub suck_file {
93 my $file = shift || croak "suck_file called without argument";
94 open(H,$file) || die "can't open '$file': $!";
95 my $content;
96 while (<H>) { $content .= $_; } ;
97 close(H);
98 return $content;
99 }
100
101 $html{'header'}=suck_file($include_files{'header'});
102 $html{'separator'}=suck_file($include_files{'separator'});
103 $html{'submit'}=suck_file($include_files{'submit'});
104 $html{'footer'}=suck_file($include_files{'footer'});
105
106 #------------------------------------------------------------------
107
108 sub php_header {
109 my ($page_nr,@sql_update) = @_;
110 my $out='<?php
111 include_once("common.php");
112 if (isset($update)) {
113 $member_id=id_decode($a);
114 ';
115 $out.=$php_addon[$page_nr-2] if (defined $php_addon[$page_nr-2]);
116 $out.='
117 $sql="update '.$poll.' set '.join(",\n",@sql_update).',
118 do_stranice=\'$PHP_SELF\'
119 where id=$id";
120 # print "<pre>$sql</pre>";
121 $result=pg_Exec($conn,fix_sql($sql));
122 } elseif($do_stranice != $PHP_SELF && isset($do_uri) && isset($a)) {
123 Header("Location: $do_uri?a=$a");
124 exit;
125 }
126 ?>';
127 return $out;
128 }
129
130 #------------------------------------------------------------------
131
132 # first, define some constants
133 my $common_php = suck_file("common.php");
134
135 #------------------------------------------------------------------
136
137 my $head_php=suck_file("head.php");
138
139 #------------------------------------------------------------------
140
141 $html{'kraj'}=suck_file($include_files{'thanks'});
142
143 #------------------------------------------------------------------
144
145 while (defined($ARGV[0]) and $ARGV[0] =~ /^-/) {
146 my $opt = shift;
147
148 if ($opt eq '-h') {
149 print $Usage;
150 exit;
151 }
152 } # End of option processing
153
154 my $xmlfile = shift;
155
156 die "No poll xml file provided!\n$Usage" unless defined $xmlfile;
157
158 die "Can't read $xmlfile" unless -r $xmlfile;
159
160 if (defined $poll) {
161 die "$poll isn't a directory" unless -d $poll;
162 }
163 else {
164 $xmlfile =~ m!([^/.]+)(?:\.[^/.]*)?$!;
165 $poll = $1;
166 if (-e $poll) {
167 die "$poll exists but isn't a directory"
168 unless -d $poll;
169 }
170 else {
171 mkdir $poll, 0755;
172 }
173 }
174
175 my $in_poll = 0;
176 my $after_head = 0;
177
178 my $Mode = 0;
179 my $Mode_level = 0;
180
181 my $Text;
182 my $Markedup_Text;
183 my $Object;
184 my @Ostack = ();
185
186 #my $intext = 0;
187 my $closure;
188 my @closure_stack = ();
189
190 #my $style_link = '';
191
192 #my $index = 'index.html';
193 #my @slidetitle;
194 my $body;
195 #my $inlist = 0;
196
197 #my @Titles;
198
199 my $header;
200
201 my $page_number = 0;
202
203 my $p = new XML::Parser(ErrorContext => 3,
204 Handlers => {Start => \&starthndl,
205 End => \&endhndl,
206 Char => \&text});
207 $p->parsefile($xmlfile);
208
209 #----------------------------------------------------------
210
211 # dump last php page....
212
213 print "p[$page_nr] ";
214
215 open(PAGE, ">$poll/$last_fn") or die "Couldn't open $last_fn for writing:\n$!";
216 print PAGE php_header($page_nr,@prelast_sql_update);
217 my $next_fn=sprintf("%02d.php",$page_nr);
218 $last_page=~s/##NEXTPAGE##/$next_fn/;
219 print PAGE $last_page;
220 close(PAGE);
221
222 $page_nr++;
223 open(PAGE, ">$poll/$next_fn") or die "Couldn't open $next_fn for writing:\n$!";
224 print PAGE php_header($page_nr,@last_sql_update);
225 print PAGE "$html{'header'} $html{'kraj'} $html{'footer'}";
226 close(PAGE);
227
228 # dump sql structure
229
230 open(SQL,">$poll/$poll.sql") || die "$poll.sql: $!";
231 print SQL "drop database ".$prefix.$poll.";\n";
232 print SQL "create database ".$prefix.$poll.";\n";
233 print SQL "\\connect ".$prefix.$poll.";\n";
234 print SQL "create table poslani ( member_id int4 not null, unesen timestamp default now() );\n";
235 print SQL "create table $poll (do_stranice text default null, ",join(",\n",@sql_create),");\n";
236 close(SQL);
237
238 # dump common.php
239
240 open(PHP,">$poll/common.php") || die "common.php: $!";
241 $common_php =~ s/##DB##/$poll/g;
242 my $db_name = $prefix.$poll;
243 $common_php =~ s/##DB_NAME##/$db_name/g;
244 $common_php =~ s/##PREFIX##/$prefix/g;
245 $common_php =~ s/##DB_USER##/$db_user/g;
246 $common_php =~ s/##PREFIX##/$prefix/g;
247 my $members_db = $prefix."members";
248 $common_php =~ s/##MEMBERS_DB##/$members_db/g;
249 $common_php =~ s/##WITHOUT_INVITATION##/$without_invitation/g;
250
251 print PHP $common_php;
252 close(PHP);
253
254 open(PHP,">$poll/head.php") || die "head.php: $!";
255 my $max_page = $page_nr - 1;
256 $head_php=~ s/##MAXPAGE##/$max_page/;
257 $head_php=~ s/##TEXT##/Ispunili ste %02d%% ankete/;
258 print PHP $head_php;
259 close(PHP);
260
261 # 01.php -> index.php
262 rename "$poll/01.php","$poll/index.php" || die "can't rename '$poll/01.php' to index.php";
263
264 ################
265 ## End of main
266 ################
267
268 # return unique name of pitanje
269 sub new_pit {
270 my $out="p".$pitanje_nr;
271 $out .= "_".$p_suffix if ($p_suffix);
272 $curr_suffix=$p_suffix;
273 $p_suffix++;
274 return $out;
275 }
276
277 # current pitanje
278 sub curr_pit {
279 return "p".$pitanje_nr.$curr_suffix;
280 }
281
282 #----------------------------------------------------------
283
284 sub starthndl {
285 my ($xp, $el, %atts) = @_;
286
287 # return unless ($in_poll or $el eq 'slideshow');
288
289 unless ($in_poll) {
290 $in_poll = $xp->depth + 1;
291 return;
292 }
293
294 if ($Mode) {
295
296 if ($Mode eq 'pass') {
297 $Markedup_Text .= "\n" . $xp->recognized_string;
298 }
299 elsif ($Mode eq 'object') {
300 push(@Ostack, $Object);
301
302 $Object = {_Atts => \%atts,
303 _Text => ''
304 };
305 bless $Object, "Slideobj::$el";
306 }
307
308 # skip does nothing
309 return;
310 }
311
312 unless ($after_head) {
313 if ($el eq 'head') {
314 $after_head = 1;
315 start_mode($xp, 'object');
316
317 push(@closure_stack, $closure);
318 $closure =
319 sub {
320 my ($xp, $text) = @_;
321
322 unless (defined $text) {
323
324 $header = $Object;
325 }
326 };
327
328 return;
329 }
330
331 # die "The head element must be the first thing in the slideshow";
332 }
333
334
335 my $new_closure;
336
337 my $subname = "Poll::$el";
338
339 if (defined &$subname) {
340 no strict 'refs';
341
342 &$subname($xp, $el, \%atts, \$new_closure);
343 }
344 else {
345 $body .= x($xp->recognized_string);
346 $new_closure =
347 sub {
348 my ($xp, $text) = @_;
349
350 if (defined $text) {
351 $body .= x($text);
352 }
353 else {
354 $body .= x("</$el>");
355 }
356 };
357 }
358
359 push(@closure_stack, $closure);
360 $closure = $new_closure;
361 } # End starthndl
362
363 sub endhndl {
364 my ($xp, $el) = @_;
365
366 return unless $in_poll;
367
368 my $lev = $xp->depth;
369
370 if ($lev == $in_poll - 1) {
371 $in_poll = 0;
372 $xp->finish;
373 return;
374 }
375
376 if ($Mode_level == $lev) {
377
378 if ($Mode eq 'pass') {
379 &$closure($xp, $Markedup_Text)
380 if (defined $closure);
381 }
382
383 $Mode = $Mode_level = 0;
384 }
385
386 if ($Mode) {
387 if ($Mode eq 'pass') {
388 $Markedup_Text .= "</$el>";
389 }
390 elsif ($Mode eq 'object') {
391 my $this = $Object;
392 if (2 == keys %$this) {
393 $this = $this->{_Text};
394 }
395
396 $Object = pop(@Ostack);
397
398 my $slot = $Object->{$el};
399 if (defined $slot) {
400 if (ref($slot) eq 'ARRAY') {
401 push(@$slot, $this);
402 }
403 else {
404 $Object->{$el} = [$slot, $this];
405 }
406 }
407 else {
408 $Object->{$el} = $this;
409 }
410 }
411
412 return;
413 }
414
415 &$closure($xp)
416 if defined $closure;
417
418 $closure = pop(@closure_stack);
419 } # End endhndl
420
421 #----------------------------------------------------------
422
423 sub text {
424 my ($xp, $data) = @_;
425
426 return unless $in_poll;
427
428 if ($Mode ) {
429
430 if ($Mode eq 'pass') {
431 my $safe = sgml_escape($data);
432
433 $Text .= $safe;
434 $Markedup_Text .= $safe;
435 }
436 elsif ($Mode eq 'object') {
437 $Object->{_Text} .= $data
438 if $data =~ /\S/;
439 }
440
441 return;
442 }
443
444 &$closure($xp, sgml_escape($data))
445 if (defined $closure);
446
447 } # End text
448
449 sub start_mode {
450 my ($xp, $mode) = @_;
451
452 if ($mode eq 'pass') {
453 $Text = '';
454 $Markedup_Text = '';
455 }
456 elsif ($mode eq 'object') {
457 $Object = {_Atts => undef,
458 _Text => undef
459 };
460 }
461
462 $Mode = $mode;
463 $Mode_level = $xp->depth;
464 } # End start_mode
465
466 sub sgml_escape {
467 my ($str) = @_;
468
469 $str =~ s/\&/\&amp;/g;
470 $str =~ s/</\&lt;/g;
471 $str =~ s/>/\&gt;/g;
472
473 $str;
474 } # End sgml_escape
475
476
477 ################################################################
478
479 package Poll;
480
481 sub page {
482 package main;
483
484 my ($xp, $el, $attref, $ncref) = @_;
485
486 $$ncref = sub {
487 my ($xp, $text) = @_;
488
489 if (! defined $text) {
490
491 print "p[$page_nr] ";
492
493 if (defined $last_fn) {
494 open(PAGE, ">$poll/$last_fn") or die "Couldn't open $last_fn for writing:\n$!";
495 print PAGE php_header($page_nr,@prelast_sql_update);
496 my $next_fn=sprintf("%02d.php",$page_nr);
497 $last_page=~s/##NEXTPAGE##/$next_fn/;
498 print PAGE $last_page;
499 close(PAGE);
500
501 }
502 @prelast_sql_update=@last_sql_update;
503 @last_sql_update=@sql_update;
504 @sql_update = ();
505
506 $last_fn=sprintf("%02d.php",$page_nr);
507 $last_page="$html{'header'} $body $html{'submit'} $html{'footer'}";
508 # delete vars for next page
509 $page_nr++;
510 $body="";
511 }
512 }
513 } # page
514
515 sub nr {
516 package main;
517
518 my ($xp, $el, $attref, $ncref) = @_;
519
520 $pitanje_tag="";
521
522 $$ncref = sub {
523 my ($xp, $text) = @_;
524 if (defined($text)) {
525 $body.=x($text);
526 chomp $text;
527 $pitanje_tag .= x($text);
528 } else {
529 $pitanje_nr = $pitanje_tag;
530 $pitanje_nr =~ s/[^0-9a-zA-Z]//g;
531 print "$pitanje_nr ";
532 }
533 $p_suffix="";
534 };
535 } # nr
536
537
538 sub hr {
539 $body .= "<br></td></tr>$html{'separator'}<tr><td></td><td><br>";
540 }
541
542 sub br {
543 $body .= "<br>\n";
544 }
545
546 sub pit {
547 package main;
548
549 my ($xp, $el, $attref, $ncref) = @_;
550
551 $body.="<p>";
552
553 $$ncref = sub {
554 my ($xp, $text) = @_;
555
556 if (defined $text) {
557 $body.=x($text);
558 } else {
559 $body.="</p>";
560 }
561 }
562 }
563
564 sub podpit {
565 package main;
566
567 my ($xp, $el, $attref, $ncref) = @_;
568
569 $body.='<table width="100%" cellspacing="0" cellpadding="2" border="0">';
570 $$ncref = sub {
571 my ($xp, $text) = @_;
572
573 if (defined $text) {
574 $body.=x($text);
575 } else {
576 $body.="</table>";
577 }
578 }
579 }
580
581
582 sub odg {
583 package main;
584
585 my ($xp, $el, $attref, $ncref) = @_;
586
587 $body .= "<p>";
588
589 $$ncref = sub {
590 my ($xp, $text) = @_;
591
592 if (defined $text) {
593 $body .= x($text);
594 } else {
595 $body .= "</p>";
596 }
597 }
598 }
599
600 sub php {
601 package main;
602 my ($xp, $el, $attref, $ncref) = @_;
603
604 $body.="<?php\n";
605
606 $$ncref = sub {
607 my ($xp, $text) = @_;
608
609 if (defined $text) {
610 $text=~s/ lt / < /g;
611 $text=~s/ le / <= /g;
612 $text=~s/ gt / > /g;
613 $text=~s/ ge / >= /g;
614 $body.=x($text);
615 } else {
616 $body.="\n?>\n";
617 }
618 }
619 }
620
621 sub dropdown {
622 package main;
623
624 my ($xp, $el, $attref, $ncref) = @_;
625
626 my @dropdown_data;
627
628 my $default_value = x($attref->{default_value}) || 'null';
629 my $default_text = x($attref->{default_text}) || '-';
630
631 $$ncref = sub {
632 my ($xp, $text) = @_;
633
634 if (defined $text) {
635 chomp $text;
636 $text=~s/^\s*//g;
637 $text=~s/^[\d\.\s]+//g if ($remove_nrs_in_answers);
638 $text=~s/\s*$//g;
639 push @dropdown_data,x($text) if ($text ne "");
640 } else {
641 my $opt;
642 my $id=1;
643 my $p=new_pit();
644 $body.="<select name=$p >\n";
645 $body.="<option value=\"$default_value\">$default_text</option>\n";
646 foreach $opt (@dropdown_data) {
647 if (defined($opt) && $opt ne "") {
648 $body.="<option value=$id>$opt</option>\n";
649 $id++;
650 }
651 }
652 $body.="</select>\n";
653
654 push @sql_create,"$p int4";
655 push @sql_update,"$p=\$$p";
656 }
657 }
658 }
659
660 sub textbox {
661 package main;
662 my ($xp, $el, $attref, $ncref) = @_;
663
664 $$ncref = sub {
665 my ($xp, $text) = @_;
666 my $size=$attref->{size};
667 $size = 25 if (! defined $size || $size == 0); # default
668 my $p=new_pit();
669 $body.="<input type=text name=$p size=".x($size)." >\n";
670 push @sql_create,"$p text";
671 push @sql_update,"$p='\$$p'";
672 }
673 }
674
675 sub radiobuttons_tab {
676 package main;
677 my ($xp, $el, $attref, $ncref) = @_;
678
679 $$ncref = sub {
680 my ($xp, $text) = @_;
681 if (! defined $text) {
682 my $nr=$attref->{nr};
683 my $p=new_pit();
684 for (my $i=1; $i<=$nr; $i++) {
685 $body.="<td><input type=radio name=$p value=$i></td> ";
686 }
687 push @sql_create,"$p int4";
688 push @sql_update,"$p=\$$p";
689 }
690 }
691 }
692
693 sub radiobuttons {
694 package main;
695 my ($xp, $el, $attref, $ncref) = @_;
696
697 my @radiobuttons_data;
698
699 $$ncref = sub {
700 my ($xp, $text) = @_;
701
702 if (defined $text) {
703 chomp $text;
704 $text=~s/^\s*//g;
705 $text=~s/^[\d\.\s]+//g if ($remove_nrs_in_answers);
706 $text=~s/\s*$//g;
707 push @radiobuttons_data,x($text) if ($text ne "");
708 } else {
709 my $opt;
710 my $p=new_pit();
711 my $id=1;
712 foreach $opt (@radiobuttons_data) {
713 if (defined($opt) && $opt ne "") {
714 $body.="<input type=radio name=$p value=$id> $opt<br>\n";
715 $id++;
716 }
717 }
718 push @sql_create,"$p int4";
719 push @sql_update,"$p=\$$p";
720 }
721 }
722 }
723 sub checkbox {
724 package main;
725 my ($xp, $el, $attref, $ncref) = @_;
726
727 $$ncref = sub {
728 my ($xp, $text) = @_;
729 my $p=new_pit();
730 $body.="<input type=checkbox name=$p >\n";
731 push @sql_create,"$p text";
732 push @sql_update,"$p='\$$p'";
733 }
734 }
735
736 sub checkboxes {
737 package main;
738
739 my ($xp, $el, $attref, $ncref) = @_;
740
741 my @checkboxes_data;
742
743 $$ncref = sub {
744 my ($xp, $text) = @_;
745
746
747 if (defined $text) {
748 chomp $text;
749 $text=~s/^\s*//g;
750 $text=~s/^[\d\.\s]+//g if ($remove_nrs_in_answers);
751 $text=~s/\s*$//g;
752 push @checkboxes_data,x($text) if ($text ne "");
753 } else {
754 my $opt;
755 my $base_p=new_pit();
756 my $id=1;
757
758 my $before=$attref->{before};
759 my $after=$attref->{after};
760 my $middle=$attref->{middle};
761 if (! $before && ! $after && ! $middle) {
762 $middle="&nbsp;";
763 $after="<br>";
764 }
765 my $hide_description=$attref->{hide_description};
766
767 foreach $opt (@checkboxes_data) {
768 if (defined($opt) && $opt ne "") {
769 $p=$base_p."_".$id;
770 $id++;
771 $body .= x($before) if ($before);
772 $body.="<input type=checkbox name=$p>";
773 $body .= x($middle) if ($middle);
774 $body .= "$opt" if (! $hide_description);
775 $body .= x($after) if ($after);
776 $body.="\n";
777
778 push @sql_create,"$p boolean";
779 push @sql_update,"$p=\$$p";
780 }
781 }
782 $php_addon[$page_nr].="fix_checkboxes($base_p,".($id-1).");";
783
784 }
785 }
786 }
787
788 sub html {
789 package main;
790
791 my ($xp, $el, $attref, $ncref) = @_;
792
793 $body.="<p>";
794
795 $$ncref = sub {
796 my ($xp, $text) = @_;
797
798 if (defined $text) {
799 $body.=x($text);
800 } elsif ($attref->{include}) {
801 $body.=suck_file($attref->{include});
802 } else {
803 $body.="</p>";
804 }
805 }
806 }
807
808 print "\n\nTo create database for poll $poll use:\n\n";
809 print "\$ psql template1 < $poll/$poll.sql\n\n";
810 print "THIS WILL DISTROY ALL DATA IN EXISTING DATABASE ".$prefix.$poll." !!\n";
811
812 # read configuration data
813 #
814 # FIX: write actually this :-)
815 sub config {
816 package main;
817 my ($xp, $el, $attref, $ncref) = @_;
818
819 $$ncref = sub {
820 my ($xp, $text) = @_;
821 $db_user=x($attref->{db_user});
822 $prefix=x($attref->{prefix});
823 $without_invitation=x($attref->{without_invitation}) &&
824 print "Pool is without need for unique ID (and invitation URLs).\n";
825 $remove_nrs_in_answers=x($attref->{$remove_nrs_in_answers}) &&
826 print "Numbers before answers will be removed.\n";
827
828 foreach my $file (qw(header separator submit footer thanks)) {
829 if ($attref->{$file}) {
830 $include_files{$file}=x($attref->{$file});
831 print "Using custom $file '$include_files{$file}'\n";
832 $html{$file} = suck_file($include_files{$file});
833 }
834 }
835 }
836 }
837
838 #---------------------------------------------------------------

  ViewVC Help
Powered by ViewVC 1.1.26