[prev] [thread] [next] [lurker] [Date index for 2005/01/27]
Author: richardc Date: 2005-01-27 10:15:10 +0000 (Thu, 27 Jan 2005) New Revision: 1794 Added: trunk/Siesta-Web/ trunk/Siesta-Web/cgi-bin/ trunk/Siesta-Web/lib/ trunk/Siesta-Web/lib/Siesta/ trunk/Siesta-Web/lib/Siesta/Web.pm trunk/Siesta-Web/lib/Siesta/Web/ trunk/Siesta-Web/lib/Siesta/Web/FakeApache.pm trunk/Siesta-Web/lib/Template/ trunk/Siesta-Web/lib/Template/Plugin/ trunk/Siesta-Web/lib/Template/Plugin/Siesta.pm trunk/Siesta-Web/t/ trunk/Siesta-Web/web-frontend/ Removed: trunk/siesta/cgi-bin/ trunk/siesta/lib/Siesta/Web.pm trunk/siesta/lib/Siesta/Web/FakeApache.pm trunk/siesta/lib/Template/Plugin/Siesta.pm trunk/siesta/web-frontend/ Modified: trunk/siesta/MANIFEST Log: move Siesta-Web out of the core dist (fuck web sites) Copied: trunk/Siesta-Web/cgi-bin (from rev 1792, trunk/siesta/cgi-bin) Copied: trunk/Siesta-Web/lib/Siesta/Web/FakeApache.pm (from rev 1792, trunk/siesta/lib/Siesta/Web/FakeApache.pm) Copied: trunk/Siesta-Web/lib/Siesta/Web.pm (from rev 1792, trunk/siesta/lib/Siesta/Web.pm) Copied: trunk/Siesta-Web/lib/Template/Plugin/Siesta.pm (from rev 1792, trunk/siesta/lib/Template/Plugin/Siesta.pm) Copied: trunk/Siesta-Web/web-frontend (from rev 1792, trunk/siesta/web-frontend) Modified: trunk/siesta/MANIFEST =================================================================== --- trunk/siesta/MANIFEST 2005-01-27 10:07:59 UTC (rev 1793) +++ trunk/siesta/MANIFEST 2005-01-27 10:15:10 UTC (rev 1794) @@ -43,8 +43,6 @@ lib/Siesta/Test.pm lib/Siesta/Member.pm lib/Siesta/UserGuide.pod -lib/Siesta/Web.pm -lib/Siesta/Web/FakeApache.pm lib/Template/Plugin/Siesta.pm messages/backup messages/challenge @@ -79,22 +77,3 @@ t/20fullsend.t t/30nacho.t t/config -web-frontend/lib/I_SHOULDNT_EXIST.tt2 -web-frontend/lib/_errors_list.tt2 -web-frontend/lib/_footer.tt2 -web-frontend/lib/_header.tt2 -web-frontend/lib/_login_box.tt2 -web-frontend/lib/_navbar.tt2 -web-frontend/lib/_pub_archive_list.tt2 -web-frontend/lib/_pub_lists_list.tt2 -web-frontend/lib/_topbar.tt2 -web-frontend/siesta/images/siesta_logo.gif -web-frontend/siesta/images/zero.gif -web-frontend/siesta/index.tt2 -web-frontend/siesta/list.tt2 -web-frontend/siesta/login.tt2 -web-frontend/siesta/logout.tt2 -web-frontend/siesta/register.tt2 -web-frontend/siesta/resume.tt2 -web-frontend/siesta/siesta.css -web-frontend/tt2.cgi Deleted: trunk/siesta/lib/Siesta/Web/FakeApache.pm =================================================================== --- trunk/siesta/lib/Siesta/Web/FakeApache.pm 2005-01-27 10:07:59 UTC (rev 1793) +++ trunk/siesta/lib/Siesta/Web/FakeApache.pm 2005-01-27 10:15:10 UTC (rev 1794) @@ -1,53 +0,0 @@ -use strict; -package Siesta::Web::FakeApache; -use base 'Class::Accessor::Fast'; -__PACKAGE__->mk_accessors(qw( filename uri headers content_type )); - -sub new { - my $class = shift; - if (0) { - require YAML; - require CGI; - print CGI->header('text/plain'); - print YAML::Dump(\%ENV ); - exit; - } - $class->SUPER::new({ - filename => "$ENV{DOCUMENT_ROOT}/$ENV{SCRIPT_NAME}", # this is fragile - uri => $ENV{REQUEST_URI}, - headers => [], - content_type => 'text/html', - }); -} - -sub header_out { - my $self = shift; - push @{ $self->headers }, [ @_ ]; -} - -sub send_http_header { - my $self = shift; - print "Content-Type: ", $self->content_type, "\r\n"; - print "$_->[0]: $_->[1]\r\n" for @{ $self->headers }; - print "\r\n"; -} - -sub print { - my $self = shift; - print @_; -} - -sub log_reason { - shift; - print STDERR @_; -} - - -package Apache::Constants; -$INC{'Apache/Constants.pm'} = 1; -sub import { - my $caller = caller; - no strict 'refs'; - *{"$caller\::$_"} = sub {} for qw( DECLINED SERVER_ERROR OK ); -} -1; Deleted: trunk/siesta/lib/Siesta/Web.pm =================================================================== --- trunk/siesta/lib/Siesta/Web.pm 2005-01-27 10:07:59 UTC (rev 1793) +++ trunk/siesta/lib/Siesta/Web.pm 2005-01-27 10:15:10 UTC (rev 1794) @@ -1,79 +0,0 @@ -use strict; -package Siesta::Web; -use Apache::Constants qw( :common ); -use Template; -use Apache::Session::SharedMem; -use CGI; -use Siesta; -use Siesta::Config; - -use constant Cookie => 'siesta_session'; - -=head1 SYNOPSIS - - PerlModule Siesta::Web - <Files *.tt2> - SetHandler perl-script - PerlHandler Siesta::Web - </Files> - -=cut - -my $tt; -sub handler { - my $r = shift; - - my $file = $r->filename; - $file =~ /\.tt2$/ or return DECLINED; - - my $cgi = CGI->new; - my $session_id = $cgi->cookie( Cookie ); - my %session; - # try the session in the cookie, or a new one - for my $id ($session_id, undef) { - eval { - tie %session, 'Apache::Session::SharedMem', $id, - +{ expires_in => 24 * 60 * 60 }; # 24 hours - }; - last unless $@; - } - - unless ( $session{_session_id} ) { - $r->log_reason( "couldn't get session" ); - return SERVER_ERROR; - } - - my @headers = ( - [ 'Set-Cookie' => - $cgi->cookie(-name => Cookie, - -value => $session{_session_id}) ] - ); - - my $params = { - set_header => sub { push @headers, @_; return }, - uri => $r->uri, - cgi => $cgi, - session => \%session, - }; - - my $root = $config->root; - $tt ||= Template->new( - ABSOLUTE => 1, - INCLUDE_PATH => "$root/web-frontend/siesta:$root/web-frontend/lib" ); - - my $out; - $tt->process($file, $params, \$out) - or do { - $r->log_reason( $tt->error ); - return SERVER_ERROR; - }; - - $r->header_out( @$_ ) for @headers; - $r->content_type('text/html'); - $r->send_http_header; - $r->print( $out ); - - return OK; -} - -1; Deleted: trunk/siesta/lib/Template/Plugin/Siesta.pm =================================================================== --- trunk/siesta/lib/Template/Plugin/Siesta.pm 2005-01-27 10:07:59 UTC (rev 1793) +++ trunk/siesta/lib/Template/Plugin/Siesta.pm 2005-01-27 10:15:10 UTC (rev 1794) @@ -1,279 +0,0 @@ -package Template::Plugin::Siesta; -use strict; -use base qw( Template::Plugin Class::Accessor::Fast ); -__PACKAGE__->mk_accessors(qw( errors context success cgi user )); -use Siesta; -use Siesta::Message; -use Siesta::Deferred; -use CGI (); - -=head1 NAME - -Template::Plugin::Siesta - convenience class for Siesta template pages - -=head1 METHODS - -=item ->new( {foo => 'bar'} ) - -creates a new Template::Siesta::Plugin from, using a hashref to -provide arguments, - -=item ->new( foo => 'bar' ) - -creates a new Template::Siesta::Plugin from, using an array of name -value pairs to provide arguments, - -if the arguments contain an action request then ( see ->action() ) -then the requested action will be performed before returning the new -object; - -=cut - -sub new { - my $referent = shift; - my $context = shift; - my %args = ref($_[0]) eq 'HASH' ? %{ $_[0] } : @ _; - - my $class = ref $referent || $referent; - my $self = bless { %args, - errors => [], - context => $context, - cgi => CGI->new, - }, $class; - - $self->_perform_action - if $self->action && $self->cgi->param('submit'); - - return $self; -} - -=item ->action - -if called with no aruments, returns the currently defined action. if -called with a string value, sets the action or warns of an error if -the class cannot ->ACTION_$action - -=cut - -sub action { - my ($self, $action) = @_; - - if ($action) { - if ($self->can("ACTION_$action") ) { - $self->{action} = $action; - } - else { - $self->error("Template::Siesta::Plugin - Unknown action $action"); - } - } - return $self->{action}; -} - -sub _perform_action { - my $self = shift; - - my $action_method = "ACTION_" . $self->action; - $self->errors([]); # zero the errors from previous action. - $self->success( $self->$action_method() ); -} - - -my $MIN_PASS = 6; # should come out of a config I guess ... -sub ACTION_register { - my $self = shift; - - my ($pass1) = $self->_getParam('pass1',"(\\w{$MIN_PASS,40})"); - my ($pass2) = $self->_getParam('pass2',"(\\w{$MIN_PASS,40})"); - my ($email) = $self->_getParam('email','(\S{6,40})' ); - - unless (defined $pass1) { - $self->error("Passwords must be at least $MIN_PASS long"); - return; - } - if ( defined($pass1) && defined($pass2) && $pass1 ne $pass2) { - $self->error("Password and confirmation must match"); - return; - } - - my $user = Siesta::Member->load( $email ) ||= - Siesta::Member->create({ email => $email, password => $pass1 }); - - # should return a list of the ticked checkboxes need to confirm - # they are public lists, as you shouldnt be able to sub to private - # lists before you are subscribed I guess. - my @subscriptions = $self->cgi->param('subscribe'); - - foreach my $list_name (@subscriptions) { - my $list = Siesta::List->load( $list_name ); - my $sub_address = $list->address( 'sub' ); - eval { - Siesta->process( - action => 'sub', - list => $list_name, - mail => <<END, -From: $email -To: $sub_address -Subject: Web subscription - -Little pig, little pig, let me in -END - ); - }; - $self->error( $@ ) if $@; - } - return 1; # success -} - -sub ACTION_login { - my $self = shift; - my ($email) = $self->_getParam('email', '(\S+)' ); - my ($pass) = $self->_getParam('pass', '(\S+)' ); - - my $user = Siesta::Member->load( $email ) or return; - - # no null passwords - return unless $pass; - if ($pass eq $user->password) { - return $user; - } - return; -} - -sub ACTION_move_plugin { - my $self = shift; - - my $plugin = Siesta::Plugin->retrieve( $self->_getParam('id', '(\d+)' )) - or return; - my $list = $plugin->list; - return unless $self->user == $list->owner; - - my ($to) = $self->_getParam( 'to', '(\d+)' ); - # the rest of the queue - my @queue = grep { $_ != $plugin } $list->plugins( $plugin->queue ); - splice @queue, $to - 1, 0, $plugin; - $list->set_plugins( $plugin->queue => map { $_->name } @queue ); -} - -sub ACTION_add_plugin { - my $self = shift; - - my $list = Siesta::List->load( $self->_getParam('list', '(\S+)') ) - or return; - return unless $self->user->id == $list->owner->id; - - my ($queue) = $self->_getParam('queue', '(\S+)'); - my ($type) = $self->_getParam('type', '(\S+)'); - - # mmm, evil tastes sooo good - eval { - $list->add_plugin( $queue, - ( $self->_getParam('personal', '(\S+)') ? '+' : '') . $type ); - } or do { $self->error( $@ ); return }; - return 1; -} - -sub ACTION_delete_plugin { - my $self = shift; - - my ($id) = $self->_getParam( 'id', '(\d+)' ); - my $plugin = Siesta::Plugin->retrieve( $id ) or return; - return unless $plugin->list->owner->id == $self->user->id; - $plugin->delete; - return 1; -} - -sub ACTION_resume_message { - my $self = shift; - - my $message = Siesta::Deferred->retrieve( - $self->_getParam( 'id', '(\d+)' ) - ) - or return; - return unless $self->user->id == $message->who; - - Siesta::Message->resume( $message->id ); - return 1; -} - -sub ACTION_set_pref { - my $self = shift; - - my $list = Siesta::List->retrieve( $self->_getParam( 'list', - qr/^(\d+)$/ ) ) - or return; - for my $plugin (map { $_->promote } Siesta::Plugin->search({ list => $list })) { - for my $pref (keys %{ $plugin->options }) { - my $val; - if ($plugin->personal && - ( ($val) = $self->_getParam( "personal_$pref", '(.*)' ) ) ) { - $plugin->member( $self->user ); - $plugin->pref( $pref, $val ); - } - if (( $plugin->list->owner == $self->user ) && - ( ($val) = $self->_getParam( "list_$pref", '(.*)' ) ) ) { - $plugin->member( undef ); - $plugin->pref( $pref, $val ); - } - } - } - return 1; -} - - -sub _getParam { - my ($self,$param,$regex) = @_; - - my $var = $self->cgi->param($param); - if (defined $var) { - return $var =~ /$regex/; - } - return; -} - -sub user { $_[0]->context->stash->get('session.user') } - -sub available_plugins { - [ Siesta->available_plugins ]; -} - -sub lists { - [ Siesta::List->retrieve_all ]; -} - -sub list { - my ($self, $list) = @_; - Siesta::List->load( $list ); -} - -# messages deferred for the current user -sub deferred { - my $self = shift; - my $id = shift; - if ($id) { - return Siesta::Deferred->search( who => $self->user, id => $id); - } - [ Siesta::Deferred->search( who => $self->user ) ]; -} - -=item ->error( $what ) - -blow an error - -=cut - -sub error { - my $self = shift; - push @{ $self->errors }, @_; -} - -=item ->errors - -returns a list of errors that ocurred during an action request. - -=item ->success - -Return value of the action - -=cut - -1;
Generated at 11:00 on 27 Jan 2005 by mariachi 0.52