10 |
|
|
11 |
use XML::Parser; |
use XML::Parser; |
12 |
use common; |
use common; |
13 |
|
use Carp; |
14 |
|
|
15 |
$|=1; |
$|=1; |
16 |
|
|
20 |
|
|
21 |
my @Modes = qw(object pass skip); |
my @Modes = qw(object pass skip); |
22 |
|
|
23 |
my $dir; |
my $poll; |
24 |
my $dowarn = 1; |
my $dowarn = 1; |
25 |
|
|
26 |
my $pitanje_nr = 0; # curr. pitanje |
my $pitanje_nr = 0; # curr. pitanje |
54 |
# this is usename in database |
# this is usename in database |
55 |
my $db_user="dpavlin"; |
my $db_user="dpavlin"; |
56 |
|
|
57 |
|
# This option allows users to fill poll without using invitation URL. |
58 |
|
# That also means it's unpossible for them to return to exiting poll |
59 |
|
# because they don't have thair own unique ID. Howver, it enables simple |
60 |
|
# polls to be conducted by just publishing URL to them. |
61 |
|
my $without_invitation=0; |
62 |
|
|
63 |
|
# This will remove numbers before answers. That enables you to have |
64 |
|
# answers written like: |
65 |
|
# 1.1 red |
66 |
|
# 1.2 black |
67 |
|
# and users will see just "red" and "black" |
68 |
|
my $remove_nrs_in_answers=0; |
69 |
|
|
70 |
|
# This defines files which will be included in various places to produce |
71 |
|
# design. You could desing them using your faviourite html editor (vim :-) |
72 |
|
# and then split them into separate files |
73 |
|
|
74 |
|
my %include_files = ( |
75 |
|
# this file is included at top of each paAge |
76 |
|
'header' => "header.html", |
77 |
|
# this file is used to separate questions |
78 |
|
'separator' => "separator.html", |
79 |
|
# this file is used to show "submit" button, which under multi-page |
80 |
|
# polls will also bring next page |
81 |
|
'submit' => "next.html", |
82 |
|
# this file is included at bottom of each page |
83 |
|
'footer' => "footer.html", |
84 |
|
# this file will be showen after poll is completed |
85 |
|
'thanks' => "thanks.html" |
86 |
|
); |
87 |
|
|
88 |
|
my %html; # buffer for suck(_file)ed html files |
89 |
|
|
90 |
#------------------------------------------------------------------ |
#------------------------------------------------------------------ |
91 |
|
|
92 |
sub suck_file { |
sub suck_file { |
93 |
my $file = shift @_; |
my $file = shift || croak "suck_file called without argument"; |
94 |
open(H,$file) || die "can't open '$file': $!"; |
open(H,$file) || die "can't open '$file': $!"; |
95 |
my $content; |
my $content; |
96 |
while (<H>) { $content .= $_; } ; |
while (<H>) { $content .= $_; } ; |
98 |
return $content; |
return $content; |
99 |
} |
} |
100 |
|
|
101 |
my $html_header=suck_file("header.html"); |
$html{'header'}=suck_file($include_files{'header'}); |
102 |
my $html_separator=suck_file("separator.html"); |
$html{'separator'}=suck_file($include_files{'separator'}); |
103 |
my $html_next=suck_file("next.html"); |
$html{'submit'}=suck_file($include_files{'submit'}); |
104 |
my $html_footer=suck_file("footer.html"); |
$html{'footer'}=suck_file($include_files{'footer'}); |
105 |
|
|
106 |
#------------------------------------------------------------------ |
#------------------------------------------------------------------ |
107 |
|
|
108 |
sub php_header { |
sub php_header { |
109 |
my ($page_nr,@sql_update) = @_; |
my ($page_nr,@sql_update) = @_; |
110 |
my $out='<?php |
my $out='<?php |
111 |
include("common.php"); |
include_once("common.php"); |
112 |
if (isset($update)) { |
if (isset($update)) { |
113 |
$member_id=id_decode($a); |
$member_id=id_decode($a); |
114 |
'; |
'; |
115 |
$out.=$php_addon[$page_nr-2] if (defined $php_addon[$page_nr-2]); |
$out.=$php_addon[$page_nr-2] if (defined $php_addon[$page_nr-2]); |
116 |
$out.=' |
$out.=' |
117 |
$sql="update '.$dir.' set '.join(",\n",@sql_update).', |
$sql="update '.$poll.' set '.join(",\n",@sql_update).', |
118 |
do_stranice=\'$PHP_SELF\' |
do_stranice=\'$PHP_SELF\' |
119 |
where id=$id"; |
where id=$id"; |
120 |
# print "<pre>$sql</pre>"; |
# print "<pre>$sql</pre>"; |
121 |
$result=pg_Exec($conn,fix_sql($sql)); |
$result=pg_Exec($conn,fix_sql($sql)); |
122 |
} elseif($do_stranice != $PHP_SELF) { |
} elseif($do_stranice != $PHP_SELF && isset($do_uri) && isset($a)) { |
123 |
Header("Location: $do_uri?a=$a"); |
Header("Location: $do_uri?a=$a"); |
124 |
exit; |
exit; |
125 |
} |
} |
138 |
|
|
139 |
#------------------------------------------------------------------ |
#------------------------------------------------------------------ |
140 |
|
|
141 |
my $html_kraj=suck_file("thanks.html"); |
$html{'kraj'}=suck_file($include_files{'thanks'}); |
142 |
|
|
143 |
#------------------------------------------------------------------ |
#------------------------------------------------------------------ |
144 |
|
|
157 |
|
|
158 |
die "Can't read $xmlfile" unless -r $xmlfile; |
die "Can't read $xmlfile" unless -r $xmlfile; |
159 |
|
|
160 |
if (defined $dir) { |
if (defined $poll) { |
161 |
die "$dir isn't a directory" unless -d $dir; |
die "$poll isn't a directory" unless -d $poll; |
162 |
} |
} |
163 |
else { |
else { |
164 |
$xmlfile =~ m!([^/.]+)(?:\.[^/.]*)?$!; |
$xmlfile =~ m!([^/.]+)(?:\.[^/.]*)?$!; |
165 |
$dir = $1; |
$poll = $1; |
166 |
if (-e $dir) { |
if (-e $poll) { |
167 |
die "$dir exists but isn't a directory" |
die "$poll exists but isn't a directory" |
168 |
unless -d $dir; |
unless -d $poll; |
169 |
} |
} |
170 |
else { |
else { |
171 |
mkdir $dir, 0755; |
mkdir $poll, 0755; |
172 |
} |
} |
173 |
} |
} |
174 |
|
|
212 |
|
|
213 |
print "p[$page_nr] "; |
print "p[$page_nr] "; |
214 |
|
|
215 |
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$!"; |
216 |
print PAGE php_header($page_nr,@prelast_sql_update); |
print PAGE php_header($page_nr,@prelast_sql_update); |
217 |
my $next_fn=sprintf("%02d.php",$page_nr); |
my $next_fn=sprintf("%02d.php",$page_nr); |
218 |
$last_page=~s/##NEXTPAGE##/$next_fn/; |
$last_page=~s/##NEXTPAGE##/$next_fn/; |
220 |
close(PAGE); |
close(PAGE); |
221 |
|
|
222 |
$page_nr++; |
$page_nr++; |
223 |
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$!"; |
224 |
print PAGE php_header($page_nr,@last_sql_update); |
print PAGE php_header($page_nr,@last_sql_update); |
225 |
print PAGE "$html_header $html_kraj $html_footer"; |
print PAGE "$html{'header'} $html{'kraj'} $html{'footer'}"; |
226 |
close(PAGE); |
close(PAGE); |
227 |
|
|
228 |
# dump sql structure |
# dump sql structure |
229 |
|
|
230 |
open(SQL,">$dir/$dir.sql") || die "$dir.sql: $!"; |
open(SQL,">$poll/$poll.sql") || die "$poll.sql: $!"; |
231 |
|
print SQL "drop database ".$prefix.$poll.";\n"; |
232 |
|
print SQL "create database ".$prefix.$poll.";\n"; |
233 |
|
print SQL "\\connect ".$prefix.$poll.";\n"; |
234 |
print SQL "create table poslani ( member_id int4 not null, unesen timestamp default now() );\n"; |
print SQL "create table poslani ( member_id int4 not null, unesen timestamp default now() );\n"; |
235 |
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"; |
236 |
close(SQL); |
close(SQL); |
237 |
|
|
238 |
# dump common.php |
# dump common.php |
239 |
|
|
240 |
open(PHP,">$dir/common.php") || die "common.php: $!"; |
open(PHP,">$poll/common.php") || die "common.php: $!"; |
241 |
$common_php =~ s/##DB##/$dir/g; |
$common_php =~ s/##DB##/$poll/g; |
242 |
my $db_name = $prefix.$dir; |
my $db_name = $prefix.$poll; |
243 |
$common_php =~ s/##DB_NAME##/$db_name/g; |
$common_php =~ s/##DB_NAME##/$db_name/g; |
244 |
$common_php =~ s/##PREFIX##/$prefix/g; |
$common_php =~ s/##PREFIX##/$prefix/g; |
245 |
$common_php =~ s/##DB_USER##/$db_user/g; |
$common_php =~ s/##DB_USER##/$db_user/g; |
246 |
$common_php =~ s/##PREFIX##/$prefix/g; |
$common_php =~ s/##PREFIX##/$prefix/g; |
247 |
my $members_db = $prefix."members"; |
my $members_db = $prefix."members"; |
248 |
$common_php =~ s/##MEMBERS_DB##/$members_db/g; |
$common_php =~ s/##MEMBERS_DB##/$members_db/g; |
249 |
|
$common_php =~ s/##WITHOUT_INVITATION##/$without_invitation/g; |
250 |
|
|
251 |
print PHP $common_php; |
print PHP $common_php; |
252 |
close(PHP); |
close(PHP); |
253 |
|
|
254 |
open(PHP,">$dir/head.php") || die "head.php: $!"; |
open(PHP,">$poll/head.php") || die "head.php: $!"; |
255 |
my $max_page = $page_nr - 1; |
my $max_page = $page_nr - 1; |
256 |
$head_php=~ s/##MAXPAGE##/$max_page/; |
$head_php=~ s/##MAXPAGE##/$max_page/; |
257 |
$head_php=~ s/##TEXT##/Ispunili ste %02d%% ankete/; |
$head_php=~ s/##TEXT##/Ispunili ste %02d%% ankete/; |
259 |
close(PHP); |
close(PHP); |
260 |
|
|
261 |
# 01.php -> index.php |
# 01.php -> index.php |
262 |
rename "$dir/01.php","$dir/index.php" || die "can't rename '$dir/01.php' to index.php"; |
rename "$poll/01.php","$poll/index.php" || die "can't rename '$poll/01.php' to index.php"; |
263 |
|
|
264 |
################ |
################ |
265 |
## End of main |
## End of main |
267 |
|
|
268 |
# return unique name of pitanje |
# return unique name of pitanje |
269 |
sub new_pit { |
sub new_pit { |
270 |
my $out="p".$pitanje_nr.$p_suffix; |
my $out="p".$pitanje_nr; |
271 |
|
$out .= "_".$p_suffix if ($p_suffix); |
272 |
$curr_suffix=$p_suffix; |
$curr_suffix=$p_suffix; |
273 |
$p_suffix++; |
$p_suffix++; |
274 |
return $out; |
return $out; |
342 |
&$subname($xp, $el, \%atts, \$new_closure); |
&$subname($xp, $el, \%atts, \$new_closure); |
343 |
} |
} |
344 |
else { |
else { |
345 |
$body .= $xp->recognized_string; |
$body .= x($xp->recognized_string); |
346 |
$new_closure = |
$new_closure = |
347 |
sub { |
sub { |
348 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
349 |
|
|
350 |
if (defined $text) { |
if (defined $text) { |
351 |
$body .= $text; |
$body .= x($text); |
352 |
} |
} |
353 |
else { |
else { |
354 |
$body .= "</$el>"; |
$body .= x("</$el>"); |
355 |
} |
} |
356 |
}; |
}; |
357 |
} |
} |
473 |
$str; |
$str; |
474 |
} # End sgml_escape |
} # End sgml_escape |
475 |
|
|
476 |
|
|
477 |
################################################################ |
################################################################ |
478 |
|
|
479 |
package Poll; |
package Poll; |
491 |
print "p[$page_nr] "; |
print "p[$page_nr] "; |
492 |
|
|
493 |
if (defined $last_fn) { |
if (defined $last_fn) { |
494 |
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$!"; |
495 |
if ($page_nr == 2) { |
print PAGE php_header($page_nr,@prelast_sql_update); |
|
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 |
|
|
|
|
|
|
|
496 |
my $next_fn=sprintf("%02d.php",$page_nr); |
my $next_fn=sprintf("%02d.php",$page_nr); |
497 |
$last_page=~s/##NEXTPAGE##/$next_fn/; |
$last_page=~s/##NEXTPAGE##/$next_fn/; |
498 |
print PAGE $last_page; |
print PAGE $last_page; |
504 |
@sql_update = (); |
@sql_update = (); |
505 |
|
|
506 |
$last_fn=sprintf("%02d.php",$page_nr); |
$last_fn=sprintf("%02d.php",$page_nr); |
507 |
$last_page="$html_header $body $html_next $html_footer"; |
$last_page="$html{'header'} $body $html{'submit'} $html{'footer'}"; |
508 |
# delete vars for next page |
# delete vars for next page |
509 |
$page_nr++; |
$page_nr++; |
510 |
$body=""; |
$body=""; |
536 |
|
|
537 |
|
|
538 |
sub hr { |
sub hr { |
539 |
$body .= "<br></td></tr>$html_separator<tr><td></td><td><br>"; |
$body .= "<br></td></tr>$html{'separator'}<tr><td></td><td><br>"; |
540 |
} |
} |
541 |
|
|
542 |
sub br { |
sub br { |
625 |
|
|
626 |
my @dropdown_data; |
my @dropdown_data; |
627 |
|
|
628 |
|
my $default_value = x($attref->{default_value}) || 'null'; |
629 |
|
my $default_text = x($attref->{default_text}) || '-'; |
630 |
|
|
631 |
$$ncref = sub { |
$$ncref = sub { |
632 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
633 |
|
|
634 |
if (defined $text) { |
if (defined $text) { |
635 |
chomp $text; |
chomp $text; |
636 |
$text=~s/^\s*//g; |
$text=~s/^\s*//g; |
637 |
$text=~s/^[\d\.\s]+//g; |
$text=~s/^[\d\.\s]+//g if ($remove_nrs_in_answers); |
638 |
$text=~s/\s*$//g; |
$text=~s/\s*$//g; |
639 |
push @dropdown_data,x($text) if ($text ne ""); |
push @dropdown_data,x($text) if ($text ne ""); |
640 |
} else { |
} else { |
642 |
my $id=1; |
my $id=1; |
643 |
my $p=new_pit(); |
my $p=new_pit(); |
644 |
$body.="<select name=$p >\n"; |
$body.="<select name=$p >\n"; |
645 |
$body.="<option value=null>-</option>\n"; |
$body.="<option value=\"$default_value\">$default_text</option>\n"; |
646 |
foreach $opt (@dropdown_data) { |
foreach $opt (@dropdown_data) { |
647 |
if (defined($opt) && $opt ne "") { |
if (defined($opt) && $opt ne "") { |
648 |
$body.="<option value=$id>$opt</option>\n"; |
$body.="<option value=$id>$opt</option>\n"; |
702 |
if (defined $text) { |
if (defined $text) { |
703 |
chomp $text; |
chomp $text; |
704 |
$text=~s/^\s*//g; |
$text=~s/^\s*//g; |
705 |
$text=~s/^[\d\.\s]+//g; |
$text=~s/^[\d\.\s]+//g if ($remove_nrs_in_answers); |
706 |
$text=~s/\s*$//g; |
$text=~s/\s*$//g; |
707 |
push @radiobuttons_data,x($text) if ($text ne ""); |
push @radiobuttons_data,x($text) if ($text ne ""); |
708 |
} else { |
} else { |
747 |
if (defined $text) { |
if (defined $text) { |
748 |
chomp $text; |
chomp $text; |
749 |
$text=~s/^\s*//g; |
$text=~s/^\s*//g; |
750 |
$text=~s/^[\d\.\s]+//g; |
$text=~s/^[\d\.\s]+//g if ($remove_nrs_in_answers); |
751 |
$text=~s/\s*$//g; |
$text=~s/\s*$//g; |
752 |
push @checkboxes_data,x($text) if ($text ne ""); |
push @checkboxes_data,x($text) if ($text ne ""); |
753 |
} else { |
} else { |
785 |
} |
} |
786 |
} |
} |
787 |
|
|
788 |
|
sub html { |
789 |
|
package main; |
790 |
|
|
791 |
|
my ($xp, $el, $attref, $ncref) = @_; |
792 |
|
|
793 |
|
$body.="<p>"; |
794 |
|
|
795 |
|
$$ncref = sub { |
796 |
|
my ($xp, $text) = @_; |
797 |
|
|
798 |
|
if (defined $text) { |
799 |
|
$body.=x($text); |
800 |
|
} elsif ($attref->{include}) { |
801 |
|
$body.=suck_file($attref->{include}); |
802 |
|
} else { |
803 |
|
$body.="</p>"; |
804 |
|
} |
805 |
|
} |
806 |
|
} |
807 |
|
|
808 |
|
print "\n\nTo create database for poll $poll use:\n\n"; |
809 |
|
print "\$ psql template1 < $poll/$poll.sql\n\n"; |
810 |
|
print "THIS WILL DISTROY ALL DATA IN EXISTING DATABASE ".$prefix.$poll." !!\n"; |
811 |
|
|
812 |
# read configuration data |
# read configuration data |
813 |
# |
# |
814 |
# FIX: write actually this :-) |
# FIX: write actually this :-) |
820 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
821 |
$db_user=x($attref->{db_user}); |
$db_user=x($attref->{db_user}); |
822 |
$prefix=x($attref->{prefix}); |
$prefix=x($attref->{prefix}); |
823 |
|
$without_invitation=x($attref->{without_invitation}) && |
824 |
|
print "Pool is without need for unique ID (and invitation URLs).\n"; |
825 |
|
$remove_nrs_in_answers=x($attref->{$remove_nrs_in_answers}) && |
826 |
|
print "Numbers before answers will be removed.\n"; |
827 |
|
|
828 |
|
foreach my $file (qw(header separator submit footer thanks)) { |
829 |
|
if ($attref->{$file}) { |
830 |
|
$include_files{$file}=x($attref->{$file}); |
831 |
|
print "Using custom $file '$include_files{$file}'\n"; |
832 |
|
$html{$file} = suck_file($include_files{$file}); |
833 |
|
} |
834 |
|
} |
835 |
} |
} |
836 |
} |
} |
837 |
|
|