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