XML-Twig-3.54/0000755000175000017500000000000015022234425013256 5ustar mrodrigumrodriguXML-Twig-3.54/README0000644000175000017500000000602315022224060014131 0ustar mrodrigumrodriguNAME XML::Twig - Tree interface to XML documents allowing processing chunk by chunk of huge documents. SUMMARY (see perldoc XML::Twig for full details) XML::Twig is (yet another!) XML transformation module. Its strong points: can be used to process huge documents while still being in tree mode; not bound by DOM or SAX, so it is very perlish and offers a very comprehensive set of methods; simple to use; DWIMs as much as possible What it doesn't offer: full SAX support (it can export SAX, but only reads XML), full XPath support (unless you use XML::Twig::XPath), nor DOM support. Other drawbacks: it is a big module, and with over 500 methods available it can be a bit overwhelming. A good starting point is the tutorial at http://xmltwig.org/xmltwig/tutorial/index.html. In fact the whole XML::Twig page at http://xmltwig.org/xmltwig/ has plenty of information to get you started with XML::Twig TOOLS XML::Twig comes with a few tools built on top of it: xml_pp XML pretty printer xml_grep XML grep - grep XML files using XML::Twig's subset of XPath xml_split split big XML files xml_merge merge back files created by xml_split xml_spellcheck spellcheck XML files skipping tags Running perl Makefile.PL will prompt you for each tool installation. perl Makefile.PL -y will install all of the tools without prompt perl Makefile.PL -n will skip the installation of the tools SYNOPSYS single-tree mode my $t= XML::Twig->new(); $t->parsefile( 'doc.xml'); $t->print; chunk mode # print the document, at most one full section is loaded in memory my $t= XML::Twig->new( twig_handlers => { section => \&flush}); $t->parsefile( 'doc.xml'); $t->flush; sub flush { (my $twig, $section)= @_; $twig->flush; } sub-tree mode # print all section title's in the document, # all other elements are ignored (and not stored) my $t= XML::Twig->new( twig_roots => { 'section/title' => sub { $_->print, "\n" } } ); $t->parsefile( 'doc.xml'); INSTALLATION perl Makefile.PL make make test make install DEPENDENCIES XML::Twig needs XML::Parser (and the expat library) installed Modules that can enhance XML::Twig are: Scalar::Util or WeakRef to avoid memory leaks Tie::IxHash to use the keep_atts_order option XML::XPathEngine to use XML::Twig::XPath LWP to use parseurl HTML::Entities to use the html_encode filter HTML::TreeBuilder to process HTML instead of XML CHANGES See the Changes file AUTHOR Michel Rodriguez (mirod@cpan.org) The Twig page is at http://www.xmltwig.org/xmltwig git project repository: http://github.com/mirod/xmltwig See the XML::Twig tutorial at http://www.xmltwig.org/xmltwig/tutorial/index.html COPYRIGHT Copyright (c) 1999-2025, Michel Rodriguez. All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. XML-Twig-3.54/tools/0000755000175000017500000000000015022234425014416 5ustar mrodrigumrodriguXML-Twig-3.54/tools/xml_spellcheck/0000755000175000017500000000000015022234425017413 5ustar mrodrigumrodriguXML-Twig-3.54/tools/xml_spellcheck/xml_spellcheck0000755000175000017500000001455112732215763022355 0ustar mrodrigumrodrigu#!/usr/bin/perl -w use strict; use XML::Twig; use Getopt::Long; use Pod::Usage; use File::Temp qw{tempfile}; my $DEFAULT_SC = 'aspell -c'; my $DEFAULT_PP = 'indented'; my $DEFAULT_EXT= '.bak'; my $VERSION="0.02"; my ( $spellchecker, $ext, $attributes, $exclude_elements, $include_elements, $pretty_print, $version, $help, $man); GetOptions( 'spellchecker=s' => \$spellchecker, 'backup-extension=s' => \$ext, 'attributes' => \$attributes, 'exclude_elements=s' => \$exclude_elements, 'include_elements=s' => \$include_elements, 'pretty_print:s' => \$pretty_print, 'version' => \$version, 'help' => \$help, 'man' => \$man, ) or pod2usage(-verbose => 1, -exitval => -1); pod2usage( -verbose => 1, -exitval => 0) if $help; pod2usage( -verbose => 2, -exitval => 0) if $man; if( $version) { print "$0 version $VERSION\n"; exit;} # option processing $spellchecker ||= $DEFAULT_SC; $ext ||= $DEFAULT_EXT; if( $exclude_elements && $include_elements) { die "cannot use both --exclude-elements and --include-elements\n"; } if( defined $pretty_print and !$pretty_print) { $pretty_print= $DEFAULT_PP; } my %twig_options; my( %include_elements); if( $exclude_elements) { my @exclude_elts = split /\s+/, $exclude_elements; my %start_tag_handlers= map { $_ => \&exclude_elt } @exclude_elts; $twig_options{start_tag_handlers}= \%start_tag_handlers; } if( $include_elements) { my @include_elts = split /\s+/, $include_elements; my %start_tag_handlers= map { $_ => \&include_elt } @include_elts; $twig_options{start_tag_handlers}= \%start_tag_handlers; } $twig_options{pretty_print}= $pretty_print if( $pretty_print); foreach my $file (@ARGV) { my $id=0; my $id2elt={}; # id => element my( $tmp_fh, $tmp_file) = tempfile( "xml_spellcheck_XXXX", SUFFIX => '.txt' ); my $t= XML::Twig->new( keep_encoding =>1, %twig_options,); $t->parsefile( $file); foreach my $elt ($t->descendants( '#TEXT')) { if( (!$include_elements and !$exclude_elements) or ($include_elements and $elt->inherit_att( '#include')) or ($exclude_elements and !$elt->inherit_att( '#exclude')) ) { $id++; process_text( $t, $elt, $id, $id2elt, $tmp_fh) } } close $tmp_fh; system( "$spellchecker $tmp_file") ==0 or die "$spellchecker $tmp_file failed: $?"; open( $tmp_fh, "<$tmp_file") or die "cannot open temp file $tmp_file: $!"; while( <$tmp_fh>) { chomp; my( $id, $text)= split /:/, $_, 2; my $wrap= $id2elt->{$id}; $text=~ s{<\\n>}{\n}g; my $text_elt= $wrap->first_child or die "internal error 100\n"; if( $text_elt->gi eq '#PCDATA') { $text_elt->set_pcdata( $text); } elsif( $text_elt->gi eq '#CDATA') { $text_elt->set_cdata( $text); } else { die "internal error 101\n"; } $wrap->erase; } close $tmp_fh; rename( $file, "$file$ext") or die "cannot save backup file $file$ext: $!"; open( FILE, ">$file") or die "cannot save spell checked file $file: $!"; $t->print( \*FILE); close FILE; } sub include_elt { $_->set_att( '#include' => 1) ; } sub exclude_elt { $_->set_att( '#exclude' => 1) ; } sub process_text { my( $t, $elt, $id, $id2elt, $tmp_fh)= @_; my $wrap= $elt->wrap_in( '#SC'); #$wrap->set_att( '#ID' => $id); $id2elt->{$id}= $wrap; my $text= $elt->text; $text=~ s{\n}{<\\n>}g; print $tmp_fh "$id:$text\n"; } __END__ =head1 NAME xml_spellcheck - spellcheck XML files =head1 SYNOPSIS xml_spellcheck [options] =head1 DESCRIPTION xml_spellcheck lets you spell check the content of an XML file. It extracts the text (the content of elements and optionally of attributes), call a spell checker on it and then recreates the XML document. =head1 OPTIONS Note that all options can be abbreviated to the first letter =over 4 =item --conf Gets the options from a configuration file. NOT IMPLEMENTED YET. =item --spellchecker The command to use for spell checking, including any option By default C is used =item --backup-extension By default the original file is saved with a C<.bak> extension. This option changes the extension =item --attributes Spell check attribute content. By default attribute values are NOT spell checked. NOT YET IMPLEMENTED =item --exclude_elements A list of elements that should not be spell checked =item --include_elements A list of elements that should be spell checked (by default all elements are spell checked). C<--exclude_elements> and C<--include_elements> are mutually exclusive =item --pretty_print A pretty print style for the document, as defined in XML::Twig. If the option is provided without a value then the C style is used =item --version Dislay the tool version and exit =item --help Display help message and exit =item --man Display longer help message and exit =back =head1 EXAMPLES =head1 BUGS =head1 TODO =over 4 =item --conf option =item --attribute option =back =head1 PRE-REQUISITE XML::Twig, Getopt::Long, Pod::Usage, File::Temp XML::Twig requires XML::Parser. =head1 SEE ALSO XML::Twig =head1 COPYRIGHT AND DISCLAIMER This program is Copyright 2003 by Michel Rodriguez This program is free software; you can redistribute it and/or modify it under the terms of the Perl Artistic License or the GNU General Public License as published by the Free Software Foundation either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. If you do not have a copy of the GNU General Public License write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. =head1 AUTHOR Michel Rodriguez xml_spellcheck is available at http://www.xmltwig.com/xmltwig/ XML-Twig-3.54/tools/xml_grep/0000755000175000017500000000000015022234425016233 5ustar mrodrigumrodriguXML-Twig-3.54/tools/xml_grep/xml_grep0000755000175000017500000003270114645746140020015 0ustar mrodrigumrodrigu#!/usr/bin/perl -w use strict; use Getopt::Long; use Pod::Usage; use XML::Twig; my $VERSION="0.9"; # options (all used globally in the script) my( $help, $man, @roots, @paths, $files, $count, $nb_results, $nb_results_per_file, $encoding, @exclude, $wrap, $nowrap, $descr, $group, $pretty_print, $version, $text_only, $date, $html, $tidy, $css_sel, $add_ns, $verbose, $strict ); # used to check if the wrapping tags need to be output my $results = 0; my $file_results = 0; # first process the case where the user provides only # an xpath expression and a list of files if( @ARGV && ($ARGV[0] !~ m{^-}) ) { splice( @ARGV, 0, 0, '--group_by_file', 'file', '--pretty_print', 'indented', '--cond'); } GetOptions( 'help' => \$help, 'man' => \$man, 'Version' => \$version, 'cond=s' => \@paths, 'exclude|v=s' => \@exclude, 'root=s' => \@roots, 'files' => \$files, 'count' => \$count, 'nb_results=i' => \$nb_results, 'by_file=i' => \$nb_results_per_file, 'encoding=s' => \$encoding, 'css_sel' => \$css_sel, 'wrap:s' => \$wrap, 'nowrap' => \$nowrap, 'descr:s' => \$descr, 'group_by_file:s' => \$group, 'pretty_print:s' => \$pretty_print, 'text_only' => \$text_only, 'date!' => \$date, 'strict' => \$strict, 'html' => \$html, 'tidy' => \$tidy, 'add_ns' => \$add_ns, 'verbose' => \$verbose, ) or pod2usage(2); pod2usage(1) if $help; pod2usage(-exitstatus => 0, -verbose => 2) if $man; if( $version) { warn "$0 version $VERSION\n"; exit; } binmode STDOUT, ':utf8'; # case where options are given, but no root or path, assume the # first arg is a path if( !@roots and !@paths and !@exclude and @ARGV) { @paths= shift @ARGV; } unless( @roots or @paths or @exclude or $files) { pod2usage(1); exit; } if( ($files or $count) and !@paths) { pod2usage(1); exit; } if( ($files or $count) and (@roots or $encoding or defined( $wrap) or defined( $group) or defined( $pretty_print))) { pod2usage(1); exit; } if( $files and !@ARGV) { pod2usage(1); exit; } if( !$files and !$count and @paths and !@roots) { @roots= @paths; @paths=(); } $date=1 unless( defined $date); # defaults for optional arguments to options $group = 'file' if( defined $group and !$group); $pretty_print = 'indented' if( defined $pretty_print and !$pretty_print); if( $nowrap) { $wrap=''; } elsif( !defined( $wrap) and (@roots or @paths)) { $wrap= 'xml_grep'; } if( !defined( $descr) and (@roots or @paths)) { if( $date) { $date= localtime(); $descr = qq{version="$VERSION" date="$date"} } else { $descr = qq{version="$VERSION"}; } } # some globals my $current_file; my $count_file = 0; my $count_total = 0; my $nb_results_left_in_current_file=0; # will be used to create the twig my %options; if( $count) { my $twig_roots={}; my $twig_root= sub { $count_file++; $_[0]->purge; }; foreach my $path (@paths) { $twig_roots->{$path}= $twig_root; } $options{twig_roots}= $twig_roots; } elsif( @exclude) { # general options $nowrap=1; # twig options $options{twig_print_outside_roots} = 1; my $root_handlers={}; foreach my $exclude (@exclude) { $root_handlers->{$exclude}= sub { }; } $options{twig_roots}= $root_handlers; } else { create_regular_handlers( \%options, \@roots, \@paths); } if( $tidy) { $html= 1; $options{use_tidy}= 1; } $options{pretty_print} = $pretty_print if( $pretty_print); $options{output_encoding} = $encoding if( $encoding); $options{css_sel} = $css_sel if( $css_sel); my $t= create_twig( %options); if( @ARGV) { foreach my $file (@ARGV) { $current_file= $file; if( $nb_results_per_file) { $nb_results_left_in_current_file= $nb_results_per_file; } if( $verbose) { warn "parsing '$file'\n"; } my $ok= $html && ($current_file=~ m{^(http|ftp|file)://}) ? $t->safe_parseurl_html( $file) : ($current_file=~ m{^(http|ftp|file)://}) ? $t->safe_parseurl( $file) : $html ? $t->safe_parsefile_html( $file) : $t->safe_parsefile( $file); if( !$ok) { if( $@ =~ m{XMLGREP: FOUND}) { # in files mode print $current_file, "\n"; $nb_results--; exit unless( $nb_results); } elsif( $@ =~ m{^XMLGREP: NB_RESULT_REACHED}) { print file_result_end() if( $group && $file_results); print result_end() if( $results); exit; } else { $@ ||= 'unknown cause'; if( $strict) { die $@; } warn $@; if( !$count) { print "\n"; } } } if( $count) { print "$current_file: $count_file\n"; $count_total += $count_file; $count_file=0; } elsif( @roots) { print file_result_end() if( $file_results); } elsif( $count) { print "$count_total matches\n"; } } if( $count) { print "total: $count_total\n"; } print result_end() if( $results); } else { $file_results=0; my $ok= $t->safe_parse( \*STDIN); if( !$ok and ( $@ !~ m{^XMLGREP: NB_RESULT_REACHED})) { if( !$strict) { warn $@; } else { die $@; } } if( $count) { print "$count_total matches\n"; } else { print result_end(); } } sub create_regular_handlers { my( $options, $roots, $paths)= @_; if( @$roots) { my $root_handlers={}; my $root_handler= twig_roots_handler( @$paths); foreach my $root (@$roots) { $root_handlers->{$root}= $root_handler; } $options->{twig_roots}= $root_handlers; } if( @$paths) { my $twig_handlers={}; my $twig_handler= twig_handlers(); foreach my $path (@$paths) { $twig_handlers->{$path}= $twig_handler; } $options->{twig_handlers}= $twig_handlers; } } sub create_twig { my( %options)= @_; my $twig; eval { $twig= XML::Twig->new( %options) }; if( $@) { # see if we are in the case where the only condition uses string() or regexp if( ($@=~ m{^(regexp|string\(\)) condition not supported on twig_roots option}) && $options{twig_roots} && !$options{twig_handlers} && ( keys %{$options{twig_roots}} == 1) ) { # in this case add the proper twig_roots option my $cond= (keys %{$options{twig_roots}})[0]; (my $root= $cond)=~ s{\[[^\]]*\]$}{}; #warn "cond: '$cond' - root: '$root'\n"; delete $options{twig_roots}; delete $options{twig_handlers}; @paths= ($cond); @roots= ($root); create_regular_handlers( \%options, \@roots, \@paths); return create_twig( %options); } elsif( $@=~ m{^wrong condition: unrecognized expression in handler: '(.*?)'}) { die "error in filter condition '$1'\n"; } else { die "error: $@"; } } return $twig; } sub twig_roots_handler { my( @paths)= @_; return sub { my( $t, $root)= @_; if( !@paths or $_->att( '#print')) { print result_start() if( !$results); print file_result_start() if( $group && !$file_results); if( $text_only) { print $root->text, "\n"; } else { $root->print; } if( ! -- $nb_results) { $@= "XMLGREP: NB_RESULT_REACHED"; die; } if( ! -- $nb_results_left_in_current_file) { $t->finish_now(); } } $t->purge; 1; }; } sub twig_handlers { if( $files) { return sub { $@="XMLGREP: FOUND"; die; }; } else { return sub { my( $t, $hit)= @_; foreach my $elt ( $hit->ancestors_or_self) { $elt->set_att( '#print' => 1); } 1; }; } } sub result_start { $results=1; return if( $text_only); my $enc_decl= $encoding ? qq{encoding="$encoding" } : ''; return $wrap ? qq{\n<$wrap $descr>\n} : ''; } sub result_end { my $result; return if( $text_only); if( !$group) { $result= "\n"; } $result .= qq{\n} if( $wrap); return $result; } sub file_result_start { $file_results=1; return if( $text_only); my $result; $result= qq{<$group filename="$current_file">}; if( !$pretty_print) { $result.= "\n"; } return $result; } sub file_result_end { $file_results=0; return '' if( $text_only); return qq{\n\n}; } __END__ =head1 NAME xml_grep - grep XML files looking for specific elements =head1 SYNOPSYS xml_grep [options] or xml_grep By default you can just give C an XPath expression and a list of files, and get an XML file with the result. This is equivalent to writing xml_grep --group_by_file file --pretty_print indented --cond =head1 OPTIONS =over 4 =item B<--help> brief help message =item B<--man> full documentation =item B<--Version> display the tool version =item B<--root> look for and return xml chunks matching if neither C<--root> nor C<--file> are used then the element(s) that trigger the C<--cond> option is (are) used. If C<--cond> is not used then all elements matching the are returned several C<--root> can be provided =item B<--cond> return the chunks (or file names) only if they contain elements matching several C<--cond> can be provided (in which case they are OR'ed) =item B<--files> return only file names (do not generate an XML output) usage of this option precludes using any of the options that define the XML output: C<--roots>, C<--encoding>, C<--wrap>, C<--group_by_file> or C<--pretty_print> =item B<--count> return only the number of matches in each file usage of this option precludes using any of the options that define the XML output: C<--roots>, C<--encoding>, C<--wrap>, C<--group_by_file> or C<--pretty_print> =item B<--strict> without this option parsing errors are reported to STDOUT and the file skipped =item B<--date> when on (by default) the wrapping element get a C attribute that gives the date the tool was run. with C<--nodate> this attribute is not added, which can be useful if you need to compare 2 runs. =item B<--encoding> encoding of the xml output (utf-8 by default) =item B<--nb_results> output only results =item B<--by_file> output only results by file =item B<--wrap> wrap the xml result in the provided tag (defaults to 'xml_grep') If wrap is set to an empty string (C<--wrap ''>) then the xml result is not wrapped at all. =item B<--nowrap> same as using C<--wrap ''>: the xml result is not wrapped. =item B<--descr> attributes of the wrap tag (defaults to C<< version="" date="" >>) =item B<--group_by_file> wrap results for each files into a separate element. By default that element is named C. It has an attribute named C that gives the name of the file. the short version of this option is B<-g> =item B<--exclude> same as using C<-v> in grep: the elements that match the condition are excluded from the result, the input file(s) is (are) otherwise unchanged the short form of this option is B<-v> =item B<--pretty_print> pretty print the output using XML::Twig styles ('C', 'C' or 'C' are probably what you are looking for) if the option is used but no style is given then 'C' is used short form for this argument is B<-s> =item B<--text_only> Displays the text of the results, one by line. =item B<--html> Allow HTML input, files are converted using HTML::TreeBuilder =item B<--Tidy> Allow HTML input, files are converted using HTML::Tidy =back =head2 Condition Syntax is an XPath-like expression as allowed by XML::Twig to trigger handlers. examples: 'para' 'para[@compact="compact"]' '*[@urgent]' '*[@urgent="1"]' 'para[string()="WARNING"]' see XML::Twig for a more complete description of the syntax options are processed by Getopt::Long so they can start with '-' or '--' and can be abbreviated (C<-r> instead of C<--root> for example) =head1 DESCRIPTION B does a grep on XML files. Instead of using regular expressions it uses XPath expressions (in fact the subset of XPath supported by XML::Twig) the results can be the names of the files or XML elements containing matching elements. =head1 SEE ALSO XML::Twig Getopt::Long =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Michel Rodriguez XML-Twig-3.54/tools/xml_merge/0000755000175000017500000000000015022234425016375 5ustar mrodrigumrodriguXML-Twig-3.54/tools/xml_merge/xml_merge0000755000175000017500000000746415022223261020311 0ustar mrodrigumrodrigu#!/usr/bin/perl -w # $Id: /xmltwig/trunk/tools/xml_merge/xml_merge 12 2007-04-22T06:04:54.627880Z mrodrigu $ use strict; use XML::Twig; use FindBin qw( $RealBin $RealScript); use Getopt::Std; $Getopt::Std::STANDARD_HELP_VERSION=1; # to stop processing after --help or --version use vars qw( $VERSION $USAGE); $VERSION= "0.02"; $USAGE= "xml_merge [-o ] [-i] [-v] [-h] [-m] [-V] [file]\n"; { # main block my $opt={}; getopts('o:ivhmV', $opt); if( $opt->{h}) { die $USAGE, "\n"; } if( $opt->{m}) { exec "pod2text $RealBin/$RealScript"; } if( $opt->{V}) { print "xml_merge version $VERSION\n"; exit; } if( $opt->{o}) { open( my $out, '>', $opt->{o}) or die "cannot create $opt->{o}: $!"; $opt->{fh}= $out; # used to set twig_print_outside_roots } else { $opt->{fh}= 1; } # this way twig_print_outside_roots outputs to STDOUT $opt->{subdocs} = 1; $opt->{file} = $ARGV[0]; $opt->{twig_roots}= $opt->{i} ? { 'xi:include' => sub { $opt->{file}= $_->att( 'href'); if( $_->att( 'subdocs')) { merge( $opt); } else { spit( $opt); } }, } : { '?merge' => sub { $opt= parse( $_->data, $opt); if( $opt->{subdocs}) { merge( $opt); } else { spit( $opt); } }, } ; merge( $opt); if( $opt->{v}) { warn "done\n"; } } sub merge { my( $opt)= @_; my $t= XML::Twig->new( keep_encoding => 1, keep_spaces => 1, twig_roots => $opt->{twig_roots}, twig_print_outside_roots => $opt->{fh}, ); if( $opt->{v} && $opt->{file}) { warn "merging $opt->{file} (parsing)\n"; } if( $opt->{file}) { $t->parsefile( $opt->{file}); } else { $t->parse( \*STDIN); } } sub spit { my( $opt)= @_; if( $opt->{v} && $opt->{file}) { warn "merging $opt->{file} (no parsing)\n"; } open( my $in, '<', $opt->{file}) or die "cannot open sub document '$opt->{file}': $!"; while( <$in>) { next if( m{^\Q{o}) { print {$opt->{fh}} $_; } else { print $_; } } close $in; } # data is the pi data, # (ugly) format is keyword1 = val1 : keyword2 = val2 ... : filename # ex: subdoc = 1 : file-01.xml sub parse { my( $data, $opt)= @_; while( $data=~ s{^\s*(\S+)\s*=\s*(\S+)\s*:\s*}{}) { $opt->{$1}= $2; } $opt->{file}= $data; return $opt; } # for Getop::Std sub HELP_MESSAGE { return $USAGE; } sub VERSION_MESSAGE { return $VERSION; } __END__ =head1 NAME xml_merge - merge back XML files split with C =head1 DESCRIPTION C takes several xml files that have been split using C and recreates a single file. =head1 OPTIONS =over 4 =item -o unless this option is used the program output goes to STDOUT =item -i the files use XInclude instead of processing instructions (they were created using the C<-i> option in C) =item -v verbose output =item -V outputs version and exit =item -h short help =item -m man (requires pod2text to be in the path) =back =head1 EXAMPLES xml_merge foo-00.xml # output to stdout xml_merge -o foo.xml foo-00.xml # output to foo.xml =head1 SEE ALSO XML::Twig, xml_split =head1 TODO/BUGS =head1 AUTHOR Michel Rodriguez =head1 LICENSE This tool is free software; you can redistribute it and/or modify it under the same terms as Perl itself. XML-Twig-3.54/tools/xml_pp/0000755000175000017500000000000015022234425015715 5ustar mrodrigumrodriguXML-Twig-3.54/tools/xml_pp/xml_pp0000755000175000017500000001751713015053270017152 0ustar mrodrigumrodrigu#!/usr/bin/perl -w # $Id: /xmltwig/trunk/tools/xml_pp/xml_pp 32 2008-01-18T13:11:52.128782Z mrodrigu $ use strict; use XML::Twig; use File::Temp qw/tempfile/; use File::Basename qw/dirname/; my @styles= XML::Twig->_pretty_print_styles; # from XML::Twig my $styles= join '|', @styles; # for usage my %styles= map { $_ => 1} @styles; # to check option my $DEFAULT_STYLE= 'indented'; my $USAGE= "usage: $0 [-v] [-i] [-s ($styles)] [-p ] [-e ] [-l] [-f ] []"; # because of the -i.bak option I don't think I can use one of the core # option processing modules, so it's custom handling and no clusterization :--( my %opt= process_options(); # changes @ARGV my @twig_options=( pretty_print => $opt{style}, error_context => 1, ); if( $opt{preserve_space_in}) { push @twig_options, keep_spaces_in => $opt{preserve_space_in};} if( $opt{encoding}) { push @twig_options, output_encoding => $opt{encoding}; } else { push @twig_options, keep_encoding => 1; } # in normal (ie not -l) mode tags are output as soon as possible push @twig_options, twig_handlers => { _all_ => sub { $_[0]->flush } } unless( $opt{load}); if( @ARGV) { foreach my $file (@ARGV) { print STDERR "$file\n" if( $opt{verbose}); my $t= XML::Twig->new( @twig_options); my $tempfile; if( $opt{in_place}) { (undef, $tempfile)= tempfile( DIR => dirname( $file)) or die "cannot create tempfile for $file: $!\n" ; open( PP_OUTPUT, ">$tempfile") or die "cannot create tempfile $tempfile: $!"; select PP_OUTPUT; } $t= $t->safe_parsefile( $file); if( $t) { if( $opt{load}) { $t->print; } select STDOUT; if( $opt{in_place}) { close PP_OUTPUT; my $mode= mode( $file); if( $opt{backup}) { my $backup= backup( $file, $opt{backup}); rename( $file, $backup) or die "cannot create backup file $backup: $!"; } rename( $tempfile, $file) or die "cannot overwrite file $file: $!"; if( $mode ne mode( $file)) { chmod $mode, $file or die "cannot set $file mode to $mode: $!"; } } } else { if( defined $tempfile) { unlink $tempfile or die "cannot unlink temp file $tempfile: $!"; } die $@; } } } else { my $t= XML::Twig->new( @twig_options); $t->parse( \*STDIN); if( $opt{load}) { $t->print; } } sub mode { my( $file)= @_; return (stat($file))[2]; } sub process_options { my %opt; while( @ARGV && ($ARGV[0]=~ m{^-}) ) { my $opt= shift @ARGV; if( ($opt eq '-v') || ($opt eq '--verbose') ) { die $USAGE if( $opt{verbose}); $opt{verbose}= 1; } elsif( ($opt eq '-s') || ($opt eq '--style') ) { die $USAGE if( $opt{style}); $opt{style}= shift @ARGV; die $USAGE unless( $styles{$opt{style}}); } elsif( ($opt=~ m{^-i(.*)$}) || ($opt=~ m{^--in_place(.*)$}) ) { die $USAGE if( $opt{in_place}); $opt{in_place}= 1; $opt{backup}= $1 ||''; } elsif( ($opt eq '-p') || ($opt eq '--preserve') ) { my $tags= shift @ARGV; my @tags= split /\s+/, $tags; $opt{preserve_space_in} ||= []; push @{$opt{preserve_space_in}}, @tags; } elsif( ($opt eq '-e') || ($opt eq '--encoding') ) { die $USAGE if( $opt{encoding}); $opt{encoding}= shift @ARGV; } elsif( ($opt eq '-l') || ($opt eq '--load')) { die $USAGE if( $opt{load}); $opt{load}=1; } elsif( ($opt eq '-f') || ($opt eq '--files') ) { my $file= shift @ARGV; push @ARGV, files_from( $file); } elsif( ($opt eq '-h') || ($opt eq '--help')) { system "pod2text", $0; exit; } elsif( $opt eq '--') { last; } else { die $USAGE; } } $opt{style} ||= $DEFAULT_STYLE; return %opt; } # get the list of files (one per line) from a file sub files_from { my $file= shift; open( FILES, "<$file") or die "cannot open file $file: $!"; my @files; while( ) { chomp; push @files, $_; } close FILES; return @files; } sub backup { my( $file, $extension)= @_; my $backup; if( $extension=~ m{\*}) { ($backup= $extension)=~ s{\*}{$file}g; } else { $backup= $file.$extension; } return $backup; } __END__ =head1 NAME xml_pp - xml pretty-printer =head1 SYNOPSYS xml_pp [options] [] =head1 DESCRIPTION XML pretty printer using XML::Twig =head1 OPTIONS =over 4 =item -i[] edits the file(s) in place, if an extension is provided (no space between C<-i> and the extension) then the original file is backed-up with that extension The rules for the extension are the same as Perl's (see perldoc perlrun): if the extension includes no "*" then it is appended to the original file name, If the extension does contain one or more "*" characters, then each "*" is replaced with the current filename. =item -s