/[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.6 - (show annotations)
Thu Apr 24 19:11:45 2003 UTC (20 years, 11 months ago) by dpavlin
Branch: MAIN
Changes since 1.5: +50 -43 lines
File MIME type: text/plain
fixes for polls with just 1 page

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

  ViewVC Help
Powered by ViewVC 1.1.26