9 |
use strict; |
use strict; |
10 |
|
|
11 |
use XML::Parser; |
use XML::Parser; |
|
use common; |
|
12 |
use Carp; |
use Carp; |
13 |
|
use Text::Iconv; |
14 |
|
|
15 |
$|=1; |
$|=1; |
16 |
|
|
23 |
my $poll; |
my $poll; |
24 |
my $dowarn = 1; |
my $dowarn = 1; |
25 |
|
|
26 |
my $question_nr = 0; # curr. question |
my $q_type = "q"; # q=question, u=unnumbered question |
27 |
|
my %question_nr; # curr. question numbers |
28 |
my $question_tag = ""; # originalni oblik broja questions |
my $question_tag = ""; # originalni oblik broja questions |
29 |
my $page_nr = 1; # prvo question na strani |
my $page_nr = 1; # prvo question na strani |
30 |
|
|
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 { |
sub suck_file { |
176 |
|
|
177 |
#------------------------------------------------------------------ |
#------------------------------------------------------------------ |
178 |
|
|
179 |
$html{'kraj'}=suck_file($include_files{'thanks'}); |
$html{'thanks'}=suck_file($include_files{'thanks'}); |
180 |
|
|
181 |
#------------------------------------------------------------------ |
#------------------------------------------------------------------ |
182 |
|
|
260 |
$page_nr++; |
$page_nr++; |
261 |
open(PAGE, ">$poll/$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$!"; |
262 |
print PAGE php_header($page_nr,@last_sql_update); |
print PAGE php_header($page_nr,@last_sql_update); |
263 |
print PAGE "$html{'header'} $html{'kraj'} $html{'footer'}"; |
print PAGE "$html{'header'} $html{'thanks'} $html{'footer'}"; |
264 |
close(PAGE); |
close(PAGE); |
265 |
|
|
266 |
# dump sql structure |
# dump sql structure |
305 |
|
|
306 |
# return unique name of question |
# return unique name of question |
307 |
sub new_que { |
sub new_que { |
308 |
my $out="p".$question_nr; |
my $out=$q_type.( $question_nr{$q_type} || 0 ); |
309 |
$out .= "_".$p_suffix if ($p_suffix); |
$out .= "_".$p_suffix if ($p_suffix); |
310 |
$curr_suffix=$p_suffix; |
$curr_suffix=$p_suffix; |
311 |
$p_suffix++; |
$p_suffix++; |
314 |
|
|
315 |
# current question |
# current question |
316 |
sub curr_que { |
sub curr_que { |
317 |
return "p".$question_nr.$curr_suffix; |
return $q_type.( $question_nr{$q_type} || 0 ).$curr_suffix; |
318 |
} |
} |
319 |
|
|
320 |
#---------------------------------------------------------- |
#---------------------------------------------------------- |
548 |
chomp $text; |
chomp $text; |
549 |
$question_tag .= x($text); |
$question_tag .= x($text); |
550 |
} else { |
} else { |
551 |
$question_nr = $question_tag; |
$question_nr{$q_type} = $question_tag; |
552 |
$question_nr =~ s/[^0-9a-zA-Z]//g; |
$question_nr{$q_type} =~ s/[^0-9a-zA-Z]//g; |
553 |
print "$question_nr "; |
print "$question_nr{$q_type} "; |
554 |
} |
} |
555 |
$p_suffix=""; |
$p_suffix=""; |
556 |
}; |
}; |
566 |
|
|
567 |
my ($xp, $el, $attref, $ncref) = @_; |
my ($xp, $el, $attref, $ncref) = @_; |
568 |
|
|
569 |
$body.=$html{'que_before'} if ($html{'que_before'}); |
my $nonum = x($attref->{unnumbered}); |
570 |
|
if ($nonum) { |
571 |
|
$q_type = $u_db_col; # unnumbered questions |
572 |
|
} else { |
573 |
|
$q_type = $q_db_col; |
574 |
|
} |
575 |
|
|
576 |
|
$question_nr{$q_type}++; |
577 |
|
|
578 |
|
# attribute markup_before override que_before |
579 |
|
my $markup_before = x($attref->{markup_before}); |
580 |
|
my $markup_after = x($attref->{markup_after}); |
581 |
|
|
582 |
|
if (defined($markup_before)) { |
583 |
|
$body.=$markup_before; |
584 |
|
} elsif ($html{'que_before'}) { |
585 |
|
$body.=$html{'que_before'} |
586 |
|
} |
587 |
|
|
588 |
$$ncref = sub { |
$$ncref = sub { |
589 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
591 |
if (defined $text) { |
if (defined $text) { |
592 |
$body.=x($text); |
$body.=x($text); |
593 |
} else { |
} else { |
594 |
$body.=$html{'que_after'} if ($html{'que_after'}); |
if (defined($markup_after)) { |
595 |
|
$body.=$markup_after; |
596 |
|
} elsif ($html{'que_after'}) { |
597 |
|
$body.=$html{'que_after'} |
598 |
|
} |
599 |
} |
} |
600 |
} |
} |
601 |
} |
} |
605 |
|
|
606 |
my ($xp, $el, $attref, $ncref) = @_; |
my ($xp, $el, $attref, $ncref) = @_; |
607 |
|
|
608 |
$body.=$html{'subque_before'} if ($html{'subque_before'}); |
my $markup_before = x($attref->{markup_before}); |
609 |
|
my $markup_after = x($attref->{markup_after}); |
610 |
|
|
611 |
|
if (defined($markup_before)) { |
612 |
|
$body.=$markup_before; |
613 |
|
} elsif ($html{'subque_before'}) { |
614 |
|
$body.=$html{'subque_before'} |
615 |
|
} |
616 |
|
|
617 |
$$ncref = sub { |
$$ncref = sub { |
618 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
620 |
if (defined $text) { |
if (defined $text) { |
621 |
$body.=x($text); |
$body.=x($text); |
622 |
} else { |
} else { |
623 |
$body.=$html{'subque_after'} if ($html{'subque_after'}); |
if (defined($markup_after)) { |
624 |
|
$body.=$markup_after; |
625 |
|
} elsif ($html{'subque_after'}) { |
626 |
|
$body.=$html{'subque_after'} |
627 |
|
} |
628 |
} |
} |
629 |
} |
} |
630 |
} |
} |
635 |
|
|
636 |
my ($xp, $el, $attref, $ncref) = @_; |
my ($xp, $el, $attref, $ncref) = @_; |
637 |
|
|
638 |
$body.=$html{'ans_before'} if ($html{'ans_before'}); |
my $markup_before = x($attref->{markup_before}); |
639 |
|
my $markup_after = x($attref->{markup_after}); |
640 |
|
|
641 |
|
if (defined($markup_before)) { |
642 |
|
$body.=$markup_before; |
643 |
|
} elsif ($html{'ans_before'}) { |
644 |
|
$body.=$html{'ans_before'} |
645 |
|
} |
646 |
|
|
647 |
$$ncref = sub { |
$$ncref = sub { |
648 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
650 |
if (defined $text) { |
if (defined $text) { |
651 |
$body .= x($text); |
$body .= x($text); |
652 |
} else { |
} else { |
653 |
$body.=$html{'ans_after'} if ($html{'ans_after'}); |
if (defined($markup_after)) { |
654 |
|
$body.=$markup_after; |
655 |
|
} elsif ($html{'ans_after'}) { |
656 |
|
$body.=$html{'ans_after'} |
657 |
|
} |
658 |
} |
} |
659 |
} |
} |
660 |
} |
} |
741 |
$$ncref = sub { |
$$ncref = sub { |
742 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
743 |
if (! defined $text) { |
if (! defined $text) { |
744 |
my $nr=$attref->{nr}; |
my $nr=$attref->{nr} || die "need <radiobuttons_tab nr=\"999\"> for number of buttons"; |
745 |
|
# shownumbers="before|after" |
746 |
|
my $shownumbers=lc(x($attref->{shownumbers})) || 'no'; |
747 |
|
my $showlabels=lc(x($attref->{showlabels})) || 'no'; |
748 |
|
my $class=lc(x($attref->{class})) || ''; |
749 |
|
$class=' class="'.$class.'"' if ($class); |
750 |
my $p=new_que(); |
my $p=new_que(); |
751 |
for (my $i=1; $i<=$nr; $i++) { |
for (my $i=1; $i<=$nr; $i++) { |
752 |
$body.="<td><input type=radio name=$p value=$i></td> "; |
$body.="<td$class>"; |
753 |
|
$body.=$i if ($shownumbers eq "before"); |
754 |
|
if ($showlabels eq "before" && $attref->{"label_$i"}) { |
755 |
|
$body.=x($attref->{"label_$i"}); |
756 |
|
} |
757 |
|
$body.="<input type=radio name=$p value=$i>"; |
758 |
|
$body.=$i if ($shownumbers eq "after"); |
759 |
|
$body.="</td> "; |
760 |
} |
} |
761 |
push @sql_create,"$p int4"; |
push @sql_create,"$p int4"; |
762 |
push @sql_update,"$p=\$$p"; |
push @sql_update,"$p=\$$p"; |
927 |
|
|
928 |
$$ncref = sub { |
$$ncref = sub { |
929 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
930 |
|
# encoding should be checked first since it also |
931 |
|
# initialize iconv for conversion from XML's UTF-8 |
932 |
|
$html_encoding=$attref->{html_encoding} if ($attref->{html_encoding}); |
933 |
$db_user=x($attref->{db_user}); |
$db_user=x($attref->{db_user}); |
934 |
$prefix=x($attref->{prefix}); |
$prefix=x($attref->{prefix}); |
935 |
$without_invitation=x($attref->{without_invitation}) && |
$without_invitation=x($attref->{without_invitation}) && |
945 |
$html{$file} = suck_file($include_files{$file}); |
$html{$file} = suck_file($include_files{$file}); |
946 |
} |
} |
947 |
} |
} |
948 |
|
$q_db_col=x($attref->{q_db_col}) || 'q'; |
949 |
|
$u_db_col=x($attref->{u_db_col}) || 'u'; |
950 |
|
|
951 |
|
|
952 |
} |
} |
953 |
} |
} |