view release on metacpan or  search on metacpan

lib/Text/Split.pm  view on Meta::CPAN

    my %given = @_;

    my $data = $self->data;
    my $length = length $$data;
    return unless $length; # Nothing to split

    my $from = $self->_parent ? $self->tail + 1 : 0;
    return if $length <= $from; # Was already at end of data

    pos $data = $from;
    return unless $$data =~ m/\G[[:ascii:]]*?($matcher)/mgc;
    my @match = map { substr $$data, $-[$_], $+[$_] - $-[$_] } ( 0 .. -1 + scalar @- );
    shift @match;
    my $found = shift @match;
    my ( $mhead, $mtail ) = ( $-[1], $+[1] - 1 );

    my $head = _fhead $data, $mhead;
    my $tail = _ftail $data, $mtail;

    # TODO This is hacky
    my @matched = @match;

    my $content = substr $$data, $head, 1 + $tail - $head;

    my $split =  __PACKAGE__->new(
        data => $data, parent => $self,
        start => $from, mhead => $mhead, mtail => $mtail, head => $head, tail => $tail,
        matcher => $matcher, found => $found, matched => \@matched,
        content => $content,
        default => $self->default,
    );

    return $split unless wantarray && ( my $slurp = delete $given{slurp} );
    return ( $split, $split->slurp( $slurp, %given ) );
}

sub slurp {
    my $self = shift;
    my $slurp = 1;
    $slurp = shift if @_ % 2; # Odd number of arguments
    my %given = @_;

    my $split = $self;

    _strip_edness \%given;
    my %slurp = _parse_slurp $self->default->{slurp};
    exists $given{$_} and $slurp{$_} = $given{$_} for qw/ chomp trim /;
    %slurp = _parse_slurp $slurp, %slurp unless $slurp eq 1;

    my @content;
    push @content, $self->parent->content if $slurp{slurpl};
    push @content, $split->preceding;
    push @content, $split->content if $slurp{slurpr};

    my $content = join '', @content;
    if ( $slurp{trim} ) {
        s/^\s*//, s/\s*$//, for $content;
    }

    if ( wantarray && $slurp{wantlist} ) {
        @content = grep { $_ ne "\n" } split m/(\n)/, $content;
        @content = map { "$_\n" } @content unless $slurp{chomp};
        return @content;
    }
    else {
        return $content;
    }
}

sub preceding {
    my $self = shift;

    my $data = $self->data;
    my $length = $self->head - $self->start;
    return '' unless $length;
    return substr $$data, $self->start, $length;
}
sub pre { return shift->preceding( @_ ) }

sub remaining {
    my $self = shift;

    my $data = $self->data;
    return $$data if $self->is_root;

    my $from = $self->tail + 1;

    my $length = length( $$data ) - $from + 1;
    return '' unless $length;
    return substr $$data, $from, $length;
}
sub re { return shift->remaining( @_ ) }

sub match {
    my $self = shift;
    my $ii = shift;
    return $self->found if $ii == -1;
    return $self->_matched->[$ii];
}

sub is {
    my $self = shift;
    my $ii = shift;
    my $is = shift;

    return unless defined ( my $match = $self->match( $ii ) );
    if ( ref $is eq 'Regexp' )  { $match =~ $is }
    else                        { return $match eq $is }
}

1;

__END__
=pod

=head1 NAME

Text::Split - Text splitting with fine-grained control

=head1 VERSION