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->{'db'} = 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'});
        $self->{'poll'} = $self->{'db'}->get($self->{'poll_name'});
        
        # create new database if it doesn't exist
        if (! $self->{'poll'}) {
                $self->{'db'}->put($self->{'poll_name'}, { 'questions' => [] });
                $self->{'poll'} = $self->{'db'}->get($self->{'poll_name'});
        }

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

        if ($self->{'poll'} && defined($self->{'poll'}->{'questions'})) {
                $self->{'order'} = (scalar @{$self->{'poll'}->{'questions'}})+1;
        } else {
                $self->{'order'} = 1;
        }

        return $self;
}

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;

        $self->{'param'}->{'var'} = "v".$self->{'order'};
        $self->{'param'}->{'poll_name'} = $self->{'poll_name'};
        $self->{'param'}->{'order'} = $self->{'order'};

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

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

sub list_questions {
        my $self = shift;

}

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?";

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

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

        push @{$self->{'poll'}->{'questions'}}, $question;

        $self->{'db'}->put($self->{'poll_name'}, $self->{'poll'});

        $self->{'order'}++;

        $self->editor();
}
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			$self->{'db'} = 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			$self->{'poll'} = $self->{'db'}->get($self->{'poll_name'});
31
32			# create new database if it doesn't exist
33			if (! $self->{'poll'}) {
34			$self->{'db'}->put($self->{'poll_name'}, { 'questions' => [] });
35			$self->{'poll'} = $self->{'db'}->get($self->{'poll_name'});
36			}
37
38	dpavlin	4	#print $self->{'cgi'}->header, Dumper($self->{'db'});
39	dpavlin	1
40			if ($self->{'poll'} && defined($self->{'poll'}->{'questions'})) {
41			$self->{'order'} = (scalar @{$self->{'poll'}->{'questions'}})+1;
42			} else {
43			$self->{'order'} = 1;
44			}
45
46			return $self;
47			}
48
49			sub get_html {
50			my $self = shift;
51
52			my ($template,$param) = @_;
53
54			my $html;
55			$self->{'tt'}->process($template, $param, \$html) \|\|
56	dpavlin	4	confess $self->{'tt'}->error();
57	dpavlin	1
58			return $html;
59			}
60
61			#
62	dpavlin	4	# Acme methods
63			#
64
65			sub unbless {
66			my $self = shift;
67
68			my $var = Dumper(\@_);
69
70			while ($var =~ s/bless\(\s([{\[].?[}\]])\s,\s'DBM::Deep'\s*\)/$1/sg) { };
71			my $VAR1;
72			eval $var;
73			warn("eval of $var failed: $@") if ($@);
74
75			return (wantarray ? @{$VAR1} : shift @{$VAR1});
76			}
77
78			#
79	dpavlin	1	# CGI methods
80			#
81
82			sub editor {
83			my $self = shift;
84
85			$self->{'param'}->{'var'} = "v".$self->{'order'};
86			$self->{'param'}->{'poll_name'} = $self->{'poll_name'};
87			$self->{'param'}->{'order'} = $self->{'order'};
88
89	dpavlin	4	$self->{'param'}->{'poll'} = $self->unbless($self->{'poll'});
90
91	dpavlin	1	return $self->get_html('editor.html', $self->{'param'});
92			}
93
94			sub list_questions {
95			my $self = shift;
96
97			}
98
99			sub save_question {
100			my $self = shift;
101
102			my %v = map { $_ => $self->{'param'}->{$_} } qw(poll_name order);
103
104	dpavlin	4	# print "v = ",Dumper(\%v);
105	dpavlin	1
106			my $o = $self->{'cgi'}->param('order') \|\| die "no order?";
107
108			my $question = {
109			'q' => $self->{'cgi'}->param('q'),
110			'a' => $self->{'cgi'}->param('a'),
111			'var' => $self->{'cgi'}->param('var') \|\| die,
112			'time' => time(),
113			'order' => $o \|\| die,
114			};
115
116	dpavlin	4	#print "question = ",Dumper($question);
117	dpavlin	1
118			push @{$self->{'poll'}->{'questions'}}, $question;
119
120			$self->{'db'}->put($self->{'poll_name'}, $self->{'poll'});
121
122			$self->{'order'}++;
123
124			$self->editor();
125			}