[poe-commits] extras/whip/Whip State.pm,1.2,1.3 Tag.pm,1.2,1.3

[<rc...@us...>]

Update of /cvsroot/poe/extras/whip/Whip
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3299/Whip

Modified Files:
	State.pm Tag.pm 
Log Message:
Massive uncategorized changes from a long time ago.

Index: State.pm
===================================================================
RCS file: /cvsroot/poe/extras/whip/Whip/State.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** State.pm	19 Nov 2002 17:55:09 -0000	1.2
--- State.pm	13 Feb 2004 18:12:44 -0000	1.3
***************
*** 15,21 ****
  use CGI qw(escapeHTML);
  
! sub STATE_PARENT () { 0 }
! sub STATE_VALUES () { 1 }
! sub STATE_ID     () { 2 }
  
  ### Static functions to lock and unlock resources.  They should be
--- 15,20 ----
  use CGI qw(escapeHTML);
  
! sub STATE_VALUES () { 0 }
! sub STATE_ID     () { 1 }
  
  ### Static functions to lock and unlock resources.  They should be
***************
*** 30,35 ****
  
    if (exists $locks{$lock_file}) {
!     main::error( 500,
!                  "500 Attempt To Double Lock",
                   "Could not lock file <tt>" . escapeHTML($lock_file) .
                   "</tt> because it already is locked."
--- 29,33 ----
  
    if (exists $locks{$lock_file}) {
!     Whip->error( 500, "Attempt To Double Lock",
                   "Could not lock file <tt>" . escapeHTML($lock_file) .
                   "</tt> because it already is locked."
***************
*** 39,44 ****
    my $lock_fh = gensym();
    unless (open $lock_fh, ">", $lock_file) {
!     main::error( 500,
!                  "500 Could Not Open Lock",
                   "Could not open lock file <tt>" . escapeHTML($lock_file) .
                   "</tt>: $!"
--- 37,41 ----
    my $lock_fh = gensym();
    unless (open $lock_fh, ">", $lock_file) {
!     Whip->error( 500, "Could Not Open Lock",
                   "Could not open lock file <tt>" . escapeHTML($lock_file) .
                   "</tt>: $!"
***************
*** 47,52 ****
  
    unless (flock($lock_fh, LOCK_EX)) {
!     main::error( 500,
!                  "500 Could Not Acquire Lock",
                   "Could not acquire lock on <tt>" .
                   escapeHTML($lock_file) . "</tt>: $!"
--- 44,48 ----
  
    unless (flock($lock_fh, LOCK_EX)) {
!     Whip->error( 500, "Could Not Acquire Lock",
                   "Could not acquire lock on <tt>" .
                   escapeHTML($lock_file) . "</tt>: $!"
***************
*** 63,76 ****
    my $lock_fh = delete $locks{$lock_file};
    unless (defined $lock_fh) {
!     main:error( 500,
!                 "500 Attempt To Unlock Unlocked Resource",
!                 "Could not unlock <tt>" . escapeHTML($lock_file) .
!                 "</tt> because it already is unlocked."
!               );
    }
  
    unless (flock($lock_fh, LOCK_UN)) {
!     main::error( 500,
!                  "500 Could Not Release Lock",
                   "Could not release lock on <tt>" .
                   escapeHTML($lock_file) . "</tt>: $!"
--- 59,70 ----
    my $lock_fh = delete $locks{$lock_file};
    unless (defined $lock_fh) {
!     Whip->error( 500, "Attempt To Unlock Unlocked Resource",
!                  "Could not unlock <tt>" . escapeHTML($lock_file) .
!                  "</tt> because it already is unlocked."
!                );
    }
  
    unless (flock($lock_fh, LOCK_UN)) {
!     Whip->error( 500, "Could Not Release Lock",
                   "Could not release lock on <tt>" .
                   escapeHTML($lock_file) . "</tt>: $!"
***************
*** 84,91 ****
  
  sub new {
!   my ($class, $parent_state) = @_;
    my $self = bless
!     [ $parent_state,  # STATE_PARENT
!       {},             # STATE_VALUES
        undef,          # STATE_ID
      ], $class;
--- 78,84 ----
  
  sub new {
!   my ($class, $values) = @_;
    my $self = bless
!     [ $values,        # STATE_VALUES
        undef,          # STATE_ID
      ], $class;
***************
*** 105,109 ****
    my $state_path = &main::DIR_STATE;
    my $state_file;
!   unless (defined $id) {
      while (1) {
        $id = sha1_hex(Time::HiRes::time() . "-$$-" . rand());
--- 98,105 ----
    my $state_path = &main::DIR_STATE;
    my $state_file;
!   if (defined $id) {
!     $state_file = "$state_path/$id";
!   }
!   else {
      while (1) {
        $id = sha1_hex(Time::HiRes::time() . "-$$-" . rand());
***************
*** 117,122 ****
    unless (open(STATE, ">", $state_file)) {
      _unlock("state");
!     main::error( 500,
!                  "500 Error Saving State",
                   "Could not save state in <tt>" . escapeHTML($state_file) .
                   "</tt>: $!"
--- 113,117 ----
    unless (open(STATE, ">", $state_file)) {
      _unlock("state");
!     Whip->error( 500, "Error Saving State",
                   "Could not save state in <tt>" . escapeHTML($state_file) .
                   "</tt>: $!"
***************
*** 144,152 ****
    my $state_file = &main::DIR_STATE . "/" . $id;
    unless (open(STATE, "<", $state_file)) {
      _unlock("state");
!     main::error( 500,
!                  "500 Error Loading State",
                   "Could not load state from <tt>" . escapeHTML($state_file) .
!                  "</tt>: $!"
                 );
    }
--- 139,147 ----
    my $state_file = &main::DIR_STATE . "/" . $id;
    unless (open(STATE, "<", $state_file)) {
+     my $error = $!;
      _unlock("state");
!     Whip->error( 500, "Error Loading State",
                   "Could not load state from <tt>" . escapeHTML($state_file) .
!                  "</tt>: $error"
                 );
    }
***************
*** 167,172 ****
    my $self = shift;
    unless (defined $self->[STATE_ID]) {
!     main::error( 500,
!                  "500 Error Destroying State",
                   "Could not destroy non-existent state."
                 );
--- 162,166 ----
    my $self = shift;
    unless (defined $self->[STATE_ID]) {
!     Whip->error( 500, "Error Destroying State",
                   "Could not destroy non-existent state."
                 );
***************
*** 179,184 ****
  
    unless (unlink $state_file) {
!     main::error( 500,
!                  "500 Error Destroying State",
                   "Could not destroy state in <tt>" . escapeHTML($state_file) .
                   "</tt>: $!"
--- 173,177 ----
  
    unless (unlink $state_file) {
!     Whip->error( 500, "Error Destroying State",
                   "Could not destroy state in <tt>" . escapeHTML($state_file) .
                   "</tt>: $!"
***************
*** 258,270 ****
    }
  
-   if (defined $self->[STATE_PARENT]) {
-     if (wantarray) {
-       my @return = $self->[STATE_PARENT]->fetch($attribute);
-       return @return;
-     }
-     my $return = $self->[STATE_PARENT]->fetch($attribute);
-     return $return;
-   }
- 
    return @default;
  }
--- 251,254 ----

Index: Tag.pm
===================================================================
RCS file: /cvsroot/poe/extras/whip/Whip/Tag.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Tag.pm	19 Nov 2002 17:55:09 -0000	1.2
--- Tag.pm	13 Feb 2004 18:12:44 -0000	1.3
***************
*** 13,30 ****
  sub TAG_NAME    () { 0 }
  sub TAG_DATA    () { 1 }
! sub TAG_SUBTAGS () { 2 }
! sub TAG_WHIP    () { 3 }
  
! sub ZERO   () { 0x00 }
! sub ONE    () { 0x01 }
! sub MANY   () { 0x02 }
  
! sub QMARK () { ZERO | ONE }
! sub STAR  () { ZERO | ONE | MANY }
! sub PLUS  () { ONE | MANY }
  
  use vars qw($whip_self);
  
! # Handle inheritance and base class loading via the C<use> line.
  
  sub import {
--- 13,61 ----
  sub TAG_NAME    () { 0 }
  sub TAG_DATA    () { 1 }
! sub TAG_WHIP    () { 2 }
! sub TAG_PARAM   () { 3 }
  
! sub SCALAR () { 0x0100 }
! sub LIST   () { 0x0200 }
  
! sub REQ    () { 0x1000 }
  
  use vars qw($whip_self);
  
! ### Helper: Render something.
! 
! sub render_page {
!   my ($self, $page_id) = @_;
!   $self->[TAG_WHIP]->render_page($page_id, {});
! }
! 
! ### Accessor: Get a parameter.
! 
! sub get_param {
!   my ($self, $field_name) = @_;
!   return $self->[TAG_PARAM]->{$field_name};
! }
! 
! ### Helper: Emit a document.
! 
! sub emit_document {
!   my $self = shift;
!   $self->[TAG_WHIP]->emit_document(@_);
! }
! 
! ### Accessor: Find out why something failed.
! 
! sub get_fail_flags {
!   my ($self, $field_name) = @_;
!   if (exists $self->[TAG_PARAM]->{_whip_failed}->{$field_name}) {
!     return
!       join( ", ",
!             sort values %{$self->[TAG_PARAM]->{_whip_failed}->{$field_name}}
!           );
!   }
!   return ();
! }
! 
! ### Handle inheritance and base class loading via the C<use> line.
  
  sub import {
***************
*** 32,36 ****
  
    my $caller_package = (caller)[0];
!   foreach (qw(ZERO ONE MANY QMARK STAR PLUS)) {
      no strict 'refs';
      *{"$caller_package\::$_"} = \&{"$class\::$_"};
--- 63,67 ----
  
    my $caller_package = (caller)[0];
!   foreach (qw(SCALAR LIST REQ)) {
      no strict 'refs';
      *{"$caller_package\::$_"} = \&{"$class\::$_"};
***************
*** 40,64 ****
      my $base_package = Whip->load_page("$base_class.tag");
      eval "package $caller_package; use base qw($base_package)";
!     die if $@;
      undef $whip_self;
    }
  }
  
! # Create a new whip tag.
  
  sub new {
!   my ($class, $whip, $tag_name, $tag_data) = @_;
  
    my $self = bless [], $class;
    $self->[TAG_NAME]    = $tag_name;
    $self->[TAG_DATA]    = [ ];
-   $self->[TAG_SUBTAGS] = { };
    $self->[TAG_WHIP]    = $whip;
  
    while (my ($name, $val) = each %$tag_data) {
!     $self->set_contents( Whip::Attribute->new($name, $val) );
    }
  
!   # Load the tag.
    $self->open();
  
--- 71,95 ----
      my $base_package = Whip->load_page("$base_class.tag");
      eval "package $caller_package; use base qw($base_package)";
!     die if @$;
      undef $whip_self;
    }
  }
  
! ### Create a new whip tag.
  
  sub new {
!   my ($class, $whip, $tag_name, $tag_data, $page_params) = @_;
  
    my $self = bless [], $class;
    $self->[TAG_NAME]    = $tag_name;
    $self->[TAG_DATA]    = [ ];
    $self->[TAG_WHIP]    = $whip;
+   $self->[TAG_PARAM]   = $page_params;
  
    while (my ($name, $val) = each %$tag_data) {
!     $self->set_contents(Whip::Attribute->new($name, $val));
    }
  
!   # Open the tag.
    $self->open();
  
***************
*** 66,89 ****
  }
  
! # Determine whether a tag can contain another tag.
  
! sub can_contain {
!   my ($self, $child_tag) = @_;
!   return 1 if exists $self->[TAG_SUBTAGS]->{$child_tag};
  
!   foreach (keys %{$self->[TAG_SUBTAGS]}) {
!     return 1 if $self->isa("Whip::Tag::$_");
!   }
  }
  
! # Set the subtags for this tag.  Subtags are tags that this tag can
! # contain.
  
! sub set_subtags {
!   my ($self, $sub_tags) = @_;
!   $self->[TAG_SUBTAGS] = $sub_tags;
  }
  
! # Accessor: Return the name of the tag.
  
  sub name {
--- 97,139 ----
  }
  
! ### Virtual base method.
  
! sub get_syntax { () }
  
! ### Accessor to get the page ID.
! 
! sub get_page_id {
!   my $self = shift;
!   return $self->[TAG_WHIP]->get_page_id();
  }
  
! ### Simple takes.  These create "take_foo" accessors for the simple
! ### cases.
  
! sub set_syntax {
!   my $package = shift;
! 
!   my @syntax = $package->get_syntax();
!   if (@syntax % 2) {
!     Whip->error( 500, "Error Loading Tag Syntax",
!            "<tt>$package\::get_syntax()</tt> returned an odd number of things."
!          );
!   }
! 
!   my %syntax = @syntax;
! 
!   foreach my $name (keys %syntax) {
!     no strict 'refs';
!     *{"$package\::take_$name"} =
!       sub {
!         my $self = shift;
!         $self->push($name => @_);
!       }
!   }
! 
!   Whip->set_syntax($package, \@syntax);
  }
  
! ### Accessor: Return the name of the tag.
  
  sub name {
***************
*** 92,108 ****
  }
  
! # Virtual base methods: Open and close the tag.
  
  sub open  { }
  sub close { }
  
! # Set the tag's contents.  Contents are data fields.
  
  sub set_contents {
    my ($self, @contents) = @_;
!   push @{$self->[TAG_DATA]}, @contents;
  }
  
! # Get the tag's contents as a list.
  
  sub get_contents {
--- 142,158 ----
  }
  
! ### Virtual base methods: Open and close the tag.
  
  sub open  { }
  sub close { }
  
! ### Set the tag's contents.  Contents are data fields.
  
  sub set_contents {
    my ($self, @contents) = @_;
!   CORE::push @{$self->[TAG_DATA]}, @contents;
  }
  
! ### Get the tag's contents as a list.
  
  sub get_contents {
***************
*** 111,115 ****
  }
  
! # Get the tag's contents as a hash.  The list is flattened out.
  
  sub get_contents_as_hash {
--- 161,165 ----
  }
  
! ### Get the tag's contents as a hash.  The list is flattened out.
  
  sub get_contents_as_hash {
***************
*** 124,128 ****
          $contents{$name} = [ $contents{$name} ];
        }
!       push @{$contents{$name}}, $value;
      }
      else {
--- 174,178 ----
          $contents{$name} = [ $contents{$name} ];
        }
!       CORE::push @{$contents{$name}}, $value;
      }
      else {
***************
*** 133,139 ****
  }
  
! # Fetch a single value from a tag.  In scalar context, the last value
! # for an attribute name is returned.  In list context, all the values
! # for the name are returned.
  
  sub fetch {
--- 183,189 ----
  }
  
! ### Fetch a single value from a tag.  In scalar context, the last
! ### value for an attribute name is returned.  In list context, all the
! ### values for the name are returned.
  
  sub fetch {
***************
*** 144,148 ****
      my $name = $_->name();
      next unless "Whip::Tag::$name"->isa("Whip::Tag::$target_name");
!     push @value, $_->value();
    }
  
--- 194,198 ----
      my $name = $_->name();
      next unless "Whip::Tag::$name"->isa("Whip::Tag::$target_name");
!     CORE::push @value, $_->value();
    }
  
***************
*** 153,166 ****
  }
  
! # Replace the contents of the tag with a new set of values.
  
  sub replace_contents {
    my $self = shift;
    $self->[TAG_DATA] = [ ];
    while (my ($name, $value) = splice(@_, 0, 2)) {
!     push @{$self->[TAG_DATA]}, Whip::Attribute->new($name, $value);
    }
  }
  
  1;
  
--- 203,232 ----
  }
  
! sub push {
!   my ($self, $target_name, @values) = @_;
!   foreach (@values) {
!     CORE::push @{$self->[TAG_DATA]}, Whip::Attribute->new($target_name, $_);
!   }
! }
! 
! ### Replace the contents of the tag with a new set of values.  May be
! ### obsolete.
  
  sub replace_contents {
    my $self = shift;
+   die;
    $self->[TAG_DATA] = [ ];
    while (my ($name, $value) = splice(@_, 0, 2)) {
!     CORE::push @{$self->[TAG_DATA]}, Whip::Attribute->new($name, $value);
    }
  }
  
+ ### Emit a data event.
+ 
+ sub emit {
+   my ($self, $type, $value) = @_;
+   $self->[TAG_WHIP]->emit($type, $value);
+ }
+ 
  1;