--- make_poll.pl 2003/04/24 19:11:45 1.6
+++ make_poll.pl 2003/11/08 22:42:18 1.20
@@ -10,6 +10,7 @@
use XML::Parser;
use common;
+use Carp;
$|=1;
@@ -22,15 +23,16 @@
my $poll;
my $dowarn = 1;
-my $pitanje_nr = 0; # curr. pitanje
-my $pitanje_tag = ""; # originalni oblik broja pitanja
-my $page_nr = 1; # prvo pitanje na strani
+my $q_type = "q"; # q=question, u=unnumbered question
+my %question_nr; # curr. question numbers
+my $question_tag = ""; # originalni oblik broja questions
+my $page_nr = 1; # prvo question na strani
my $p_suffix=""; # if more than one box per question
my $curr_suffix=""; # trenutni suffix
-my @stack_pit; # stack pitanja (pitanje, suffix)
+my @stack_que; # stack of questions (question, suffix)
my @sql_create = ("id serial",
"http_referer character varying(500)",
@@ -53,10 +55,64 @@
# this is usename in database
my $db_user="dpavlin";
+# This option allows users to fill poll without using invitation URL.
+# That also means it's unpossible for them to return to exiting poll
+# because they don't have thair own unique ID. Howver, it enables simple
+# polls to be conducted by just publishing URL to them.
+my $without_invitation=0;
+
+# This will remove numbers before answers. That enables you to have
+# answers written like:
+# 1.1 red
+# 1.2 black
+# and users will see just "red" and "black"
+my $remove_nrs_in_answers=0;
+
+# This defines files which will be included in various places to produce
+# design. You could desing them using your faviourite html editor (vim :-)
+# and then split them into separate files
+
+my %include_files = (
+# this file is included at top of each paAge
+ 'header' => "header.html",
+# this file is used to separate questions
+ 'separator' => "separator.html",
+# this file is used to show "submit" button, which under multi-page
+# polls will also bring next page
+ 'submit' => "next.html",
+# this file is included at bottom of each page
+ 'footer' => "footer.html",
+# this file will be showen after poll is completed
+ 'thanks' => "thanks.html"
+);
+
+# buffer for suck(_file)ed html files
+# and additional markup before and after tags
+my %html = (
+ 'hr_before' => "
",
+ 'hr_after' => "
", + 'que_after' => "
", + 'subque_before' => '", + 'ans_after' => "
", + 'html_before' => "", + 'html_after' => "
", + +); + +# name of database colums +# for questions +my $q_db_col = "q"; +# for unnumbered questions +my $u_db_col = "u"; + + #------------------------------------------------------------------ sub suck_file { - my $file = shift @_; + my $file = shift || croak "suck_file called without argument"; open(H,$file) || die "can't open '$file': $!"; my $content; while ($sql"; +# print "
$sql"; $result=pg_Exec($conn,fix_sql($sql)); } elseif($do_stranice != $PHP_SELF && isset($do_uri) && isset($a)) { Header("Location: $do_uri?a=$a"); @@ -104,7 +160,7 @@ #------------------------------------------------------------------ -my $html_kraj=suck_file("thanks.html"); +$html{'thanks'}=suck_file($include_files{'thanks'}); #------------------------------------------------------------------ @@ -179,9 +235,6 @@ print "p[$page_nr] "; open(PAGE, ">$poll/$last_fn") or die "Couldn't open $last_fn for writing:\n$!"; -if ($page_nr <= 2) { - print PAGE php_new_poll(); -} print PAGE php_header($page_nr,@prelast_sql_update); my $next_fn=sprintf("%02d.php",$page_nr); $last_page=~s/##NEXTPAGE##/$next_fn/; @@ -191,12 +244,15 @@ $page_nr++; open(PAGE, ">$poll/$next_fn") or die "Couldn't open $next_fn for writing:\n$!"; print PAGE php_header($page_nr,@last_sql_update); -print PAGE "$html_header $html_kraj $html_footer"; +print PAGE "$html{'header'} $html{'thanks'} $html{'footer'}"; close(PAGE); # dump sql structure open(SQL,">$poll/$poll.sql") || die "$poll.sql: $!"; +print SQL "drop database ".$prefix.$poll.";\n"; +print SQL "create database ".$prefix.$poll.";\n"; +print SQL "\\connect ".$prefix.$poll.";\n"; print SQL "create table poslani ( member_id int4 not null, unesen timestamp default now() );\n"; print SQL "create table $poll (do_stranice text default null, ",join(",\n",@sql_create),");\n"; close(SQL); @@ -212,6 +268,7 @@ $common_php =~ s/##PREFIX##/$prefix/g; my $members_db = $prefix."members"; $common_php =~ s/##MEMBERS_DB##/$members_db/g; +$common_php =~ s/##WITHOUT_INVITATION##/$without_invitation/g; print PHP $common_php; close(PHP); @@ -230,233 +287,199 @@ ## End of main ################ -# return unique name of pitanje -sub new_pit { - my $out="p".$pitanje_nr.$p_suffix; +# return unique name of question +sub new_que { + my $out=$q_type.( $question_nr{$q_type} || 0 ); + $out .= "_".$p_suffix if ($p_suffix); $curr_suffix=$p_suffix; $p_suffix++; return $out; } -# current pitanje -sub curr_pit { - return "p".$pitanje_nr.$curr_suffix; +# current question +sub curr_que { + return $q_type.( $question_nr{$q_type} || 0 ).$curr_suffix; } #---------------------------------------------------------- sub starthndl { - my ($xp, $el, %atts) = @_; + my ($xp, $el, %atts) = @_; -# return unless ($in_poll or $el eq 'slideshow'); +# return unless ($in_poll or $el eq 'slideshow'); - unless ($in_poll) { - $in_poll = $xp->depth + 1; - return; - } - - if ($Mode) { + unless ($in_poll) { + $in_poll = $xp->depth + 1; + return; + } + + if ($Mode) { + if ($Mode eq 'pass') { + $Markedup_Text .= "\n" . $xp->recognized_string; + } elsif ($Mode eq 'object') { + push(@Ostack, $Object); + + $Object = { + _Atts => \%atts, + _Text => '' + }; + bless $Object, "Slideobj::$el"; + } - if ($Mode eq 'pass') { - $Markedup_Text .= "\n" . $xp->recognized_string; - } - elsif ($Mode eq 'object') { - push(@Ostack, $Object); + # skip does nothing + return; + } - $Object = {_Atts => \%atts, - _Text => '' - }; - bless $Object, "Slideobj::$el"; - } + unless ($after_head) { + if ($el eq 'head') { + $after_head = 1; + start_mode($xp, 'object'); - # skip does nothing - return; - } + push(@closure_stack, $closure); + $closure = sub { + my ($xp, $text) = @_; - unless ($after_head) { - if ($el eq 'head') { - $after_head = 1; - start_mode($xp, 'object'); - - push(@closure_stack, $closure); - $closure = - sub { - my ($xp, $text) = @_; - - unless (defined $text) { - - $header = $Object; - } - }; + unless (defined $text) { + $header = $Object; + } + }; + return; + } - return; - } +# die "The head element must be the first thing in the slideshow"; + } -# die "The head element must be the first thing in the slideshow"; - } + my $new_closure; - my $new_closure; + my $subname = "Poll::$el"; - my $subname = "Poll::$el"; + if (defined &$subname) { + no strict 'refs'; - if (defined &$subname) { - no strict 'refs'; + &$subname($xp, $el, \%atts, \$new_closure); + } else { + $body .= x($xp->recognized_string); + $new_closure = sub { + my ($xp, $text) = @_; - &$subname($xp, $el, \%atts, \$new_closure); - } - else { - $body .= x($xp->recognized_string); - $new_closure = - sub { - my ($xp, $text) = @_; - - if (defined $text) { - $body .= x($text); - } - else { - $body .= x("$el>"); + if (defined $text) { + $body .= x($text); + } else { + $body .= x("$el>"); + } + }; } - }; - } - push(@closure_stack, $closure); - $closure = $new_closure; -} # End starthndl + push(@closure_stack, $closure); + $closure = $new_closure; +} # End starthndl sub endhndl { - my ($xp, $el) = @_; + my ($xp, $el) = @_; - return unless $in_poll; + return unless $in_poll; - my $lev = $xp->depth; + my $lev = $xp->depth; - if ($lev == $in_poll - 1) { - $in_poll = 0; - $xp->finish; - return; - } - - if ($Mode_level == $lev) { - - if ($Mode eq 'pass') { - &$closure($xp, $Markedup_Text) - if (defined $closure); - } + if ($lev == $in_poll - 1) { + $in_poll = 0; + $xp->finish; + return; + } + + if ($Mode_level == $lev) { + + if ($Mode eq 'pass') { + &$closure($xp, $Markedup_Text) if (defined $closure); + } - $Mode = $Mode_level = 0; - } + $Mode = $Mode_level = 0; + } - if ($Mode) { - if ($Mode eq 'pass') { - $Markedup_Text .= "$el>"; - } - elsif ($Mode eq 'object') { - my $this = $Object; - if (2 == keys %$this) { - $this = $this->{_Text}; - } - - $Object = pop(@Ostack); - - my $slot = $Object->{$el}; - if (defined $slot) { - if (ref($slot) eq 'ARRAY') { - push(@$slot, $this); - } - else { - $Object->{$el} = [$slot, $this]; - } - } - else { - $Object->{$el} = $this; - } - } + if ($Mode) { + if ($Mode eq 'pass') { + $Markedup_Text .= "$el>"; + } elsif ($Mode eq 'object') { + my $this = $Object; + if (2 == keys %$this) { + $this = $this->{_Text}; + } - return; - } + $Object = pop(@Ostack); - &$closure($xp) - if defined $closure; + my $slot = $Object->{$el}; + if (defined $slot) { + if (ref($slot) eq 'ARRAY') { + push(@$slot, $this); + } else { + $Object->{$el} = [$slot, $this]; + } + } else { + $Object->{$el} = $this; + } + } - $closure = pop(@closure_stack); + return; + } + + &$closure($xp) if defined $closure; + + $closure = pop(@closure_stack); } # End endhndl #---------------------------------------------------------- sub text { - my ($xp, $data) = @_; + my ($xp, $data) = @_; - return unless $in_poll; + return unless $in_poll; - if ($Mode ) { + if ($Mode) { - if ($Mode eq 'pass') { - my $safe = sgml_escape($data); + if ($Mode eq 'pass') { + my $safe = sgml_escape($data); - $Text .= $safe; - $Markedup_Text .= $safe; - } - elsif ($Mode eq 'object') { - $Object->{_Text} .= $data - if $data =~ /\S/; - } + $Text .= $safe; + $Markedup_Text .= $safe; + } elsif ($Mode eq 'object') { + $Object->{_Text} .= $data if $data =~ /\S/; + } - return; - } + return; + } - &$closure($xp, sgml_escape($data)) - if (defined $closure); + &$closure($xp, sgml_escape($data)) if (defined $closure); } # End text sub start_mode { - my ($xp, $mode) = @_; + my ($xp, $mode) = @_; - if ($mode eq 'pass') { - $Text = ''; - $Markedup_Text = ''; - } - elsif ($mode eq 'object') { - $Object = {_Atts => undef, - _Text => undef - }; - } + if ($mode eq 'pass') { + $Text = ''; + $Markedup_Text = ''; + } elsif ($mode eq 'object') { + $Object = { + _Atts => undef, + _Text => undef + }; + } - $Mode = $mode; - $Mode_level = $xp->depth; + $Mode = $mode; + $Mode_level = $xp->depth; } # End start_mode sub sgml_escape { - my ($str) = @_; + my ($str) = @_; - $str =~ s/\&/\&/g; - $str =~ s/\</g; - $str =~ s/>/\>/g; + $str =~ s/\&/\&/g; + $str =~ s/\</g; + $str =~ s/>/\>/g; - $str; + $str; } # End sgml_escape - -sub php_new_poll { - return '$sql"; - $result=pg_Exec($conn,fix_sql($sql)); - $lastoid=pg_getlastoid($result); - $result = pg_Exec($conn,fix_sql("select id from '.$poll.' where oid=$lastoid")); - $row=pg_fetch_row($result,0); - $id=$row[0]; -?>'; -} - ################################################################ package Poll; @@ -475,13 +498,7 @@ if (defined $last_fn) { open(PAGE, ">$poll/$last_fn") or die "Couldn't open $last_fn for writing:\n$!"; - if ($page_nr < 2) { - print PAGE php_new_poll(); - } else { - print PAGE php_header($page_nr,@prelast_sql_update); - } # last_sql_update - - + print PAGE php_header($page_nr,@prelast_sql_update); my $next_fn=sprintf("%02d.php",$page_nr); $last_page=~s/##NEXTPAGE##/$next_fn/; print PAGE $last_page; @@ -493,7 +510,7 @@ @sql_update = (); $last_fn=sprintf("%02d.php",$page_nr); - $last_page="$html_header $body $html_next $html_footer"; + $last_page="$html{'header'} $body $html{'submit'} $html{'footer'}"; # delete vars for next page $page_nr++; $body=""; @@ -506,18 +523,18 @@ my ($xp, $el, $attref, $ncref) = @_; - $pitanje_tag=""; + $question_tag=""; $$ncref = sub { my ($xp, $text) = @_; if (defined($text)) { $body.=x($text); chomp $text; - $pitanje_tag .= x($text); + $question_tag .= x($text); } else { - $pitanje_nr = $pitanje_tag; - $pitanje_nr =~ s/[^0-9a-zA-Z]//g; - print "$pitanje_nr "; + $question_nr{$q_type} = $question_tag; + $question_nr{$q_type} =~ s/[^0-9a-zA-Z]//g; + print "$question_nr{$q_type} "; } $p_suffix=""; }; @@ -525,19 +542,32 @@ sub hr { - $body .= "
"; + my $nonum = x($attref->{unnumbered}); + if ($nonum) { + $q_type = $u_db_col; # unnumbered questions + } else { + $q_type = $q_db_col; + } + + $question_nr{$q_type}++; + + # attribute markup_before override que_before + my $markup_before = x($attref->{markup_before}); + my $markup_after = x($attref->{markup_after}); + + if (defined($markup_before)) { + $body.=$markup_before; + } elsif ($html{'que_before'}) { + $body.=$html{'que_before'} + } $$ncref = sub { my ($xp, $text) = @_; @@ -545,43 +575,70 @@ if (defined $text) { $body.=x($text); } else { - $body.="
"; + if (defined($markup_after)) { + $body.=$markup_after; + } elsif ($html{'que_after'}) { + $body.=$html{'que_after'} + } } } } -sub podpit { +sub subque { package main; my ($xp, $el, $attref, $ncref) = @_; - $body.='"; + my $markup_before = x($attref->{markup_before}); + my $markup_after = x($attref->{markup_after}); + if (defined($markup_before)) { + $body.=$markup_before; + } elsif ($html{'ans_before'}) { + $body.=$html{'ans_before'} + } + $$ncref = sub { my ($xp, $text) = @_; if (defined $text) { $body .= x($text); } else { - $body .= "
"; + if (defined($markup_after)) { + $body.=$markup_after; + } elsif ($html{'ans_after'}) { + $body.=$html{'ans_after'} + } } } } @@ -614,21 +671,24 @@ my @dropdown_data; + my $default_value = x($attref->{default_value}) || 'null'; + my $default_text = x($attref->{default_text}) || '-'; + $$ncref = sub { my ($xp, $text) = @_; if (defined $text) { chomp $text; $text=~s/^\s*//g; - $text=~s/^[\d\.\s]+//g; + $text=~s/^[\d\.\s]+//g if ($remove_nrs_in_answers); $text=~s/\s*$//g; push @dropdown_data,x($text) if ($text ne ""); } else { my $opt; my $id=1; - my $p=new_pit(); + my $p=new_que(); $body.="