File Coverage

File:	tools/xml_merge/xml_merge
Coverage:	85.4%

line	stmt	bran	cond	sub	time	code
1						#!/usr/bin/perl -w
2						# $Id: /xmltwig/trunk/tools/xml_merge/xml_merge 12 2007-04-22T06:04:54.627880Z mrodrigu $
3	25 25 25			25	62090 30 662	use strict;
4
5	25 25 25			25	34300 29 170	use XML::Twig;
6	25 25 25			25	6723 14740 1970	use FindBin qw( $RealBin $RealScript);
7	25 25 25			25	26818 558 1187	use Getopt::Std;
8
9	25				1811399	$Getopt::Std::STANDARD_HELP_VERSION=1; # twice to prevent warning with 5.6.1 (I know it's dumb!)
10	25				27	$Getopt::Std::STANDARD_HELP_VERSION=1; # to stop processing after --help or --version
11
12	25 25 25			25	71 23 30077	use vars qw( $VERSION $USAGE);
13
14	25				36	$VERSION= "0.02";
15	25				31	$USAGE= "xml_merge [-o <output_file>] [-i] [-v] [-h] [-m] [-V] [file]\n";
16
17						{ # main block
18
19	25 25				25 35	my $opt={};
20	25				67	getopts('o:ivhmV', $opt);
21
22	25 1	100			840 0	if( $opt->{h}) { die $USAGE, "\n"; }
23	24 1	100			50 0	if( $opt->{m}) { exec "pod2text $RealBin/$RealScript"; }
24	23 1 1	100			42 24 0	if( $opt->{V}) { print "xml_merge version $VERSION\n"; exit; }
25
26	22	100			49	if( $opt->{o})
27	21	50			952	{ open( my $out, '>', $opt->{o}) or die "cannot create $opt->{o}: $!";
28	21				44	$opt->{fh}= $out; # used to set twig_print_outside_roots
29						}
30						else
31	1				2	{ $opt->{fh}= 1; } # this way twig_print_outside_roots outputs to STDOUT
32
33	22				28	$opt->{subdocs} = 1;
34	22				33	$opt->{file} = $ARGV[0];
35
36	24			24	39	$opt->{twig_roots}= $opt->{i} ? { 'xi:include' => sub { $opt->{file}= $_->att( 'href');
37	24 1	100			58 4	if( $_->att( 'subdocs')) { merge( $opt); }
38	23				27	else { spit( $opt); }
39						},
40						}
41	59			59	94	: { '?merge' => sub { $opt= parse( $_->data, $opt);
42	59 1	100			94 8	if( $opt->{subdocs}) { merge( $opt); }
43	58				80	else { spit( $opt); }
44						},
45						}
46
47	22	100			131	;
48
49	22				42	merge( $opt);
50
51	22 0	50			0 0	if( $opt->{v}) { warn "done\n"; }
52
53						}
54
55						sub merge
56	24			24	28	{ my( $opt)= @_;
57	24				102	my $t= XML::Twig->new( keep_encoding => 1, keep_spaces => 1,
58						twig_roots => $opt->{twig_roots},
59						twig_print_outside_roots => $opt->{fh},
60						);
61	24 0	50	33		60 0	if( $opt->{v} && $opt->{file}) { warn "merging $opt->{file} (parsing)\n"; }
62	24 24 0	50			51 55 0	if( $opt->{file}) { $t->parsefile( $opt->{file}); } else { $t->parse( \*STDIN); }
63						}
64
65						sub spit
66	81			81	65	{ my( $opt)= @_;
67	81 0	50	33		143 0	if( $opt->{v} && $opt->{file}) { warn "merging $opt->{file} (no parsing)\n"; }
68	81	50			1047	open( my $in, '<', $opt->{file}) or die "cannot open sub document '$opt->{file}': $!";
69	81				608	while( <$in>)
70	308	100	100		911	{ next if( m{^\Q<?xml version} \|\| m{^\s*</?xml_split:root});
71	250 240 240 10	100			234 120 653 13	if( $opt->{o}) { print {$opt->{fh}} $_; } else { print $_; }
72						}
73	81				586	close $in;
74						}
75
76						# data is the pi data,
77						# (ugly) format is keyword1 = val1 : keyword2 = val2 ... : filename
78						# ex: subdoc = 1 : file-01.xml
79
80						sub parse
81	59			59	51	{ my( $data, $opt)= @_;
82	59 59				246 201	while( $data=~ s{^\s(\S+)\s=\s(\S+)\s:\s*}{}) { $opt->{$1}= $2; }
83	59				51	$opt->{file}= $data;
84	59				59	return $opt;
85						}
86
87
88						# for Getop::Std
89	0			0		sub HELP_MESSAGE { return $USAGE; }
90	0			0		sub VERSION_MESSAGE { return $VERSION; }
91