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];
                $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			return scalar @{$self->{'poll'}->{'questions'}} \|\| 0;
44			}
45
46	dpavlin	1	sub get_html {
47			my $self = shift;
48
49			my ($template,$param) = @_;
50
51			my $html;
52			$self->{'tt'}->process($template, $param, \$html) \|\|
53	dpavlin	4	confess $self->{'tt'}->error();
54	dpavlin	1
55			return $html;
56			}
57
58			#
59	dpavlin	4	# 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	dpavlin	1	# CGI methods
77			#
78
79			sub editor {
80			my $self = shift;
81
82	dpavlin	5	# 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	dpavlin	1	$self->{'param'}->{'poll_name'} = $self->{'poll_name'};
91
92	dpavlin	4	$self->{'param'}->{'poll'} = $self->unbless($self->{'poll'});
93
94	dpavlin	5	print qq{<!--},Dumper($self->{'param'}),qq{-->};
95
96	dpavlin	1	return $self->get_html('editor.html', $self->{'param'});
97			}
98
99	dpavlin	5
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	dpavlin	1	sub list_questions {
115			my $self = shift;
116
117			}
118
119	dpavlin	5	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	dpavlin	1	sub save_question {
150			my $self = shift;
151
152			my %v = map { $_ => $self->{'param'}->{$_} } qw(poll_name order);
153
154	dpavlin	4	# print "v = ",Dumper(\%v);
155	dpavlin	1
156	dpavlin	5	my $o = $self->{'cgi'}->param('order');
157			die "no order?" if (! defined($o));
158	dpavlin	1
159	dpavlin	5	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	dpavlin	1	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	dpavlin	5	'order' => $o,
172	dpavlin	1	};
173
174	dpavlin	4	#print "question = ",Dumper($question);
175	dpavlin	1
176	dpavlin	5	$self->{'poll'}->{'questions'}->[$o] = $question;
177	dpavlin	1
178	dpavlin	5	$self->editor();
179			}
180	dpavlin	1
181	dpavlin	5	sub delete_question {
182			my $self = shift;
183	dpavlin	1
184	dpavlin	5	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			$self->status("Question $nr deleted");
193			$self->editor();
194			} else {
195			$self->status("Can't delete question $nr which doesn't exist!");
196			$self->editor();
197			}
198
199	dpavlin	1	}
200	dpavlin	5
201			sub edit_question {
202			my $self = shift;
203
204			my $nr = $self->{'cgi'}->param('order');
205			if (! defined($nr)) {
206			$self->status("Edit question called without a number!");
207			$self->editor();
208			}
209
210			$self->status("Editing question $nr");
211
212			$self->{'param'}->{'buttons'} = [
213			{ 'save' => ' Save changes ' },
214			{ 'cancel' => ' Cancel and Add new ' },
215			];
216
217			$self->editor($nr);
218			}
219
220
221			sub status {
222			my $self = shift;
223
224			my $text = join(" ",@_);
225
226			$self->{'param'}->{'status'} .= $text.'<br/>';
227			$self->{'param'}->{'title'} = $text;
228			}