Web::Chain project:    Web/Chain.pm


     package Web::Chain;
#                                doom@kzsu.stanford.edu
#                                28 Aug 2004

=pod

=head1 NAME

Web::Chain - Perl module to manage linear chains of doomfile nodes

=head1 SYNOPSIS

   use Web::Chain;

   my $chain1 = Web::Chain->new();
   $new_node = $chain1->add_link($name, $after_node_name);
   $new_node->set_body(\$new_body);

   # Alternately, set body given name of the node
   $chain1->set_body($name, \$new_body);

   @sequence = $chain1->get_names();

   # Rename a node
   $chain1->rename_node( $node, $new_name );

   # To move a chain segment around:
   $chain2 = $chain1->extract_segment($begin_name, $end_name);
   $chain1->insert_segment( $chain2, $after_node_name );

   # Alternate form, in one step:
   $chain1->move_segment($begin_name, $end_name, $after_node_name);

=head1 DESCRIPTION

This code is intended to facillitate processing linear
chain of nodes of information, commonly a series of
web pages joined in a sequence by "next" and
"previous" links.

=head1 METHODS

=head2 CONCEPTS

In the following methods, it's frequently necessary to
be able to specify a place in a chain where something
will happen (e.g. a new node will be added).  So we
need to be able to point at a location between two
nodes in a chain, and this is done by indicating the
node immediately before this location.

For convenience, there are two ways you can specify a node
in a chain.  A reference to the node object itself may be
used, or alternately you may use the unique name assigned to
the node object.  If no location is given, the convention is
usually that the beginning of the chain is indicated (in a 
few cases it is taken as meaning the end of the chain).

=head2 ACCESSORS

For our purposes accessors are code that directly accesses 
the attributes of the object.  All other code (including code 
in this module) is supposed to be polite and access them only 
by going through these accessors.  

=over

=cut

use 5.006;
use strict;
use warnings;
use Carp;

use Web::Node;
use Web::Definitions qw($DEBUG
                        $DF_VERSION
                        $DF_NODE_NAME_PINNED_RULE
                       );

our $VERSION = $DF_VERSION;

=item B<new> - creates a new chain object, to manipulate linear chains of doomfiles nodes

=cut

sub new {
   my $class = shift;
  ($DEBUG) && print STDERR "  Creating new doomfiles chain object\n";

  bless {
         _beg   => undef,   # beginning node object
         _end   => undef,   # ending node object   # The "_end" field is not yet rigorously used
                                                   # Much existing code presumes a chain ends when 
                                                   #    $node->next is undef
         _beg_prev => undef, # before the beginning - a node name, see Web::Chain::IO::output_splice
         _end_next => undef, # after the end -        a node name, see Web::Chain::IO::output_splice

         _exists => {},     # ref to a hash of existing names of all nodes in the chain
        } , $class
}

=item B<get_beg> - return the first node in the chain

=cut

sub get_beg {
   my ($self) = @_;
   my $subname = ( caller(0) )[3];

   # This is very useful to protect this code
   # from knowledge of how it's implemented.
   # Or something.
   return $self->{_beg};
}

=item B<set_beg> - set the beginning node for the chain to the node provided as an argument

=cut

sub set_beg {
   my ($self, $arg) = @_;
   my $subname = ( caller(0) )[3];

   my $node = $self->_handle_node_argument($arg);
   $self->{_beg} = $node;

   return $self->{_beg};
}

=item B<set_body> - given a node name (or object) and a reference to a 
  block of text, sets that as the node body.
  Example:
     $chain1->set_body($node_name, \$node_body);

=cut

sub set_body {
   my ($self, $arg, $body_ref) = @_;

   my $node = $self->_handle_node_argument($arg);  
   $node->body($body_ref);
}


=item B<set_end> - set the end node for the chain to the node provided as an argument

=cut

sub set_end {
   my ($self, $arg) = @_;
   my $subname = ( caller(0) )[3];

   my $node = $self->_handle_node_argument($arg);
   $self->{_end} = $node;

   return $self->{_end};
}

=item B<get_end> - return the last node in the chain.  Checks the _end field 
  and simply returns that if it is defined, if not it scans from the 
  beginning of the chain to find the first node with no defined next.

=cut

sub get_end {
  my ($self) = @_;
  my $subname = ( caller(0) )[3];

  # If the _end field has been properly defined, just return that.
  if ( defined( $self->{_end} ) ) {
    return $self->{_end};
  }

  # Otherwise, scan from beginning to first node with undefined next
  my $node = $self->get_beg;          # Initialize to first node in chain
  my $last_node = $node;      
  unless ($node) { return undef;  }   # If chain is empty, give up now.
  while ( $node = $node->get_next ) { # follow chain until next is undefined
    $last_node = $node;

    # Just being paranoid
    my $i++;
    my $limit = 100000;
    carp "$subname: over $limit iterations, looks like infinite loop" if $i > $limit;
  }
  return $last_node;
}

=item B<get_beg_prev> - return the node name of a node which will be pointed 
   at before the beginning of this chain.  This field allows code such 
   as output_splice to be able to output a chain from memory with a first 
   node that points at another already existing node. 

=cut

sub get_beg_prev {
   my ($self) = @_;
   my $subname = ( caller(0) )[3];
   return $self->{_beg_prev};
}

=item B<set_beg_prev> - set the node name of a node which will be pointed 
   at before the beginning of this chain.  

=cut

sub set_beg_prev {
   my ($self, $arg) = @_;
   my $subname = ( caller(0) )[3];

   my $node = $self->_handle_node_name_argument($arg);
   $self->{_beg_prev} = $node;

   return $self->{_beg_prev};
}

=item B<get_end_next> - return the node name of a node which will be pointed 
   at after the end of this chain.  This field allows code such 
   as output_splice to be able to output a chain from memory with a last 
   node that points at another already existing node. 

=cut

sub get_end_next {
   my ($self) = @_;
   my $subname = ( caller(0) )[3];
   return $self->{_end_next};
}

=item B<set_end_next> - set the node name of a node which will be pointed 
   at before the beginning of this chain.  

=cut

sub set_end_next {
   my ($self, $arg) = @_;
   my $subname = ( caller(0) )[3];
   my $node = $self->_handle_node_name_argument($arg);
   $self->{_end_next} = $node;
   return $self->{_end_next};
}

=item B<get_exists_hashref> - returns the hash reference of the
    structure used internally to check for prior usage of a
    node name in the chain.  This is for testing purposes;
    the following "record_names", "remove_names" and 
    "name_exists" methods are generally more useful.

=cut 

sub get_exists_hashref { 
  my ($self) = @_;
  my $subname = ( caller(0) )[3];

  return $self->{_exists};
}

=item B<record_names> - records the given name (or series of names passed as an array reference)
   as being in use in the chain as node names.
   Examples:
     $self->record_names($name);
     $self->record_names(  \@insert_names );

=cut 

sub record_names { 
  my $subname = ( caller(0) )[3];
  my $self = shift;
  my $arg = shift;  # $arg may be a single string, or an array reference
  if (@_) {  # want to error if passed an array rather than an array ref
    croak "$subname: Too many arguments: $arg " . join(" ", @_);
  }

  my @names;
  my $r = ref($arg); 
  if ($r =~ m{^$}) {   # not ref, so assume string 
    push @names, $arg;    
  } elsif ($r =~ m{ARRAY}) { 
    @names = @{ $arg }; 
  } else { croak "$subname passed something other than a string or array ref"; 
  }

  foreach (@names) { 
    $self->{ _exists } -> { $_ } = 1;
  }
}

=item B<remove_names> - erase the given name (or series of names passed as an array reference)
   from the list of node names currently in use.

=cut 

sub remove_names { 
  my $subname = ( caller(0) )[3];
  my $self = shift;
  my $arg = shift;  # $arg may be a single string, or an array reference
  if (@_) {  # want to error if passed an array rather than an array ref
    croak "$subname: Too many arguments: $arg " . join(" ", @_);
  }
  my @names;
  my $r = ref($arg); 
  if ($r =~ m{^$}) {   # not ref, so assume string 
    push @names, $arg;    
  } elsif ($r =~ m{ARRAY}) { 
    @names = @{ $arg }; 
  } else { croak "$subname passed something other than a string or array ref"; 
  }

  foreach (@names) { 
    delete $self->{ _exists } -> { $_ };
  }
}


=item B<name_exists> - lower level routine, check if the given node name
   has already been used in this chain object.

=cut

sub name_exists {
   my ($self, $name) = @_;
   my $subname = ( caller(0) )[3];

   my $check = ( $self->{_exists}->{$name} );
   return $check;
}

=item B<refresh_exists_hash> - this does a linear scan of names of nodes, 
  builds an "exists" hash, and replaces the internal _exists hash ref 
  with it.  This is a cop-out option: if you're having trouble tracking 
  down a badly behaved routine that isn't updating _exists correctly, 
  you can run this and paper over the problem.  Alternately, it could 
  be used as a "clean-up" option at the end of a routine you want to 
  make absolutely sure isn't badly behaved.  Returns the list of names, 
  just like get_names.

  ### TODO This needs testing.

=cut 

sub refresh_exists_hash() { 
   my ($self, $name) = @_;
   my $subname = ( caller(0) )[3];

   my $check = ( $self->{_exists}->{$name} );

   my @names= $self->get_names;

   my %new_existance; 
   foreach my $name (@names) {     
     $new_existance{$name} = 1;
   }

   %{ $self->{_exists} } = %new_existance;

   return @names;  
}



=back

=head2 INTERNAL METHODS

These routines are used internally by other code here 
for purposes such as validating argument types. 

=over 

=item B<_handle_node_argument> -  Internally used routine to clean up a node argument:
  If the given argument is the name of a node, find and return the node object.
  If the given argument is a node object, just pass it through.
  If it is undefined, also return undefined.
  Error conditions: (1) a string which is not a node name;
                    (2) some other object type besides a node.

=cut

sub _handle_node_argument {
   my ($self, $arg) = @_;
   my $subname = ( caller(0) )[3];

   my $node;
   unless ( defined($arg) ) { return $arg; }

   if ( my $type = ref($arg) ) {
     # Checking object type
     unless ($type =~ "^Web::Node") {  ### TODO Any better way? Does this break inheritence?
       croak "$subname: argument type $type is not a Web::Node object";
     }
     $node = $arg;
   } else {
     $node = $self->get_node_from_name($arg)
       or croak "$subname: $arg is not the name of a node in the chain that begins with " . 
         $self->{_beg}->name . ": $!";
   }
   return $node;
}

=item B<_validate_node_name> - Internally used routine to check whether a 
  node name is valid

=cut 

sub _validate_node_name { 
   my ($self, $arg) = @_;
   my $subname = ( caller(0) )[3];

# DELETE
#    my @caller_label = qw(package filename line subroutine hasargs
#    wantarray evaltext is_require hints bitmask);

#    if ($DEBUG) { 
#      my @caller_output = caller(1);
#      for (0..$#caller_label) { 
#         print STDERR "c1*: $caller_label[$_]: $caller_output[$_]\n";
#      }
#      @caller_output = caller(2);
#      for (0..$#caller_label) { 
#         print STDERR "c2*: $caller_label[$_]: $caller_output[$_]\n";
#      }
#    }
# END DELETIA

   my $node;
   if ( $arg =~ m/$DF_NODE_NAME_PINNED_RULE/ ) { 
      $node = $arg;
   } else { 
     croak "$subname: $arg needs to be a valid node name string (not, for example a node object).\n";
   }
   return $node;
}


=item B<_handle_node_name_argument> - Internally used routine to check 
  node name arguments (which are expected to be a string and not 
  a node object). This is much like _validate_node_name except that 
  "false" is an allowed value which will be converted to undef.

=cut 

sub _handle_node_name_argument { 
   my ($self, $arg) = @_;
   my $subname = ( caller(0) )[3];

   my $node;
   unless($arg) { return undef; }
   if ( $arg =~ m/$DF_NODE_NAME_PINNED_RULE/ ) { 
      $node = $arg;
   } else { 
     croak "$subname: $arg needs to be a valid node name string (not, for example a node object).\n";
   }
   return $node;
}

=item B<_check_chain_argument> -  Internally used routine to check a chain argument, 
  and make sure it's the right type:  this ensures that the argument 
  type is the same as the type of the current object the method has been called 
  on.  If there's no error, it returns the chain object.  As a special case an 
  undefined argument is also passed through without error.

=cut

sub _check_chain_argument { 
   my ($self, $arg) = @_;
   my $subname = ( caller(0) )[3];

   if ($self) {  
     my $type =  ref($arg);
     my $expected = ref($self);
     unless( $expected eq $type ) {
       croak "$subname: argument is of type $type, not $expected as expected.";
     }
   } else {  # note: perl's false values (zero, blank) get converted to undef.
     return undef;
   }
   return $arg;
}

=back

=head2 LOWER LEVEL METHODS

These are mid-way between the ACCESORS above and the higher level 
chain manipulation routines that follows.  

In theory, these should not be accessing object attributes directly 
without going through an accessor, though in practice cleaning up 
those kind of short-cuts is a low priority. 

=over 

=item B<add_link> - lower level routine, creates a link in the chain,
   i.e. a new node of a given name (first argument), after the
   specified node (the second argument).
   The second argument may be the node name (a string) or a node object.
   If there is no second argument, the link will be added at the start
   of the chain.
   Example usage:
     $new_node = $chain1->add_link($name, $after_node_name);
   For more details, see the L<"EXPLICIT_EXPLICATION"|/add_link> section below.

=cut

sub add_link {

   my ($self, $name, $where) = @_;
   my $subname = ( caller(0) )[3];
   my $new_node = Web::Node->new($name);

   if ( $self->name_exists($name) ) {
     croak "$subname: $name exists already in chain beginning with " . $self->{_beg}->name ;
   }

   my $location_node = $self->_handle_node_argument($where);

   my $follow_node;
   if ($location_node) {

       if ( $follow_node = $location_node->next() ) {
          # The "normal" case: 4 updates to pointers of 3 nodes
          $location_node->next($new_node);  # 1
          $new_node->next($follow_node);    # 2
          $new_node->prev($location_node);  # 3
          $follow_node->prev($new_node);    # 4
        } else { # no following node, so we're appending to the end of the chain
          $location_node->next($new_node);  # 1
          $new_node->prev($location_node);  # 3
        }

   } elsif( $follow_node = $self->{_beg} ) { # undefined location means it goes in first place...
     $new_node->next($follow_node);    # 2
     $follow_node->prev($new_node);    # 4

     $self->{_beg}=$new_node;
   } else { # ... if {_beg} is also undefined, then this is the first node to ever be added to the chain.
     $self->{_beg}=$new_node;
   }

   if( not ( $new_node->next ) ){   
       $self->{_end}=$new_node;     # _end is not currently used, but someday it might be
   }

   $self->record_names($name);

   return $new_node;  # return newly created node added to chain.
}

=item B<rename_node> - assigns a new name to the given node.
  Updates the node existance record (the _exists field),
  ensures that the node names in this chain are unique.
  Example usage:

    $chain->rename_node( $node, $new_name );

=cut

sub rename_node {
  my ($self, $node_arg, $new_name) = @_;
  my $subname = ( caller(0) )[3];

  my $node = $self->_handle_node_argument($node_arg);

  if ( $self->name_exists($new_name) ) {
     croak "$subname: Can't rename a node as $new_name, that's already in use in chain that begins " . $self->{_beg}->name;
  }

  my $old_name = $node->name;

  $node->name($new_name);  # The actual rename

  $self->record_names($new_name);  # Record new name in _exists hash for this chain

  # Remove exists hash entry for the old name:
  $self->remove_names($old_name);

}

=item B<get_node_from_name>  - find the node in a chain with the given name.
   returns the node object, or undefined if not found.

=cut

sub get_node_from_name {
# Note that this is just by the internal routine _handle_node_argument.  

   my ($self, $name) = @_;
   my $subname = ( caller(0) )[3];
   my $found_node;
   my $node = $self->{_beg};        # Initialize to first node in chain
   unless ($node) { return undef; } # If chain is empty, give up now.

   while( 1 ) { # step forward through chain as long until we find it 

       if ($node->name eq $name) {
         $found_node = $node;
         last;
       }

       ### TODO - generalize this
       # Just being paranoid about possible crazy loop structures
       my $i++;
       my $limit = 100000; 
       carp "$subname: over $limit iterations, looks like infinite loop" if $i > $limit;

       unless ( $node = $node->next) { last; }  # advance to next node in the chain, bail if at end
     } 

   return $found_node; # undef if not found
 }

=item B<get_body_from_offset> - given an offset (like an array indicie),
  step through a chain and return the body (really a ref to a string)
  of the indicated node.

=cut

sub get_body_from_offset {
   my ($self, $offset) = @_;
   my $subname = ( caller(0) )[3];

   my $node = $self->get_node_from_offset($offset);

   if ($node) {
     return $node->body;
   } else {
     return undef;
   }
}

=item B<get_name_from_offset> - given an offset (like an array indicie),
  step through a chain and return the name of the indicated node.

=cut

sub get_name_from_offset {
   my ($self, $offset) = @_;
   my $subname = ( caller(0) )[3];

   my $node = $self->get_node_from_offset($offset);

   if ($node) {
     return $node->name;
   } else {
     return undef;
   }
}

=item B<get_node_from_offset> - given an offset (like an array indicie)
  step through a chain and return the indicated node.
  (used by get_name_from_offset and get_body_from_offset).

=cut

sub get_node_from_offset {
   my ($self, $offset) = @_;
   my $subname = ( caller(0) )[3];

   my $node = $self->{_beg};

   for (my $i=0; $i<$offset; $i++) {
     if ($node) {
        $node = $node->next;
      } else {
        if ($DEBUG) { print "Chain: "; print join " ", $self->get_names; print "\n"; }
        carp "$subname: Offset $offset is too large for chain beginning with " . $self->{_beg}->name . "\n";
        return undef;
      }
   }
   unless ($node) {
     if ($DEBUG) { print "Chain: "; print join " ", $self->get_names; print "\n"; }
     carp "$subname: Offset $offset is too large for chain beginning with " . $self->{_beg}->name . "\n";
     return undef;
   }
   return $node;
}

=item B<get_names> - return an array of all names in the chain

=cut

sub get_names {
   my ($self) = @_;
   my $subname = ( caller(0) )[3];

   my @name;
   my $node = $self->{_beg};
   push @name, $node->name;
   while ($node = $node->next ) {
      push @name, $node->name;
   }
   return @name;
}

=item B<extract_segment> - given the beginning and end nodes
   (either the node objects themselves, or the names of the nodes)
   remove that segement from the chain, returning it in a new
   chain object.
   Example usage:

   $chain2 = $chain1->extract_segment($begin_name, $end_name);

=cut

sub extract_segment {
   my ($self, $begin_arg, $end_arg) = @_;
   my $subname = ( caller(0) )[3];

   my $begin_node = $self->_handle_node_argument( $begin_arg );
   my $end_node =   $self->_handle_node_argument( $end_arg );

   my $chain_new = Web::Chain->new;

   # This is just pointer manipulation, just need the right changes at the endpoints

   my $location = $begin_node->get_prev;
   my $close = $end_node->get_next;
   $chain_new->{_beg} = $begin_node;
   ### $chain_new->{_end} = $end_node;
   $end_node->set_next( undef );
   # Heal the break where chain is excised
   $location->set_next($close);
   $close->set_prev($location);

   # Get a list of the nodes (object or name form) to be extracted
   my @extraction = $chain_new->get_names;

   # Delete this hash slice from "exists" hash for old chain
   $self->remove_names( \@extraction );

   # add the names to the "exists" hash for the new chain.
   $chain_new->record_names( \@extraction ) ;

   # Alternately could save some steps here with a:
   #   @extraction = $chain_new->refresh_exists_hash();

   return $chain_new;
}

=item B<insert_segment> - inserts another chain into this chain,
   at the specified location.  The inserted chain will go
   immediately after the given node (the second argument).
   This argument may be either the node object itself,
   the name of the node, or undefined, meaning the beginning
   of the chain.
   A detailed explanation of how this method works is 
   down in the L<"EXPLICIT_EXPLICATION"|/insert_segment> section below.
   Example usage:

     $chain1->insert_segment( $chain2, $after_node_arg );


=cut

sub insert_segment {
   my ($self, $insert_chain, $location_arg) = @_;
   my $subname = ( caller(0) )[3];

   my $location = $self->_handle_node_argument( $location_arg );
   
   $self->_check_chain_argument( $insert_chain );

   my ($break_point_1, $break_point_2, $insert_chain_1, $insert_chain_2);

   $insert_chain_1  = $insert_chain->get_beg;
   $insert_chain_2  = $insert_chain->get_end;

   if ($break_point_1 = $location ) {                      
     $break_point_2 = $location->get_next if $location;    # if undef, we're at end of chain (can't do step 4 below)
   } else {   # the beginning of chain case 
     $break_point_2 = $self->get_beg;
     $self->set_beg( $insert_chain_1 );
     # also will skip "step 1" below
   }

   unless( $insert_chain_1 ) { return 1; } # if insert_chain is nil, no operation.
   unless( $self->get_beg  ) {  # if original chain is nil, final state is just the insert_chain
     $self=$insert_chain; 
     return 1;
   } 

   # do any node names in the $insert_chain already exist in the $self chain?
   my @insert_names = $insert_chain->get_names();
   foreach my $new_name (@insert_names) { 
     croak "$subname: node name $new_name is already in use in chain that begins" . $self->get_beg
       if ( $self->name_exists($new_name) );
   }
                                                                  # "steps"
   $break_point_1->set_next($insert_chain_1) if $break_point_1;      #1
   $insert_chain_1->set_prev($break_point_1);                        #2

   $insert_chain_2->set_next($break_point_2);                        #3
   $break_point_2->set_prev($insert_chain_2) if $break_point_2;      #4

   # Update the "_exists" hash with the newly inserted names
   $self->record_names(  \@insert_names );

}

=item B<move_segment> - move a chain segment to another location in
   the same chain.  Requires three arguments, the beginning and
   end nodes (inclusive), and the location to move the segment to
   (indicated by the node immediately before the location, which as
   usual can be the node name, the node itself, or undefined meaning
   the chain beginning).
   Example usage:

     $chain1->move_segment($begin_name, $end_name, $after_node_name);

=cut

sub move_segment {
   my ($self, $begin_arg, $end_arg, $location_arg) = @_;
   my $subname = ( caller(0) )[3];

   # Got to go through this folderol to make sure we've got 
   # names and not node object.  The price of flexible interfaces.
   my $begin_node = $self->_handle_node_argument( $begin_arg );
   my $end_node =   $self->_handle_node_argument( $end_arg );
   my $begin_name = $begin_node->get_name;
   my $end_name = $end_node->get_name;

   my $location = $self->_handle_node_argument( $location_arg );
   my $location_name = $location->get_name;

   my @names = $self->get_names;

   # Doing some bounds checking on the arguments
   foreach (@names) { 
     if ($DEBUG) { 
       print STDERR "verifying that $begin_name, $end_name, and $location_name are defined strings\n";
       unless($begin_name) { croak "$subname: no begin_name"; }
       unless($end_name)   { croak "$subname: no end_name"; }
       unless($location)   { croak "$subname: no location_name"; }
     }

     if ( (m/^ $begin_name $/x) .. (m/^ $end_name $/x) ) {
        if ( m/^ $location_name $/x ) {
          croak "$subname: Can't move a sub-segment of a chain into itself: " .
                "$location_name is between $begin_name and $end_name.";
        }        
      }
   }

   my $sub_segment = $self->extract_segment($begin_node, $end_node);
   $self->insert_segment( $sub_segment, $location );

}

1;

__END__

=back

=head1  EXPLICIT_EXPLICATION

=head2 add_link

To understand what the add_link method has to do, let's
work through an example:

Suppose initially we have a two-element chain like:


   relative      location:       follow:
   positions
                          next
                           ->
   names           ALPHA        BLVD
                          prev
                           <-

The location is called "ALPHA" (the spot after the ALPHA node).
We want to add_link there called "RALPHA", by doing something like:

  $chain1->add_link('RALPHA', $location_node);

Or:

  $chain1->add_link('RALPHA', 'ALPHA');

So then the chain will have three elements like:


 location:       new:           follow:

          next            next
           ->              ->
   ALPHA        RALPHA          BLVD
          prev            prev
           <-              <-

Four updates need to be done on the three nodes:

   ALPHA->next('RALPHA');

   RALPHA->next('BLVD');
   RALPHA->prev('ALPHA');

   BLVD->prev('RALPHA');

The basic steps then in perl code are:

   my $follow_node = $location_node->next();

   $location_node->next($new_node);
   $new_node->next($follow_node);
   $new_node->prev($location_node);
   $follow_node->prev($new_node);

But we need to cover other cases also.
(1) prepending a node to the beginning of the chain
(2) appending a node to the end of the chain
(3) creating the first node ever added to the chain

That's what the "if/elsif/else" structure is for in the add_link method.

=head2 insert_segment

The insert_segment method inserts a second chain into the
current chain, at a specified location (as usual, indicated
by the node immediately prior to the place where it will be
inserted):

   $chain1->insert_segment( $chain2, $after_node_arg );

To understand in detail how this works, consider a simple diagram
(note, in this case we're not indicating the forward and backward links --
"next" and "prev" -- that connect the nodes of these linear chains):


    Original chain ($self):

                  $location
                    |
                    v
    A   B   C   D   E   F   G   H
                    ^   ^
                    |   |
                   bp1 bp2

(bp = "break point", the points on the original
chain where we cut into it)


    Insert chain:

     1  2  3  4
     ^        ^
     |        |                 
    ic1      ic2

(ic = the "insert chain")

    Finished chain (final state of $self):

    A   B   C   D   E    1   2  3   4    F   G   H
                    ^    ^          ^    ^
                    |    |          |    |
                   bp1  ic1        ic2  bp2


Then we need to update 4 links on four nodes:

  Step   Pseudo-perl:

    1    bp1->set_next(ic1)
    2    ic1->set_prev(bp1)
    3    ic2->set_next(bp2)
    4    bp2->set_prev(ic2)

So that's simple enough.  But for this to work generally,
we need to cover a number of corner cases:

  (1) location is at the end:  appending to the original chain (bp2=undef, skip step 4)
  (2) location is at the front:  prepending (bp1=undef, skip step 1)
  (3) original chain is 1 link long:   (bp2=undef, skip step 4)
  (4) original chain is 0 links long:  final state is just the "insert chain"
  (5) insert chain is 1 link long: ic1=ic2, no special handling
  (6) insert chain is 0 links long:  no operation


=head1 DEPENDENCIES

Note: these are notes about stuff in other modules, hence may
become outdated if those modules change.

The definition of what an allowed doomfile node name is
found in Web::Definitions, in the form of a regexp
that matches them.  As of this writing, a node name must be
all uppercase or numerics with underscores or hyphens.
The lower-case "c" is also allowed, in order to do names
like "McCLAUREN".

The Chain module uses the Web::Node module as a primitive.
A user of the Chain module should not need to use one of
the primitive methods

=head1 FUTURE DEVELOPMENT

Some sort of lazy read of the contents of the nodes would
be a good thing to have (don't store the bulky stuff for
long chains, read it in when you need it).

Could sub-class Node, to get a version that stores "body"
as temp files, rather than tries to keep it in memory?

=head1 SEE ALSO

=over 

=item L<Project Documentation|Web::Project>

=item L<Web::Node>

=item L<Web::Chain::IO>

=item L<Web::Definitions>

=back 

=head1 AUTHOR

Joseph Brenner, E<lt>doom@kzsu.stanford.eduE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2004 by Joseph Brenner

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=head1 BUGS

None reported... yet.

=cut

     

Joseph Brenner, Sat Nov 6 17:04:11 2004