/[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.21 - (show annotations)
Tue Apr 13 15:11:58 2004 UTC (19 years, 11 months ago) by dpavlin
Branch: MAIN
Changes since 1.20: +21 -1 lines
File MIME type: text/plain
removed common.pl and integrated recoding to arbitrary output charset
using <config html_encoding="Windows-1250"> for example.

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

  ViewVC Help
Powered by ViewVC 1.1.26