head	1.16;
access;
symbols
	STRING_DIVERT_0_96:1.16
	STRING_DIVERT_0_95:1.13
	STRING_DIVERT_0_94:1.11
	STRING_DIVERT_0_93:1.6
	STRING_DIVERT_0_92:1.5
	STRING_DIVERT_0_91:1.2;
locks; strict;
comment	@# @;


1.16
date	2005.11.16.13.14.27;	author rse;	state Exp;
branches;
next	1.15;
commitid	Sb7E0kfoRoNzdZ9r;

1.15
date	2005.11.16.12.51.13;	author rse;	state Exp;
branches;
next	1.14;
commitid	HQRI1CIOOxpz5Z9r;

1.14
date	2005.11.16.12.08.49;	author rse;	state Exp;
branches;
next	1.13;
commitid	pA9WqyMLYDm0RY9r;

1.13
date	2005.11.16.10.55.02;	author rse;	state Exp;
branches;
next	1.12;
commitid	G14de4yj10mKrY9r;

1.12
date	2005.11.16.10.54.17;	author rse;	state Exp;
branches;
next	1.11;
commitid	7GU56TJTibPsrY9r;

1.11
date	2005.02.22.13.21.34;	author rse;	state Exp;
branches;
next	1.10;

1.10
date	2005.02.22.11.04.16;	author rse;	state Exp;
branches;
next	1.9;

1.9
date	2004.11.03.08.11.18;	author rse;	state Exp;
branches;
next	1.8;

1.8
date	2004.11.03.08.10.00;	author rse;	state Exp;
branches;
next	1.7;

1.7
date	2004.11.03.08.06.45;	author rse;	state Exp;
branches;
next	1.6;

1.6
date	2003.09.22.12.58.25;	author rse;	state Exp;
branches;
next	1.5;

1.5
date	2003.05.29.18.45.49;	author rse;	state Exp;
branches;
next	1.4;

1.4
date	2003.05.29.18.43.50;	author rse;	state Exp;
branches;
next	1.3;

1.3
date	2003.05.23.20.37.32;	author rse;	state Exp;
branches;
next	1.2;

1.2
date	2003.05.23.11.09.56;	author rse;	state Exp;
branches;
next	1.1;

1.1
date	2003.05.22.18.56.50;	author rse;	state Exp;
branches;
next	;


desc
@@


1.16
log
@bump version before release
@
text
@##
##  String::Divert - String Object supporting Folding and Diversion
##  Copyright (c) 2003-2005 Ralf S. Engelschall <rse@@engelschall.com>
##
##  This file is part of String::Divert, a Perl module providing
##  a string object supporting folding and diversion.
##
##  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
##

#   _________________________________________________________________________
#
#   STANDARD OBJECT ORIENTED API
#   _________________________________________________________________________
#

package String::Divert;

use 5.006;
use strict;
use warnings;

use Carp;
require Exporter;

our $VERSION   = '0.96';

our @@ISA       = qw(Exporter);
our @@EXPORT    = qw();
our @@EXPORT_OK = qw();

#   internal: create an anonymous object name
my $_anonymous_count = 1;
sub _anonymous_name () {
    return sprintf("ANONYMOUS:%d", $_anonymous_count++);
}

#   object construction
sub new ($;$) {
    my ($proto, $name) = @@_;

    my $class = ref($proto) || $proto;
    my $self = {};
    bless ($self, $class);

    $name ||= &String::Divert::_anonymous_name();

    $self->{name}      = $name;                             # name of object
    $self->{overwrite} = 'none';                            # overwrite mode (none|once|always)
    $self->{storage}   = 'all';                             # storage mode (none|fold|all)
    $self->{copying}   = 'pass';                            # copying mode (pass|clone)
    $self->{chunks}    = [];                                # string chunks
    $self->{diversion} = [];                                # stack of active diversions
    $self->{foldermk}  = '{#%s#}';                          # folder text representation format
    $self->{folderre}  = '\{#([a-zA-Z_][a-zA-Z0-9_]*)#\}';  # folder text representation regexp
    $self->{folderlst} = undef;                             # folder object of last folding operation

    return $self;
}

#   object destruction (explicit)
sub destroy ($) {
    $_[0]->overload(0);
    bless $_[0], 'UNIVERSAL';
    undef $_[0];
    return;
}

#   object destruction (implicit)
sub DESTROY ($) {
    $_[0]->overload(0);
    bless $_[0], 'UNIVERSAL';
    return;
}

#   clone object
sub clone ($) {
    my ($self) = @@_;
    my $ov = $self->overload();
    $self->overload(0);
    eval { require Storable; };
    croak "required module \"Storable\" not installed" if ($@@);
    my $clone = Storable::dclone($self);
    $self->overload($ov);
    $clone->overload($ov);
    return $clone;
}

#   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)) {
        croak "invalid overwrite mode argument"
            if ($mode !~ m/^(none|once|always)$/);
        $self->{overwrite} = $mode;
    }
    return $old_mode;
}

#   operation: set/get storage mode
sub storage ($;$) {
    my ($self, $mode) = @@_;
    return $self->{diversion}->[-1]->storage($mode)
        if (@@{$self->{diversion}} > 0);
    my $old_mode = $self->{storage};
    if (defined($mode)) {
        croak "invalid storage mode argument"
            if ($mode !~ m/^(none|fold|all)$/);
        $self->{storage} = $mode;
    }
    return $old_mode;
}

#   operation: set/get copy constructor mode
sub copying ($;$) {
    my ($self, $mode) = @@_;
    return $self->{diversion}->[-1]->copying($mode)
        if (@@{$self->{diversion}} > 0);
    my $old_mode = $self->{copying};
    if (defined($mode)) {
        croak "invalid copying mode argument"
            if ($mode !~ m/^(clone|pass)$/);
        $self->{copying} = $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 '' and $self->{storage} !~ m/^(none|fold)/);
        croak "empty folding object name"
            if ($id eq '');
        if ($self->{storage} ne 'none') {
            my $object = $self->folding($id);
            $object = $self->new($id) if (not defined($object));
            croak "cannot create new folding sub object \"$id\""
                if (not defined($object));
            push(@@chunks, $object);
        }
        $string = $';
    }
    push(@@chunks, $string) if ($string ne '' and $self->{storage} !~ m/^(none|fold)/);
    return @@chunks;
}

#   operation: assign an object
sub assign ($$) {
    my ($self, $obj) = @@_;
    return $self->{diversion}->[-1]->assign($obj)
        if (@@{$self->{diversion}} > 0);
    croak "cannot assign undefined object"
        if (not defined($obj));
    if (&String::Divert::_isobj($obj)) {
        $self->{chunks} = [ $obj ];
        $self->{folderlst} = $obj if (ref($obj));
    }
    else {
        $self->{chunks} = [];
        foreach my $chunk ($self->_chunking($obj)) {
            push(@@{$self->{chunks}}, $chunk);
            $self->{folderlst} = $chunk if (ref($chunk));
        }
    }
    return $self;
}

#   operation: append an object
sub append ($$) {
    my ($self, $obj) = @@_;
    return $self->{diversion}->[-1]->append($obj)
        if (@@{$self->{diversion}} > 0);
    croak "cannot append undefined object"
        if (not defined($obj));
    if (   $self->{overwrite} eq 'once'
        or $self->{overwrite} eq 'always') {
        $self->assign($obj);
        $self->{overwrite} = 'none'
            if ($self->{overwrite} eq 'once');
    }
    else {
        if (&String::Divert::_isobj($obj)) {
            push(@@{$self->{chunks}}, $obj);
            $self->{folderlst} = $obj if (ref($obj));
        }
        else {
            foreach my $chunk ($self->_chunking($obj)) {
                if (ref($chunk) or (@@{$self->{chunks}} > 0 and ref($self->{chunks}->[-1]))) {
                    push(@@{$self->{chunks}}, $chunk);
                    $self->{folderlst} = $chunk if (ref($chunk));
                }
                elsif (@@{$self->{chunks}} > 0) {
                    $self->{chunks}->[-1] .= $chunk;
                }
                else {
                    $self->{chunks} = [ $chunk ];
                }
            }
        }
    }
    return $self;
}

#   operation: unfold (and return) string contents temporarily
sub string ($) {
    my ($self) = @@_;
    return $self->{diversion}->[-1]->string()
        if (@@{$self->{diversion}} > 0);
    return $self->_string([]);
}

#   internal: string() operation with loop detection
sub _string ($$) {
    my ($self, $visit) = @@_;
    my $string = '';
    if (grep { &String::Divert::_isobjeq($_, $self) } @@{$visit}) {
        croak "folding loop detected: " .
            join(" -> ", map { $_->name() } @@{$visit}) . 
            " -> " . $self->name();
    }
    push(@@{$visit}, $self);
    foreach my $chunk (@@{$self->{chunks}}) {
        if (ref($chunk)) {
            #   folding loop detection
            my $prefix = '';
            #   check for existing prefix
            #   (keep in mind that m|([^\n]+)$|s _DOES NOT_
            #   take a possibly existing terminating newline
            #   into account, so we really need an extra match!)
            if ($string =~ m|([^\n]+)$|s and $string !~ m|\n$|s) {
                $prefix = $1;
                $prefix =~ s|[^ \t]| |sg;
            }
            my $block = $chunk->_string($visit); # recursion!
            $block =~ s|\n(?=.)|\n$prefix|sg if ($prefix ne '');
            $string .= $block;
        }
        else {
            $string .= $chunk;
        }
    }
    pop(@@{$visit});
    return $string;
}

#   operation: unfold string contents temporarily until already true or finally false
sub bool ($) {
    my ($self) = @@_;
    return $self->{diversion}->[-1]->bool()
        if (@@{$self->{diversion}} > 0);
    my $string = '';
    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);
    return undef if ($self->{storage} eq 'none');
    $id = &String::Divert::_anonymous_name()
        if (not defined($id));
    if (ref($id)) {
        croak "folding object not of class String::Divert"
            if (not &String::Divert::_isobj($id));
        push(@@{$self->{chunks}}, $id);
        $self->{folderlst} = $id;
        return $id;
    }
    else {
        my $object = $self->folding($id);
        $object = $self->new($id) if (not defined($object));
        croak "unable to create new folding object"
            if (not defined($object));
        push(@@{$self->{chunks}}, $object);
        $self->{folderlst} = $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 ne '' ? [ $string ] : [];
    $self->{folderlst} = undef;
    return $string;
}

#   internal: check whether object is a String::Divert object
sub _isobj ($) {
    my ($obj) = @@_;
    return (    ref($obj)
            and (   UNIVERSAL::isa($obj, "String::Divert")
                 or UNIVERSAL::isa($obj, "String::Divert::__OVERLOAD__")));
}

#   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) = @@_;
    if (defined($id)) {
        my $folding; $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); # recursion!
                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($a) and defined($b)) {
        #   configure folder
        my $test = sprintf($a, "foo");
        my ($id) = ($test =~ m|${b}()|s);
        croak "folder construction format and matching regular expression do not correspond"
            if (not defined($id) or (defined($id) and $id ne "foo"));
        $self->{foldermk} = $a;
        $self->{folderre} = $b;
        return;
    }
    else {
        #   create folder
        return "" if ($self->{storage} eq 'none');
        $a = &String::Divert::_anonymous_name()
            if (not defined($a));
        my $folder = sprintf($self->{foldermk}, $a);
        return $folder;
    }
}

#   operation: push diversion of operations to sub-object
sub divert ($;$) {
    my ($self, $id) = @@_;
    my $object; $object = undef;
    if (not defined($id)) {
        #   choose last folding object
        foreach my $obj (reverse ($self, @@{$self->{diversion}})) {
            $object = $obj->{folderlst};
            last if (defined($object));
        }
        croak "no last folding sub-object found"
            if (not defined($object));
    }
    else {
        #   choose named folding object
        $object = $self->folding($id);
        croak "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));
    if ($num !~ m|^\d+$|) {
        #   lookup number by name
        my $name = $num;
        for (my $num = 1; $num <= @@{$self->{diversion}}; $num++) {
            last if ($self->{diversion}->[-$num]->{name} eq $name);
        }
        croak "no object named \"$name\" found for undiversion"
            if ($num > @@{$self->{diversion}});
    }
    $num = @@{$self->{diversion}} if ($num == 0);
    croak "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 (or undef if none exist)
        return $self->{diversion}->[-1];
    }
    else {
        #   return all diversions (in reverse order of activation) (or empty array if none exist)
        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    = qw();
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_copyconst,
    #'${}'      => \&op_deref_string,
    #'%{}'      => \&op_deref_hash,
    #'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_deref_string ($$$) {
#    my $self = shift;
#    return $self;
#}

#sub op_deref_hash ($$$) {
#    my $self = shift;
#    return $self;
#}

sub op_copyconst {
    my ($self, $other, $reverse) = @@_;
    if ($self->{copying} eq 'pass') {
        #   object is just passed-through
        return $self;
    }
    else { 
        #   object is recursively cloned
        return $self->clone();
    }
}

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_unknown>: op=$op\n";
#    return $self;
#}

1;

@


1.15
log
@change "divert" method without arg to really divert to the last established folder.
@
text
@d40 1
a40 1
our $VERSION   = '0.95';
@


1.14
log
@o add folding loop detection to "string" method
o use anonymous names already in "new" method
o don't follow diversions on "folding" method to
  allow one to divert back to upper objects, too.
o document that "folding" method returns all
  foldings if no name or object is specified.
o change sample2.pl to show the usual "head" diversion
  once one is already diverted in "body".
@
text
@d70 1
d189 1
d195 1
d217 1
d223 1
d309 1
d318 1
d330 1
d367 1
a367 1
                $folding = $chunk->folding($id);
d416 3
a418 5
        foreach my $chunk ($self->folding()) {
            if (ref($chunk)) {
                $object = $chunk;
                last;
            }
d440 1
a440 1
        for ($num = 1; $num <= @@{$self->{diversion}}; $num++) {
@


1.13
log
@bump version before release
@
text
@d46 6
d60 1
a60 1
    $name ||= "";
d237 6
d244 6
d252 1
d262 1
a262 1
            my $block = $chunk->string(); # recursion!
d270 1
a291 6
#   internal: create an anonymous object name
my $_anonymous_count = 1;
sub _anonymous_name () {
    return sprintf("ANONYMOUS:%d", $_anonymous_count++);
}

a349 2
    return $self->{diversion}->[-1]->folding($id)
        if (@@{$self->{diversion}} > 0);
@


1.12
log
@o document "bool" method in Divert.pod, too.
o allow objects to be passed to "append" and "assign" methods
o call "destroy" method in "DESTROY"
o support anonymous sub-objects
o completely reviewed and cleaned up implementation
@
text
@d40 1
a40 1
our $VERSION   = '0.94';
@


1.11
log
@o add "copy constructor" in overloaded API plus a copying() method
  for selecting what to do in the "copy constructor": passing
  the object as is or cloning via clone() method.
o add clone() method for recursively cloning object
o replace "die" with Carp's "croak" for better error messages
@
text
@d54 10
a63 8
    $self->{name}      = (defined($name) ? $name : '');
    $self->{overwrite} = 'none';
    $self->{storage}   = 'all';
    $self->{copying}   = 'pass';
    $self->{chunks}    = [ '' ];
    $self->{diversion} = [];
    $self->{foldermk}  = '{#%s#}';
    $self->{folderre}  = '\{#([a-zA-Z_][a-zA-Z0-9_]*)#\}';
d78 2
d115 1
a115 1
        croak "invalid mode argument"
d129 1
a129 1
        croak "invalid mode argument"
d139 2
d143 1
a143 1
        croak "invalid mode argument"
d151 1
a151 1
sub _chunking ($) {
d163 1
a163 1
            croak "cannot reuse or create folding sub object \"$id\""
d173 1
a173 1
#   operation: assign a string
d175 2
a176 2
    my ($self, $string) = @@_;
    return $self->{diversion}->[-1]->assign($string)
d178 10
a187 7
    croak "cannot assign undefined string"
        if (not defined($string));
    croak "cannot assign reference ".ref($string)." as string"
        if (ref($string));
    $self->{chunks} = [];
    foreach my $chunk ($self->_chunking($string)) {
        push(@@{$self->{chunks}}, $chunk);
d192 1
a192 1
#   operation: append a string
d194 2
a195 2
    my ($self, $string) = @@_;
    return $self->{diversion}->[-1]->append($string)
d197 2
a198 4
    croak "cannot assign undefined string"
        if (not defined($string));
    croak "cannot assign reference as string"
        if (ref($string));
d201 1
a201 4
        $self->{chunks} = [];
        foreach my $chunk ($self->_chunking($string)) {
            push(@@{$self->{chunks}}, $chunk);
        }
d206 6
a211 6
        foreach my $chunk ($self->_chunking($string)) {
            if (ref($chunk)) {
                push(@@{$self->{chunks}}, $chunk);
            }
            else {
                if (ref($self->{chunks}->[-1])) {
d214 3
d218 1
a218 1
                    $self->{chunks}->[-1] .= $chunk;
a228 1
    my $string = '';
d231 1
a256 1
    my $string = '';
d259 1
d272 6
d279 1
a279 1
sub fold ($$) {
d283 2
a284 1
    croak "undefined folding object identifier"
a285 1
    return undef if ($self->{storage} eq 'none');
d288 1
a288 2
            if (   UNIVERSAL::isa($id, "String::Divert")
                or UNIVERSAL::isa($id, "String::Divert::__OVERLOAD__"));
d308 1
a308 1
    $self->{chunks} = [ $string ];
d312 8
d339 1
a339 1
        my $folding = undef;
d368 1
a368 1
sub folder ($$;$) {
d370 1
a370 1
    if (defined($b)) {
d383 2
d391 1
a391 1
sub divert ($$) {
d393 18
a410 3
    my $object = $self->folding($id);
    croak "folding sub-object \"$id\" not found"
        if (not defined($object));
d420 1
d442 1
a442 1
        #   return last diversion only
d446 1
a446 1
        #   return all diversions (in reverse order of activation)
@


1.10
log
@say hello to 2005 here, to
@
text
@a24 4
use 5.006;
use strict;
use warnings;

d33 5
d57 1
d79 13
d111 1
a111 1
        die "invalid mode argument"
d125 1
a125 1
        die "invalid mode argument"
d132 12
d152 1
a152 1
        die "empty folding object name"
d157 1
a157 1
            die "cannot reuse or create folding sub object \"$id\""
d172 1
a172 1
    die "cannot assign undefined string"
d174 1
a174 1
    die "cannot assign reference ".ref($string)." as string"
d188 1
a188 1
    die "cannot assign undefined string"
d190 1
a190 1
    die "cannot assign reference as string"
d270 1
a270 1
    die "undefined folding object identifier"
d274 1
a274 1
        die "folding object not of class String::Divert"
d283 1
a283 1
        die "unable to create new folding object"
d354 1
a354 1
        die "folder construction format and matching regular expression do not correspond"
d372 1
a372 1
    die "folding sub-object \"$id\" not found"
d387 1
a387 1
        die "no object named \"$name\" found for undiversion"
d391 2
a392 1
    die "less number (".scalar(@@{$self->{diversion}}).") of diversions active than requested ($num) to undivert"
d482 1
a484 1
    #'='        => \&op_copyconst,
a512 6
#sub op_copyconst {
#    my ($self, $other, $reverse) = @@_;
#    #   intentionally do not copy at all
#    return $self;
#}

d523 12
@


1.9
log
@include year 2004 in Copyright
@
text
@d3 1
a3 1
##  Copyright (c) 2003-2004 Ralf S. Engelschall <rse@@engelschall.com>
@


1.8
log
@add default empty EXPORT array
@
text
@d3 1
a3 1
##  Copyright (c) 2003 Ralf S. Engelschall <rse@@engelschall.com>
@


1.7
log
@use empty EXPORT_OK because we have an OO style API only
@
text
@d42 1
d440 1
@


1.6
log
@fix obj->folder(format, pattern) implementation
@
text
@d39 1
a39 1
our $VERSION   = '0.93';
d42 1
a42 6
our @@EXPORT_OK = qw(new destroy DESTROY
                    name overwrite storage
                    assign append string bool
                    fold unfold folding folder
                    divert undivert diversion
                    overload);
@


1.5
log
@bump for release
@
text
@d39 1
a39 1
our $VERSION   = '0.92';
d330 1
a330 1
        my $id = ($test =~ m|${b}()|s);
d332 1
a332 1
            if ($id ne "foo");
@


1.4
log
@o fix auto-indentation generation on unfolding
o add "storage" mode functionality
@
text
@d39 1
a39 1
our $VERSION   = '0.91';
@


1.3
log
@fix auto-indentation generation on unfolding
@
text
@d43 1
a43 1
                    name overwrite
d59 1
d107 14
d128 1
a128 1
        push(@@chunks, $prolog) if ($prolog ne '');
d131 7
a137 5
        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);
d140 1
a140 1
    push(@@chunks, $string) if ($string ne '');
d249 1
d339 1
d359 8
@


1.2
log
@o direct MakeMaker to not install sample[12].pl
o cleanup naming of module, etc.
o remove trailing whitespaces from codes
o cleanup and extend documentation
@
text
@d188 5
a192 1
            if ($string =~ m|([^\n]*)(\r?\n)*$|s) {
@


1.1
log
@finally add this little nasty beast to CVS
@
text
@d2 2
a3 2
##  String::Divert - Diversion String Object
##  Copyright (c) 2003 Ralf S. Engelschall <rse@@engelschall.com> 
d5 2
a6 2
##  This file is part of String::Divert, a Perl module for
##  dealing with strings containing nested diversions.
d25 1
a25 1
use 5.005;
d39 2
d42 1
a42 1
our @@EXPORT_OK = qw(new destroy DESTROY 
a47 1
our $VERSION   = '0.90';
d78 1
a78 1
}   
d152 1
a152 1
    if (   $self->{overwrite} eq 'once' 
@