Text-Clip-0.0014000755001750001750 011401235773 12141 5ustar00robrob000000000000README000644001750001750 243111401235773 13101 0ustar00robrob000000000000Text-Clip-0.0014NAME Text::Clip - Clip and extract text in clipboard-like way VERSION version 0.0014 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 => '[]' ) $content = # --- START qwerty 1 2 3 4 5 6 8 9 10 The end Alternatively, with ( $mark, $content ) = $mark->find( qr/ The end/, slurp => '()' ) $content = qwerty 1 2 3 4 5 6 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 "clipped" between the marks. AUTHOR Robert Krimen 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. Changes000644001750001750 120611401235773 13513 0ustar00robrob000000000000Text-Clip-0.0014TODO: - Test for /mgc - Automatically add /m to end of pattern? - Add 'next' for repeating the same pattern 0.0014 Tuesday June 01 09:48:31 PDT 2010: - Change name to Text::Clip 0.0013 Tuesday June 01 09:15:52 PDT 2010: - Give Text::Clip rename notice 0.0012 Friday May 07 11:43:20 PDT 2010: - Do not automatically add "\n" to the end of the empty string - Check for 0 length before splitting - Add trimming (trim, trimmed) 0.0011 Thursday May 06 07:39:26 PDT 2010: - Improved regular expression handling - Added separate .slurp method 0.0010 Wednesday May 05 18:00:16 PDT 2010: - Initial release Text000755001750001750 011401235773 13554 5ustar00robrob000000000000Text-Clip-0.0014/libClip.pm000644001750001750 1516411401235773 15167 0ustar00robrob000000000000Text-Clip-0.0014/lib/Textpackage 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}; } sub _parse_slurp ($@) { my $slurp = shift; my %slurp = @_; # Can/will be overidden _strip_edness \%slurp; if ( ref $slurp eq 'HASH' ) { $slurp = { %$slurp }; _strip_edness $slurp; %slurp = ( %slurp, %$slurp ); } else { $slurp =~ m{^ ([\@\$])? ([\(\[]) ([\)\]]) (/)? }x or die "Invalid slurp pattern ($slurp)"; $slurp{wantlist} = $1 eq '@' ? 1 : 0 if $1; $slurp{slurpl} = $2 eq '[' ? 1 : 0; $slurp{slurpr} = $3 eq ']' ? 1 : 0; $slurp{chomp} = 1 if $4; } return %slurp; } sub find { return shift->split( @_ ); } sub split { my $self = shift; my $matcher; $matcher = shift if @_ % 2; # Odd number of arguments 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::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 "clipped" between the marks. =head1 AUTHOR Robert Krimen =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 t000755001750001750 011401235773 12325 5ustar00robrob000000000000Text-Clip-0.001402-slurp.t000644001750001750 167211401235773 14243 0ustar00robrob000000000000Text-Clip-0.0014/t#!/usr/bin/env perl use strict; use warnings; use Test::Most; plan 'no_plan'; use Text::Clip; my ( $t0, $content, $data ); $data = <<_END_; { abcdefghijklmnopqrstuvwxyz qwerty - 1 2 3 4 5 5 6 7 8 9 xyzzy } _END_ $t0 = Text::Clip->new( data => $data ); ( $t0, $content ) = $t0->split( qr/rty/, slurp => '[]' ); is( $content, <<_END_ ); { abcdefghijklmnopqrstuvwxyz qwerty _END_ $data = <<_END_; # Xyzzy # --- START qwerty 1 2 3 4 5 6 8 9 10 The end # abcdefghi jklmnop _END_ $t0 = Text::Clip->new( data => $data )->find( qr/#\s*--- START/ ); ( $t0, $content ) = $t0->find( qr/ The end/, slurp => '[]' ); is( $content, <<_END_ ); # --- START qwerty 1 2 3 4 5 6 8 9 10 The end _END_ $t0 = Text::Clip->new( data => $data )->find( qr/#\s*--- START/ ); ( $t0, $content ) = $t0->find( qr/ The end/, slurp => '()' ); is( $content, <<_END_ ); qwerty 1 2 3 4 5 6 _END_ 04-trim.t000644001750001750 107211401235773 14045 0ustar00robrob000000000000Text-Clip-0.0014/t#!/usr/bin/env perl use strict; use warnings; use Test::Most; plan 'no_plan'; use Text::Clip; my ( $t0, $content, $data ); $data = <<_END_; M1 M2 M3 _END_ $t0 = Text::Clip->new( data => $data ); my $pattern = qr/\Z/m; $t0 = $t0->find( $pattern ); cmp_deeply( [ $t0->slurp( '@[)', chomp => 1 ) ], [ '', qw/ M1 M2 M3 /, '' ] ); cmp_deeply( [ $t0->slurp( '@[)', chomp => 1, trim => 1 ) ], [ qw/ M1 M2 M3 / ] ); cmp_deeply( [ $t0->slurp( '@[)', chomp => 1, trimmed => 1 ) ], [ qw/ M1 M2 M3 / ] ); is( $t0->slurp( '$[]', chomp => 1, trimmed => 1 ) , "M1\nM2\nM3" ); 01-basic.t000644001750001750 210211401235773 14143 0ustar00robrob000000000000Text-Clip-0.0014/t#!/usr/bin/env perl use strict; use warnings; use Test::Most; plan 'no_plan'; use Text::Clip; my ( $t0, $p0, $p1, $p2 ); sub o0 ($) { my $p0 = $_[0]; diag $p0->start, " ", $p0->head, " ", $p0->tail, " m ", $p0->mhead, " ", $p0->mtail; } sub opr ($) { my $p0 = $_[0]; diag 'pr: [', $p0->preceding, ']'; } sub ore ($) { my $p0 = $_[0]; diag 're: [', $p0->remaining, ']'; } my $data = <<_END_; { abcdefghijklmnopqrstuvwxyz qwerty - 1 2 3 4 5 5 6 7 8 9 xyzzy } _END_ $p0 = Text::Clip->new( data => $data ); is( $p0->preceding, '' ); is( $p0->remaining, $data ); $p1 = $p0->split( qr/rty/ ); is( $p1->preceding, <<_END_ ); { abcdefghijklmnopqrstuvwxyz _END_ is( $p1->remaining, <<_END_ ); - 1 2 3 4 5 5 6 7 8 9 xyzzy } _END_ $p2 = $p1->split( qr/ 5 (6) 7 / ); is( $p2->preceding, <<_END_ ); - _END_ is( $p2->remaining, <<_END_ ); xyzzy } _END_ is( $p2->match( 0 ), 6 ); is( $p2->found, ' 5 6 7 ' ); $p0 = $p2; $p0 = $p0->split( qr/}\n\n/ ); is( $p0->preceding, <<_END_ ); xyzzy _END_ is( $p0->remaining, '' ); 03-section.t000644001750001750 177411401235773 14546 0ustar00robrob000000000000Text-Clip-0.0014/t#!/usr/bin/env perl use strict; use warnings; use Test::Most; plan 'no_plan'; use Text::Clip; my ( $t0, $content, $data ); $data = <<_END_; M1 M2 M3 # --- IGNORE abcd I1 I2 I3 # --- SKIP efgh S1 S2 S3 ijkl # --- _END_ $t0 = Text::Clip->new( data => $data ); my $pattern = qr/^#[^\S\n]*---[^\S\n]*(\S+)?/m; $t0 = $t0->find( $pattern ); is( $t0->match( 0 ), 'IGNORE' ); cmp_deeply( [ $t0->slurp( '@[)', chomp => 1 ) ], [ '', qw/ M1 M2 M3 /, '' ] ); $t0 = $t0->find( $pattern ); is( $t0->match( 0 ), 'SKIP' ); is( $t0->slurp( '()' ), <<_END_ ); I1 I2 I3 _END_ $t0 = $t0->find( $pattern ); is( $t0->match( 0 ), undef ); is( $t0->slurp(), <<_END_ ); # --- SKIP efgh S1 S2 S3 ijkl _END_ is( $t0->remaining, <<_END_ ); _END_ $data = <<_END_; A1 A2 B1 B2 B3 C1 C2 _END_ chomp $data; $t0 = Text::Clip->new( data => $data ); my @got; while( $t0 = $t0->find( qr/(\n\n+|\Z)/ ) ) { push @got, map { s/^\s*//; s/\s*$//; $_ } $t0->slurp; } cmp_deeply( \@got, [ "A1\nA2", "B1\nB2\nB3", "C1\nC2" ] ); META.yml000644001750001750 63611401235773 13457 0ustar00robrob000000000000Text-Clip-0.0014--- abstract: 'Clip and extract text in clipboard-like way' author: - 'Robert Krimen ' build_requires: Test::Most: 0 configure_requires: ExtUtils::MakeMaker: 6.31 generated_by: 'Dist::Zilla version 2.101170' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Text-Clip recommends: {} requires: Any::Moose: 0 version: 0.0014 Makefile.PL000644001750001750 306311401235773 14175 0ustar00robrob000000000000Text-Clip-0.0014 use strict; use warnings; use ExtUtils::MakeMaker 6.31; my %WriteMakefileArgs = ( 'test' => { 'TESTS' => 't/*.t' }, 'NAME' => 'Text::Clip', 'DISTNAME' => 'Text-Clip', 'CONFIGURE_REQUIRES' => { 'ExtUtils::MakeMaker' => '6.31' }, 'AUTHOR' => 'Robert Krimen ', 'BUILD_REQUIRES' => { 'Test::Most' => '0' }, 'ABSTRACT' => 'Clip and extract text in clipboard-like way', 'EXE_FILES' => [], 'VERSION' => '0.0014', 'PREREQ_PM' => { 'Any::Moose' => '0' }, 'LICENSE' => 'perl' ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); MANIFEST000644001750001750 16211401235773 13331 0ustar00robrob000000000000Text-Clip-0.0014Changes MANIFEST META.yml Makefile.PL README lib/Text/Clip.pm t/01-basic.t t/02-slurp.t t/03-section.t t/04-trim.t