--- make_poll.pl 2003/04/08 17:53:46 1.1 +++ make_poll.pl 2003/11/08 01:08:44 1.17 @@ -1,45 +1,38 @@ #!/usr/bin/perl -w # - -use XML::Parser; +# Dobrica Pavlinusic +# +# Originally made for proof. during April 2001; later released under GPL v2 +# +# 2003-04-dd general cleanup in preparation of release use strict; +use XML::Parser; +use common; +use Carp; + $|=1; my $Usage =<<'End_of_Usage;'; -slides [-h] [-d dir] [-mode mode] slide-doc - -Convert a slideshow document into html, with a separate html document -for each slide and an index to all of them. - - -h Print this message and exit - - -w warn about unrecognized tags - - -d Use dir as directory into which to write html pages. Defaults - to basename of supplied doc file. - - -mode Output mode. Choices are html, html-style. Default is - html-style. - +I will write usage information here. I promise! End_of_Usage; my @Modes = qw(object pass skip); -my $dir; +my $poll; my $dowarn = 1; -my $dostyle = 0; -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)", @@ -62,80 +55,93 @@ # 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_before' => "

", + 'que_after' => "

", + 'subque_before' => '', + 'subque_after' => "

", + 'ans_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"; -my $html_header.=<<'End_of_header;'; - - - - proof.anketa - - - - - - - - - - - - - - - - - - - - - - -End_of_separator; - -#------------------------------------------------------------------ +sub suck_file { + my $file = shift || croak "suck_file called without argument"; + open(H,$file) || die "can't open '$file': $!"; + my $content; + while () { $content .= $_; } ; + close(H); + return $content; +} -my $html_footer=<<'End_of_footer;'; - - - - - - - -


-
	-End_of_header; #------------------------------------------------------------------ -my $html_separator=<<'End_of_separator;'; -

	- - -

- - - -End_of_footer; +$html{'header'}=suck_file($include_files{'header'}); +$html{'separator'}=suck_file($include_files{'separator'}); +$html{'submit'}=suck_file($include_files{'submit'}); +$html{'footer'}=suck_file($include_files{'footer'}); #------------------------------------------------------------------ sub php_header { my ($page_nr,@sql_update) = @_; -my $out='$sql"; $result=pg_Exec($conn,fix_sql($sql)); - } elseif($do_stranice != $PHP_SELF) { + } elseif($do_stranice != $PHP_SELF && isset($do_uri) && isset($a)) { Header("Location: $do_uri?a=$a"); exit; } @@ -146,203 +152,15 @@ #------------------------------------------------------------------ # first, define some constants -my $common_inc=' -$PREFIX="'.$prefix.'"; -$DB_USER="'.$db_user.'"; -$MEMBERS_DB="'.$prefix.'_members"; -'; - -# then append rest of text - -$common_inc.=<<'End_of_common;'; - -$conn = pg_connect("dbname=$PREFIX$db user=$DB_USER"); -$result=pg_Exec($conn,"set datestyle = 'german'"); - -set_magic_quotes_runtime(1); - -// return number of true answers - -function fix_checkboxes($var,$nr) { - for($i=1; $i<=$nr; $i++) { - if (isset($GLOBALS[$var."_".$i])) { - $GLOBALS[$var."_".$i]="true"; - $nr++; - } else { - $GLOBALS[$var."_".$i]="false"; - } - } - return $nr; - -} - -function checked($var) { - if ($var == "true" || $var == "t") return 1; - return 0; -} - -function id_encode($id) { - return md5($id).strtr($id,"1234567890","abcdef1234"); -} - -function id_decode($eid) { - $id=substr(strtr($eid,"abcdef1234","1234567890"),32); - if (md5($id) == substr($eid,0,32)) { - return $id; - } else { - return 0; - } -} - -function fix_sql($sql) { - $sql=ereg_replace(",([ \t\n\r]*),",",null\\1,",$sql); - $sql=ereg_replace(",([ \t\n\r]*),",",null\\1,",$sql); - $sql=ereg_replace(",([ \t\n\r]*),",",null\\1,",$sql); - $sql=ereg_replace("=([ \t\n\r,]+)","=null\\1",$sql); - $sql=ereg_replace("=([ \t\n\r,]*)$","=null\\1",$sql); - return $sql; -} - -function get_answer($p) { - global $conn,$id,$db; - $result = pg_Exec ($conn,"select $p from $db where id=$id"); - if ($result && pg_numrows($result) > 0) { - $row=pg_fetch_row($result,0); - if (isset($row[0]) && $row[0] != "") { - $GLOBALS[$p]=$row[0]; - return $row[0]; - } - } - $GLOBALS[$p]=0; - return 0; -} - -function get_answers($p) { - global $conn,$id,$db; - $result = pg_Exec ($conn,"select $p from $db where id=$id"); - if ($result && pg_numrows($result) > 0) { - $row=pg_fetch_array($result,0); - $pit=split(",",$p); - while(list($key,$val) = each($row)) { - $GLOBALS[$key]=$val; - } - } -} -function get_member($pitanja,$uvjet) { - global $member_id; - $p_conn = pg_connect("dbname=$MEMBERS_DB user=$DB_USER"); - if ($uvjet == "") $uvjet="true"; - $result=pg_Exec($p_conn,"select id,$pitanja from member - where $uvjet and id = $member_id"); - $numrows=pg_numrows($result); - if ($numrows) { - $row=pg_fetch_array($result,0); - $pit=split(",",$pitanja); - while(list($key,$val) = each($row)) { - $GLOBALS["member_".$key]=$val; - } - } -} - -if (isset($a) && !isset($id) && !isset($pid)) { - global $conn,$db,$do_stranice; - $pid=id_decode($a); - $result = pg_Exec ($conn,"select id,do_stranice from $db where member_id=$pid"); - if ($result && pg_numrows($result) > 0) { - $row=pg_fetch_array($result,0); - $id=$row[id]; - $do_stranice=$row[do_stranice]; - $do_uri="http://".$SERVER_NAME.":".$SERVER_PORT.$row[do_stranice]; - } -} - -End_of_common; +my $common_php = suck_file("common.php"); #------------------------------------------------------------------ -my $head_php.=<<'End_of_head;'; - - Header("Content-type: image/gif"); - header ("Expires: Mon, 26 Jul 1997 05:00:00 GMT"); // Date in the past - header ("Last-Modified: ".gmdate("D, d M Y H:i:s")." GMT"); // always modified - header ("Cache-Control: no-cache, must-revalidate"); // HTTP/1.1 - header ("Pragma: no-cache"); // HTTP/1.0 - $string=implode($argv," "); - $im = imagecreatefromgif("head.gif"); - $red = ImageColorAllocate($im, 255, 0, 0); - $black = ImageColorAllocate($im, 0, 0, 0); - $px = (imagesx($im)-7.5*strlen($string))/2; - if (! isset($pcnt)) { - $pcnt=floor(substr(basename($HTTP_REFERER),0,2)/$max_page*100); - } - ImageTTFText($im, 6, 0, 10, 65, $black, dirname($PATH_TRANSLATED)."/head.ttf", "Ispunili ste ".sprintf("%02d",$pcnt)."% ankete"); - $w=80; - ImageRectangle($im,149,60,151+$w,66,$black); - ImageFilledRectangle($im,150,61,150+floor($pcnt*$w/100),65,$red); - ImageGif($im); - ImageDestroy($im); - -End_of_head; +my $head_php=suck_file("head.php"); #------------------------------------------------------------------ -my $html_kraj=<<'End_of_kraj;'; - - - - wopi.poll - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


-
-
	- -Hvala vam na sudjelovanju u anketi! - - -Zahvaljujemo se na va�em vremenu. Nadamo se da �ete i vi biti -me�u sretnim dobitnicima. - - -Do slijede�e ankete i nagradne igre srda�no vas pozdravljamo. - - Hvala. - - -`proof.` -

		- -

- - - -End_of_kraj; +$html{'thanks'}=suck_file($include_files{'thanks'}); #------------------------------------------------------------------ @@ -353,48 +171,30 @@ print $Usage; exit; } - elsif ($opt eq '-d') { - $dir = shift; - } - elsif ($opt eq '-w') { - $dowarn = 1; - } - elsif ($opt eq '-mode') { - my $marg = shift; - if ($marg eq 'html') { - $dostyle = 0; - } - else { - die "Unrecognized mode: $marg\n$Usage"; - } - } - else { - die "Unrecognized option: $opt\n$Usage"; - } } # End of option processing -my $docfile = shift; +my $xmlfile = shift; -die "No docfile provided:\n$Usage" unless defined $docfile; +die "No poll xml file provided!\n$Usage" unless defined $xmlfile; -die "Can't read $docfile" unless -r $docfile; +die "Can't read $xmlfile" unless -r $xmlfile; -if (defined $dir) { - die "$dir isn't a directory" unless -d $dir; +if (defined $poll) { + die "$poll isn't a directory" unless -d $poll; } else { - $docfile =~ m!([^/.]+)(?:\.[^/.]*)?$!; - $dir = $1; - if (-e $dir) { - die "$dir exists but isn't a directory" - unless -d $dir; + $xmlfile =~ m!([^/.]+)(?:\.[^/.]*)?$!; + $poll = $1; + if (-e $poll) { + die "$poll exists but isn't a directory" + unless -d $poll; } else { - mkdir $dir, 0755; + mkdir $poll, 0755; } } -my $in_slideshow = 0; +my $in_poll = 0; my $after_head = 0; my $Mode = 0; @@ -405,31 +205,28 @@ my $Object; my @Ostack = (); -my $intext = 0; +#my $intext = 0; my $closure; my @closure_stack = (); -my $style_link = ''; +#my $style_link = ''; -my $index = 'index.html'; -my @slidetitle; +#my $index = 'index.html'; +#my @slidetitle; my $body; -my $inlist = 0; +#my $inlist = 0; -my @Titles; +#my @Titles; my $header; -my $prolog = "\n"; -$prolog .= "\n"; - my $page_number = 0; my $p = new XML::Parser(ErrorContext => 3, Handlers => {Start => \&starthndl, End => \&endhndl, Char => \&text}); -$p->parsefile($docfile); +$p->parsefile($xmlfile); #---------------------------------------------------------- @@ -437,7 +234,7 @@ print "p[$page_nr] "; -open(PAGE, ">$dir/$last_fn") or die "Couldn't open $last_fn for writing:\n$!"; +open(PAGE, ">$poll/$last_fn") or die "Couldn't open $last_fn for writing:\n$!"; print PAGE php_header($page_nr,@prelast_sql_update); my $next_fn=sprintf("%02d.php",$page_nr); $last_page=~s/##NEXTPAGE##/$next_fn/; @@ -445,248 +242,247 @@ close(PAGE); $page_nr++; -open(PAGE, ">$dir/$next_fn") or die "Couldn't open $next_fn for writing:\n$!"; +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_kraj; +print PAGE "$html{'header'} $html{'thanks'} $html{'footer'}"; close(PAGE); # dump sql structure -open(SQL,">$dir/$dir.sql") || die "$dir.sql: $!"; +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 $dir (do_stranice text default null, ",join(",\n",@sql_create),");\n"; +print SQL "create table $poll (do_stranice text default null, ",join(",\n",@sql_create),");\n"; close(SQL); -# dump common.inc +# dump common.php + +open(PHP,">$poll/common.php") || die "common.php: $!"; +$common_php =~ s/##DB##/$poll/g; +my $db_name = $prefix.$poll; +$common_php =~ s/##DB_NAME##/$db_name/g; +$common_php =~ s/##PREFIX##/$prefix/g; +$common_php =~ s/##DB_USER##/$db_user/g; +$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; -open(PHP,">$dir/common.inc") || die "common.inc: $!"; -print PHP ''; +print PHP $common_php; close(PHP); -open(PHP,">$dir/head.php") || die "head.php: $!"; -print PHP '$poll/head.php") || die "head.php: $!"; +my $max_page = $page_nr - 1; +$head_php=~ s/##MAXPAGE##/$max_page/; +$head_php=~ s/##TEXT##/Ispunili ste %02d%% ankete/; print PHP $head_php; -print PHP '?>'; close(PHP); +# 01.php -> index.php +rename "$poll/01.php","$poll/index.php" || die "can't rename '$poll/01.php' to index.php"; + ################ ## 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_slideshow or $el eq 'slideshow'); +# return unless ($in_poll or $el eq 'slideshow'); - unless ($in_slideshow) { - $in_slideshow = $xp->depth + 1; - return; - } + unless ($in_poll) { + $in_poll = $xp->depth + 1; + return; + } - if ($Mode) { + if ($Mode) { + if ($Mode eq 'pass') { + $Markedup_Text .= "\n" . $xp->recognized_string; + } elsif ($Mode eq 'object') { + push(@Ostack, $Object); - 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"; + } - $Object = {_Atts => \%atts, - _Text => '' - }; - bless $Object, "Slideobj::$el"; - } + # skip does nothing + return; + } - # skip does nothing - return; - } + unless ($after_head) { + if ($el eq 'head') { + $after_head = 1; + start_mode($xp, 'object'); - 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; - } - }; + push(@closure_stack, $closure); + $closure = sub { + my ($xp, $text) = @_; - return; - } + unless (defined $text) { + $header = $Object; + } + }; + 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 = "Slideshow::$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 .= $xp->recognized_string; - $new_closure = - sub { - my ($xp, $text) = @_; - - if (defined $text) { - $body .= $text; - } - else { - $body .= ""; + &$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(""); + } + }; } - }; - } - 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_slideshow; + return unless $in_poll; - my $lev = $xp->depth; + my $lev = $xp->depth; - if ($lev == $in_slideshow - 1) { - $in_slideshow = 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 .= ""; - } - 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 .= ""; + } 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_slideshow; + 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; + $str; } # End sgml_escape -sub slidename { - my ($num) = @_; - - sprintf("slide%03d.html", $num); -} # End slidename - ################################################################ -package Slideshow; +package Poll; sub page { package main; @@ -701,32 +497,8 @@ print "p[$page_nr] "; if (defined $last_fn) { - # 01.php -> index.php - $last_fn="index.php" if ($last_fn eq "01.php"); - open(PAGE, ">$dir/$last_fn") or die "Couldn't open $last_fn for writing:\n$!"; - if ($page_nr == 2) { - print PAGE '$sql"; - $result=pg_Exec($conn,fix_sql($sql)); - $lastoid=pg_getlastoid($result); - $result = pg_Exec($conn,fix_sql("select id from '.$dir.' where oid=$lastoid")); - $row=pg_fetch_row($result,0); - $id=$row[0]; -?>'; - - } else { - print PAGE php_header($page_nr,@prelast_sql_update); - } # last_sql_update - - + open(PAGE, ">$poll/$last_fn") or die "Couldn't open $last_fn for writing:\n$!"; + 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; @@ -738,7 +510,7 @@ @sql_update = (); $last_fn=sprintf("%02d.php",$page_nr); - $last_page="$html_header $body $html_footer"; + $last_page="$html{'header'} $body $html{'submit'} $html{'footer'}"; # delete vars for next page $page_nr++; $body=""; @@ -751,18 +523,18 @@ my ($xp, $el, $attref, $ncref) = @_; - $pitanje_tag=""; + $question_tag=""; $$ncref = sub { my ($xp, $text) = @_; if (defined($text)) { - $body.=$text; + $body.=x($text); chomp $text; - $pitanje_tag .= $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=""; }; @@ -770,63 +542,69 @@ sub hr { - $body .= "
$html_separator
"; + $body .= $html{'hr_before'}.$html{'separator'}.$html{'hr_after'}; } -sub br { - $body .= "
\n"; -} - -sub pit { +sub que { package main; my ($xp, $el, $attref, $ncref) = @_; - $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}++; + + $body.=$html{'que_before'} if ($html{'que_before'}); $$ncref = sub { my ($xp, $text) = @_; if (defined $text) { - $body.=$text; + $body.=x($text); } else { - $body.="

"; + $body.=$html{'que_after'} if ($html{'que_after'}); } } } -sub podpit { +sub subque { package main; my ($xp, $el, $attref, $ncref) = @_; - $body.=''; + $body.=$html{'subque_before'} if ($html{'subque_before'}); + $$ncref = sub { my ($xp, $text) = @_; if (defined $text) { - $body.=$text; + $body.=x($text); } else { - $body.="

"; + $body.=$html{'subque_after'} if ($html{'subque_after'}); } } } -sub odg { +sub ans { package main; my ($xp, $el, $attref, $ncref) = @_; - $body .= "

"; - + $body.=$html{'ans_before'} if ($html{'ans_before'}); + $$ncref = sub { my ($xp, $text) = @_; if (defined $text) { - $body .= $text; + $body .= x($text); } else { - $body .= "

"; + $body.=$html{'ans_after'} if ($html{'ans_after'}); } } } @@ -845,7 +623,7 @@ $text=~s/ le / <= /g; $text=~s/ gt / > /g; $text=~s/ ge / >= /g; - $body.=$text; + $body.=x($text); } else { $body.="\n?>\n"; } @@ -859,21 +637,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,$text if ($text ne ""); + push @dropdown_data,x($text) if ($text ne ""); } else { my $opt; my $id=1; - my $p=new_pit(); + my $p=new_que(); $body.="\n"; + my $p=new_que(); + $body.="\n"; push @sql_create,"$p text"; push @sql_update,"$p='\$$p'"; } @@ -910,10 +691,16 @@ $$ncref = sub { my ($xp, $text) = @_; if (! defined $text) { - my $nr=$attref->{nr}; - my $p=new_pit(); + my $nr=$attref->{nr} || die "need for number of buttons"; + # shownumbers="before|after" + my $shownumbers=lc(x($attref->{shownumbers})) || 'no'; + my $p=new_que(); for (my $i=1; $i<=$nr; $i++) { - $body.=" "; + $body.=""; + $body.=$i if ($shownumbers eq "before"); + $body.=""; + $body.=$i if ($shownumbers eq "after"); + $body.=" "; } push @sql_create,"$p int4"; push @sql_update,"$p=\$$p"; @@ -933,12 +720,12 @@ 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 @radiobuttons_data,$text if ($text ne ""); + push @radiobuttons_data,x($text) if ($text ne ""); } else { my $opt; - my $p=new_pit(); + my $p=new_que(); my $id=1; foreach $opt (@radiobuttons_data) { if (defined($opt) && $opt ne "") { @@ -957,7 +744,7 @@ $$ncref = sub { my ($xp, $text) = @_; - my $p=new_pit(); + my $p=new_que(); $body.="\n"; push @sql_create,"$p text"; push @sql_update,"$p='\$$p'"; @@ -978,12 +765,12 @@ 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 @checkboxes_data,$text if ($text ne ""); + push @checkboxes_data,x($text) if ($text ne ""); } else { my $opt; - my $base_p=new_pit(); + my $base_p=new_que(); my $id=1; my $before=$attref->{before}; @@ -999,11 +786,11 @@ if (defined($opt) && $opt ne "") { $p=$base_p."_".$id; $id++; - $body .= $before if ($before); + $body .= x($before) if ($before); $body.=""; - $body .= $middle if ($middle); + $body .= x($middle) if ($middle); $body .= "$opt" if (! $hide_description); - $body .= $after if ($after); + $body .= x($after) if ($after); $body.="\n"; push @sql_create,"$p boolean"; @@ -1016,483 +803,93 @@ } } -#--------------------------------------------------------------- - -sub slide { - package main; - - my ($xp, $el, $attref, $ncref) = @_; - - my $prev = $page_number ? slidename($page_number) : $index; - $page_number++; - my $fn = slidename($page_number); - my $next = slidename($page_number + 1); - - open(SLIDE, ">$dir/$fn") or die "Couldn't open $fn for writing:\n$!"; - - print SLIDE $prolog; - - undef @slidetitle; - $body = ''; - $inlist = 0; - - $$ncref = - sub { - my ($xp, $text) = @_; - - if (defined $text) { - #ignore text at slide toplevel - } - else { - $Titles[$page_number] = $slidetitle[0]; - - print SLIDE "$slidetitle[0]\n"; - print SLIDE $style_link; - print SLIDE "\n"; - - if ($dostyle) { - print SLIDE "\n"; - } - else { - print SLIDE "\n"; - } - - my $navbar = "\n"; - $navbar .= "\n"; - $navbar .= "\n"; - $navbar .= "\n"; - $navbar .= "\n"; - - print SLIDE "$navbar

\n"; - if ($dostyle) { - print SLIDE "

\n"; - print SLIDE "

$slidetitle[1]

\n"; - } - else { - print SLIDE "

\n"; - print SLIDE "

\n"; - print SLIDE "

"; - print SLIDE "

"; - print SLIDE "$slidetitle[1]"; - print SLIDE "

\n"; - print SLIDE "

\n"; - print SLIDE "

\n"; - print SLIDE "\n"; - } - print SLIDE $body; - - if ($inlist) { - print SLIDE "\n\n"; - } - - unless ($dostyle) { - print SLIDE "\n\n"; - print SLIDE "\n

\n"; - } - - print SLIDE "\n

\n$navbar"; - print SLIDE "\n\n"; - close(SLIDE); - } - }; -} # End slide - -sub title { - package main; - - my ($xp, $el, $attref, $ncref) = @_; - - if ($xp->current_element eq 'slide') { - start_mode($xp, 'pass'); - - $$ncref = - sub { - $slidetitle[0] = $Text; - $slidetitle[1] = $Markedup_Text; - }; - } -} # End title - -sub point { - package main; - - my ($xp, $el, $attref, $ncref) = @_; - - if ($inlist and $inlist ne 'ul') { - $body .= "\n\n"; - $inlist = 0; - } - - unless ($inlist) { - $body .= "\n

"; - } - else { - $body .= "\n
"; - } - - $$ncref = - sub { - my ($xp, $text) = @_; - - if (defined $text) { - $text =~ s/\s+/ /g; - $body .= $text; - } - else { - if ($dostyle) { - $body .= "

"; - } - else { - $body .= "\n
"; - } - - $$ncref = - sub { - my ($xp, $text) = @_; - - if (defined $text) { - $text =~ s/\s+/ /g; - $body .= $text; - } - else { - if ($dostyle) { - $body .= "

"; - } - else { - $body .= "

"; - $body .= $attref->{term} .": \n"; - } - else { - $body .= "
"; - $body .= $attref->{term} . ": "; - } - - $$ncref = - sub { - my ($xp, $text) = @_; - - if (defined $text) { - $text =~ s/\s+/ /g; - $body .= $text; - } - else { - if ($dostyle) { - $body .= "