File Coverage

blib/lib/urpm/xml_info.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package urpm::xml_info;
2              
3 1     1   1408 use strict;
  1         1  
  1         28  
4 1     1   295 use XML::LibXML::Reader;
  0            
  0            
5              
6             =head1 NAME
7              
8             urpm::xml_info - XML data manipulation related routines for urpmi
9              
10             =head1 SYNOPSIS
11              
12             =head1 DESCRIPTION
13              
14             =over
15              
16             =cut
17              
18             # throw an exception on error
19             sub get_nodes {
20             my ($xml_info, $xml_info_file, $fullnames) = @_;
21              
22             my $get_one_node = _get_one_node($xml_info);
23             _get_xml_info_nodes($xml_info_file, $get_one_node, $fullnames);
24             }
25              
26             # throw an exception on error
27             sub do_something_with_nodes {
28             my ($xml_info, $xml_info_file, $do, $o_wanted_attributes) = @_;
29              
30             my $get_one_node = _get_one_node($xml_info, $o_wanted_attributes);
31             _do_something_with_xml_info_nodes($xml_info_file, $get_one_node, $do);
32             }
33              
34              
35             sub open_lzma {
36             my ($xml_info_file) = @_;
37              
38             $xml_info_file =~ s/'/'\\''/g;
39             open(my $F, "xz -dc '$xml_info_file' |");
40             $F;
41             }
42              
43             ################################################################################
44             sub _open_xml_reader {
45             my ($xml_info_file) = @_;
46              
47             my $reader = new XML::LibXML::Reader(IO => open_lzma($xml_info_file)) or die "cannot read $xml_info_file\n";
48              
49             $reader->read;
50             $reader->name eq 'media_info' or die "global tag not found\n";
51              
52             $reader->read; # first tag
53              
54             $reader;
55             }
56              
57             sub _get_all_attributes {
58             my ($reader) = @_;
59             my %entry;
60              
61             $reader->moveToFirstAttribute;
62              
63             do {
64             $entry{$reader->name} = $reader->value;
65             } while $reader->moveToNextAttribute == 1;
66            
67             \%entry;
68             }
69              
70             sub _get_attributes {
71             my ($reader, $o_wanted_attributes) = @_;
72              
73             if ($o_wanted_attributes) {
74             my %entry = map { $_ => $reader->getAttribute($_) } @$o_wanted_attributes;
75             \%entry;
76             } else {
77             _get_all_attributes($reader);
78             }
79             }
80              
81             sub _get_simple_value_node {
82             my ($value_name, $o_wanted_attributes) = @_;
83              
84             sub {
85             my ($reader) = @_;
86             my $entry = _get_attributes($reader, $o_wanted_attributes);
87              
88             $reader->read; # get value
89             $entry->{$value_name} = $reader->value;
90             $entry->{$value_name} =~ s/^\n//;
91              
92             $reader->read; # close tag
93             $reader->read; # open next tag
94              
95             $entry;
96             };
97             }
98              
99             sub _get_changelog_node {
100             my ($reader, $fn) = @_;
101            
102             $reader->nextElement('log'); # get first
103              
104             my @changelogs;
105             my $time;
106             while ($time = $reader->getAttribute('time')) {
107             push @changelogs, my $e = { time => $time };
108              
109             $reader->nextElement('log_name'); $reader->read;
110             $e->{name} = $reader->value;
111              
112             $reader->nextElement('log_text'); $reader->read;
113             $e->{text} = $reader->value;
114            
115             $reader->read; #
116             $reader->read; #
117             $reader->read; #
118             $reader->read if $reader->readState != 0; # there may be SIGNIFICANT_WHITESPACE between and
119             }
120              
121             { fn => $fn, changelogs => \@changelogs };
122             }
123              
124             sub _get_one_node {
125             my ($xml_info, $o_wanted_attributes) = @_;
126              
127             if ($xml_info eq 'changelog') {
128             \&_get_changelog_node;
129             } elsif ($xml_info eq 'info') {
130             _get_simple_value_node('description', $o_wanted_attributes);
131             } else {
132             _get_simple_value_node('files', $o_wanted_attributes);
133             }
134             }
135              
136             sub _get_xml_info_nodes {
137             my ($xml_info_file, $get_node, $fullnames) = @_;
138              
139             my $fullnames_re = '^(' . join('|', map { quotemeta $_ } @$fullnames) . ')$';
140              
141             my %todo = map { $_ => 1 } @$fullnames;
142             my %nodes;
143             _iterate_on_nodes($xml_info_file,
144             sub {
145             my ($reader, $fn) = @_;
146             if ($fn =~ /$fullnames_re/) {
147             $nodes{$fn} = $get_node->($reader);
148             delete $todo{$fn};
149             keys(%todo) == 0;
150             } else {
151             $reader->next;
152             0;
153             }
154             });
155              
156             %todo and die "could not find " . join(', ', keys %todo) . " in $xml_info_file\n";
157              
158             %nodes;
159             }
160              
161             sub _do_something_with_xml_info_nodes {
162             my ($xml_info_file, $get_node, $do) = @_;
163              
164             _iterate_on_nodes($xml_info_file,
165             sub {
166             my ($reader, $fn) = @_;
167             my $h = $get_node->($reader, $fn); # will read until closing tag
168             $do->($h);
169             0;
170             });
171             }
172              
173             sub _iterate_on_nodes {
174             my ($xml_info_file, $do) = @_;
175              
176             my $reader = _open_xml_reader($xml_info_file);
177              
178             my $fn;
179             while ($fn = $reader->getAttribute('fn')) {
180             $do->($reader, $fn) and return; # $do must go to next node otherwise it loops!
181             }
182              
183             $reader->readState == 3 || $reader->name eq 'media_info'
184             or die qq(missing attribute "fn" in tag ") . $reader->name . qq("\n);
185             }
186              
187             1;
188              
189              
190             =back
191              
192             =head1 COPYRIGHT
193              
194             Copyright (C) 2005 MandrakeSoft SA
195              
196             Copyright (C) 2005-2010 Mandriva SA
197              
198             =cut