File Coverage

blib/lib/Data/SearchReplace.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	33	38	86.8
condition	14	16	87.5
subroutine	7	7	100.0
pod	0	2	0.0
total	90	99	90.9

package Data::SearchReplace;

use 5.006;
use strict;
#use warnings;
#use Data::Dumper;
require Exporter;

our @ISA = qw(Exporter);

our @EXPORT_OK = ( 'sr' );

our $VERSION = '1.02';

# CVS stuff
our $date = '$Date: 2007/04/26 09:37:11 $';
our $author = '$Author: steve $';
our $version = '$Revision: 1.02 $';

sub new { bless $_[1] || {}, $_[0] }

{
  my $_counter = 0;
  sub sr {
      my $class = _is_package($_[0]) ? shift : Data::SearchReplace->new();

      # we reset our counter if the caller doesn't come from us...
      # if you decide to override the private functions _array and _hash
      # in your own modules you might want to rethink this...
      $_counter = 0 if ((caller())[0] ne 'Data::SearchReplace');

      my $attrib = defined($_[1]) ? shift : {};
      my $var = shift;

      # what action are we taking?
      #  (input to this function overrides class values)
      my $action = 'SEARCH';
         $action = 'REGEX' if (defined $attrib->{REGEX} &&
			       length($attrib->{REGEX}) );
         $action = 'FUNCT' if (defined $attrib->{CODE}  &&
			       length($attrib->{CODE})  );

      # did they setup their vars in class?
        $attrib->{$_} ||= $class->{$_} || ''
		  for (qw(SEARCH REPLACE REGEX CODE));

      if (ref($var) eq 'HASH') {
         _hash($class, $attrib, $var);
      }elsif (ref($var) eq 'ARRAY') {
         _array($class, $attrib, $var);
      }elsif (ref($var) eq 'SCALAR') {
	 if ($action eq 'SEARCH') {
            ++$_counter if ($$var =~ s/$attrib->{SEARCH}/$attrib->{REPLACE}/g);
	 }elsif ($action eq 'REGEX') {
	    eval '++$_counter if ($$var =~ '.$attrib->{REGEX}.')';
		 warn $@ if $@;
	 }elsif ($action eq 'FUNCT') {
	    my $oldvar = $var;
	    $$var = $attrib->{CODE}->($$oldvar);
	    ++$_counter unless $$oldvar eq $$var;
	 }
      }elsif (ref($var)){
	 return; # something we can't handle
      }

  return $_counter;
  }
}

sub _hash { sr($_[0], $_[1], ref($_[2]->{$_}) ? $_[2]->{$_} : \$_[2]->{$_}) for (keys %{$_[2]}) }

sub _array { sr($_[0], $_[1], ref($_) ? $_ : \$_) for (@{$_[2]}) }

sub _is_package {
    return unless (defined($_[0]) && ref($_[0]));

    for (qw(SCALAR HASH ARRAY REF GLOB CODE)) {
	next unless (ref($_[0]) eq $_);
	return;
    }

return 1; # made it through the tests so we assume it's a package
}

1;
__END__