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 |
|
|
108 |
# for unnumbered questions |
# for unnumbered questions |
109 |
my $u_db_col = "u"; |
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 { |
131 |
my $file = shift || croak "suck_file called without argument"; |
my $file = shift || croak "suck_file called without argument"; |
132 |
open(H,$file) || die "can't open '$file': $!"; |
if (! -f $file) { |
133 |
|
my $template_file = $file; |
134 |
|
$template_file =~ s,^.*?/*([^/]+)$,$1,; |
135 |
|
if (-f $template_file) { |
136 |
|
print "WARNING: can't find '$file', copy template '$template_file' ? [Y/n]: "; |
137 |
|
my $a = <STDIN>; |
138 |
|
chomp $a; |
139 |
|
if ($a =~ m/^y/i || $a eq "") { |
140 |
|
open(I,$template_file) || die "FATAL: can't open template file '$template_file': $!"; |
141 |
|
open(O,"> $file") || die "FATAL: can't create '$file' from template: $!"; |
142 |
|
while(<I>) { |
143 |
|
print O $_; |
144 |
|
} |
145 |
|
close(I); |
146 |
|
close(O); |
147 |
|
print "File '$file' created from template '$template_file'\n"; |
148 |
|
} |
149 |
|
} |
150 |
|
|
151 |
|
} |
152 |
|
|
153 |
|
if (! -f $file) { |
154 |
|
print STDERR "FATAL: please create file $file and then re-run this script!\n"; |
155 |
|
exit 1; |
156 |
|
} |
157 |
|
|
158 |
|
open(H,$file) || die "FATAL: can't open '$file': $!"; |
159 |
my $content; |
my $content; |
160 |
while (<H>) { $content .= $_; } ; |
while (<H>) { $content .= $_; } ; |
161 |
close(H); |
close(H); |
598 |
} else { |
} else { |
599 |
$q_type = $q_db_col; |
$q_type = $q_db_col; |
600 |
} |
} |
601 |
|
|
602 |
$question_nr{$q_type}++; |
$question_nr{$q_type}++; |
603 |
|
|
604 |
$body.=$html{'que_before'} if ($html{'que_before'}); |
# attribute markup_before override que_before |
605 |
|
my $markup_before = x($attref->{markup_before}); |
606 |
|
my $markup_after = x($attref->{markup_after}); |
607 |
|
|
608 |
|
if (defined($markup_before)) { |
609 |
|
$body.=$markup_before; |
610 |
|
} elsif ($html{'que_before'}) { |
611 |
|
$body.=$html{'que_before'} |
612 |
|
} |
613 |
|
|
614 |
$$ncref = sub { |
$$ncref = sub { |
615 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
617 |
if (defined $text) { |
if (defined $text) { |
618 |
$body.=x($text); |
$body.=x($text); |
619 |
} else { |
} else { |
620 |
$body.=$html{'que_after'} if ($html{'que_after'}); |
if (defined($markup_after)) { |
621 |
|
$body.=$markup_after; |
622 |
|
} elsif ($html{'que_after'}) { |
623 |
|
$body.=$html{'que_after'} |
624 |
|
} |
625 |
} |
} |
626 |
} |
} |
627 |
} |
} |
631 |
|
|
632 |
my ($xp, $el, $attref, $ncref) = @_; |
my ($xp, $el, $attref, $ncref) = @_; |
633 |
|
|
634 |
$body.=$html{'subque_before'} if ($html{'subque_before'}); |
my $markup_before = x($attref->{markup_before}); |
635 |
|
my $markup_after = x($attref->{markup_after}); |
636 |
|
|
637 |
|
if (defined($markup_before)) { |
638 |
|
$body.=$markup_before; |
639 |
|
} elsif ($html{'subque_before'}) { |
640 |
|
$body.=$html{'subque_before'} |
641 |
|
} |
642 |
|
|
643 |
$$ncref = sub { |
$$ncref = sub { |
644 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
646 |
if (defined $text) { |
if (defined $text) { |
647 |
$body.=x($text); |
$body.=x($text); |
648 |
} else { |
} else { |
649 |
$body.=$html{'subque_after'} if ($html{'subque_after'}); |
if (defined($markup_after)) { |
650 |
|
$body.=$markup_after; |
651 |
|
} elsif ($html{'subque_after'}) { |
652 |
|
$body.=$html{'subque_after'} |
653 |
|
} |
654 |
} |
} |
655 |
} |
} |
656 |
} |
} |
661 |
|
|
662 |
my ($xp, $el, $attref, $ncref) = @_; |
my ($xp, $el, $attref, $ncref) = @_; |
663 |
|
|
664 |
$body.=$html{'ans_before'} if ($html{'ans_before'}); |
my $markup_before = x($attref->{markup_before}); |
665 |
|
my $markup_after = x($attref->{markup_after}); |
666 |
|
|
667 |
|
if (defined($markup_before)) { |
668 |
|
$body.=$markup_before; |
669 |
|
} elsif ($html{'ans_before'}) { |
670 |
|
$body.=$html{'ans_before'} |
671 |
|
} |
672 |
|
|
673 |
$$ncref = sub { |
$$ncref = sub { |
674 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
676 |
if (defined $text) { |
if (defined $text) { |
677 |
$body .= x($text); |
$body .= x($text); |
678 |
} else { |
} else { |
679 |
$body.=$html{'ans_after'} if ($html{'ans_after'}); |
if (defined($markup_after)) { |
680 |
|
$body.=$markup_after; |
681 |
|
} elsif ($html{'ans_after'}) { |
682 |
|
$body.=$html{'ans_after'} |
683 |
|
} |
684 |
} |
} |
685 |
} |
} |
686 |
} |
} |
770 |
my $nr=$attref->{nr} || die "need <radiobuttons_tab nr=\"999\"> for number of buttons"; |
my $nr=$attref->{nr} || die "need <radiobuttons_tab nr=\"999\"> for number of buttons"; |
771 |
# shownumbers="before|after" |
# shownumbers="before|after" |
772 |
my $shownumbers=lc(x($attref->{shownumbers})) || 'no'; |
my $shownumbers=lc(x($attref->{shownumbers})) || 'no'; |
773 |
|
my $showlabels=lc(x($attref->{showlabels})) || 'no'; |
774 |
|
my $class=lc(x($attref->{class})) || ''; |
775 |
|
$class=' class="'.$class.'"' if ($class); |
776 |
my $p=new_que(); |
my $p=new_que(); |
777 |
for (my $i=1; $i<=$nr; $i++) { |
for (my $i=1; $i<=$nr; $i++) { |
778 |
$body.="<td>"; |
$body.="<td$class>"; |
779 |
$body.=$i if ($shownumbers eq "before"); |
$body.=$i if ($shownumbers eq "before"); |
780 |
|
if ($showlabels eq "before" && $attref->{"label_$i"}) { |
781 |
|
$body.=x($attref->{"label_$i"}); |
782 |
|
} |
783 |
$body.="<input type=radio name=$p value=$i>"; |
$body.="<input type=radio name=$p value=$i>"; |
784 |
$body.=$i if ($shownumbers eq "after"); |
$body.=$i if ($shownumbers eq "after"); |
785 |
$body.="</td> "; |
$body.="</td> "; |
953 |
|
|
954 |
$$ncref = sub { |
$$ncref = sub { |
955 |
my ($xp, $text) = @_; |
my ($xp, $text) = @_; |
956 |
|
# encoding should be checked first since it also |
957 |
|
# initialize iconv for conversion from XML's UTF-8 |
958 |
|
$html_encoding=$attref->{html_encoding} if ($attref->{html_encoding}); |
959 |
$db_user=x($attref->{db_user}); |
$db_user=x($attref->{db_user}); |
960 |
$prefix=x($attref->{prefix}); |
$prefix=x($attref->{prefix}); |
961 |
$without_invitation=x($attref->{without_invitation}) && |
$without_invitation=x($attref->{without_invitation}) && |
974 |
$q_db_col=x($attref->{q_db_col}) || 'q'; |
$q_db_col=x($attref->{q_db_col}) || 'q'; |
975 |
$u_db_col=x($attref->{u_db_col}) || 'u'; |
$u_db_col=x($attref->{u_db_col}) || 'u'; |
976 |
|
|
977 |
|
|
978 |
} |
} |
979 |
} |
} |
980 |
|
|