/[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.22 - (show annotations)
Mon Apr 19 16:33:10 2004 UTC (14 years, 11 months ago) by dpavlin
Branch: MAIN
CVS Tags: HEAD
Changes since 1.21: +27 -1 lines
File MIME type: text/plain
ask to copy template into poll's dir if they don't exist

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

  ViewVC Help
Powered by ViewVC 1.1.26