libs/Data/Filter.pm

## ------------------------------------------------------------------------
##  $Id: Filter.pm,v 1.1 2002/12/22 14:19:17 joko Exp $
## ------------------------------------------------------------------------
##  $Log: Filter.pm,v $
##  Revision 1.1  2002/12/22 14:19:17  joko
##  + initial check-in
##
## ------------------------------------------------------------------------


package Data::Filter;

use strict;
use warnings;

use base 'DesignPattern::Object::Logger';


use Data::Dumper;

use Regexp::Group;
use libp qw( mkObject );
use Data::Compare::Struct qw( isEmpty );

# ------------    common perl object constructor    ------------
sub new {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;
  my @args = ();
  @_ && (@args = @_);
  #$logger->debug( __PACKAGE__ . "->new( @args )" );      # this is not "common"!
  my $self = { @_ };
  bless $self, $class;
  $self->{caller} = caller;
  
  #print Dumper(caller(2));
  #exit;
  
  $self->_init();
  return $self;
}  

sub _init {
  my $self = shift;
  
  # try to load filter-declaration from configuration scope inside perl-module (yes - it's already abstracted out there!)
  $self->{declaration} = mkObject($self->{module});
#print Dumper($self->{declaration});
  

  # the regexp-object which does the hard work for us ;-)
  $self->{regexp} = Regexp::Group->new(
    'data' => \$self->{data},   # reference ...
    #'data' => $self->{data},   # ... or not?
    'metadata' => $self->{declaration}->metadata(),
    'patterns' => $self->{declaration}->patterns(),
    'coderefs' => $self->{declaration}->coderefs(),
    'verbose' => 1,
  );
  
}

sub run {
  my $self = shift;
  my $steps = shift;
  my $coderef = shift;

        #print "cb: $coderef", "\n";
  
  my $result = $self->{regexp}->scan($steps, $coderef);

  # configure tracing
    # respects additional trace-options passed to _trace-method
    $self->{TRACE_OPTIONS} = 1;
    # disables _any_ tracing - even if sub-conditions evaluate to true values
    $self->{TRACE_DISABLED} = 0;
  
  # trace the result
  # cute:  ;-)
  #$self->trace('matches after Regexp::Group->scan', $self->{regexp}->getMatches(), 1, undef, { tag => '', exit => 0 });
  #$self->trace('results after Regexp::Group->scan', $self->{regexp}->getResults(), 1, undef, { tag => '', exit => 0 });
  
  return $result;
}

sub index {
  my $self = shift;
  my $steps = shift;
  
  # configure tracing
    # respects additional trace-options passed to _trace-method
    $self->{TRACE_OPTIONS} = 1;
    # disables _any_ tracing - even if sub-conditions evaluate to true values
    $self->{TRACE_DISABLED} = 0;
  
  # trace the result
  # cute:  ;-)
  #$self->trace('matches after Regexp::Group->scan', $self->{regexp}->getMatches(), 1, undef, { tag => '', exit => 0 });
  #$self->trace('results after Regexp::Group->scan', $self->{regexp}->getResults(), 1, undef, { tag => '', exit => 0 });
  
  my $result = $self->{regexp}->scan($steps);


  return $result;
}

sub continue {
  my $self = shift;
  my $scankey = shift;
  my $result = $self->{regexp}->continue($scankey);
}

sub getResults {
  my $self = shift;
  return $self->{regexp}->{result};
}

sub getResultCount {
  my $self = shift;
  #my $count = ($#{$self->{regexp}->{result}} == -1 ? 0 : $#{$self->{regexp}->{result}});
  #$count++;

  
  my $matches = $self->{regexp}->getMatches();
  return if isEmpty($matches);
  
  my $count = $#{$matches};
  $count++;
  return $count;
}

1;
1	joko	1.1	## ------------------------------------------------------------------------
2	joko	1.2	## $Id: Filter.pm,v 1.1 2002/12/22 14:19:17 joko Exp $
3	joko	1.1	## ------------------------------------------------------------------------
4	joko	1.2	## $Log: Filter.pm,v $
5			## Revision 1.1 2002/12/22 14:19:17 joko
6			## + initial check-in
7			##
8	joko	1.1	## ------------------------------------------------------------------------
9
10
11			package Data::Filter;
12
13			use strict;
14			use warnings;
15
16			use base 'DesignPattern::Object::Logger';
17
18
19			use Data::Dumper;
20
21			use Regexp::Group;
22			use libp qw( mkObject );
23			use Data::Compare::Struct qw( isEmpty );
24
25			# ------------ common perl object constructor ------------
26			sub new {
27			my $invocant = shift;
28			my $class = ref($invocant) \|\| $invocant;
29			my @args = ();
30			@_ && (@args = @_);
31			#$logger->debug( __PACKAGE__ . "->new( @args )" ); # this is not "common"!
32			my $self = { @_ };
33			bless $self, $class;
34			$self->{caller} = caller;
35
36			#print Dumper(caller(2));
37			#exit;
38
39			$self->_init();
40			return $self;
41			}
42
43			sub _init {
44			my $self = shift;
45
46			# try to load filter-declaration from configuration scope inside perl-module (yes - it's already abstracted out there!)
47			$self->{declaration} = mkObject($self->{module});
48			#print Dumper($self->{declaration});
49
50
51			# the regexp-object which does the hard work for us ;-)
52			$self->{regexp} = Regexp::Group->new(
53			'data' => \$self->{data}, # reference ...
54			#'data' => $self->{data}, # ... or not?
55			'metadata' => $self->{declaration}->metadata(),
56			'patterns' => $self->{declaration}->patterns(),
57			'coderefs' => $self->{declaration}->coderefs(),
58			'verbose' => 1,
59			);
60
61			}
62
63			sub run {
64			my $self = shift;
65			my $steps = shift;
66			my $coderef = shift;
67
68			#print "cb: $coderef", "\n";
69
70			my $result = $self->{regexp}->scan($steps, $coderef);
71
72			# configure tracing
73			# respects additional trace-options passed to _trace-method
74			$self->{TRACE_OPTIONS} = 1;
75			# disables _any_ tracing - even if sub-conditions evaluate to true values
76			$self->{TRACE_DISABLED} = 0;
77
78			# trace the result
79			# cute: ;-)
80			#$self->trace('matches after Regexp::Group->scan', $self->{regexp}->getMatches(), 1, undef, { tag => '', exit => 0 });
81			#$self->trace('results after Regexp::Group->scan', $self->{regexp}->getResults(), 1, undef, { tag => '', exit => 0 });
82
83			return $result;
84			}
85
86			sub index {
87			my $self = shift;
88			my $steps = shift;
89
90			# configure tracing
91			# respects additional trace-options passed to _trace-method
92			$self->{TRACE_OPTIONS} = 1;
93			# disables _any_ tracing - even if sub-conditions evaluate to true values
94			$self->{TRACE_DISABLED} = 0;
95
96			# trace the result
97			# cute: ;-)
98			#$self->trace('matches after Regexp::Group->scan', $self->{regexp}->getMatches(), 1, undef, { tag => '', exit => 0 });
99			#$self->trace('results after Regexp::Group->scan', $self->{regexp}->getResults(), 1, undef, { tag => '', exit => 0 });
100
101			my $result = $self->{regexp}->scan($steps);
102
103
104			return $result;
105			}
106
107			sub continue {
108			my $self = shift;
109			my $scankey = shift;
110			my $result = $self->{regexp}->continue($scankey);
111			}
112
113			sub getResults {
114			my $self = shift;
115			return $self->{regexp}->{result};
116			}
117
118			sub getResultCount {
119			my $self = shift;
120			#my $count = ($#{$self->{regexp}->{result}} == -1 ? 0 : $#{$self->{regexp}->{result}});
121			#$count++;
122
123
124			my $matches = $self->{regexp}->getMatches();
125			return if isEmpty($matches);
126
127			my $count = $#{$matches};
128			$count++;
129			return $count;
130			}
131
132			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26