Index: ossp-pkg/string-divert/Divert.pm RCS File: /v/ossp/cvs/ossp-pkg/string-divert/Divert.pm,v co -q -kk -p'1.1' '/v/ossp/cvs/ossp-pkg/string-divert/Divert.pm,v' | diff -u /dev/null - -L'ossp-pkg/string-divert/Divert.pm' 2>/dev/null --- ossp-pkg/string-divert/Divert.pm +++ - 2024-05-19 00:52:49.369981409 +0200 @@ -0,0 +1,541 @@ +## +## String::Divert - Diversion String Object +## Copyright (c) 2003 Ralf S. Engelschall +## +## This file is part of String::Divert, a Perl module for +## dealing with strings containing nested diversions. +## +## This program is free software; you can redistribute it and/or +## modify it under the terms of the GNU General Public License +## as published by the Free Software Foundation; either version +## 2.0 of the License, or (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this file; if not, write to the Free Software Foundation, +## Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. +## +## Divert.pm: Module Implementation +## + +use 5.005; +use strict; +use warnings; + +# _________________________________________________________________________ +# +# STANDARD OBJECT ORIENTED API +# _________________________________________________________________________ +# + +package String::Divert; + +require Exporter; + +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(new destroy DESTROY + name overwrite + assign append string bool + fold unfold folding folder + divert undivert diversion + overload); +our $VERSION = '0.90'; + +# object construction +sub new ($;$) { + my ($proto, $name) = @_; + + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + + $self->{name} = (defined($name) ? $name : ''); + $self->{overwrite} = 'none'; + $self->{chunks} = [ '' ]; + $self->{diversion} = []; + $self->{foldermk} = '{#%s#}'; + $self->{folderre} = '\{#([a-zA-Z_][a-zA-Z0-9_]*)#\}'; + + return $self; +} + +# object destruction (explicit) +sub destroy ($) { + $_[0]->overload(0); + bless $_[0], 'UNIVERSAL'; + undef $_[0]; + return; +} + +# object destruction (implicit) +sub DESTROY ($) { + return; +} + +# operation: set/get name of object +sub name ($;$) { + my ($self, $name) = @_; + return $self->{diversion}->[-1]->name($name) + if (@{$self->{diversion}} > 0); + my $old_name = $self->{name}; + if (defined($name)) { + $self->{name} = $name; + } + return $old_name; +} + +# operation: set/get overwrite mode +sub overwrite ($;$) { + my ($self, $mode) = @_; + return $self->{diversion}->[-1]->overwrite($mode) + if (@{$self->{diversion}} > 0); + my $old_mode = $self->{overwrite}; + if (defined($mode)) { + die "invalid mode argument" + if ($mode !~ m/^(none|once|always)$/); + $self->{overwrite} = $mode; + } + return $old_mode; +} + +# internal: split string into chunks +sub _chunking ($) { + my ($self, $string) = @_; + my @chunks = (); + my $folderre = $self->{folderre}; + while ($string =~ m/${folderre}()/s) { + my ($prolog, $id) = ($`, $1); + push(@chunks, $prolog) if ($prolog ne ''); + die "empty folding object name" + if ($id eq ''); + my $object = $self->folding($id); + $object = $self->new($id) if (not defined($object)); + die "cannot reuse or create folding sub object \"$id\"" + if (not defined($object)); + push(@chunks, $object); + $string = $'; + } + push(@chunks, $string) if ($string ne ''); + return @chunks; +} + +# operation: assign a string +sub assign ($$) { + my ($self, $string) = @_; + return $self->{diversion}->[-1]->assign($string) + if (@{$self->{diversion}} > 0); + die "cannot assign undefined string" + if (not defined($string)); + die "cannot assign reference ".ref($string)." as string" + if (ref($string)); + $self->{chunks} = []; + foreach my $chunk ($self->_chunking($string)) { + push(@{$self->{chunks}}, $chunk); + } + return $self; +} + +# operation: append a string +sub append ($$) { + my ($self, $string) = @_; + return $self->{diversion}->[-1]->append($string) + if (@{$self->{diversion}} > 0); + die "cannot assign undefined string" + if (not defined($string)); + die "cannot assign reference as string" + if (ref($string)); + if ( $self->{overwrite} eq 'once' + or $self->{overwrite} eq 'always') { + $self->{chunks} = []; + foreach my $chunk ($self->_chunking($string)) { + push(@{$self->{chunks}}, $chunk); + } + $self->{overwrite} = 'none' + if ($self->{overwrite} eq 'once'); + } + else { + foreach my $chunk ($self->_chunking($string)) { + if (ref($chunk)) { + push(@{$self->{chunks}}, $chunk); + } + else { + if (ref($self->{chunks}->[-1])) { + push(@{$self->{chunks}}, $chunk); + } + else { + $self->{chunks}->[-1] .= $chunk; + } + } + } + } + return $self; +} + +# operation: unfold (and return) string contents temporarily +sub string ($) { + my ($self) = @_; + my $string = ''; + return $self->{diversion}->[-1]->string() + if (@{$self->{diversion}} > 0); + foreach my $chunk (@{$self->{chunks}}) { + if (ref($chunk)) { + my $prefix = ''; + if ($string =~ m|([^\n]*)(\r?\n)*$|s) { + $prefix = $1; + $prefix =~ s|[^ \t]| |sg; + } + my $block = $chunk->string(); # recursion! + $block =~ s|\n(?=.)|\n$prefix|sg if ($prefix ne ''); + $string .= $block; + } + else { + $string .= $chunk; + } + } + return $string; +} + +# operation: unfold string contents temporarily until already true or finally false +sub bool ($) { + my ($self) = @_; + my $string = ''; + return $self->{diversion}->[-1]->bool() + if (@{$self->{diversion}} > 0); + foreach my $chunk (@{$self->{chunks}}) { + if (ref($chunk)) { + $string .= $chunk->string(); # recursion! + } + else { + $string .= $chunk; + } + return 1 if ($string); + } + return 0; +} + +# operation: append folding sub-object +sub fold ($$) { + my ($self, $id) = @_; + return $self->{diversion}->[-1]->fold($id) + if (@{$self->{diversion}} > 0); + die "undefined folding object identifier" + if (not defined($id)); + if (ref($id)) { + die "folding object not of class String::Divert" + if ( UNIVERSAL::isa($id, "String::Divert") + or UNIVERSAL::isa($id, "String::Divert::__OVERLOAD__")); + push(@{$self->{chunks}}, $id); + return $id; + } + else { + my $object = $self->folding($id); + $object = $self->new($id) if (not defined($object)); + die "unable to create new folding object" + if (not defined($object)); + push(@{$self->{chunks}}, $object); + return $object; + } +} + +# operation: unfold string contents permanently +sub unfold ($) { + my ($self) = @_; + return $self->{diversion}->[-1]->unfold() + if (@{$self->{diversion}} > 0); + my $string = $self->string(); + $self->{chunks} = [ $string ]; + return $string; +} + +# internal: compare whether two objects are the same +sub _isobjeq ($$) { + my ($obj1, $obj2) = @_; + my $ov1 = $obj1->overload(); + my $ov2 = $obj2->overload(); + $obj1->overload(0); + $obj2->overload(0); + my $rv = ($obj1 == $obj2); + $obj1->overload($ov1); + $obj2->overload($ov2); + return $rv; +} + +# operation: lookup particular or all folding sub-object(s) +sub folding ($;$) { + my ($self, $id) = @_; + return $self->{diversion}->[-1]->folding($id) + if (@{$self->{diversion}} > 0); + if (defined($id)) { + my $folding = undef; + foreach my $chunk (@{$self->{chunks}}) { + if (ref($chunk)) { + if ( (ref($id) and &String::Divert::_isobjeq($chunk, $id)) + or (not ref($id) and $chunk->name() eq $id) ) { + $folding = $chunk; + last; + } + $folding = $chunk->folding($id); + last if (defined($folding)); + } + } + return $folding; + } + else { + my @foldings = (); + foreach my $chunk (@{$self->{chunks}}) { + if (ref($chunk)) { + foreach my $subchunk ($chunk->folding()) { + push(@foldings, $subchunk); + } + push(@foldings, $chunk); + } + } + return @foldings; + } +} + +# operation: configure or generate textually represented folding object +sub folder ($$;$) { + my ($self, $a, $b) = @_; + if (defined($b)) { + # configure folder + my $test = sprintf($a, "foo"); + my $id = ($test =~ m|${b}()|s); + die "folder construction format and matching regular expression do not correspond" + if ($id ne "foo"); + $self->{foldermk} = $a; + $self->{folderre} = $b; + return; + } + else { + # create folder + my $folder = sprintf($self->{foldermk}, $a); + return $folder; + } +} + +# operation: push diversion of operations to sub-object +sub divert ($$) { + my ($self, $id) = @_; + my $object = $self->folding($id); + die "folding sub-object \"$id\" not found" + if (not defined($object)); + push(@{$self->{diversion}}, $object); + return $self; +} + +# operation: pop diversion of operations to sub-object +sub undivert ($;$) { + my ($self, $num) = @_; + $num = 1 if (not defined($num)); + $num = @{$self->{diversion}} if ($num == 0); + die "less number (".scalar(@{$self->{diversion}}).") of diversions active than requested ($num) to undivert" + if ($num > @{$self->{diversion}}); + while ($num-- > 0) { + pop(@{$self->{diversion}}); + } + return $self; +} + +# operation: lookup last or all diversion(s) +sub diversion ($) { + my ($self) = @_; + if (not wantarray) { + # return last diversion only + return $self->{diversion}->[-1]; + } + else { + # return all diversions (in reverse order of activation) + return reverse(@{$self->{diversion}}); + } +} + +# _________________________________________________________________________ +# +# API SWITCHING +# _________________________________________________________________________ +# + +# object overloading toogle method +sub overload ($;$) { + # NOTICE: This function is special in that it exploits the fact + # that Perl's @_ contains just ALIASES for the arguments of + # the function and hence the function can adjust them. This + # allows us to tie() the variable of our object ($_[0]) into the + # overloading sub class or back to our main class. Just tie()ing + # a copy of $_[0] (usually named $self in the other methods) + # would be useless, because the Perl TIE mechanism is attached to + # _variables_ and not to the objects itself. Hence this function + # does no "my ($self, $mode) = @_;" and instead uses @_ directly + # throughout its body. + my $old_mode = (ref($_[0]) eq "String::Divert" ? 0 : 1); + if (defined($_[1])) { + if ($_[1]) { + # bless and tie into overloaded subclass + my $self = $_[0]; + bless $_[0], "String::Divert::__OVERLOAD__"; + #tie $_[0], "String::Divert::__OVERLOAD__", $self; + # according to "BUGS" section in "perldoc overload": + # "Relation between overloading and tie()ing is broken. + # Overloading is triggered or not basing on the previous + # class of tie()d value. This happens because the presence + # of overloading is checked too early, before any tie()d + # access is attempted. If the FETCH()ed class of the + # tie()d value does not change, a simple workaround is to + # access the value immediately after tie()ing, so that + # after this call the previous class coincides with the + # current one."... So, do this now! + #my $dummy = ref($_[0]); + } + else { + # untie and rebless into master class + #untie $_[0]; + bless $_[0], "String::Divert"; + } + } + return $old_mode; +} + +# _________________________________________________________________________ +# +# OPERATOR OVERLOADING API +# _________________________________________________________________________ +# + +package String::Divert::__OVERLOAD__; + +our @ISA = qw(Exporter String::Divert); +our @EXPORT_OK = qw(); + +# define operator overloading +use overload ( + '""' => \&op_string, + 'bool' => \&op_bool, + '0+' => \&op_numeric, + '.' => \&op_concat, + '.=' => \&op_append, + '*=' => \&op_fold, + '<>' => \&op_unfold, + '>>' => \&op_divert, + '<<' => \&op_undivert, + #'${}' => \&op_deref_string, + #'%{}' => \&op_deref_hash, + #'=' => \&op_copyconst, + #'nomethod' => \&op_unknown, + 'fallback' => 0 +); + +#sub TIESCALAR ($$) { +# my ($class, $self) = @_; +# bless $self, $class; +# return $self; +#} + +#sub UNTIE ($) { +# my ($self) = @_; +# return; +#} + +#sub FETCH ($) { +# my ($self) = @_; +# return $self; +#} + +#sub STORE ($$) { +# my ($self, $other) = @_; +# return $self if (ref($other)); +# $self->assign($other); +# my $dummy = ref($self); +# return $self; +#} + +#sub op_copyconst { +# my ($self, $other, $reverse) = @_; +# # intentionally do not copy at all +# return $self; +#} + +#sub op_deref_string ($$$) { +# my $self = shift; +# return $self; +#} + +#sub op_deref_hash ($$$) { +# my $self = shift; +# return $self; +#} + +sub op_string ($$$) { + my ($self, $other, $rev) = @_; + return $self->string(); +} + +sub op_bool ($$$) { + my ($self, $other, $reverse) = @_; + return $self->bool(); +} + +sub op_numeric ($$$) { + my ($self, $other, $reverse) = @_; + return $self->string(); +} + +sub op_concat ($$$) { + my ($self, $other, $reverse) = @_; + return ($reverse ? $other . $self->string() : $self->string() . $other); +} + +sub op_append ($$$) { + my ($self, $other, $reverse) = @_; + $self->append($other); + return $self; +} + +sub op_fold ($$$) { + my ($self, $other, $reverse) = @_; + $self->fold($other); + return $self; +} + +sub op_unfold ($$$) { + my ($self, $other, $reverse) = @_; + $self->unfold; + return $self; +} + +#sub op_folding ($$$) { +# my ($self, $other, $reverse) = @_; +# $self->folding($other); +# return $self; +#} + +sub op_divert ($$$) { + my ($self, $other, $reverse) = @_; + $self->divert($other); + return $self; +} + +sub op_undivert ($$$) { + my ($self, $other, $reverse) = @_; + $self->undivert($other); + return $self; +} + +#sub op_diversion ($$$) { +# my ($self, $other, $reverse) = @_; +# $self->diversion(); +# return $self; +#} + +#sub op_unknown ($$$$) { +# my ($self, $other, $rev, $op) = @_; +# print ": op=$op\n"; +# return $self; +#} + +1; + Index: ossp-pkg/string-divert/Divert.pod RCS File: /v/ossp/cvs/ossp-pkg/string-divert/Divert.pod,v co -q -kk -p'1.1' '/v/ossp/cvs/ossp-pkg/string-divert/Divert.pod,v' | diff -u /dev/null - -L'ossp-pkg/string-divert/Divert.pod' 2>/dev/null --- ossp-pkg/string-divert/Divert.pod +++ - 2024-05-19 00:52:49.373015218 +0200 @@ -0,0 +1,367 @@ +## +## String::Divert - Diversion String Object +## Copyright (c) 2003 Ralf S. Engelschall +## +## This file is part of String::Divert, a Perl module for +## dealing with strings containing nested diversions. +## +## This program is free software; you can redistribute it and/or +## modify it under the terms of the GNU General Public License +## as published by the Free Software Foundation; either version +## 2.0 of the License, or (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this file; if not, write to the Free Software Foundation, +## Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. +## +## Divert.pod: Module Documentation +## + +=pod + +=head1 NAME + +B - String Object with Folding and Diversions + +=head1 SYNOPSIS + + use String::Divert; + + # standard object-oriented API (SAPI) + $x = new String::Divert; + $x->assign("foo"); + $x->fold("sub"); + $x->append("quux"); + $x->divert("sub"); + $x->append("bar"); + $x->undivert(0); + print "x=".$x->string()."\n"; + $x->destroy(); + + # extended operator-overloaded API (XAPI) + $x = new String::Divert; + $x->overload(1); + $x .= "foo"; + $x *= "sub"; + $x .= "quux"; + $x >> "sub"; + $x .= "bar"; + $x << 0; + print "x=$x\n"; + undef $x; + +=head1 ABSTRACT + +B is small Perl 5 module providing a scalar-like +string object with some overloaded operators, providing the concept of +I for supporting nested output generation. + +=head1 DESCRIPTION + +B is small Perl 5 module providing a scalar-like +string object with some overloaded operators, providing the concept of +I. This supports the nested generation of structured outputs. +The idea is to decouple the sequential generation of structured output +from the nested and non-sequential structure of the output. + +=head1 APPLICATION PROGRAMMING INTERFACE (API) + +B provides two Application Programming Interfaces (API): +a standard object-oriented API (SAPI) providing the core functionality +and an extended operator-overloading API (XAPI) providing additional +convinience in using the functionality (see also method B). + +=head2 Object Lifetime + +The following methods deal with the lifetime of a B +object: + +=over 4 + +=item SAPI: C<$x = >B [C<$name>]C<;> + +I. This creates a new string object with either +an empty initial name or the one given in C<$name>. + +=item SAPI: C<$x-E>BC<;> + +=item SAPI: C + +I. This destroys the string object in C<$x> and this +way releases all of its resources. Folding sub objects are destroyed +implicitly unless they are still references by the application. + +=back + +=head2 Object Attributes + +The following methods adjust attributes of a B +object: + +=over 4 + +=item SAPI: C<$overloaded = $x-E>BC<;> + +=item SAPI: [C<$old_overloaded =>] C<$x-E>BC<($new_overloaded);> + +I. Either just retrieves whether string +object C<$x> is operator overloaded or sets new operator overloading. If +C<$new_overloaded> is I, operator overloading is disabled (only +SAPI is active); if it is I, operator overloading is enabled (both +SAPI and XAPI are active). + +=item SAPI: C<$name = $x-E>BC<;> + +=item SAPI: [C<$old_name =>] C<$x-E>BC<($new_name);> + +I. Either just retrieves the current name of string +object C<$x> or sets a new name. The name of a string object is used to +identify the object on folding and diversion in case no object reference +is used. + +=item SAPI: C<$mode = $x-E>BC<;> + +=item SAPI: [C<$old_mode =>] C<$x-E>BC<($new_mode);> + +I. Retrieves the current overwrite mode of string object +C<$x> or sets a new overwrite mode. The mode can be C<"none"> (no +overwriting), C<"once"> (no overwriting once on next B operation +only), or C<"always"> (overwriting on every B operation). + +=back + +=head2 Content Manipulation + +The following methods manipulate the contents of a B +object: + +=over 4 + +=item SAPI: [C<$x =>] C<$x-E>BC<($string);> + +I. Assigns C<$string> as the new contents +of the string object C<$x>. The existing contents is lost. + +=item SAPI: [C<$x =>] C<$x-E>BC<($string);> + +=item XAPI: C<$x .= $string;> + +I. Appends C<$string> to the existing contents of the +string object C<$x>. If the B mode (see above) is C<"once">, +the previous contents is removed first and the B mode set to +C<"none">. If it is C<"always">, the previous contents is removed every +time. + +=item SAPI: C<$string = $x-E>BC<;> + +=item XAPI: C<$string = "$x";> + +I. This unfolds the contents of string +object C<$x> and returns it as a string. The contents of the string +object is still kept in folded internal format. For permanently +unfolding the contents in string object C<$x>, you have to use operation +B. + +=back + +=head2 Content Folding + +The following methods deal with content folding of a B +object: + +=over 4 + +=item SAPI: [C<$y =>] C<$x-E>BC<($name);> + +=item SAPI: C<$x-E>BC<($y);> + +=item XAPI: [C<$y = (>]C<$x EE= $name>[C<)>]C<;> + +=item XAPI: C<$x EE $y;> + +I. This folds the contents of string cobject C<$x> at +the current position by appending a B sub object (given +in existing object C<$y> or created on-the-fly with name I). The +sub-object representing the folding is allowed to be re-appended by name +or through C<$y>. + +=item SAPI: [C<$string =>] C<$x-E>BC<;> + +=item XAPI: [C<$string =>] C$xE;> + +I. This unfolds the contents of string +object C<$x> and stores the result permanently as the new contents. For +temporarily unfolding the contents in string object C<$x>, you can +use operation B. + +=item SAPI: C<$y = $x-E>BC<($name);> + +=item XAPI: C<$y = ($x EE= $name);> + +I. This lookups in string object C<$x> the +contained folding sub-object with name C<$name>. + +=item SAPI: C<$x-E>BC<($format, $regex);> + +=item SAPI: C<$string = $x-E>BC<($name);> + +I. This configures (if +the two argument form is used) or generates (if the one argument +form is used) textual representation of a content folding. For +configuring, the C<$format> has to be a Perl sprintf() format string +(containing only a single C<%s> for expanding the name of the folding +object) generating the textual representation and C<$regex> a Perl +regular expression (containing a single clustering parenthesis +pair) for matching a generated textual representation and returning +the name of the folding object. The defaults are "C<{#%s#}>" and +"C<\{#([a-zA-Z_][a-zA-Z0-9_]*)#\}>". In the one argument form, the +function applies C<$name> to the previously configured C<$format> and +returns the result for inclusion into a string which in turn is assigned +or appended to the string object. + +=back + +=head2 Operation Diversion + +The following methods deal with operation diversion of a +B object: + +=over 4 + +=item SAPI: [C<$x =>] C<$x-E>BC<($name);> + +=item SAPI: [C<$x =>] C<$x-E>BC<($y);> + +=item XAPI: C<$x EE $name;> + +=item XAPI: C<$x EE $y;> + +I. This activates in string object C<$x> +a content diversion to a sub-object (given by name C<$name> or object +reference C<$y>). The diversion target should be a folded sub-object of +C<$x>, but is not technically required. + +=item SAPI: [C<$x =>] C<$x-E>BC<($num);> + +=item XAPI: C<$x EE $num;> + +I. This deactivates the last C<$num> +activated diversions. If C<$num> is C<0>, deactivates all activated +diversions. + +=item SAPI: C<$y = $x-E>BC<;> + +=item SAPI: C<@y = $x-E>BC<;> + +I. This lookups and returns the last or all +(in reverse oder of activation) sub-objects of activated diversion. + +=back + +=head1 EXAMPLE + +The following part of a fictive CGI program demonstrates how to generate +the structured HTML code in a nested, clean and intuitive fashion: + + # create new object with operator overloading activated + use String::Divert; + my $html = new String::Divert; + $html->overload(1); + + # generate outer HTML framework + $html .= + "\n" . + " \n" . + " " . $html->folder("head") . + " \n" . + " \n" . + " " . $html->folder("body") . + " \n" . + "\n"; + + # generate header + $html >> "head"; + $html .= "foo\n"; + $html << 1; + + # generate body + $html >> "body"; + $html .= "\n" . + " \n" . + " \n" . + " \n" . + " \n" . + "
\n" . + " " . $html->folder("left") . + " \n" . + " " . $html->folder("right") . + "
\n"; + + # generate left contents + $html >> "left"; + $html .= "bar1\n" . + "bar2\n"; + + # generate right contents + $html >> "right"; + $html .= "quux1\n" . + "quux2\n"; + + # undivert all diversions and output unfolded HTML + $html << 0; + print $html; + + # destroy object + $html->destroy; + +The output of this program obviously is: + + + + foo + + + + + + + +
+ bar1 + bar2 + + quux1 + quux2 +
+ + + +=head1 SEE ALSO + +=over 0 + +=item B's C function. + +=item B module B. + +=item B's C filter. + +=back + +=head1 HISTORY + +B was implemented in May 2003 by Ralf S. Engelschall +Erse@engelschall.comE for reducing the complexity in conditional +generation of HTML code within a web application. + +=head1 AUTHOR + +Ralf S. Engelschall Erse@engelschall.comE + +=cut + Index: ossp-pkg/string-divert/MANIFEST RCS File: /v/ossp/cvs/ossp-pkg/string-divert/MANIFEST,v co -q -kk -p'1.1' '/v/ossp/cvs/ossp-pkg/string-divert/MANIFEST,v' | diff -u /dev/null - -L'ossp-pkg/string-divert/MANIFEST' 2>/dev/null --- ossp-pkg/string-divert/MANIFEST +++ - 2024-05-19 00:52:49.375826054 +0200 @@ -0,0 +1,9 @@ +MANIFEST +README +TODO +Makefile.PL +Divert.pm +Divert.pod +test.pl +sample1.pl +sample2.pl Index: ossp-pkg/string-divert/Makefile.PL RCS File: /v/ossp/cvs/ossp-pkg/string-divert/Makefile.PL,v co -q -kk -p'1.1' '/v/ossp/cvs/ossp-pkg/string-divert/Makefile.PL,v' | diff -u /dev/null - -L'ossp-pkg/string-divert/Makefile.PL' 2>/dev/null --- ossp-pkg/string-divert/Makefile.PL +++ - 2024-05-19 00:52:49.378332884 +0200 @@ -0,0 +1,11 @@ + +use 5.005; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'String::Divert', + VERSION_FROM => 'Divert.pm', + PREREQ_PM => {}, + AUTHOR => 'Ralf S. Engelschall ' +); + Index: ossp-pkg/string-divert/README RCS File: /v/ossp/cvs/ossp-pkg/string-divert/README,v co -q -kk -p'1.1' '/v/ossp/cvs/ossp-pkg/string-divert/README,v' | diff -u /dev/null - -L'ossp-pkg/string-divert/README' 2>/dev/null --- ossp-pkg/string-divert/README +++ - 2024-05-19 00:52:49.380867383 +0200 @@ -0,0 +1,12 @@ +String::Divert +============== + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + Index: ossp-pkg/string-divert/TODO RCS File: /v/ossp/cvs/ossp-pkg/string-divert/TODO,v co -q -kk -p'1.1' '/v/ossp/cvs/ossp-pkg/string-divert/TODO,v' | diff -u /dev/null - -L'ossp-pkg/string-divert/TODO' 2>/dev/null --- ossp-pkg/string-divert/TODO +++ - 2024-05-19 00:52:49.383412562 +0200 @@ -0,0 +1,7 @@ + + TODO + ==== + + o recursion by fold und divert checken + o resurrect TIE mechanism for assignment once Perl is no longer buggy + Index: ossp-pkg/string-divert/sample1.pl RCS File: /v/ossp/cvs/ossp-pkg/string-divert/sample1.pl,v co -q -kk -p'1.1' '/v/ossp/cvs/ossp-pkg/string-divert/sample1.pl,v' | diff -u /dev/null - -L'ossp-pkg/string-divert/sample1.pl' 2>/dev/null --- ossp-pkg/string-divert/sample1.pl +++ - 2024-05-19 00:52:49.385978187 +0200 @@ -0,0 +1,28 @@ + +use lib "./blib/lib"; + +use String::Divert; + +# standard object-oriented API (SAPI) +$x = new String::Divert; +$x->assign("foo"); +$x->fold("sub"); +$x->append("quux"); +$x->divert("sub"); +$x->append("bar"); +$x->undivert(0); +print "x=".$x->string()."\n"; +$x->destroy(); + +# extended operator-overloaded API (XAPI) +$x = new String::Divert; +$x->overload(1); +$x .= "foo"; +$x *= "sub"; +$x .= "quux"; +$x >> "sub"; +$x .= "bar"; +$x << 0; +print "x=$x\n"; +undef $x; + Index: ossp-pkg/string-divert/sample2.pl RCS File: /v/ossp/cvs/ossp-pkg/string-divert/sample2.pl,v co -q -kk -p'1.1' '/v/ossp/cvs/ossp-pkg/string-divert/sample2.pl,v' | diff -u /dev/null - -L'ossp-pkg/string-divert/sample2.pl' 2>/dev/null --- ossp-pkg/string-divert/sample2.pl +++ - 2024-05-19 00:52:49.388511762 +0200 @@ -0,0 +1,55 @@ + +use lib "./blib/lib"; + +# create new object with operator overloading activated +use String::Divert; +my $html = new String::Divert; +$html->overload(1); + +# generate outer HTML framework +$html .= + "\n" . + " \n" . + " " . $html->folder("head") . + " \n" . + " \n" . + " " . $html->folder("body") . + " \n" . + "\n"; + +# generate header +$html >> "head"; +$html .= "foo\n"; +$html << 1; + +# generate body +$html >> "body"; +$html .= "\n" . + " \n" . + " \n" . + " \n" . + " \n" . + "
\n" . + " " . $html->folder("left") . + " \n" . + " " . $html->folder("right") . + "
\n"; + +# generate left contents +$html >> "left"; +$html .= "bar1\n" . + "bar2\n"; +$html << 1; + +# generate right contents +$html >> "right"; +$html .= "quux1\n" . + "quux2\n"; + +# undivert all diversions and output unfolded HTML +$html << 0; +print $html; + +# destroy object +$html->destroy; + Index: ossp-pkg/string-divert/test.pl RCS File: /v/ossp/cvs/ossp-pkg/string-divert/test.pl,v co -q -kk -p'1.1' '/v/ossp/cvs/ossp-pkg/string-divert/test.pl,v' | diff -u /dev/null - -L'ossp-pkg/string-divert/test.pl' 2>/dev/null --- ossp-pkg/string-divert/test.pl +++ - 2024-05-19 00:52:49.391067212 +0200 @@ -0,0 +1,133 @@ +## +## String::Divert - Diversion String Object +## Copyright (c) 2003 Ralf S. Engelschall +## +## This file is part of String::Divert, a Perl module for +## dealing with strings containing nested diversions. +## +## This program is free software; you can redistribute it and/or +## modify it under the terms of the GNU General Public License +## as published by the Free Software Foundation; either version +## 2.0 of the License, or (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this file; if not, write to the Free Software Foundation, +## Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. +## +## test.pl: Module Test Suite +## + +use Test::More tests => 36; + +# test: module loading +BEGIN { use_ok('String::Divert') }; + +# test: object creation +my $x = new String::Divert; +ok(defined($x), "object creation"); +$x->destroy; +$x = new String::Divert; +ok(defined($x), "object (re)creation"); +ok($x->name() eq "", "object name"); +$x->name("xx"); +ok($x->name() eq "xx", "overwritten object name"); +$x->name("x"); + +# test: simple content +ok($x->string() eq "", "empty initial content"); +$x->append("foo"); +$x->append("bar"); +ok($x->string() eq "foobar", "appended content"); +$x->assign("quux"); +ok($x->string() eq "quux", "assigned content"); +$x->assign("foo"); +ok($x->string() eq "foo", "(re)assigned content"); +$x->append("bar"); +ok($x->string() eq "foobar", "append after assign"); + +# test: content overwrite mode +$x->assign("foo"); +$x->overwrite('once'); +$x->append("bar"); +$x->append("quux"); +ok($x->string() eq "barquux", "appending with overwrite 'once'"); +$x->overwrite('always'); +$x->append("bar"); +$x->append("quux"); +ok($x->string() eq "quux", "appending with overwrite 'always'"); +$x->overwrite('none'); +$x->append("bar"); +$x->append("quux"); +ok($x->string() eq "quuxbarquux", "appending with overwrite 'none'"); + +# test: content folding +$x->assign("foo"); +$x->fold("bar"); +$x->append("quux"); +my $bar = $x->folding("bar"); +ok(defined($bar), "folding object retrival 1"); +ok($x->string() eq "fooquux", "folding 1"); +$bar->append("bar"); +ok($x->string() eq "foobarquux", "folding 2"); +$bar->fold("baz"); +$bar->append("bar2"); +$bar->fold("baz"); +$bar->append("bar3"); +ok($x->string() eq "foobarbar2bar3quux", "folding 3"); +my $baz = $x->folding("baz"); +ok(defined($baz), "folding object retrival 2"); +$baz->append("baz"); +ok($baz->string() eq "baz", "folding 3"); +ok($bar->string() eq "barbazbar2bazbar3", "folding 4"); +ok($x->string() eq "foobarbazbar2bazbar3quux", "folding 5"); +$baz->assign("XX"); +ok($baz->string() eq "XX", "folding 6"); +ok($bar->string() eq "barXXbar2XXbar3", "folding 7"); +ok($x->string() eq "foobarXXbar2XXbar3quux", "folding 8"); +my @foldings = $x->folding(); +ok(@foldings == 3, "folding 9"); + +# test: content diversion +$x->assign("foo"); +$x->fold("bar"); +$x->append("quux"); +$x->divert("bar"); +$x->append("bar1"); +$x->fold("baz"); +$x->append("bar2"); +$x->divert("baz"); +$x->append("baz"); +ok($x->string() eq "baz", "diversion 1"); +$x->undivert; +ok($x->string() eq "bar1bazbar2", "diversion 2"); +$x->undivert; +ok($x->string() eq "foobar1bazbar2quux", "diversion 3"); +$x->divert("bar"); +$x->divert("baz"); +my @diversions = $x->diversion(); +ok(@diversions == 2, "diversion 4"); +$x->undivert(0); +@diversions = $x->diversion(); +ok(@diversions == 0, "diversion 5"); + +# test: operator overloading +ok($x->overload == 0, "default overloading mode"); +$x->overload(1); +ok($x->overload == 1, "default overloading mode"); +$x->assign("foo"); +ok("$x" eq "foo", "stringify operation"); +$x .= "bar"; +ok("$x" eq "foobar", "appending string"); +$x *= "baz"; +$x .= "quux"; +ok("$x" eq "foobarquux", "appending folding"); +$x >> "baz"; +$x .= "baz"; +$x << 0; +ok("$x" eq "foobarbazquux", "diversion"); +