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	## ------------------------------------------------------------------------
2	## $Id: Filter.pm,v 1.1 2002/12/22 14:19:17 joko Exp $
3	## ------------------------------------------------------------------------
4	## $Log: Filter.pm,v $
5	## Revision 1.1 2002/12/22 14:19:17 joko
6	## + initial check-in
7	##
8	## ------------------------------------------------------------------------
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