view release on metacpan or  search on metacpan

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

package Text::Clip;
BEGIN {
  $Text::Clip::VERSION = '0.0014';
}
# ABSTRACT: Clip and extract text in clipboard-like way


use Any::Moose;

has data => qw/ reader data writer _data required 1 /;
has [qw/ start head tail mhead mtail /] => qw/ is rw required 1 isa Int default 0 /;
has _parent => qw/ is ro isa Maybe[Text::Clip] init_arg parent /;

has found => qw/ is ro required 1 isa Str /, default => '';
has content => qw/ is ro required 1 isa Str /, default => '';
has _matched => qw/ init_arg matched is ro isa ArrayRef /, default => sub { [] };
sub matched { return @{ $_[0]->matched } }
has matcher => qw/ is ro /, default => undef;

has default => qw/  is ro lazy_build 1 isa HashRef /;
sub _build_default { {
    slurp => '[)',
} }

sub BUILD {
    my $self = shift;
    my $data = $self->data;
    if ( ref $data ne 'SCALAR' ) {
        chomp $data;
        $data .= "\n" if length $data;
        $self->_data( \$data );
    }
}

sub _fhead ($$) {
    my ( $data, $from ) = @_;
    my $i0 = rindex $$data, "\n", $from;
    return $i0 + 1 unless -1 == $i0;
    return 0;
}

sub _ftail ($$) {
    my ( $data, $from ) = @_;
    my $i0 = index $$data, "\n", $from;
    return $i0 unless -1 == $i0;
    return -1 + length $$data;
}

sub parent {
    my $self = shift;
    if ( my $parent = $self->_parent ) { return $parent }
    return $self; # We are the base (root) split
}

sub is_root {
    my $self = shift;
    return ! $self->_parent;
}

sub _strip_edness ($) {
    my $slurp = $_[0];
    $slurp->{chomp} = delete $slurp->{chomped} if
        exists $slurp->{chomped} && not exists $slurp->{chomp};
    $slurp->{trim} = delete $slurp->{trimmed} if
        exists $slurp->{trimmed} && not exists $slurp->{trim};

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

    }

    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::Clip - Clip and extract text in clipboard-like way

=head1 VERSION

version 0.0014

=head1 SYNOPSIS

    $data = <<_END_
    # Xyzzy
    #   --- START 
        qwerty

            1 2 3 4 5 6
    8 9 10 The end

    # abcdefghi
            jklmnop
    _END_

    $mark = Text::Clip->new( data => ... )->find( qr/#\s*--- START/ )
    ( $mark, $content ) = $mark->find( qr/ The end/, slurp => '[]' )

C<$content> = 

    #   --- START 
        qwerty

            1 2 3 4 5 6
    8 9 10 The end

Alternatively, with

    ( $mark, $content ) = $mark->find( qr/ The end/, slurp => '()' )

C<$content> = 

        qwerty

            1 2 3 4 5 6

=head1 DESCRIPTION

Text::Clip allows you to mark/slice up a piece of text. String matching (by regular expression, etc.) is used to place marks. The first mark lets you access the text preceding and following the mark. Subsequent marks allow you to slurp up the text "c...

=head1 AUTHOR

  Robert Krimen <robertkrimen@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2010 by Robert Krimen.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut