Regexp-RegGrp-2.01/000755 000765 000120 00000000000 13075333222 015343 5ustar00leejohnsonadmin000000 000000 Regexp-RegGrp-2.01/Changes000644 000765 000120 00000003467 13075332601 016650 0ustar00leejohnsonadmin000000 000000 Revision history for Regexp-RegGrp 2.01 2017-04-18 - Makefile.PL moved to ExtUtils::MakeMaker to fix no . in @INC (perl 5.25.11+) 2.00 2015-05-29 - New maintainer: LEEJO - Repoint issue tracker/repo at leejo's fork - Add .travis.yml for CI goodness - Add Changes test - Add MYMETA.json to .gitignore 1.002001 2012-02-18 - Use gnutar to build distribution. 1.002 2011-05-18 - Changed version number. 1.001_002 2011-04-14 - Fixed tests for perl > 5.13.5 1.001_001 2011-04-05 - Splited up RegGrp.pm. - Added tests. 1.000001 2011-02-27 - Fixed "undefined submatches bug" (Thanks to Dan Thomas). 1.000 2011-01-17 - Changed versioning. - Raised major version due to changes in versioning. - Changed required perl version to 5.8.9. 0.04 2010-12-02 - Changed version number. 0.03_01 2010-10-29 - Fixed (?^: regexp syntax handling for perl 5.14. - Changed backreferences handling. - Fixed POD. 0.0203 2010-09-17 - Fixed zero-length submatch bug for perl 5.8. - Added unit test for zero-length submatch. 0.0202 2010-09-13 - Moved documentation for modifier option to the right place. 0.0201 2010-09-12 - Fixed POD. 0.02 2010-09-11 - Changed version number. 0.01_05 2010-09-07 - Changed modifier option. - Added unit tests for modifier option. 0.01_04 2010-09-02 - Added modifier option. - Updated documentation. 0.01_03 2010-08-23 - Updated Changes. - Fixed package. - Removed obsolete condition. 0.01_02 2010-08-22 - Changed version. - Added opts parameter to store function. - Fixed abstract. - Fixed .gitignore and .cvsignore. - Switched to Module::Install. - Updated MANIFEST. 0.01_01 2010-07-29 - First version, released on an unsuspecting world. Regexp-RegGrp-2.01/MANIFEST000644 000765 000120 00000000466 13075333222 016502 0ustar00leejohnsonadmin000000 000000 Changes lib/Regexp/RegGrp.pm lib/Regexp/RegGrp/Data.pm Makefile.PL MANIFEST README.md t/00-load.t t/01-data.t t/02-reggrp.t t/03-io.t t/pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Regexp-RegGrp-2.01/META.json000644 000765 000120 00000002344 13075333222 016767 0ustar00leejohnsonadmin000000 000000 { "abstract" : "Groups a regular expressions collection", "author" : [ "Lee Johnson " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Regexp-RegGrp", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "Test::More" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : {} } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/leejo/regexp-reggrp-perl/issues" }, "homepage" : "https://metacpan.org/module/Regexp::RegGrp", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://github.com/leejo/regexp-reggrp-perl" } }, "version" : "2.01", "x_serialization_backend" : "JSON::PP version 2.27400_02" } Regexp-RegGrp-2.01/META.yml000644 000765 000120 00000001402 13075333222 016611 0ustar00leejohnsonadmin000000 000000 --- abstract: 'Groups a regular expressions collection' author: - 'Lee Johnson ' build_requires: Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Regexp-RegGrp no_index: directory: - t - inc requires: {} resources: bugtracker: https://github.com/leejo/regexp-reggrp-perl/issues homepage: https://metacpan.org/module/Regexp::RegGrp license: http://dev.perl.org/licenses/ repository: https://github.com/leejo/regexp-reggrp-perl version: '2.01' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Regexp-RegGrp-2.01/Makefile.PL000644 000765 000120 00000001311 13075333176 017321 0ustar00leejohnsonadmin000000 000000 #!perl use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Regexp::RegGrp', ABSTRACT_FROM => 'lib/Regexp/RegGrp.pm', VERSION_FROM => 'lib/Regexp/RegGrp.pm', AUTHOR => 'Lee Johnson ', LICENSE => 'perl', PREREQ_PM => { }, BUILD_REQUIRES => { 'Test::More' => 0, }, META_MERGE => { resources => { license => 'http://dev.perl.org/licenses/', homepage => 'https://metacpan.org/module/Regexp::RegGrp', bugtracker => 'https://github.com/leejo/regexp-reggrp-perl/issues', repository => 'https://github.com/leejo/regexp-reggrp-perl' }, }, test => { TESTS => 't/*.t', }, ); Regexp-RegGrp-2.01/README.md000644 000765 000120 00000013150 13075331610 016621 0ustar00leejohnsonadmin000000 000000 # NAME Regexp::RegGrp - Groups a regular expressions collection
Build Status Coverage Status
# VERSION Version 2.00 # DESCRIPTION Groups regular expressions to one regular expression # SYNOPSIS use Regexp::RegGrp; my $reggrp = Regexp::RegGrp->new( { reggrp => [ { regexp => '%name%', replacement => 'John Doe', modifier => $modifier }, { regexp => '%company%', replacement => 'ACME', modifier => $modifier } ], restore_pattern => $restore_pattern } ); $reggrp->exec( \$scalar ); To return a scalar without changing the input simply use (e.g. example 2): my $ret = $reggrp->exec( \$scalar ); The first argument must be a hashref. The keys are: - reggrp (required) Arrayref of hashrefs. The keys of each hashref are: - regexp (required) A regular expression - replacement (optional) Scalar or sub. A replacement for the regular expression match. If not set, nothing will be replaced except "store" is set. In this case the match is replaced by something like sprintf("\\x01%d\\x01", $idx) where $idx is the index of the stored element in the store\_data arrayref. If "store" is set the default is: sub { return sprintf( "\x01%d\x01", $_[0]->{store_index} ); } If a custom restore\_pattern is passed to to constructor you MUST also define a replacement. Otherwise it is undefined. If you define a subroutine as replacement an hashref is passed to this subroutine. This hashref has four keys: - match Scalar. The match of the regular expression. - submatches Arrayref of submatches. - store\_index The next index. You need this if you want to create a placeholder and store the replacement in the $self->{store\_data} arrayref. - opts Hashref of custom options. - modifier (optional) Scalar. The default is 'sm'. - store (optional) Scalar or sub. If you define a subroutine an hashref is passed to this subroutine. This hashref has three keys: - match Scalar. The match of the regular expression. - submatches Arrayref of submatches. - opts Hashref of custom options. A replacement for the regular expression match. It will not replace the match directly. The replacement will be stored in the $self->{store\_data} arrayref. The placeholders in the text can easily be rereplaced with the restore\_stored method later. - restore\_pattern (optional) Scalar or Regexp object. The default restore pattern is qr~\x01(\d+)\x01~ This means, if you use the restore\_stored method it is looking for \\x010\\x01, \\x011\\x01, ... and replaces the matches with $self->{store\_data}->\[0\], $self->{store\_data}->\[1\], ... # EXAMPLES - Example 1 Common usage. #!/usr/bin/perl use strict; use warnings; use Regexp::RegGrp; my $reggrp = Regexp::RegGrp->new( { reggrp => [ { regexp => '%name%', replacement => 'John Doe' }, { regexp => '%company%', replacement => 'ACME' } ] } ); open( INFILE, 'unprocessed.txt' ); open( OUTFILE, '>processed.txt' ); my $txt = join( '', ); $reggrp->exec( \$txt ); print OUTFILE $txt; close(INFILE); close(OUTFILE); - Example 2 A scalar is requested by the context. The input will remain unchanged. #!/usr/bin/perl use strict; use warnings; use Regexp::RegGrp; my $reggrp = Regexp::RegGrp->new( { reggrp => [ { regexp => '%name%', replacement => 'John Doe' }, { regexp => '%company%', replacement => 'ACME' } ] } ); open( INFILE, 'unprocessed.txt' ); open( OUTFILE, '>processed.txt' ); my $unprocessed = join( '', ); my $processed = $reggrp->exec( \$unprocessed ); print OUTFILE $processed; close(INFILE); close(OUTFILE); # AUTHOR Merten Falk, ``. Now maintained by LEEJO # BUGS Please report any bugs or feature requests through the web interface at [http://github.com/leejo/regexp-reggrp-perl/issues](http://github.com/leejo/regexp-reggrp-perl/issues). # SUPPORT You can find documentation for this module with the perldoc command. perldoc Regexp::RegGrp # COPYRIGHT & LICENSE Copyright 2010, 2011 Merten Falk, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Regexp-RegGrp-2.01/lib/000755 000765 000120 00000000000 13075333222 016111 5ustar00leejohnsonadmin000000 000000 Regexp-RegGrp-2.01/t/000755 000765 000120 00000000000 13075333222 015606 5ustar00leejohnsonadmin000000 000000 Regexp-RegGrp-2.01/t/00-load.t000644 000765 000120 00000000301 13075331610 017120 0ustar00leejohnsonadmin000000 000000 #!perl -T use Test::More tests => 2; BEGIN { use_ok( 'Regexp::RegGrp::Data' ); use_ok( 'Regexp::RegGrp' ); } diag( "Testing Regexp::RegGrp $Regexp::RegGrp::VERSION, Perl $], $^X" ); Regexp-RegGrp-2.01/t/01-data.t000644 000765 000120 00000021453 13075331610 017126 0ustar00leejohnsonadmin000000 000000 #!perl -T use Test::More; my $regexp_tests = [ { input => { regexp => '', }, output => undef, message => 'empty regexp' }, { input => { regexp => { regexp => qr/(a)(.+?)(\1)/ }, }, output => undef, message => 'regexp is a hashref' }, { input => { regexp => [ qr/(a)(.+?)(\1)/ ], }, output => undef, message => 'regexp is an arrayref' }, { input => { regexp => qr/(a)(.+?)(\1)/, }, output => { regexp => ( $] < 5.013006 ) ? '(?-xism:(a)(.+?)(\1))' : '(?^:(a)(.+?)(\1))' }, message => 'regexp is a regexp object' }, { input => { regexp => '(a)(.+?)(\1)', }, output => { regexp => '(?sm:(a)(.+?)(\1))' }, message => 'regexp is a scalar' }, { input => { regexp => qr/(a)(.+?)(\1)/, modifier => 's' }, output => { regexp => '(?s:(a)(.+?)(\1))' }, message => 'regexp is a regexp object and modifier is set' }, { input => { regexp => '(a)(.+?)(\1)', modifier => 's' }, output => { regexp => '(?s:(a)(.+?)(\1))' }, message => 'regexp is a scalar and modifier is set' }, ]; my $replacement_tests = [ { input => { regexp => '(a)(.+?)(\1)', }, output => { replacement => undef }, message => 'empty replacement' }, { input => { regexp => '(a)(.+?)(\1)', replacement => [ 'foo' ], }, output => undef, message => 'replacement is an arrayref' }, { input => { regexp => '(a)(.+?)(\1)', replacement => { bar => 'foo' }, }, output => undef, message => 'replacement is a hashref' }, { input => { regexp => '(a)(.+?)(\1)', replacement => 'foo' }, output => { replacement => 'foo' }, message => 'replacement is a scalar' }, { input => { regexp => '(a)(.+?)(\1)', replacement => sub { return 'foo'; } }, output => { replacement => 'foo' }, message => 'replacement is a coderef' }, { input => { regexp => '(a)(.+?)(\1)', replacement => sub { return 'foo'; }, store => 'bar' }, output => { replacement => sprintf( "\x01%d\x01", 1 ) }, message => 'replacement is a coderef and store is set' }, { input => { regexp => '(a)(.+?)(\1)', replacement => sub { return 'foo'; }, store => 'bar', restore_pattern => 'baz' }, output => { replacement => 'foo' }, message => 'replacement is a coderef and store and restore_pattern are set' }, ]; my $store_tests = [ { input => { regexp => '(a)(.+?)(\1)', }, output => { store => undef }, message => 'store is undefined' }, { input => { regexp => '(a)(.+?)(\1)', store => '', }, output => { store => '' }, message => 'store is empty' }, { input => { regexp => '(a)(.+?)(\1)', store => { regexp => qr/(a)(.+?)(\1)/ }, }, output => undef, message => 'store is a hashref' }, { input => { regexp => '(a)(.+?)(\1)', store => [ qr/(a)(.+?)(\1)/ ], }, output => undef, message => 'store is an arrayref' }, { input => { regexp => qr/(a)(.+?)(\1)/, store => sub { return 'foo'; } }, output => { store => 'foo' }, message => 'store is a coderef' }, { input => { regexp => '(a)(.+?)(\1)', store => 'bar' }, output => { store => 'bar' }, message => 'store is a scalar' } ]; my $modifier_tests = [ { input => { regexp => '(a)(.+?)(\1)', modifier => { regexp => qr/(a)(.+?)(\1)/ }, }, output => undef, message => 'modifier is a hashref' }, { input => { regexp => '(a)(.+?)(\1)', modifier => \'xsm', }, output => undef, message => 'modifier is a scalarref' }, { input => { regexp => '(a)(.+?)(\1)', }, output => { regexp => '(?sm:(a)(.+?)(\1))' }, message => 'modifier is undefined and regexp is a scalar' }, { input => { regexp => qr/(a)(.+?)(\1)/, }, output => { regexp => ( $] < 5.013006 ) ? '(?-xism:(a)(.+?)(\1))' : '(?^:(a)(.+?)(\1))' }, message => 'modifier is undefined and regexp is a regexp object' }, ]; my $restore_pattern_tests = [ { input => { regexp => '(a)(.+?)(\1)' }, output => { restore_pattern => ( $] < 5.013006 ) ? '(?-xism:\x01(\d+)\x01)' : '(?^:\x01(\d+)\x01)' }, message => 'restore_pattern is undefined' }, { input => { regexp => '(a)(.+?)(\1)', restore_pattern => { regexp => qr/(a)(.+?)(\1)/ }, }, output => undef, message => 'restore_pattern is a hashref' }, { input => { regexp => '(a)(.+?)(\1)', restore_pattern => [ qr/(a)(.+?)(\1)/ ], }, output => undef, message => 'restore_pattern is an arrayref' }, { input => { regexp => '(a)(.+?)(\1)', restore_pattern => qr/(a)(.+?)(\1)/, }, output => { restore_pattern => ( $] < 5.013006 ) ? '(?-xism:(a)(.+?)(\1))' : '(?^:(a)(.+?)(\1))' }, message => 'restore_pattern is a regexp object' }, { input => { regexp => '(a)(.+?)(\1)', restore_pattern => '(a)(.+?)(\1)', }, output => { restore_pattern => ( $] < 5.013006 ) ? '(?-xism:(a)(.+?)(\1))' : '(?^:(a)(.+?)(\1))' }, message => 'restore_pattern is a scalar' }, ]; SKIP: { my $not = 1; foreach ( @$regexp_tests, @$replacement_tests, @$store_tests, @$modifier_tests, @$restore_pattern_tests ) { $not += 1; $not += scalar( keys( %{$_->{output}} ) ) if ( $_->{output} ); } eval( 'use Regexp::RegGrp::Data' ); skip( 'Regexp::RegGrp::Data not installed!', $not ) if ( $@ ); plan tests => $not; my $data = Regexp::RegGrp::Data->new(); ok( ! $data, 'Regexp::RegGrp::Data->new() without args' ); foreach my $test ( @$regexp_tests, @$store_tests, @$replacement_tests, @$modifier_tests, @$restore_pattern_tests ) { $data = Regexp::RegGrp::Data->new( $test->{input} ); ok( ! ( $data xor $test->{output} ), 'Data object ' . ( $test->{output} ? '' : 'not ' ) . 'created' . ( $test->{message} ? ' - ' . $test->{message} : '' ) ); if ( $test->{output} ) { foreach my $accessor ( keys( %{$test->{output}} ) ) { if ( defined( $test->{output}->{$accessor} ) ) { if ( ref( $data->$accessor() ) eq 'CODE' ) { my $args; $args = { store_index => 1 } if ( $accessor eq 'replacement' ); cmp_ok( $data->$accessor()->( $args ), 'eq', $test->{output}->{$accessor}, 'Field "' . $accessor . '" correctly set' . ( $test->{message} ? ' - ' . $test->{message} : '' ) ); } else { cmp_ok( $data->$accessor(), 'eq', $test->{output}->{$accessor}, 'Field "' . $accessor . '" correctly set' . ( $test->{message} ? ' - ' . $test->{message} : '' ) ); } } else { ok( ! $data->$accessor(), 'Field "' . $accessor . '" correctly set' . ( $test->{message} ? ' - ' . $test->{message} : '' ) ); } } } } } Regexp-RegGrp-2.01/t/02-reggrp.t000644 000765 000120 00000000600 13075331610 017473 0ustar00leejohnsonadmin000000 000000 #!perl -T use Test::More; SKIP: { my $not = 1; eval( 'use Regexp::RegGrp::Data' ); skip( 'Regexp::RegGrp::Data not installed!', $not ) if ( $@ ); eval( 'use Regexp::RegGrp' ); skip( 'Regexp::RegGrp not installed!', $not ) if ( $@ ); plan tests => $not; my $reggrp = Regexp::RegGrp->new(); ok( ! $reggrp, 'Regexp::RegGrp->new() without args' ); }Regexp-RegGrp-2.01/t/03-io.t000644 000765 000120 00000037167 13075331610 016637 0ustar00leejohnsonadmin000000 000000 #!perl -T use Test::More; my $test_data = { testcases => [ { description => 'Simple regexes without replacements', input_string => 'abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz', expected_output => 'abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz', reggrp => [ { regexp => qr/ab/ }, { regexp => qr/yz/ }, { regexp => qr/foo/ } ] }, { description => 'Simple regexes with scalar replacements', input_string => 'abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz', expected_output => 'ABcdefghijklmnopqrstuvwxYZABcdefghijklmnopqrstuvwxYZ', reggrp => [ { regexp => qr/ab/, replacement => 'AB' }, { regexp => qr/yz/, replacement => 'YZ' }, { regexp => qr/foo/, replacement => 'BAR' } ] }, { description => 'Simple regexes with sub replacements I', input_string => 'abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz', expected_output => 'bacdefghijklmnopqrstuvwxyYZbacdefghijklmnopqrstuvwxyYZ', reggrp => [ { regexp => qr/(a)(.)/, replacement => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s", $submatches->[1], $submatches->[0] ); } }, { regexp => qr/((y)z)/, replacement => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s", $submatches->[1], uc( $submatches->[0] ) ); } }, { regexp => qr/f(oo)?/, replacement => sub { my $in_ref = shift; my $match = $in_ref->{match}; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s", $match, $submatches->[0] ); } } ] }, { description => 'Simple regexes with sub replacements II', input_string => 'a1a2a0a1a0a2a3bcde', expected_output => 'a1a2a0a1a0a2a3bcde', reggrp => [ { regexp => qr/(a)(\d)/, replacement => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s", $submatches->[0], $submatches->[1] ); } } ] }, { description => 'Regexes with backreferences 1', input_string => 'abcxyzabcxyz', expected_output => 'bcxyzaAbcxyz', reggrp => [ { regexp => qr/(a)(.+?)(\1)/, replacement => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s%s", $submatches->[1], $submatches->[0], uc( $submatches->[2] ) ); } }, { regexp => qr/((y)z).+(\1)/, replacement => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s", $submatches->[0], uc( $submatches->[1] ) ); } }, { regexp => qr/f(oo)?/, replacement => sub { my $in_ref = shift; my $match = $in_ref->{match}; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s", $match, $submatches->[0] ); } } ] }, { description => 'Regexes with backreferences 2', input_string => 'abcxyzabcxyzabcxyz', expected_output => ( $] < 5.010000 ) ? 'bcxyzaAbcxyzabcxyz' : 'bcxyzaAbcxyzYyz', reggrp => [ { regexp => qr/(a)(.+?)(\1)/, replacement => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s%s", $submatches->[1], $submatches->[0], uc( $submatches->[2] ) ); } }, { regexp => qr/((y)z)(.+)(\g{2})/, replacement => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s%s", $submatches->[0], uc( $submatches->[1] ), $submatches->[3] ); } }, { regexp => qr/f(oo)?/, replacement => sub { my $in_ref = shift; my $match = $in_ref->{match}; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s", $match, $submatches->[0] ); } } ] }, { description => 'Store replacements', input_string => 'abcxyzabcxyzabcxyz', expected_output => "\x01" . '0' . "\x01" . 'bcx' . "\x01" . '1' . "\x01" . 'z', reggrp => [ { regexp => qr/(a)(.+?)(\1)/, store => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s%s", $submatches->[1], $submatches->[0], uc( $submatches->[2] ) ); } }, { regexp => qr/((y)z)(.+)(\2)/, store => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s%s", $submatches->[0], uc( $submatches->[1] ), $submatches->[3] ); } }, { regexp => qr/f(oo)?/, replacement => sub { my $in_ref = shift; my $match = $in_ref->{match}; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s", $match, $submatches->[0] ); } } ] }, { description => 'Restore replacements', input_string => 'abcxyzabcxyzabcxyz', expected_output => 'bcxyzaAbcxyzYyz', test_restore => 1, reggrp => [ { regexp => qr/(a)(.+?)(\1)/, store => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s%s", $submatches->[1], $submatches->[0], uc( $submatches->[2] ) ); } }, { regexp => qr/((y)z)(.+)(\2)/, store => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s%s", $submatches->[0], uc( $submatches->[1] ), $submatches->[3] ); } }, { regexp => qr/f(oo)?/, replacement => sub { my $in_ref = shift; my $match = $in_ref->{match}; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s", $match, $submatches->[0] ); } } ] }, { description => 'Store replacements with custom pattern', input_string => 'abcxyzabcxyzabcxyz', expected_output => '~~0~~bcx~~1~~z', restore_pattern => qr/~~(\d+)~~/, reggrp => [ { regexp => qr/(a)(.+?)(\1)/, replacement => sub { my $in_ref = shift; my $store_index = $in_ref->{store_index}; return sprintf( "~~%d~~", $store_index ); }, store => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s%s", $submatches->[1], $submatches->[0], uc( $submatches->[2] ) ); } }, { regexp => qr/((y)z)(.+)(\2)/, replacement => sub { my $in_ref = shift; my $store_index = $in_ref->{store_index}; return sprintf( "~~%d~~", $store_index ); }, store => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s%s", $submatches->[0], uc( $submatches->[1] ), $submatches->[3] ); } }, { regexp => qr/f(oo)?/, replacement => sub { my $in_ref = shift; my $match = $in_ref->{match}; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s", $match, $submatches->[0] ); } } ] }, { description => 'Restore replacements with custom pattern', input_string => 'abcxyzabcxyzabcxyz', expected_output => 'bcxyzaAbcxyzYyz', restore_pattern => qr/~~(\d+)~~/, test_restore => 1, reggrp => [ { regexp => qr/(a)(.+?)(\1)/, replacement => sub { my $in_ref = shift; my $store_index = $in_ref->{store_index}; return sprintf( "~~%d~~", $store_index ); }, store => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s%s", $submatches->[1], $submatches->[0], uc( $submatches->[2] ) ); } }, { regexp => qr/((y)z)(.+)(\2)/, replacement => sub { my $in_ref = shift; my $store_index = $in_ref->{store_index}; return sprintf( "~~%d~~", $store_index ); }, store => sub { my $in_ref = shift; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s%s", $submatches->[0], uc( $submatches->[1] ), $submatches->[3] ); } }, { regexp => qr/f(oo)?/, replacement => sub { my $in_ref = shift; my $match = $in_ref->{match}; my $submatches = $in_ref->{submatches}; return sprintf( "%s%s", $match, $submatches->[0] ); } } ] }, { description => 'Modifier test 1', input_string => " \n\n\n\t \n a \nb\n c\n\n", expected_output => "\n\n\n\na\nb\nc\n\n", reggrp => [ { regexp => '^[^\S\n]*', replacement => '' }, { regexp => '[^\S\n]$', replacement => '' }, { regexp => 'B', replacement => 'd' } ] }, { description => 'Modifier test 2', input_string => " \n\n\n\t \n a \n\n\nb\n c\n\n", expected_output => "a \n\n\nd\n c", reggrp => [ { regexp => '^\s*', replacement => '', modifier => 's' }, { regexp => '\s*$', replacement => '', modifier => 's' }, { regexp => 'B', replacement => 'd', modifier => 'i' } ] }, { description => 'Zero-length submatch test', input_string => " \n\n\n\t \n a \n\n\nb\n c\n\n", expected_output => "a \n\n\nx\nc", reggrp => [ { regexp => '^\s*', replacement => '', modifier => 's' }, { regexp => '^[^\S\n]*', replacement => '', modifier => 'm' }, { regexp => '\s*$', replacement => '', modifier => 's' }, { regexp => 'b', replacement => 'x' } ] } ] }; SKIP: { my $not = scalar( @{$test_data->{testcases}} ) * 2; eval( 'use Regexp::RegGrp::Data' ); skip( 'Regexp::RegGrp::Data not installed!', $not ) if ( $@ ); eval( 'use Regexp::RegGrp' ); skip( 'Regexp::RegGrp not installed!', $not ) if ( $@ ); plan tests => $not; foreach my $tc ( @{$test_data->{testcases}} ) { my $reggrp = Regexp::RegGrp->new( { reggrp => $tc->{reggrp}, restore_pattern => $tc->{restore_pattern} } ); my $input = $tc->{input_string}; $reggrp->exec( \$input ); if ( $tc->{test_restore} ) { $reggrp->restore_stored( \$input ); } is( $input, $tc->{expected_output}, $tc->{description} . ' - void context' ); $reggrp->flush_stored(); $input = $tc->{input_string}; my $output = $reggrp->exec( \$input ); if ( $tc->{test_restore} ) { $output = $reggrp->restore_stored( \$output ); } is( $output, $tc->{expected_output}, $tc->{description} . ' - scalar context' ); } }Regexp-RegGrp-2.01/t/pod.t000644 000765 000120 00000000350 13075331610 016552 0ustar00leejohnsonadmin000000 000000 #!perl -T use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); Regexp-RegGrp-2.01/lib/Regexp/000755 000765 000120 00000000000 13075333222 017343 5ustar00leejohnsonadmin000000 000000 Regexp-RegGrp-2.01/lib/Regexp/RegGrp/000755 000765 000120 00000000000 13075333222 020531 5ustar00leejohnsonadmin000000 000000 Regexp-RegGrp-2.01/lib/Regexp/RegGrp.pm000644 000765 000120 00000030541 13075332204 021071 0ustar00leejohnsonadmin000000 000000 package Regexp::RegGrp; use 5.008009; use warnings; use strict; use Carp; use Regexp::RegGrp::Data; BEGIN { if ( $] < 5.010000 ) { require re; re->import( 'eval' ); } } use constant { ESCAPE_BRACKETS => qr~(?<])~, ESCAPE_CHARS => qr~\\.~, BRACKETS => qr~\(~, BACK_REF => qr~(?:\\g?(\d\d*)|\\g\{(\d+)\})~ }; # =========================================================================== # our $VERSION = '2.01'; sub new { my ( $class, $in_ref ) = @_; my $self = {}; bless( $self, $class ); if ( ref( $in_ref ) ne 'HASH' ) { carp( 'First argument must be a hashref!' ); return; } unless ( exists( $in_ref->{reggrp} ) ) { carp( 'Key "reggrp" does not exist in input hashref!' ); return; } if ( ref( $in_ref->{reggrp} ) ne 'ARRAY' ) { carp( 'Value for key "reggrp" must be an arrayref!' ); return; } if ( ref( $in_ref->{restore_pattern} ) and ref( $in_ref->{restore_pattern} ) ne 'Regexp' ) { carp( 'Value for key "restore_pattern" must be a scalar or regexp!' ); return; } my $no = 0; map { $no++; my $reggrp_data = Regexp::RegGrp::Data->new( { regexp => $_->{regexp}, replacement => $_->{replacement}, store => $_->{store}, modifier => $_->{modifier}, restore_pattern => $in_ref->{restore_pattern} } ); unless ( $reggrp_data ) { carp( 'RegGrp No ' . $no . ' in arrayref is malformed!' ); return; } $self->reggrp_add( $reggrp_data ); } @{$in_ref->{reggrp}}; my $restore_pattern = $in_ref->{restore_pattern} || qr~\x01(\d+)\x01~; $self->{_restore_pattern} = qr/$restore_pattern/; my $offset = 1; my $midx = 0; # In perl versions < 5.10 hash %+ doesn't exist, so we have to initialize it $self->{_re_str} = ( ( $] < 5.010000 ) ? '(?{ %+ = (); })' : '' ) . join( '|', map { my $re = $_->regexp(); # Count backref brackets $re =~ s/${\(ESCAPE_CHARS)}//g; $re =~ s/${\(ESCAPE_BRACKETS)}//g; my @nparen = $re =~ /${\(BRACKETS)}/g; $re = $_->regexp(); my $backref_pattern = '\\g{%d}'; if ( $] < 5.010000 ) { $backref_pattern = '\\%d'; } $re =~ s/${\(BACK_REF)}/sprintf( $backref_pattern, $offset + ( $1 || $2 ) )/eg; my $ret; if ( $] < 5.010000 ) { # In perl versions < 5.10 we need to fill %+ hash manually # perl 5.8 doesn't reset the %+ hash correctly if there are zero-length submatches # so this is also done here $ret = '(' . $re . ')' . '(?{ %+ = ( \'_' . $midx++ . '\' => $^N ); })'; } else { $ret = '(?\'_' . $midx++ . '\'' . $re . ')'; } $offset += scalar( @nparen ) + 1; $ret; } $self->reggrp_array() ); return $self; } # re_str methods sub re_str { my $self = shift; return $self->{_re_str}; } # /re_str methods # restore_pattern methods sub restore_pattern { my $self = shift; return $self->{_restore_pattern}; } # /restore_pattern methods # store_data methods sub store_data_add { my ( $self, $data ) = @_; push( @{$self->{_store_data}}, $data ); } sub store_data_by_idx { my ( $self, $idx ) = @_; return $self->{_store_data}->[$idx]; } sub store_data_count { my $self = shift; return scalar( @{$self->{_store_data} || []} ); } sub flush_stored { my $self = shift; $self->{_store_data} = []; } # /store_data methods # reggrp methods sub reggrp_add { my ( $self, $reggrp ) = @_; push( @{$self->{_reggrp}}, $reggrp ); } sub reggrp_array { my $self = shift; return @{$self->{_reggrp}}; } sub reggrp_by_idx { my ( $self, $idx ) = @_; return $self->{_reggrp}->[$idx]; } # /reggrp methods sub exec { my ( $self, $input, $opts ) = @_; if ( ref( $input ) ne 'SCALAR' ) { carp( 'First argument in Regexp::RegGrp->exec must be a scalarref!' ); return undef; } $opts ||= {}; if ( ref( $opts ) ne 'HASH' ) { carp( 'Second argument in Regexp::RegGrp->exec must be a hashref!' ); return undef; } my $to_process = \''; my $cont = 'void'; if ( defined( wantarray ) ) { my $tmp_input = ${$input}; $to_process = \$tmp_input; $cont = 'scalar'; } else { $to_process = $input; } ${$to_process} =~ s/${\$self->re_str()}/$self->_process( { match_hash => \%+, opts => $opts } )/eg; # Return a scalar if requested by context return ${$to_process} if ( $cont eq 'scalar' ); } sub _process { my ( $self, $in_ref ) = @_; my %match_hash = %{$in_ref->{match_hash}}; my $opts = $in_ref->{opts}; my $match_key = ( keys( %match_hash ) )[0]; my ( $midx ) = $match_key =~ /^_(\d+)$/; my $match = $match_hash{$match_key}; my $reggrp = $self->reggrp_by_idx( $midx ); my @submatches = $match =~ $reggrp->regexp(); map { $_ .= ''; } @submatches; my $ret = $match; my $replacement = $reggrp->replacement(); if ( defined( $replacement ) and not ref( $replacement ) ) { $ret = $replacement; } elsif ( ref( $replacement ) eq 'CODE' ) { $ret = $replacement->( { match => $match, submatches => \@submatches, opts => $opts, store_index => $self->store_data_count() } ); } my $store = $reggrp->store(); if ( $store ) { my $tmp_match = $match; if ( not ref( $store ) ) { $tmp_match = $store; } elsif ( ref( $store ) eq 'CODE' ) { $tmp_match = $store->( { match => $match, submatches => \@submatches, opts => $opts } ); } $self->store_data_add( $tmp_match ); } return $ret; }; sub restore_stored { my ( $self, $input ) = @_; if ( ref( $input ) ne 'SCALAR' ) { carp( 'First argument in Regexp::RegGrp->restore must be a scalarref!' ); return undef; } my $to_process = \''; my $cont = 'void'; if ( defined( wantarray ) ) { my $tmp_input = ${$input}; $to_process = \$tmp_input; $cont = 'scalar'; } else { $to_process = $input; } # Here is a while loop, because there could be recursive replacements while ( ${$to_process} =~ /${\$self->restore_pattern()}/ ) { ${$to_process} =~ s/${\$self->restore_pattern()}/$self->store_data_by_idx( $1 )/egsm; } $self->flush_stored(); # Return a scalar if requested by context return ${$to_process} if ( $cont eq 'scalar' ); } 1; __END__ =head1 NAME Regexp::RegGrp - Groups a regular expressions collection =for html Build Status Coverage Status =head1 VERSION Version 2.00 =head1 DESCRIPTION Groups regular expressions to one regular expression =head1 SYNOPSIS use Regexp::RegGrp; my $reggrp = Regexp::RegGrp->new( { reggrp => [ { regexp => '%name%', replacement => 'John Doe', modifier => $modifier }, { regexp => '%company%', replacement => 'ACME', modifier => $modifier } ], restore_pattern => $restore_pattern } ); $reggrp->exec( \$scalar ); To return a scalar without changing the input simply use (e.g. example 2): my $ret = $reggrp->exec( \$scalar ); The first argument must be a hashref. The keys are: =over 4 =item reggrp (required) Arrayref of hashrefs. The keys of each hashref are: =over 8 =item regexp (required) A regular expression =item replacement (optional) Scalar or sub. A replacement for the regular expression match. If not set, nothing will be replaced except "store" is set. In this case the match is replaced by something like sprintf("\x01%d\x01", $idx) where $idx is the index of the stored element in the store_data arrayref. If "store" is set the default is: sub { return sprintf( "\x01%d\x01", $_[0]->{store_index} ); } If a custom restore_pattern is passed to to constructor you MUST also define a replacement. Otherwise it is undefined. If you define a subroutine as replacement an hashref is passed to this subroutine. This hashref has four keys: =over 12 =item match Scalar. The match of the regular expression. =item submatches Arrayref of submatches. =item store_index The next index. You need this if you want to create a placeholder and store the replacement in the $self->{store_data} arrayref. =item opts Hashref of custom options. =back =item modifier (optional) Scalar. The default is 'sm'. =item store (optional) Scalar or sub. If you define a subroutine an hashref is passed to this subroutine. This hashref has three keys: =over 12 =item match Scalar. The match of the regular expression. =item submatches Arrayref of submatches. =item opts Hashref of custom options. =back A replacement for the regular expression match. It will not replace the match directly. The replacement will be stored in the $self->{store_data} arrayref. The placeholders in the text can easily be rereplaced with the restore_stored method later. =back =item restore_pattern (optional) Scalar or Regexp object. The default restore pattern is qr~\x01(\d+)\x01~ This means, if you use the restore_stored method it is looking for \x010\x01, \x011\x01, ... and replaces the matches with $self->{store_data}->[0], $self->{store_data}->[1], ... =back =head1 EXAMPLES =over 4 =item Example 1 Common usage. #!/usr/bin/perl use strict; use warnings; use Regexp::RegGrp; my $reggrp = Regexp::RegGrp->new( { reggrp => [ { regexp => '%name%', replacement => 'John Doe' }, { regexp => '%company%', replacement => 'ACME' } ] } ); open( INFILE, 'unprocessed.txt' ); open( OUTFILE, '>processed.txt' ); my $txt = join( '', ); $reggrp->exec( \$txt ); print OUTFILE $txt; close(INFILE); close(OUTFILE); =item Example 2 A scalar is requested by the context. The input will remain unchanged. #!/usr/bin/perl use strict; use warnings; use Regexp::RegGrp; my $reggrp = Regexp::RegGrp->new( { reggrp => [ { regexp => '%name%', replacement => 'John Doe' }, { regexp => '%company%', replacement => 'ACME' } ] } ); open( INFILE, 'unprocessed.txt' ); open( OUTFILE, '>processed.txt' ); my $unprocessed = join( '', ); my $processed = $reggrp->exec( \$unprocessed ); print OUTFILE $processed; close(INFILE); close(OUTFILE); =back =head1 AUTHOR Merten Falk, C<< >>. Now maintained by LEEJO =head1 BUGS Please report any bugs or feature requests through the web interface at L. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Regexp::RegGrp =head1 COPYRIGHT & LICENSE Copyright 2010, 2011 Merten Falk, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Regexp-RegGrp-2.01/lib/Regexp/RegGrp/Data.pm000644 000765 000120 00000004655 13075331610 021751 0ustar00leejohnsonadmin000000 000000 package Regexp::RegGrp::Data; use 5.008009; use warnings; use strict; use Carp; our @ACCESSORS = ( 'regexp', 'replacement', 'store', 'restore_pattern' ); ########################################################################################## { no strict 'refs'; foreach my $field ( @ACCESSORS ) { next if defined *{'Regexp::RegGrp::Data::' . $field}{CODE}; *{'Regexp::RegGrp::Data::' . $field} = sub { my $self = shift; return $self->{'_' . $field}; }; } } sub new { my ( $class, $in_ref ) = @_; my $self = {}; bless( $self, $class ); unless ( $in_ref->{regexp} ) { carp( 'Value for key "regexp" must be a scalar or a regexp object!' ); return; } foreach my $accessor ( @ACCESSORS ) { if ( $accessor eq 'regexp' || $accessor eq 'restore_pattern' ) { if ( ref( $in_ref->{$accessor} ) and ref( $in_ref->{$accessor} ) ne 'Regexp' ) { carp( 'Value for key "' . $accessor . '" must be a scalar or a regexp object!' ); return; } } elsif ( $accessor eq 'replacement' || $accessor eq 'store' ) { if ( ref( $in_ref->{$accessor} ) and ref( $in_ref->{$accessor} ) ne 'CODE' ) { carp( 'Value for key "' . $accessor . '" must be a scalar or a code reference!' ); return; } } } if ( ref( $in_ref->{modifier} ) ) { carp( 'Value for key "modifier" must be a scalar!' ); return; } $self->{_regexp} = $in_ref->{regexp}; $self->{_replacement} = defined( $in_ref->{store} ) ? ( $in_ref->{restore_pattern} ? $in_ref->{replacement} : sub { return sprintf( "\x01%d\x01", $_[0]->{store_index} ); } ) : $in_ref->{replacement}; $self->{_store} = $in_ref->{store}; if ( defined( $in_ref->{modifier} ) || ! ref( $in_ref->{regexp} ) ) { my $modifier = defined( $in_ref->{modifier} ) ? $in_ref->{modifier} : 'sm'; $self->{_regexp} =~ s/^\(\?[\^dlupimsx-]+:(.*)\)$/$1/si; $self->{_regexp} = sprintf( '(?%s:%s)', $modifier, $self->{_regexp} ); } my $restore_pattern = $in_ref->{restore_pattern} || qr~\x01(\d+)\x01~; $self->{_restore_pattern} = qr/$restore_pattern/; return $self; } 1;