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 0 if (! defined $self->{'poll'}->{'questions'});

        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');
        confess "no order?" if (! defined($o));
        confess "order not number? [$o]" if ($o !~ /^\d+$/);

        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;

        confess "question $0 not saved" if (! $self->{'poll'}->{'questions'}->[$o]);

        $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	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			}