1package Regexp::RegGrp::Data; 2 3use 5.008009; 4use warnings; 5use strict; 6use Carp; 7 8our @ACCESSORS = ( 'regexp', 'replacement', 'store', 'restore_pattern' ); 9 10########################################################################################## 11 12{ 13 no strict 'refs'; 14 15 foreach my $field ( @ACCESSORS ) { 16 next if defined *{'Regexp::RegGrp::Data::' . $field}{CODE}; 17 18 *{'Regexp::RegGrp::Data::' . $field} = sub { 19 my $self = shift; 20 21 return $self->{'_' . $field}; 22 }; 23 } 24} 25 26sub new { 27 my ( $class, $in_ref ) = @_; 28 my $self = {}; 29 30 bless( $self, $class ); 31 32 unless ( $in_ref->{regexp} ) { 33 carp( 'Value for key "regexp" must be a scalar or a regexp object!' ); 34 return; 35 } 36 37 foreach my $accessor ( @ACCESSORS ) { 38 if ( $accessor eq 'regexp' || $accessor eq 'restore_pattern' ) { 39 if ( 40 ref( $in_ref->{$accessor} ) and 41 ref( $in_ref->{$accessor} ) ne 'Regexp' 42 ) { 43 carp( 'Value for key "' . $accessor . '" must be a scalar or a regexp object!' ); 44 return; 45 } 46 } 47 elsif ( $accessor eq 'replacement' || $accessor eq 'store' ) { 48 if ( 49 ref( $in_ref->{$accessor} ) and 50 ref( $in_ref->{$accessor} ) ne 'CODE' 51 ) { 52 carp( 'Value for key "' . $accessor . '" must be a scalar or a code reference!' ); 53 return; 54 } 55 } 56 } 57 58 if ( ref( $in_ref->{modifier} ) ) { 59 carp( 'Value for key "modifier" must be a scalar!' ); 60 return; 61 } 62 63 $self->{_regexp} = $in_ref->{regexp}; 64 $self->{_replacement} = defined( $in_ref->{store} ) ? ( 65 $in_ref->{restore_pattern} ? $in_ref->{replacement} : sub { 66 return sprintf( "\x01%d\x01", $_[0]->{store_index} ); 67 } 68 ) : $in_ref->{replacement}; 69 $self->{_store} = $in_ref->{store}; 70 71 if ( defined( $in_ref->{modifier} ) || ! ref( $in_ref->{regexp} ) ) { 72 my $modifier = defined( $in_ref->{modifier} ) ? $in_ref->{modifier} : 'sm'; 73 74 $self->{_regexp} =~ s/^\(\?[\^dlupimsx-]+:(.*)\)$/$1/si; 75 $self->{_regexp} = sprintf( '(?%s:%s)', $modifier, $self->{_regexp} ); 76 } 77 78 my $restore_pattern = $in_ref->{restore_pattern} || qr~\x01(\d+)\x01~; 79 $self->{_restore_pattern} = qr/$restore_pattern/; 80 81 return $self; 82} 83 841;