1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202
|
#!/usr/local/bin/perl -w
# POD docs at end
use strict;
use Data::Stag qw(:all);
use Getopt::Long;
use FileHandle;
my $exec;
my $codefile;
my $parser = '';
my $errhandler = "";
my $errf;
my $writer = '';
my %trap = ();
my $datafmt;
my $module;
my @units;
GetOptions("codefile|c=s"=>\$codefile,
"sub|s=s"=>\$exec,
"trap|t=s%"=>\%trap,
"parser|format|p=s" => \$parser,
"errhandler=s" => \$errhandler,
"errf|e=s" => \$errf,
"writer|w=s"=>\$writer,
"data|d=s"=>\$datafmt,
"module|m=s"=>\$module,
"units|u=s@"=>\@units,
"help|h"=>sub {system("perldoc $0");exit 0},
);
if (!$codefile && !$exec && !$module) {
$codefile = shift @ARGV if (@ARGV > 1);
die "you must supply -c or -m or -s, or provide codefile"
unless $codefile;
}
my @files = @ARGV;
$errhandler = Data::Stag->getformathandler($errhandler || 'xml');
if ($errf) {
$errhandler->file($errf);
}
else {
$errhandler->fh(\*STDERR);
}
my $catch = {};
no strict;
if ($exec) {
$catch = eval $exec;
if ($@) {
die $@;
}
if (ref($catch) ne 'HASH') {
print STDERR "exec \"$exec\" is not a hash";
exit 1;
}
}
if ($codefile) {
$catch = do "$codefile";
if ($@) {
print STDERR "\n\nstag-handle error:\n";
print STDERR "There was an error with the codefile \"$codefile\":\n\n";
die $@;
}
if (ref($catch) ne 'HASH') {
print STDERR "codefile \"$codefile\" does not return a hash";
exit 1;
}
}
if (%trap) {
#
# die Dumper \%trap;
%$catch = (%$catch, %trap);
}
use strict;
my @events;
my $inner_handler;
if ($module) {
$inner_handler = Data::Stag->makehandler($module);
} else {
my $meth = $exec ? $exec : $codefile;
if (!%$catch) {
die "method \"$meth\" did not return handler";
}
if (!ref($catch) || ref($catch) ne "HASH") {
die("$meth must return hashref");
}
$inner_handler = Data::Stag->makehandler(%$catch);
@events = keys %$catch;
}
if (@units) {
@events = @units;
}
$inner_handler->errhandler($errhandler);
my $h = Data::Stag->chainhandlers([@events],
$inner_handler,
$writer);
while (my $fn = shift @files) {
my $fh;
if (!$fn || $fn eq '-') {
$fh = \*STDIN;
$fn = '';
}
else {
$fh = FileHandle->new($fn) || die "Cannot open file: $fn";
}
my $p = Data::Stag->parser(-file=>$fn, -format=>$parser,
-errhandler=>$errhandler);
$p->handler($h);
$p->parse_fh($fh);
if ($datafmt) {
print $inner_handler->stag->$datafmt();
}
}
__END__
=head1 NAME
stag-handle - streams a stag file through a handler into a writer
=head1 SYNOPSIS
stag-handle -w itext -c my-handler.pl myfile.xml > processed.itext
stag-handle -w itext -p My::Parser -m My::Handler myfile.xml > processed.itext
=head1 DESCRIPTION
will take a Stag compatible format (xml, sxpr or itext), turn the data
into an event stream passing it through my-handler.pl
=head1 ARGUMENTS
=over
=item -help|h
shows this document
=item -module|m PERLMODULE
A module that is used to transform the input events
the module should inherit from L<Data::Stag::BaseHandler>
=item -unit|u NODE_NAME
(you should always use this option if you specify -m)
this is the unit that gets passed to the handler/transformer. this
will get set automatically if you use the the -c, -s or -t options
multiple units can be set
-u foo -u bar -u boz
=item -writer|w WRITER
writer for final transformed tree; can be xml, sxpr or itext
=item -module|m MODULE
perl modules for handling events
=item -codefile|c FILE
a file containing a perlhashref containing event handlers - see below
=item -sub|s PERL
a perl hashref containing handlers
=item -trap|t ELEMENT=SUB
=back
=head1 EXAMPLES
unix> cat my-handler.pl
{
person => sub {
my ($self, $person) = @_;
$person->set_fullname($person->get_firstname . ' ' .
$person->get_lastname);
$person;
},
address => sub {
my ($self, $address) = @_;
# remove addresses altogether from processed file
return;
},
}
=cut
|