1 |
dpavlin |
1 |
package WOPI; |
2 |
|
|
|
3 |
|
|
use strict; |
4 |
|
|
use warnings; |
5 |
|
|
|
6 |
|
|
use CGI qw(:standard); |
7 |
|
|
use CGI::Carp qw(fatalsToBrowser); |
8 |
|
|
use CGI::Session; |
9 |
|
|
use DBM::Deep; |
10 |
|
|
use Template; |
11 |
|
|
our $VERSION = '1.00'; |
12 |
|
|
|
13 |
|
|
use Data::Dumper; |
14 |
|
|
|
15 |
|
|
sub new { |
16 |
|
|
my $class = shift; |
17 |
|
|
|
18 |
|
|
my $self = {@_}; |
19 |
|
|
bless($self, $class); |
20 |
|
|
|
21 |
|
|
$self->{'cgi'} = new CGI; |
22 |
dpavlin |
5 |
$self->{'poll'} = new DBM::Deep $self->{'db_file'} || die "can't open '",$self->{'db_file'},"'"; |
23 |
dpavlin |
1 |
die "can't find database file ",$self->{'db_file'} if (! -e $self->{'db_file'}); |
24 |
|
|
die "database file ",$self->{'db_file'}," not writable!" if (! -w $self->{'db_file'}); |
25 |
|
|
$self->{'tt'} = new Template({ |
26 |
|
|
INCLUDE_PATH => $self->{'templates'}, |
27 |
|
|
EVAL_PERL => 1, |
28 |
|
|
}); |
29 |
|
|
$self->{'sess'} = new CGI::Session("driver:File", undef, {Directory=>'/tmp'}); |
30 |
|
|
# create new database if it doesn't exist |
31 |
|
|
if (! $self->{'poll'}) { |
32 |
dpavlin |
5 |
$self->{'poll'}->{'poll_name'} { 'questions' => [] }; |
33 |
dpavlin |
1 |
} |
34 |
|
|
|
35 |
dpavlin |
5 |
#print $self->{'cgi'}->header, Dumper($self->{'poll'}); |
36 |
dpavlin |
1 |
|
37 |
|
|
return $self; |
38 |
|
|
} |
39 |
|
|
|
40 |
dpavlin |
5 |
sub last_order { |
41 |
|
|
my $self = shift; |
42 |
|
|
|
43 |
dpavlin |
7 |
return 0 if (! defined $self->{'poll'}->{'questions'}); |
44 |
|
|
|
45 |
dpavlin |
5 |
return scalar @{$self->{'poll'}->{'questions'}} || 0; |
46 |
|
|
} |
47 |
|
|
|
48 |
dpavlin |
1 |
sub get_html { |
49 |
|
|
my $self = shift; |
50 |
|
|
|
51 |
|
|
my ($template,$param) = @_; |
52 |
|
|
|
53 |
|
|
my $html; |
54 |
|
|
$self->{'tt'}->process($template, $param, \$html) || |
55 |
dpavlin |
4 |
confess $self->{'tt'}->error(); |
56 |
dpavlin |
1 |
|
57 |
|
|
return $html; |
58 |
|
|
} |
59 |
|
|
|
60 |
|
|
# |
61 |
dpavlin |
4 |
# Acme methods |
62 |
|
|
# |
63 |
|
|
|
64 |
|
|
sub unbless { |
65 |
|
|
my $self = shift; |
66 |
|
|
|
67 |
|
|
my $var = Dumper(\@_); |
68 |
|
|
|
69 |
|
|
while ($var =~ s/bless\(\s*([{\[].*?[}\]])\s*,\s*'DBM::Deep'\s*\)/$1/sg) { }; |
70 |
|
|
my $VAR1; |
71 |
|
|
eval $var; |
72 |
|
|
warn("eval of $var failed: $@") if ($@); |
73 |
|
|
|
74 |
|
|
return (wantarray ? @{$VAR1} : shift @{$VAR1}); |
75 |
|
|
} |
76 |
|
|
|
77 |
|
|
# |
78 |
dpavlin |
1 |
# CGI methods |
79 |
|
|
# |
80 |
|
|
|
81 |
|
|
sub editor { |
82 |
|
|
my $self = shift; |
83 |
|
|
|
84 |
dpavlin |
5 |
# question order or current |
85 |
|
|
my $order = shift; |
86 |
|
|
|
87 |
|
|
$self->status("edit called without a number!") if (! defined($order)); |
88 |
|
|
|
89 |
|
|
$self->load_question($order) || |
90 |
|
|
$self->add_question; |
91 |
|
|
|
92 |
dpavlin |
1 |
$self->{'param'}->{'poll_name'} = $self->{'poll_name'}; |
93 |
|
|
|
94 |
dpavlin |
4 |
$self->{'param'}->{'poll'} = $self->unbless($self->{'poll'}); |
95 |
|
|
|
96 |
dpavlin |
5 |
print qq{<!--},Dumper($self->{'param'}),qq{-->}; |
97 |
|
|
|
98 |
dpavlin |
1 |
return $self->get_html('editor.html', $self->{'param'}); |
99 |
|
|
} |
100 |
|
|
|
101 |
dpavlin |
5 |
|
102 |
|
|
sub add_question { |
103 |
|
|
my $self = shift; |
104 |
|
|
|
105 |
|
|
$self->{'param'}->{'order'} = $self->last_order; |
106 |
|
|
$self->{'param'}->{'var'} = "v".($self->last_order+1); |
107 |
|
|
|
108 |
|
|
$self->{'param'}->{'buttons'} = [ |
109 |
|
|
{ 'save' => ' Add ' }, |
110 |
|
|
{ 'cancel' => ' Cancel and Add another ' }, |
111 |
|
|
]; |
112 |
|
|
|
113 |
|
|
$self->status("Adding question ",$self->last_order); |
114 |
|
|
} |
115 |
|
|
|
116 |
dpavlin |
1 |
sub list_questions { |
117 |
|
|
my $self = shift; |
118 |
|
|
|
119 |
|
|
} |
120 |
|
|
|
121 |
dpavlin |
5 |
sub load_question { |
122 |
|
|
my $self = shift; |
123 |
|
|
|
124 |
|
|
my $order = shift; |
125 |
|
|
|
126 |
|
|
return if (! defined($order)); |
127 |
|
|
|
128 |
|
|
my $q = $self->{'poll'}->{'questions'}->[$order]; |
129 |
|
|
|
130 |
|
|
if (! $q) { |
131 |
|
|
$self->status("Can't load question $order"); |
132 |
|
|
return; |
133 |
|
|
} |
134 |
|
|
|
135 |
|
|
foreach my $key (qw(q a time order var)) { |
136 |
|
|
$self->{'param'}->{$key} = $q->{$key}; |
137 |
|
|
} |
138 |
|
|
|
139 |
|
|
$self->status("Loaded question $order"); |
140 |
|
|
} |
141 |
|
|
|
142 |
|
|
sub question_exist { |
143 |
|
|
my $self = shift; |
144 |
|
|
|
145 |
|
|
my $order = shift || confess "need order"; |
146 |
|
|
return $self->{'poll'}->{'questions'}->[$order]; |
147 |
|
|
} |
148 |
|
|
|
149 |
|
|
|
150 |
|
|
|
151 |
dpavlin |
1 |
sub save_question { |
152 |
|
|
my $self = shift; |
153 |
|
|
|
154 |
|
|
my %v = map { $_ => $self->{'param'}->{$_} } qw(poll_name order); |
155 |
|
|
|
156 |
dpavlin |
4 |
# print "v = ",Dumper(\%v); |
157 |
dpavlin |
1 |
|
158 |
dpavlin |
5 |
my $o = $self->{'cgi'}->param('order'); |
159 |
dpavlin |
7 |
confess "no order?" if (! defined($o)); |
160 |
|
|
confess "order not number? [$o]" if ($o !~ /^\d+$/); |
161 |
dpavlin |
1 |
|
162 |
dpavlin |
5 |
if (! $self->{'cgi'}->param('save')) { |
163 |
|
|
$self->status("No save button, won't save question $o"); |
164 |
|
|
return; |
165 |
|
|
} |
166 |
|
|
|
167 |
|
|
$self->status("Saving question $o"); |
168 |
|
|
|
169 |
dpavlin |
1 |
my $question = { |
170 |
|
|
'q' => $self->{'cgi'}->param('q'), |
171 |
|
|
'a' => $self->{'cgi'}->param('a'), |
172 |
|
|
'var' => $self->{'cgi'}->param('var') || die, |
173 |
|
|
'time' => time(), |
174 |
dpavlin |
5 |
'order' => $o, |
175 |
dpavlin |
1 |
}; |
176 |
|
|
|
177 |
dpavlin |
4 |
#print "question = ",Dumper($question); |
178 |
dpavlin |
1 |
|
179 |
dpavlin |
5 |
$self->{'poll'}->{'questions'}->[$o] = $question; |
180 |
dpavlin |
1 |
|
181 |
dpavlin |
7 |
confess "question $0 not saved" if (! $self->{'poll'}->{'questions'}->[$o]); |
182 |
|
|
|
183 |
dpavlin |
5 |
$self->editor(); |
184 |
|
|
} |
185 |
dpavlin |
1 |
|
186 |
dpavlin |
5 |
sub delete_question { |
187 |
|
|
my $self = shift; |
188 |
dpavlin |
1 |
|
189 |
dpavlin |
5 |
my $nr = $self->{'cgi'}->param('order'); |
190 |
|
|
if (! defined($nr)) { |
191 |
|
|
$self->status("Can't delete question without a number!"); |
192 |
|
|
$self->editor(); |
193 |
|
|
} |
194 |
|
|
|
195 |
|
|
if (defined($self->{'poll'}->{'questions'}->[$nr])) { |
196 |
|
|
delete $self->{'poll'}->{'questions'}->[$nr]; |
197 |
dpavlin |
6 |
splice @{$self->{'poll'}->{'qiestions'}},$nr,1; |
198 |
|
|
$self->{'poll'}->optimize() || |
199 |
|
|
$self->status("Database optimization failed"); |
200 |
dpavlin |
5 |
$self->status("Question $nr deleted"); |
201 |
|
|
$self->editor(); |
202 |
|
|
} else { |
203 |
|
|
$self->status("Can't delete question $nr which doesn't exist!"); |
204 |
|
|
$self->editor(); |
205 |
|
|
} |
206 |
|
|
|
207 |
dpavlin |
1 |
} |
208 |
dpavlin |
5 |
|
209 |
|
|
sub edit_question { |
210 |
|
|
my $self = shift; |
211 |
|
|
|
212 |
|
|
my $nr = $self->{'cgi'}->param('order'); |
213 |
|
|
if (! defined($nr)) { |
214 |
|
|
$self->status("Edit question called without a number!"); |
215 |
|
|
$self->editor(); |
216 |
|
|
} |
217 |
|
|
|
218 |
|
|
$self->status("Editing question $nr"); |
219 |
|
|
|
220 |
|
|
$self->{'param'}->{'buttons'} = [ |
221 |
|
|
{ 'save' => ' Save changes ' }, |
222 |
|
|
{ 'cancel' => ' Cancel and Add new ' }, |
223 |
|
|
]; |
224 |
|
|
|
225 |
|
|
$self->editor($nr); |
226 |
|
|
} |
227 |
|
|
|
228 |
|
|
|
229 |
|
|
sub status { |
230 |
|
|
my $self = shift; |
231 |
|
|
|
232 |
|
|
my $text = join(" ",@_); |
233 |
|
|
|
234 |
|
|
$self->{'param'}->{'status'} .= $text.'<br/>'; |
235 |
|
|
$self->{'param'}->{'title'} = $text; |
236 |
|
|
} |