use warnings; use strict; use XML::Parser; my($filename, # ... and some more options ... ); # ... get options ... my(%child, %member, %goodness, %notroot); { #### # REIMPLEMENTING THE WHEEL STARTS HERE my(%handler, %starthandler, @endhandler, @string, $string); $handler{"Default"} = sub { }; $handler{"Start"} = sub { push @string, $string; $string = ""; my $h = $starthandler{$_[1]}; push @endhandler, ($h ? &$h(@_[2 .. @_ - 1]) : sub { }); }; $handler{"End"} = sub { &{pop @endhandler}($_[1]); $string = pop @string; }; $handler{"Char"} = sub { $string .= $_[1]; }; # REIMPLEMENTING THE WHEEL ENDS HERE (more or less) #### my($child, $member, $goodness, $id); $starthandler{"cluster"} = sub { $child = []; $member = []; $goodness = (); $id = ""; sub { "" ne $id or die "cluster without id"; $child{$id} and die "dupe cluster id: $id"; $child{$id} = $child; $member{$id} = $member; $goodness{$id} = $goodness; }; }; $starthandler{"id"} = sub { sub { $id = $string }; }; $starthandler{"goodness"} = sub { sub { $goodness = $string }; }; $starthandler{"child"} = sub { sub { $notroot{$string}++; push @$child, $string; }; }; $starthandler{"member"} = sub { sub { push @$member, $string; }; }; #### XML::Parser->new("Handlers", \%handler)->parsefile($ARGV[0]); #### warn "done parsing xml"; } # ... and here we actually do something with what we'we read, but I won't show that ... #### use warnings; use strict; use XML::Twig; my($filename, @attrib, $verbose, # ... and some more options ... ); # ... get options ... my(%cluster, %element, %attrib); { my $EMPTY = []; my %handler; for my $a (@attrib) { $attrib{$a} = 1; } $handler{"element"} = sub { my($t, $e) = @_; my $id = $e->first_child_trimmed_text("id"); length($id) or die "invalid input: element with no id"; exists($element{$id}) and die qq[invalid input: duplicate element id "$id"]; my(%new, $a, $ae); for $ae ($e->children("value")) { $attrib{$a = $ae->att("id")} and $new{$a} = $ae->text; } $element{$id} = \%new; $t->purge; 1; }; $handler{"cluster"} = sub { my($t, $e) = @_; my $id = $e->first_child_trimmed_text("id"); my %c; length($id) or die "invalid input: cluster without id"; exists($cluster{$id}) and die qq[invalid input: duplicate cluster id "$id"]; my $g = $e->first_child_trimmed_text("goodness"); length($g) and $c{"goodness"} = 0 + $g; my @m = map { $_->trimmed_text } $e->children("member"); $c{"members"} = @m ? \@m : $EMPTY; my @c = map { $_->trimmed_text } $e->children("child"); $c{"children"} = @c ? \@c : $EMPTY; $cluster{$id} = \%c; $t->purge; 1; }; my $twig = XML::Twig->new("twig_handlers", \%handler); $verbose and warn "starting to parse xml file"; $twig->parsefile($filename); $verbose and warn "finished parsing xml file"; my $root = $twig->root; } # ... and I omit the rest of the code again ...