/[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.8 - (show annotations)
Wed Sep 24 19:55:43 2003 UTC (20 years, 6 months ago) by dpavlin
Branch: MAIN
Changes since 1.7: +9 -1 lines
File MIME type: text/plain
print some instruction about database creation

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 print PAGE php_header($page_nr,@prelast_sql_update);
183 my $next_fn=sprintf("%02d.php",$page_nr);
184 $last_page=~s/##NEXTPAGE##/$next_fn/;
185 print PAGE $last_page;
186 close(PAGE);
187
188 $page_nr++;
189 open(PAGE, ">$poll/$next_fn") or die "Couldn't open $next_fn for writing:\n$!";
190 print PAGE php_header($page_nr,@last_sql_update);
191 print PAGE "$html_header $html_kraj $html_footer";
192 close(PAGE);
193
194 # dump sql structure
195
196 open(SQL,">$poll/$poll.sql") || die "$poll.sql: $!";
197 print SQL "drop database ".$prefix.$poll.";\n";
198 print SQL "create database ".$prefix.$poll.";\n";
199 print SQL "\\connect ".$prefix.$poll.";\n";
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;
236 $out .= "_".$p_suffix if ($p_suffix);
237 $curr_suffix=$p_suffix;
238 $p_suffix++;
239 return $out;
240 }
241
242 # current pitanje
243 sub curr_pit {
244 return "p".$pitanje_nr.$curr_suffix;
245 }
246
247 #----------------------------------------------------------
248
249 sub starthndl {
250 my ($xp, $el, %atts) = @_;
251
252 # return unless ($in_poll or $el eq 'slideshow');
253
254 unless ($in_poll) {
255 $in_poll = $xp->depth + 1;
256 return;
257 }
258
259 if ($Mode) {
260
261 if ($Mode eq 'pass') {
262 $Markedup_Text .= "\n" . $xp->recognized_string;
263 }
264 elsif ($Mode eq 'object') {
265 push(@Ostack, $Object);
266
267 $Object = {_Atts => \%atts,
268 _Text => ''
269 };
270 bless $Object, "Slideobj::$el";
271 }
272
273 # skip does nothing
274 return;
275 }
276
277 unless ($after_head) {
278 if ($el eq 'head') {
279 $after_head = 1;
280 start_mode($xp, 'object');
281
282 push(@closure_stack, $closure);
283 $closure =
284 sub {
285 my ($xp, $text) = @_;
286
287 unless (defined $text) {
288
289 $header = $Object;
290 }
291 };
292
293 return;
294 }
295
296 # die "The head element must be the first thing in the slideshow";
297 }
298
299
300 my $new_closure;
301
302 my $subname = "Poll::$el";
303
304 if (defined &$subname) {
305 no strict 'refs';
306
307 &$subname($xp, $el, \%atts, \$new_closure);
308 }
309 else {
310 $body .= x($xp->recognized_string);
311 $new_closure =
312 sub {
313 my ($xp, $text) = @_;
314
315 if (defined $text) {
316 $body .= x($text);
317 }
318 else {
319 $body .= x("</$el>");
320 }
321 };
322 }
323
324 push(@closure_stack, $closure);
325 $closure = $new_closure;
326 } # End starthndl
327
328 sub endhndl {
329 my ($xp, $el) = @_;
330
331 return unless $in_poll;
332
333 my $lev = $xp->depth;
334
335 if ($lev == $in_poll - 1) {
336 $in_poll = 0;
337 $xp->finish;
338 return;
339 }
340
341 if ($Mode_level == $lev) {
342
343 if ($Mode eq 'pass') {
344 &$closure($xp, $Markedup_Text)
345 if (defined $closure);
346 }
347
348 $Mode = $Mode_level = 0;
349 }
350
351 if ($Mode) {
352 if ($Mode eq 'pass') {
353 $Markedup_Text .= "</$el>";
354 }
355 elsif ($Mode eq 'object') {
356 my $this = $Object;
357 if (2 == keys %$this) {
358 $this = $this->{_Text};
359 }
360
361 $Object = pop(@Ostack);
362
363 my $slot = $Object->{$el};
364 if (defined $slot) {
365 if (ref($slot) eq 'ARRAY') {
366 push(@$slot, $this);
367 }
368 else {
369 $Object->{$el} = [$slot, $this];
370 }
371 }
372 else {
373 $Object->{$el} = $this;
374 }
375 }
376
377 return;
378 }
379
380 &$closure($xp)
381 if defined $closure;
382
383 $closure = pop(@closure_stack);
384 } # End endhndl
385
386 #----------------------------------------------------------
387
388 sub text {
389 my ($xp, $data) = @_;
390
391 return unless $in_poll;
392
393 if ($Mode ) {
394
395 if ($Mode eq 'pass') {
396 my $safe = sgml_escape($data);
397
398 $Text .= $safe;
399 $Markedup_Text .= $safe;
400 }
401 elsif ($Mode eq 'object') {
402 $Object->{_Text} .= $data
403 if $data =~ /\S/;
404 }
405
406 return;
407 }
408
409 &$closure($xp, sgml_escape($data))
410 if (defined $closure);
411
412 } # End text
413
414 sub start_mode {
415 my ($xp, $mode) = @_;
416
417 if ($mode eq 'pass') {
418 $Text = '';
419 $Markedup_Text = '';
420 }
421 elsif ($mode eq 'object') {
422 $Object = {_Atts => undef,
423 _Text => undef
424 };
425 }
426
427 $Mode = $mode;
428 $Mode_level = $xp->depth;
429 } # End start_mode
430
431 sub sgml_escape {
432 my ($str) = @_;
433
434 $str =~ s/\&/\&amp;/g;
435 $str =~ s/</\&lt;/g;
436 $str =~ s/>/\&gt;/g;
437
438 $str;
439 } # End sgml_escape
440
441
442 ################################################################
443
444 package Poll;
445
446 sub page {
447 package main;
448
449 my ($xp, $el, $attref, $ncref) = @_;
450
451 $$ncref = sub {
452 my ($xp, $text) = @_;
453
454 if (! defined $text) {
455
456 print "p[$page_nr] ";
457
458 if (defined $last_fn) {
459 open(PAGE, ">$poll/$last_fn") or die "Couldn't open $last_fn for writing:\n$!";
460 print PAGE php_header($page_nr,@prelast_sql_update);
461 my $next_fn=sprintf("%02d.php",$page_nr);
462 $last_page=~s/##NEXTPAGE##/$next_fn/;
463 print PAGE $last_page;
464 close(PAGE);
465
466 }
467 @prelast_sql_update=@last_sql_update;
468 @last_sql_update=@sql_update;
469 @sql_update = ();
470
471 $last_fn=sprintf("%02d.php",$page_nr);
472 $last_page="$html_header $body $html_next $html_footer";
473 # delete vars for next page
474 $page_nr++;
475 $body="";
476 }
477 }
478 } # page
479
480 sub nr {
481 package main;
482
483 my ($xp, $el, $attref, $ncref) = @_;
484
485 $pitanje_tag="";
486
487 $$ncref = sub {
488 my ($xp, $text) = @_;
489 if (defined($text)) {
490 $body.=x($text);
491 chomp $text;
492 $pitanje_tag .= x($text);
493 } else {
494 $pitanje_nr = $pitanje_tag;
495 $pitanje_nr =~ s/[^0-9a-zA-Z]//g;
496 print "$pitanje_nr ";
497 }
498 $p_suffix="";
499 };
500 } # nr
501
502
503 sub hr {
504 $body .= "<br></td></tr>$html_separator<tr><td></td><td><br>";
505 }
506
507 sub br {
508 $body .= "<br>\n";
509 }
510
511 sub pit {
512 package main;
513
514 my ($xp, $el, $attref, $ncref) = @_;
515
516 $body.="<p>";
517
518 $$ncref = sub {
519 my ($xp, $text) = @_;
520
521 if (defined $text) {
522 $body.=x($text);
523 } else {
524 $body.="</p>";
525 }
526 }
527 }
528
529 sub podpit {
530 package main;
531
532 my ($xp, $el, $attref, $ncref) = @_;
533
534 $body.='<table width="100%" cellspacing="0" cellpadding="2" border="0">';
535 $$ncref = sub {
536 my ($xp, $text) = @_;
537
538 if (defined $text) {
539 $body.=x($text);
540 } else {
541 $body.="</table>";
542 }
543 }
544 }
545
546
547 sub odg {
548 package main;
549
550 my ($xp, $el, $attref, $ncref) = @_;
551
552 $body .= "<p>";
553
554 $$ncref = sub {
555 my ($xp, $text) = @_;
556
557 if (defined $text) {
558 $body .= x($text);
559 } else {
560 $body .= "</p>";
561 }
562 }
563 }
564
565 sub php {
566 package main;
567 my ($xp, $el, $attref, $ncref) = @_;
568
569 $body.="<?php\n";
570
571 $$ncref = sub {
572 my ($xp, $text) = @_;
573
574 if (defined $text) {
575 $text=~s/ lt / < /g;
576 $text=~s/ le / <= /g;
577 $text=~s/ gt / > /g;
578 $text=~s/ ge / >= /g;
579 $body.=x($text);
580 } else {
581 $body.="\n?>\n";
582 }
583 }
584 }
585
586 sub dropdown {
587 package main;
588
589 my ($xp, $el, $attref, $ncref) = @_;
590
591 my @dropdown_data;
592
593 $$ncref = sub {
594 my ($xp, $text) = @_;
595
596 if (defined $text) {
597 chomp $text;
598 $text=~s/^\s*//g;
599 $text=~s/^[\d\.\s]+//g;
600 $text=~s/\s*$//g;
601 push @dropdown_data,x($text) if ($text ne "");
602 } else {
603 my $opt;
604 my $id=1;
605 my $p=new_pit();
606 $body.="<select name=$p >\n";
607 $body.="<option value=null>-</option>\n";
608 foreach $opt (@dropdown_data) {
609 if (defined($opt) && $opt ne "") {
610 $body.="<option value=$id>$opt</option>\n";
611 $id++;
612 }
613 }
614 $body.="</select>\n";
615
616 push @sql_create,"$p int4";
617 push @sql_update,"$p=\$$p";
618 }
619 }
620 }
621
622 sub textbox {
623 package main;
624 my ($xp, $el, $attref, $ncref) = @_;
625
626 $$ncref = sub {
627 my ($xp, $text) = @_;
628 my $size=$attref->{size};
629 $size = 25 if (! defined $size || $size == 0); # default
630 my $p=new_pit();
631 $body.="<input type=text name=$p size=".x($size)." >\n";
632 push @sql_create,"$p text";
633 push @sql_update,"$p='\$$p'";
634 }
635 }
636
637 sub radiobuttons_tab {
638 package main;
639 my ($xp, $el, $attref, $ncref) = @_;
640
641 $$ncref = sub {
642 my ($xp, $text) = @_;
643 if (! defined $text) {
644 my $nr=$attref->{nr};
645 my $p=new_pit();
646 for (my $i=1; $i<=$nr; $i++) {
647 $body.="<td><input type=radio name=$p value=$i></td> ";
648 }
649 push @sql_create,"$p int4";
650 push @sql_update,"$p=\$$p";
651 }
652 }
653 }
654
655 sub radiobuttons {
656 package main;
657 my ($xp, $el, $attref, $ncref) = @_;
658
659 my @radiobuttons_data;
660
661 $$ncref = sub {
662 my ($xp, $text) = @_;
663
664 if (defined $text) {
665 chomp $text;
666 $text=~s/^\s*//g;
667 $text=~s/^[\d\.\s]+//g;
668 $text=~s/\s*$//g;
669 push @radiobuttons_data,x($text) if ($text ne "");
670 } else {
671 my $opt;
672 my $p=new_pit();
673 my $id=1;
674 foreach $opt (@radiobuttons_data) {
675 if (defined($opt) && $opt ne "") {
676 $body.="<input type=radio name=$p value=$id> $opt<br>\n";
677 $id++;
678 }
679 }
680 push @sql_create,"$p int4";
681 push @sql_update,"$p=\$$p";
682 }
683 }
684 }
685 sub checkbox {
686 package main;
687 my ($xp, $el, $attref, $ncref) = @_;
688
689 $$ncref = sub {
690 my ($xp, $text) = @_;
691 my $p=new_pit();
692 $body.="<input type=checkbox name=$p >\n";
693 push @sql_create,"$p text";
694 push @sql_update,"$p='\$$p'";
695 }
696 }
697
698 sub checkboxes {
699 package main;
700
701 my ($xp, $el, $attref, $ncref) = @_;
702
703 my @checkboxes_data;
704
705 $$ncref = sub {
706 my ($xp, $text) = @_;
707
708
709 if (defined $text) {
710 chomp $text;
711 $text=~s/^\s*//g;
712 $text=~s/^[\d\.\s]+//g;
713 $text=~s/\s*$//g;
714 push @checkboxes_data,x($text) if ($text ne "");
715 } else {
716 my $opt;
717 my $base_p=new_pit();
718 my $id=1;
719
720 my $before=$attref->{before};
721 my $after=$attref->{after};
722 my $middle=$attref->{middle};
723 if (! $before && ! $after && ! $middle) {
724 $middle="&nbsp;";
725 $after="<br>";
726 }
727 my $hide_description=$attref->{hide_description};
728
729 foreach $opt (@checkboxes_data) {
730 if (defined($opt) && $opt ne "") {
731 $p=$base_p."_".$id;
732 $id++;
733 $body .= x($before) if ($before);
734 $body.="<input type=checkbox name=$p>";
735 $body .= x($middle) if ($middle);
736 $body .= "$opt" if (! $hide_description);
737 $body .= x($after) if ($after);
738 $body.="\n";
739
740 push @sql_create,"$p boolean";
741 push @sql_update,"$p=\$$p";
742 }
743 }
744 $php_addon[$page_nr].="fix_checkboxes($base_p,".($id-1).");";
745
746 }
747 }
748 }
749
750 print "\n\nTo create database for poll $poll use:\n\n";
751 print "\$ psql template1 < $poll/$poll.sql\n\n";
752 print "THIS WILL DISTROY ALL DATA IN EXISTING DATABASE ".$prefix.$poll." !!\n";
753
754 # read configuration data
755 #
756 # FIX: write actually this :-)
757 sub config {
758 package main;
759 my ($xp, $el, $attref, $ncref) = @_;
760
761 $$ncref = sub {
762 my ($xp, $text) = @_;
763 $db_user=x($attref->{db_user});
764 $prefix=x($attref->{prefix});
765 }
766 }
767
768 #---------------------------------------------------------------

  ViewVC Help
Powered by ViewVC 1.1.26