package IDZebra::Filter;
use IDZebra;
use IDZebra::Data1;
+use IDZebra::Logger qw(:flags :calls);
+use Symbol qw(gensym);
+#use Devel::Leak;
+
+our $SAFE_MODE = 1;
BEGIN {
IDZebra::init(); # ??? Do we need that at all (this is jus nmem init...)
# -----------------------------------------------------------------------------
sub _process {
my ($self) = @_;
+
+# if ($self->{dl}) {
+# print STDERR "LEAK",Devel::Leak::CheckSV($self->{dl}),"\n";
+# }
+
+# print STDERR "LEAK",Devel::Leak::NoteSV($self->{dl}),"\n";
+
# This is ugly... could be passed as parameters... but didn't work.
# I don't know why...
my $dh = IDZebra::grs_perl_get_dh($self->{context});
my $mem = IDZebra::grs_perl_get_mem($self->{context});
my $d1 = IDZebra::Data1->get($dh,$mem);
- my $rootnode = $self->process($d1);
+ my $rootnode;
+ if ($SAFE_MODE) {
+ eval {$rootnode = $self->process($d1)};
+ if ($@) {
+ logf(LOG_WARN,"Error processing perl filter:%s\n",$@);
+ }
+ } else {
+ $rootnode = $self->process($d1);
+ }
IDZebra::grs_perl_set_res($self->{context},$rootnode);
return (0);
}
sub test {
my ($proto, $file, %args) = @_;
-# print "Proto:$proto\n";
-
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
}
}
+sub readline {
+ my ($self) = @_;
+
+ my $r = IDZebra::grs_perl_readline($self->{context});
+ if ($r > 0) {
+ my $buff = $self->{_buff};
+ $self->{_buff} = undef;
+ return ($buff);
+ }
+ return (undef);
+}
+
+sub getc {
+ my ($self) = @_;
+ return(IDZebra::grs_perl_getc($self->{context}));
+}
+
+sub get_fh {
+ my ($self) = @_;
+ if ($self->{testh}) {
+ return ($self->{testh});
+ } else {
+ my $fh = gensym;
+ tie (*$fh,'IDZebra::FilterFile', $self);
+ return ($fh);
+ }
+}
+
sub readall {
my ($self, $buffsize) = @_;
my $r;
IDZebra::grs_perl_endf($self->{context},$offset);
}
}
+# ----------------------------------------------------------------------------
+# The 'virtual' filehandle for zebra extract calls
+# ----------------------------------------------------------------------------
+package IDZebra::FilterFile;
+require Tie::Handle;
+
+our @ISA = qw(Tie::Handle);
+
+sub TIEHANDLE {
+ my $class = shift;
+ my $self = {};
+ bless ($self, $class);
+ $self->{filter} = shift;
+ return ($self);
+}
+
+sub READ {
+ my $self = shift;
+ return ($self->{filter}->readf(@_));
+}
+
+sub READLINE {
+ my $self = shift;
+ return ($self->{filter}->readline());
+}
+
+sub GETC {
+ my $self = shift;
+ return ($self->{filter}->getc());
+}
+
+sub EOF {
+ croak ("EOF not implemented");
+}
+
+sub TELL {
+ croak ("TELL not implemented");
+}
+
+sub SEEK {
+ croak ("SEEK not implemented");
+}
+
+sub CLOSE {
+ my $self = shift;
+}
+
__END__
In order to get the input stream, you can use "virtual" file operators (as the source is not necessairly a file):
-=item readf($buf,$len,$offset)
+=over 4
+
+=item B<readf($buf,$len,$offset)>
Going to read $len bytes of data from offset $offset into $buff
-=item readall($bufflen)
+=item B<readline()>
+
+Read one line
+
+=item B<getc()>
+
+Get one character (byte)
+
+=item B<readall($bufflen)>
Read the entire stream, by reading $bufflen bytes at once
-=item seekf($offset)
+=item B<seekf($offset)>
Position to $offset
-=item tellf
+=item B<tellf()>
Tells the current offset (?)
-=item endf($offset)
+=item B<endf($offset)>
???
-Optionally, you can implement an init call for your class. This call is not going to be called in object, but in class context. Stupid, eh?
+=back
+
+You can optionally get a virtual perl filehandle as well:
+
+ my $fh = $self->get_fh();
+ while (<$fh>) {
+ # ...
+ }
+
+Note, that the virtual filehandle implementation is not finished yet, so some applications may have problems using that. See TODO.
+
+You can implement an init call for your class. This call is not going to be called in object, but in class context. Stupid, eh?
=head1 TEST YOUR PERL FILTER
This is quite simple. Read the Zebra manual, and follow the instructions to create your zebra.cfg. For your I<recordType> choose 'grs.perl.<YourFilterClass>'.
Copy your filter module (YourFilterClass.pm) to a directory listed in I<profilePath>. i<profilePath> is added to @INC, when interpreting your package: so if you need to load modules from different locations than the default perl include path, just add these directories.
+=head1 MISC OPTIONS
+
+By default, filter code (process method) is executed within an eval {} block, and only a warning is sent to the log, if there is an error. To turn this option off, set B<$IDZebra::Filter::SAFE_MODE> to B<0>;
+
+=head1 TODO
+
+Finish virtual (tied) filehandle methods (SEEK, EOF, TELL);
+
=head1 COPYRIGHT
Fill in