File Coverage

File:	tools/xml_pp/xml_pp
Coverage:	58.1%

line	stmt	bran	cond	sub	time	code
1						#!/usr/bin/perl -w
2						# $Id: /xmltwig/trunk/tools/xml_pp/xml_pp 32 2008-01-18T13:11:52.128782Z mrodrigu $
3	26 26 26			26	83872 32 668	use strict;
4
5	26 26 26			26	35332 38 167	use XML::Twig;
6	26 26 26			26	110998 268982 1132	use File::Temp qw/tempfile/;
7	26 26 26			26	88 18 39341	use File::Basename qw/dirname/;
8
9	26				1972685	my @styles= XML::Twig->_pretty_print_styles; # from XML::Twig
10	26				98	my $styles= join '\|', @styles; # for usage
11	26 286				34 270	my %styles= map { $_ => 1} @styles; # to check option
12
13	26				43	my $DEFAULT_STYLE= 'indented';
14
15	26				79	my $USAGE= "usage: $0 [-v] [-i<extension>] [-s ($styles)] [-p <tag(s)>] [-e <encoding>] [-l] [-f <file>] [<files>]";
16
17						# because of the -i.bak option I don't think I can use one of the core
18						# option processing modules, so it's custom handling and no clusterization :--(
19
20
21	26				44	my %opt= process_options(); # changes @ARGV
22
23	21				51	my @twig_options=( pretty_print => $opt{style},
24						error_context => 1,
25						);
26	21	50			37	if( $opt{preserve_space_in})
27	0				0	{ push @twig_options, keep_spaces_in => $opt{preserve_space_in};}
28
29	21	50			39	if( $opt{encoding})
30	0				0	{ push @twig_options, output_encoding => $opt{encoding};
31						}
32						else
33	21				36	{ push @twig_options, keep_encoding => 1; }
34
35						# in normal (ie not -l) mode tags are output as soon as possible
36	243			243	418	push @twig_options, twig_handlers => { _all_ => sub { $_[0]->flush } }
37	21	50			101	unless( $opt{load});
38
39	21	50			41	if( @ARGV)
40	21				31	{ foreach my $file (@ARGV)
41	21	50			52	{ print STDERR "$file\n" if( $opt{verbose});
42
43	21				62	my $t= XML::Twig->new( @twig_options);
44
45	21				19	my $tempfile;
46	21	50			48	if( $opt{in_place})
47	21	50			721	{ (undef, $tempfile)= tempfile( DIR => dirname( $file)) or die "cannot create tempfile for $file: $!\n" ;
48	21	50			4993	open( PP_OUTPUT, ">$tempfile") or die "cannot create tempfile $tempfile: $!";
49	21				103	select PP_OUTPUT;
50						}
51	21				65	$t= $t->safe_parsefile( $file);
52
53	21	50			40	if( $t)
54	21 0	50			42 0	{ if( $opt{load}) { $t->print; }
55
56	21				47	select STDOUT;
57
58	21	50			39	if( $opt{in_place})
59	21				1015	{ close PP_OUTPUT;
60	21				52	my $mode= mode( $file);
61	21	50			58	if( $opt{backup})
62	0				0	{ my $backup= backup( $file, $opt{backup});
63	0	0			0	rename( $file, $backup) or die "cannot create backup file $backup: $!";
64						}
65	21	50			23655	rename( $tempfile, $file) or die "cannot overwrite file $file: $!";
66	21 21	50 50			39 605	if( $mode ne mode( $file)) { chmod $mode, $file or die "cannot set $file mode to $mode: $!"; }
67						}
68
69						}
70						else
71	0	0			0	{ if( defined $tempfile)
72	0	0			0	{ unlink $tempfile or die "cannot unlink temp file $tempfile: $!"; }
73	0				0	die $@;
74						}
75						}
76						}
77						else
78	0				0	{ my $t= XML::Twig->new( @twig_options);
79	0				0	$t->parse( \*STDIN);
80	0 0	0			0 0	if( $opt{load}) { $t->print; }
81						}
82
83
84						sub mode
85	42			42	55	{ my( $file)= @_;
86	42				242	return (stat($file))[2];
87						}
88
89						sub process_options
90	26			26	25	{ my %opt;
91	26		67		147	while( @ARGV && ($ARGV[0]=~ m{^-}) )
92	29				31	{ my $opt= shift @ARGV;
93	29	50 100 100 50 100 100 50 50 0	33 33 67 100 33 100 100 33		344	if( ($opt eq '-v') \|\| ($opt eq '--verbose') )
94	0	0			0	{ die $USAGE if( $opt{verbose});
95	0				0	$opt{verbose}= 1;
96						}
97						elsif( ($opt eq '-s') \|\| ($opt eq '--style') )
98	1	50			2	{ die $USAGE if( $opt{style});
99	1				1	$opt{style}= shift @ARGV;
100	1	50			68	die $USAGE unless( $styles{$opt{style}});
101						}
102						elsif( ($opt=~ m{^-i(.)$}) \|\| ($opt=~ m{^--in_place(.)$}) )
103	23	100			109	{ die $USAGE if( $opt{in_place});
104	22				28	$opt{in_place}= 1;
105	22		50		153	$opt{backup}= $1 \|\|'';
106						}
107						elsif( ($opt eq '-p') \|\| ($opt eq '--preserve') )
108	0				0	{ my $tags= shift @ARGV;
109	0				0	my @tags= split /\s+/, $tags;
110	0		0		0	$opt{preserve_space_in} \|\|= [];
111	0 0				0 0	push @{$opt{preserve_space_in}}, @tags;
112						}
113						elsif( ($opt eq '-e') \|\| ($opt eq '--encoding') )
114	2	100			66	{ die $USAGE if( $opt{encoding});
115	1				4	$opt{encoding}= shift @ARGV;
116						}
117						elsif( ($opt eq '-l') \|\| ($opt eq '--load'))
118	2	100			66	{ die $USAGE if( $opt{load});
119	1				4	$opt{load}=1;
120						}
121						elsif( ($opt eq '-f') \|\| ($opt eq '--files') )
122	0				0	{ my $file= shift @ARGV;
123	0				0	push @ARGV, files_from( $file);
124						}
125						elsif( ($opt eq '-h') \|\| ($opt eq '--help'))
126	1 1				52020 87	{ system "pod2text", $0; exit; }
127						elsif( $opt eq '--')
128	0				0	{ last; }
129						else
130	0				0	{ die $USAGE; }
131						}
132
133	21		33		72	$opt{style} \|\|= $DEFAULT_STYLE;
134
135	21				70	return %opt;
136						}
137
138						# get the list of files (one per line) from a file
139						sub files_from
140	0			0		{ my $file= shift;
141	0	0				open( FILES, "<$file") or die "cannot open file $file: $!";
142	0					my @files;
143	0 0 0					while( <FILES>) { chomp; push @files, $_; }
144	0					close FILES;
145	0					return @files;
146						}
147
148						sub backup
149	0			0		{ my( $file, $extension)= @_;
150	0					my $backup;
151	0	0				if( $extension=~ m{\*})
152	0					{ ($backup= $extension)=~ s{\*}{$file}g; }
153						else
154	0					{ $backup= $file.$extension; }
155	0					return $backup;
156						}
157