--- make_poll.pl	2003/04/24 16:43:09	1.3
+++ make_poll.pl	2003/10/21 15:15:08	1.13
@@ -1,45 +1,26 @@
 #!/usr/bin/perl -w
 #
+# Dobrica Pavlinusic <dpavlin@rot13.org>
+#
+# 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 Text::Iconv;
-
-# output charset
-my $charset='ISO-8859-2';
-
-Text::Iconv->raise_error(0);	# Conversion errors raise exceptions
-my $from_utf8 = Text::Iconv->new('UTF8', $charset);
-sub x { 
-	return $from_utf8->convert($_[0]);
-}
+use common;
 
 $|=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
@@ -72,6 +53,19 @@
 # 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;
+
 #------------------------------------------------------------------
 
 sub suck_file {
@@ -93,18 +87,18 @@
 sub php_header {
 my ($page_nr,@sql_update) = @_;
 my $out='<?php
-	include("common.php");
+	include_once("common.php");
 	if (isset($update)) {
 		$member_id=id_decode($a);
 		';
 $out.=$php_addon[$page_nr-2] if (defined $php_addon[$page_nr-2]);
 $out.='
-		$sql="update '.$dir.' set '.join(",\n",@sql_update).',
+		$sql="update '.$poll.' set '.join(",\n",@sql_update).',
 			do_stranice=\'$PHP_SELF\'
 			where id=$id";
 #		print "<pre>$sql</pre>";
 		$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;
 	}
@@ -134,48 +128,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;
@@ -186,31 +162,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 = "<html><head>\n";
-$prolog .= "<!-- Generated by $0 on " . gmtime() . " GMT -->\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);
 
 #----------------------------------------------------------
 
@@ -218,7 +191,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/;
@@ -226,47 +199,55 @@
 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_header $html_kraj $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.php
 
-open(PHP,">$dir/common.php") || die "common.php: $!";
-$common_php =~ s/##DB##/$dir/g;
-my $db_name = $prefix.$dir;
+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;
 
 print PHP $common_php;
 close(PHP);
 
-open(PHP,">$dir/head.php") || die "head.php: $!";
+open(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;
 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;
+	my $out="p".$pitanje_nr;
+	$out .= "_".$p_suffix if ($p_suffix);
 	$curr_suffix=$p_suffix;
 	$p_suffix++;
 	return $out;
@@ -277,13 +258,15 @@
 	return "p".$pitanje_nr.$curr_suffix;
 }
 
+#----------------------------------------------------------
+
 sub starthndl {
   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;
+  unless ($in_poll) {
+    $in_poll = $xp->depth + 1;
     return;
   }
 
@@ -330,7 +313,7 @@
 
   my $new_closure;
 
-  my $subname = "Slideshow::$el";
+  my $subname = "Poll::$el";
 
   if (defined &$subname) {
     no strict 'refs';
@@ -338,16 +321,16 @@
     &$subname($xp, $el, \%atts, \$new_closure);
   }
   else {
-    $body .= $xp->recognized_string;
+    $body .= x($xp->recognized_string);
     $new_closure =
       sub {
 	my ($xp, $text) = @_;
 	
 	if (defined $text) {
-	  $body .= $text;
+	  $body .= x($text);
 	}
 	else {
-	  $body .= "</$el>";
+	  $body .= x("</$el>");
 	}
       };
   }
@@ -359,12 +342,12 @@
 sub endhndl {
   my ($xp, $el) = @_;
 
-  return unless $in_slideshow;
+  return unless $in_poll;
 
   my $lev = $xp->depth;
 
-  if ($lev == $in_slideshow - 1) {
-    $in_slideshow = 0;
+  if ($lev == $in_poll - 1) {
+    $in_poll = 0;
     $xp->finish;
     return;
   }
@@ -414,10 +397,12 @@
   $closure = pop(@closure_stack);
 }  # End endhndl
 
+#----------------------------------------------------------
+
 sub text {
   my ($xp, $data) = @_;
 
-  return unless $in_slideshow;
+  return unless $in_poll;
 
   if ($Mode ) {
 
@@ -467,15 +452,10 @@
   $str;
 }  # End sgml_escape
 
-sub slidename {
-  my ($num) = @_;
-
-  sprintf("slide%03d.html", $num);
-}  # End slidename
 
 ################################################################
 
-package Slideshow;
+package Poll;
 
 sub page {
 	package main;
@@ -490,32 +470,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 '<?php
-include("common.php");
-if (isset($do_stranice) && $do_stranice !="") {
-	Header("Location: $do_uri?a=$a");
-	exit;
-}
-$member_id=id_decode($a);
-$sql="insert into '.$dir.' ( http_referer,remote_addr,user_agent, member_id ) values (\'$HTTP_REFERER\',\'$REMOTE_ADDR\',\'$HTTP_USER_AGENT\',$member_id)";
-
-#	print "<pre>$sql</pre>";
-	$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;
@@ -545,9 +501,9 @@
 	$$ncref = sub {
 		my ($xp, $text) = @_;
 		if (defined($text)) {
-			$body.=$text;
+			$body.=x($text);
 			chomp $text;
-			$pitanje_tag .= $text;
+			$pitanje_tag .= x($text);
 		} else {
 			$pitanje_nr = $pitanje_tag;
 			$pitanje_nr =~ s/[^0-9a-zA-Z]//g;
@@ -648,13 +604,16 @@
 
 	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 {
@@ -662,7 +621,7 @@
 			my $id=1;
 			my $p=new_pit();
 			$body.="<select name=$p >\n";
-			$body.="<option value=null>-</option>\n";
+			$body.="<option value=\"$default_value\">$default_text</option>\n";
 			foreach $opt (@dropdown_data) {
 				if (defined($opt) && $opt ne "") {
 					$body.="<option value=$id>$opt</option>\n";
@@ -722,7 +681,7 @@
 		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,x($text) if ($text ne "");
 		} else {
@@ -767,7 +726,7 @@
 		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,x($text) if ($text ne "");
 		} else {
@@ -805,4 +764,44 @@
 	}
 }
 
+sub html {
+	package main;
+
+	my ($xp, $el, $attref, $ncref) = @_;
+
+	$body.="<p>";
+
+	$$ncref = sub {
+		my ($xp, $text) = @_;
+
+		if (defined $text) {
+			$body.=x($text);
+		} else {
+			$body.="</p>";
+		}
+	}
+}
+
+print "\n\nTo create database for poll $poll use:\n\n";
+print "\$ psql template1 < $poll/$poll.sql\n\n";
+print "THIS WILL DISTROY ALL DATA IN EXISTING DATABASE ".$prefix.$poll." !!\n";
+
+# read configuration data
+#
+# FIX: write actually this :-)
+sub config {
+	package main;
+	my ($xp, $el, $attref, $ncref) = @_;
+
+	$$ncref = sub {
+		my ($xp, $text) = @_;
+		$db_user=x($attref->{db_user});
+		$prefix=x($attref->{prefix});
+		$without_invitation=x($attref->{without_invitation}) &&
+			print "Pool is without need for unique ID (and invitation URLs).\n";
+		$remove_nrs_in_answers=x($attref->{$remove_nrs_in_answers}) &&
+			print "Numbers before answers will be removed.\n";
+	}
+}
+
 #---------------------------------------------------------------