trunk/lib/WOPI.pm

package WOPI;

use strict;
use warnings;

use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use CGI::Session;
use DBM::Deep;
use Template;
our $VERSION = '1.00';

use Data::Dumper;

sub new {
        my $class = shift;

        my $self = {@_};
        bless($self, $class);

        $self->{'cgi'} = new CGI;
        $self->{'poll'} = new DBM::Deep $self->{'db_file'} || die "can't open '",$self->{'db_file'},"'";
        die "can't find database file ",$self->{'db_file'} if (! -e $self->{'db_file'});
        die "database file ",$self->{'db_file'}," not writable!" if (! -w $self->{'db_file'});
        $self->{'tt'} = new Template({
                INCLUDE_PATH => $self->{'templates'},
                EVAL_PERL => 1,
        });
        $self->{'sess'} = new CGI::Session("driver:File", undef, {Directory=>'/tmp'});
        # create new database if it doesn't exist
        if (! $self->{'poll'}) {
                $self->{'poll'}->{'poll_name'}  { 'questions' => [] };
        }

#print $self->{'cgi'}->header, Dumper($self->{'poll'});

        return $self;
}

sub last_order {
        my $self = shift;

        return scalar @{$self->{'poll'}->{'questions'}} || 0;
}

sub get_html {
        my $self = shift;

        my ($template,$param) = @_;

        my $html;
        $self->{'tt'}->process($template, $param, \$html) ||
                confess $self->{'tt'}->error();

        return $html;
}

#
# Acme methods
#

sub unbless {
        my $self = shift;
        
        my $var = Dumper(\@_);

        while ($var =~ s/bless\(\s*([{\[].*?[}\]])\s*,\s*'DBM::Deep'\s*\)/$1/sg) { };
        my $VAR1;
        eval $var;
        warn("eval of $var failed: $@") if ($@);

        return (wantarray ? @{$VAR1} : shift @{$VAR1});
}

#
# CGI methods
#

sub editor {
        my $self = shift;

        # question order or current
        my $order = shift;

        $self->status("edit called without a number!") if (! defined($order));

        $self->load_question($order) ||
        $self->add_question;

        $self->{'param'}->{'poll_name'} = $self->{'poll_name'};

        $self->{'param'}->{'poll'} = $self->unbless($self->{'poll'});

print qq{<!--},Dumper($self->{'param'}),qq{-->};

        return $self->get_html('editor.html', $self->{'param'});
}


sub add_question {
        my $self = shift;

        $self->{'param'}->{'order'} = $self->last_order;
        $self->{'param'}->{'var'} = "v".($self->last_order+1);

        $self->{'param'}->{'buttons'} = [
                { 'save' => ' Add ' },
                { 'cancel' => ' Cancel and Add another ' },
        ];

        $self->status("Adding question ",$self->last_order);
}

sub list_questions {
        my $self = shift;

}

sub load_question {
        my $self = shift;

        my $order = shift;
        
        return if (! defined($order));

        my $q = $self->{'poll'}->{'questions'}->[$order];

        if (! $q) {
                $self->status("Can't load question $order");
                return;
        }

        foreach my $key (qw(q a time order var)) {
                $self->{'param'}->{$key} = $q->{$key};
        }

        $self->status("Loaded question $order");
}

sub question_exist {
        my $self = shift;

        my $order = shift || confess "need order";
        return $self->{'poll'}->{'questions'}->[$order];
}


sub save_question {
        my $self = shift;

        my %v = map { $_ => $self->{'param'}->{$_} } qw(poll_name order);

#       print "v = ",Dumper(\%v);

        my $o = $self->{'cgi'}->param('order');
        die "no order?" if (! defined($o));

        if (! $self->{'cgi'}->param('save')) {
                $self->status("No save button, won't save question $o");
                return;
        }

        $self->status("Saving question $o");

        my $question = {
                'q' => $self->{'cgi'}->param('q'),
                'a' => $self->{'cgi'}->param('a'),
                'var' => $self->{'cgi'}->param('var') || die,
                'time' => time(),
                'order' => $o,
        };

#print "question = ",Dumper($question);

        $self->{'poll'}->{'questions'}->[$o] = $question;

        $self->editor();
}

sub delete_question {
        my $self = shift;

        my $nr = $self->{'cgi'}->param('order');
        if (! defined($nr)) {
                $self->status("Can't delete question without a number!");
                $self->editor();
        }

        if (defined($self->{'poll'}->{'questions'}->[$nr])) {
                delete $self->{'poll'}->{'questions'}->[$nr];
                splice @{$self->{'poll'}->{'qiestions'}},$nr,1;
                $self->{'poll'}->optimize() ||
                        $self->status("Database optimization failed");
                $self->status("Question $nr deleted");
                $self->editor();
        } else {
                $self->status("Can't delete question $nr which doesn't exist!");
                $self->editor();
        }

}

sub edit_question {
        my $self = shift;

        my $nr = $self->{'cgi'}->param('order');
        if (! defined($nr)) {
                $self->status("Edit question called without a number!");
                $self->editor();
        }

        $self->status("Editing question $nr");

        $self->{'param'}->{'buttons'} = [
                { 'save'        => ' Save changes ' },
                { 'cancel'      => ' Cancel and Add new ' },
        ];

        $self->editor($nr);
}
        

sub status {
        my $self = shift;

        my $text = join(" ",@_);

        $self->{'param'}->{'status'} .= $text.'<br/>';
        $self->{'param'}->{'title'} = $text;
}
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	}