2 |
## $Id$ |
## $Id$ |
3 |
## ------------------------------------------------------------------------ |
## ------------------------------------------------------------------------ |
4 |
## $Log$ |
## $Log$ |
5 |
|
## Revision 1.5 2003/05/13 07:45:21 joko |
6 |
|
## now returns report |
7 |
|
## |
8 |
|
## Revision 1.4 2003/03/27 15:31:03 joko |
9 |
|
## fixes to modules regarding new namespace(s) below Data::Mungle::* |
10 |
|
## |
11 |
|
## Revision 1.3 2003/02/20 18:56:41 joko |
12 |
|
## renamed modules |
13 |
|
## |
14 |
|
## Revision 1.2 2003/02/09 04:53:23 joko |
15 |
|
## + object creation done via new mechanism |
16 |
|
## |
17 |
## Revision 1.1 2002/12/23 04:22:22 joko |
## Revision 1.1 2002/12/23 04:22:22 joko |
18 |
## + refactored from Data::Filter |
## + refactored from Data::Filter |
19 |
## |
## |
28 |
use strict; |
use strict; |
29 |
use warnings; |
use warnings; |
30 |
|
|
31 |
use base 'DesignPattern::Object::Logger'; |
use base qw( DesignPattern::Logger ); |
32 |
|
|
33 |
|
|
34 |
use Data::Dumper; |
use Data::Dumper; |
35 |
|
|
36 |
use Regexp::Group; |
use Regexp::Group; |
37 |
use libp qw( mkObject ); |
use DesignPattern::Object; |
38 |
use Data::Compare::Struct qw( isEmpty ); |
use Data::Mungle::Compare::Struct qw( isEmpty ); |
39 |
|
|
40 |
# ------------ common perl object constructor ------------ |
# ------------ common perl object constructor ------------ |
41 |
sub new { |
sub new { |
59 |
my $self = shift; |
my $self = shift; |
60 |
|
|
61 |
# try to load filter-declaration from configuration scope inside perl-module (yes - it's already abstracted out there!) |
# try to load filter-declaration from configuration scope inside perl-module (yes - it's already abstracted out there!) |
62 |
$self->{declaration} = mkObject($self->{module}); |
$self->{declaration} = DesignPattern::Object->fromPackage($self->{module}); |
63 |
#print Dumper($self->{declaration}); |
#print Dumper($self->{declaration}); |
|
|
|
64 |
|
|
65 |
# the regexp-object which does the hard work for us ;-) |
# the regexp-object which does the hard work for us ;-) |
66 |
$self->{regexp} = Regexp::Group->new( |
$self->{regexp} = Regexp::Group->new( |
70 |
'patterns' => $self->{declaration}->patterns(), |
'patterns' => $self->{declaration}->patterns(), |
71 |
'coderefs' => $self->{declaration}->coderefs(), |
'coderefs' => $self->{declaration}->coderefs(), |
72 |
'verbose' => 1, |
'verbose' => 1, |
73 |
|
'LOG_VERBOSE' => 0, |
74 |
); |
); |
75 |
|
|
76 |
} |
} |
82 |
|
|
83 |
#print "cb: $coderef", "\n"; |
#print "cb: $coderef", "\n"; |
84 |
|
|
85 |
my $result = $self->{regexp}->scan($steps, $coderef); |
$self->{regexp}->scan($steps, $coderef); |
86 |
|
|
87 |
# configure tracing |
# configure tracing |
88 |
# respects additional trace-options passed to _trace-method |
# respects additional trace-options passed to _trace-method |
95 |
#$self->trace('matches after Regexp::Group->scan', $self->{regexp}->getMatches(), 1, undef, { tag => '', exit => 0 }); |
#$self->trace('matches after Regexp::Group->scan', $self->{regexp}->getMatches(), 1, undef, { tag => '', exit => 0 }); |
96 |
#$self->trace('results after Regexp::Group->scan', $self->{regexp}->getResults(), 1, undef, { tag => '', exit => 0 }); |
#$self->trace('results after Regexp::Group->scan', $self->{regexp}->getResults(), 1, undef, { tag => '', exit => 0 }); |
97 |
|
|
98 |
return $result; |
return $self->{regexp}->get_report(); |
99 |
} |
} |
100 |
|
|
101 |
sub index { |
sub index { |