libs/Data/Filter.pm

## ------------------------------------------------------------------------
##  $Id$
## ------------------------------------------------------------------------
##  $Log$
## ------------------------------------------------------------------------


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