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