[poe-commits] extras/whip Whip.pm,1.1,1.2 index.cgi,1.2,1.3
Brought to you by:
rcaputo
Menu
▾
▴
[poe-commits] extras/whip Whip.pm,1.1,1.2 index.cgi,1.2,1.3
|
From: <rc...@us...> - 2004-02-13 18:18:42
|
Update of /cvsroot/poe/extras/whip In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3299 Modified Files: Whip.pm index.cgi Log Message: Massive uncategorized changes from a long time ago. Index: Whip.pm =================================================================== RCS file: /cvsroot/poe/extras/whip/Whip.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Whip.pm 19 Nov 2002 17:55:08 -0000 1.1 --- Whip.pm 13 Feb 2004 18:12:43 -0000 1.2 *************** *** 10,15 **** --- 10,23 ---- use XML::Parser; use Whip::Tag; + use CGI qw(:standard); + use Whip::State; + + my %whip_tag_syntax; sub WH_DOCROOT () { 0 } + sub WH_PAGE_ID () { 1 } + sub WH_COOKIE () { 2 } + sub WH_QUERY () { 3 } + sub WH_USER () { 4 } # Create the Whip singleton. It's not truly a singleton, though, *************** *** 21,26 **** --- 29,64 ---- my %param = @_; + my $query = delete $param{query}; + my $cookie = $query->cookie("whip_uid"); + + # If we have a cookie from the browser, then try to load the state + # for it. Failure to load a state isn't bad; we'll just create a + # new one. + + my $user; + if (defined $cookie and length $cookie) { + eval { + $user = Whip::State->thaw($cookie); + } + } + + # The user state was loaded from the cookie, so we don't need to + # create a new cookie. Otherwise the user state was stale/removed, + # and we build a new one and a cookie to go with it. + + if (defined $user) { + undef $cookie; + } + else { + $user = Whip::State->new({}); + $cookie = $query->cookie( -name => "whip_uid", -value => $user->freeze() ); + } + my $self = bless [ delete $param{docroot}, # WH_DOCROOT + undef, # WH_PAGE_ID + $cookie, # WH_COOKIE + $query, # WH_QUERY + $user, # WH_USER ], $class; *************** *** 28,31 **** --- 66,114 ---- } + ### Emit a document. + + sub emit_document { + my $self = shift; + my %param = @_; + + # If we have a cookie, be sure to send it to the browser so the user + # may be identified later. + my @cookie; + if (defined $self->[WH_COOKIE]) { + push @cookie, -cookie => $self->[WH_COOKIE]; + } + + # This should never happen, but it just might. + unless (defined $self->[WH_USER]) { + die "No user"; + } + + # Flush any changes to the user state. + $self->[WH_USER]->freeze(); + + print( header( -status => delete $param{status}, + @cookie, + ), + start_html(delete $param{title}), + delete $param{body}, + end_html(), + ); + exit 0; + } + + ### Throw an error. + + sub error { + my ($self, $status, $title, $body) = @_; + die [ $status, $title, $body ]; + } + + ### Set syntax for a package. + + sub set_syntax { + my ($self, $pkg, $syntax) = @_; + $whip_tag_syntax{$pkg} = $syntax; + } + ### Manage a page cache. *************** *** 52,67 **** my ($self, $page_id) = @_; unless ($page_id =~ /^(.+?)\.([^\.]+)$/) { ! die "$page_id is not a valid page ID"; } if ($2 eq "tag") { ! return "Whip::Tag::$1"; } ! if ($2 eq "act") { ! return "Whip::Action::$1"; } ! die "$page_id is not a known executable page type"; } --- 135,163 ---- my ($self, $page_id) = @_; unless ($page_id =~ /^(.+?)\.([^\.]+)$/) { ! $self->error( 404, "Page Not Found", ! "<tt>" . escapeHTML($page_id) . ! "</tt> is not a valid whip page ID." ! ); } + my $package = $1; + $package =~ tr[a-zA-Z_0-9:][_]cs; + if ($2 eq "tag") { ! return "Whip::Tag::$package"; } ! if ($2 eq "do") { ! return "Whip::Action::$package"; } ! if ($2 eq "form") { ! return "Whip::Form::$package"; ! } ! ! $self->error( 500, "Error Executing Page", ! "<tt>" . escapeHTML($page_id) . ! "</tt> is not executable." ! ); } *************** *** 102,106 **** unless (-e $path) { ! die "404 page $path not found"; } --- 198,205 ---- unless (-e $path) { ! $self->error( 404, "Page Not Found", ! "The file for <tt>" . escapeHTML($page_id) . ! "</tt> does not exist." ! ); } *************** *** 110,121 **** unless (open PAGE, $path) { ! die "500 error loading page"; } # If page is executable, then load it. my $page_data; ! if ($page_id =~ /\.(act|tag)$/) { require $path; $page_data = $self->page_to_package($page_id); } else { --- 209,228 ---- unless (open PAGE, $path) { ! $self->error( 500, "Error Loading Page", ! "The file for <tt>" . escapeHTML($page_id) . ! "</tt> could not be opened: $!" ! ); } # If page is executable, then load it. my $page_data; ! if ($page_id =~ /\.(do|tag|form)$/) { require $path; $page_data = $self->page_to_package($page_id); + + # Tags have special on-load needs. + if ($page_id =~ /\.tag$/) { + $page_data->set_syntax(); + } } else { *************** *** 140,144 **** sub start_element { ! my ($self, $parser, $tag, $args) = @_; my $page_package = $self->load_page("$tag.tag"); --- 247,251 ---- sub start_element { ! my ($self, $param, $parser, $tag, $args) = @_; my $page_package = $self->load_page("$tag.tag"); *************** *** 147,165 **** if ($tag eq "page") { ! die "<page> must be outermost tag" if @tag_stack; ! } ! else { ! unless (@tag_stack) { ! die "<$tag> must be within a page"; ! } ! ! # See if the tag's legal. ! unless ($tag_stack[-1]->can_contain($tag)) { ! my $tag_container = $tag_stack[-1]->name(); ! die "<$tag> is not part of <$tag_container>"; } } ! push @tag_stack, $page_package->new($self, $tag, $args); } --- 254,275 ---- if ($tag eq "page") { ! if (@tag_stack) { ! $self->error( 500, "Invalid Whip Content", ! "<tt>" . escapeHTML("$tag.tag") . ! "</tt> <tt><page></tt> must be the outermost tag." ! ); } } + # else { + # unless (@tag_stack) { + # $self->error( 500, "Invalid Whip Content", + # "<tt>" . escapeHTML("$tag.tag") . + # "</tt> <tt>" . escapeHTML("<$tag>") . + # "</tt> must be within a <page> tag." + # ); + # } + # } ! push @tag_stack, $page_package->new($self, $tag, $args, $param); } *************** *** 167,221 **** sub end_element { ! my ($self, $parser, $tag) = @_; unless (@tag_stack) { ! die "</$tag> has no corresponding <$tag>"; } my $open_tag = $tag_stack[-1]->name(); unless ($tag eq $open_tag) { ! die "</$tag> attempts to close <$tag>"; } ! # Close the tag, and pop it off the stack. ! $tag_stack[-1]->close($self); my $done_tag = pop @tag_stack; # Give its content to its container. ! if (@tag_stack) { ! my @contents = $done_tag->get_contents(); ! $tag_stack[-1]->set_contents(@contents); } } ! # Parser callback for some random text. sub text { ! my ($self, $parser, $text) = @_; # Ignore all-whitespace text. return unless $text =~ /\S/; ! $self->start_element($parser, "text", { text => $text }); ! $self->end_element($parser, "text"); } # Render a page. ! sub render { ! my ($self, $page_id) = @_; ! die unless $page_id =~ /\.page$/; my $parser = XML::Parser->new ( Handlers => ! { Start => sub { $self->start_element(@_) }, ! End => sub { $self->end_element(@_) }, ! Char => sub { $self->text(@_) }, } ); my $page_data = $self->load_page($page_id); $parser->parse($page_data); } --- 277,417 ---- sub end_element { ! my ($self, $param, $parser, $tag) = @_; unless (@tag_stack) { ! $self->error( 500, "Invalid Whip Content", ! "<tt>" . escapeHTML("</$tag>") . ! "</tt> has no corresponding <tt>" . ! escapeHTML("<$tag>") . "</tt>." ! ); } my $open_tag = $tag_stack[-1]->name(); unless ($tag eq $open_tag) { ! $self->error( 500, "Invalid Whip Content", ! "<tt>" . escapeHTML("</$tag>") . ! "</tt> attempts to close <tt>" . ! escapeHTML("<$open_tag>") . "</tt>." ! ); } ! # Pop the tag off the stack, validate its data, build a hash of ! # useful parameters, and close the tag with that. ! my $done_tag = pop @tag_stack; + # Validate parameters, and build a data hash. + + my @data; + if (exists $whip_tag_syntax{ref($done_tag)}) { + my @syntax = @{$whip_tag_syntax{ref($done_tag)}}; + while (my ($sub_tag, $flags) = splice(@syntax, 0, 2)) { + my @default; + if (ref($flags) eq "ARRAY") { + ($flags, @default) = @$flags; + } + + my $legal = 1; + if ($flags & LIST) { + my @value = $done_tag->fetch($sub_tag, @default); + push @data, [@value]; + if ($flags & REQ and !@value) { + $legal = 0; + last; + } + } + elsif ($flags & SCALAR) { + my $value = $done_tag->fetch($sub_tag, @default); + unless (defined $value) { + if ($flags & REQ) { + $legal = 0; + last; + } + $value = ""; + } + push @data, $value; + } + else { + $self->error( 500, "Invalid Whip Syntax", + "<tt>" . escapeHTML("<$tag>") . + "</tt> has unknown flags for subtag <tt>" . + escapeHTML("<$sub_tag>") . "</tt>." + ); + } + + unless ($legal) { + $self->error( 500, "Invalid Whip Content", + "<tt>" . escapeHTML("<$tag>") . + "</tt> requires <tt>" . + escapeHTML("<$sub_tag>") . "</tt>." + ); + } + } + } + + # Pass the data to the close tag. + $done_tag->close(@data); + } + + ### Give this tag's contents to some container. Propagates up the + ### container thingy. + + sub emit { + my ($self, $type, $value) = @_; + my $take_method = "take_$type"; + # Give its content to its container. ! my $i = @tag_stack; ! while ($i--) { ! if ($tag_stack[$i]->can($take_method)) { ! $tag_stack[$i]->$take_method($value); ! return; ! } } } ! ### Parser callback for some random text. sub text { ! my ($self, $param, $parser, $text) = @_; # Ignore all-whitespace text. return unless $text =~ /\S/; ! $self->start_element($param, $parser, "text", { text => $text }); ! $self->end_element($param, $parser, "text"); } # Render a page. ! sub render_page { ! my ($self, $page_id, $param) = @_; ! unless ($page_id =~ /\.page$/) { ! $self->error( 500, "Error Rendering Page", ! "<tt>" . escapeHTML($page_id) . ! "</tt> is not renderable." ! ); ! } my $parser = XML::Parser->new ( Handlers => ! { Start => sub { $self->start_element($param, @_) }, ! End => sub { $self->end_element($param, @_) }, ! Char => sub { $self->text($param, @_) }, } ); my $page_data = $self->load_page($page_id); + $self->[WH_PAGE_ID] = $page_id; $parser->parse($page_data); + undef $self->[WH_PAGE_ID]; + } + + ### Accessor: Get the current page ID. + + sub get_page_id { + my $self = shift; + return $self->[WH_PAGE_ID]; } *************** *** 233,236 **** --- 429,439 ---- } + ### Submit something. + + sub submit_page { + my ($self, $page_id, $param) = @_; + my $package_name = $self->load_page($page_id); + $package_name->submit_form($self, $page_id, $param); + } 1; Index: index.cgi =================================================================== RCS file: /cvsroot/poe/extras/whip/index.cgi,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** index.cgi 19 Nov 2002 17:55:08 -0000 1.2 --- index.cgi 13 Feb 2004 18:12:44 -0000 1.3 *************** *** 4,17 **** use strict; - use Whip; - sub DIR_BASE () { "/home/troc/public_html/whip" } sub DIR_DOCROOT () { DIR_BASE . "/docroot" } #------------------------------------------------------------------------------ # Main code. ! my $whip = Whip->new( docroot => DIR_DOCROOT ); ! $whip->execute_page("main.act"); exit 0; --- 4,53 ---- use strict; sub DIR_BASE () { "/home/troc/public_html/whip" } sub DIR_DOCROOT () { DIR_BASE . "/docroot" } + sub DIR_LOCK () { DIR_BASE . "/lock" } + sub DIR_STATE () { DIR_BASE . "/state" } + sub DIR_USER () { DIR_BASE . "/user" } + use Whip; #------------------------------------------------------------------------------ # Main code. ! use CGI; ! my $query = new CGI; ! ! eval { ! my $whip = Whip->new( docroot => DIR_DOCROOT, ! query => $query, ! ); ! $whip->execute_page("main.do"); ! }; ! ! if ($@) { ! if (ref($@) eq "ARRAY") { ! my ($status, $title, $body) = @{$@}; ! print( header(-status => $status), ! start_html("$status $title"), ! "<h1>$title</h1><p>$body</p>", ! end_html(), ! ); ! exit 0; ! } ! ! my $error = $@; $error = escapeHTML($error); ! print( header(-status => 500), ! start_html("Error 500"), ! "<h1>Generic Server Error</h1><p><pre>$error</pre></p>", ! end_html(), ! ); ! exit 0; ! } ! ! print( header(-status => 500), ! start_html("500 Internal Whip Error"), ! "<h1>Internal Whip Error</h1>", ! "<p>Main whip renderer did not exit when it was done.</p>", ! end_html(), ! ); exit 0; |