diff options
| -rw-r--r-- | NEWS | 2 | ||||
| -rw-r--r-- | genhdlist2 | 104 |
2 files changed, 99 insertions, 7 deletions
@@ -1,4 +1,6 @@ - genhdlist2: + o generate {info,changelog,files}.xml.lzma when they already exist, + or when --xml-media-info is used o error message when parse_hdlist (partially) fail o handle old-rpms.lst (to be generated by youri) which will allow keeping rpms for some time without having in hdlist @@ -5,6 +5,7 @@ use URPM; use MDV::Packdrakeng; use Getopt::Long; +use Encode; main(); @@ -14,7 +15,7 @@ sub usage () { } sub main() { - my %options; + my %options = (xml_media_info => 'auto'); GetOptions( 'clean' => \$options{no_incremental}, @@ -25,6 +26,7 @@ sub main() { 'nolock' => \$options{nolock}, 'allow-empty-media' => \$options{allow_empty_media}, 'file-deps=s' => \$options{file_deps}, + 'xml-media-info!' => \$options{xml_media_info}, 'media_info-dir=s' => \$options{media_info_dir}, 'h|help' => sub { usage(); exit 0 }, 'q|quiet' => sub { $options{verbose} = -1 }, @@ -88,11 +90,16 @@ sub do_it { read_file_deps($urpm, $options{file_deps}) if $options{file_deps}; - build_hdlist($urpm, \%rpms_todo, $media_info_dir, $rpms_dir, $options{no_incremental}); + if ($options{xml_media_info} eq 'auto') { + $options{xml_media_info} = -e "$media_info_dir/info.xml.lzma"; + } + my @xml_media_info = $options{xml_media_info} ? ('info', 'files', 'changelog') : (); + + build_hdlist($urpm, \%rpms_todo, $media_info_dir, $rpms_dir, \@xml_media_info, $options{no_incremental}); build_synthesis($urpm, "$synthesis.tmp"); if (1) { - foreach my $name ('hdlist.cz') { + foreach my $name ('hdlist.cz', map { "$_.xml.lzma" } @xml_media_info) { print "replacing $media_info_dir/$name with $name.tmp\n" if $verbose >= 0; rename "$media_info_dir/$name.tmp", "$media_info_dir/$name" or die "rename $media_info_dir/$name failed: $?\n"; } @@ -130,7 +137,7 @@ sub read_file_deps { } sub build_hdlist { - my ($urpm, $rpms_todo, $media_info_dir, $rpms_dir, $b_no_incremental) = @_; + my ($urpm, $rpms_todo, $media_info_dir, $rpms_dir, $xml_media_info, $b_no_incremental) = @_; my $hdlist = "$media_info_dir/hdlist.cz"; @@ -143,6 +150,7 @@ sub build_hdlist { my $out = { hdlist => $out_hdlist, + map { $_ => open_xml_lzma("$media_info_dir/$_.xml.lzma.tmp") } @$xml_media_info }; if (-e $hdlist && !$b_no_incremental) { @@ -151,6 +159,8 @@ sub build_hdlist { } add_new_rpms_to_hdlist($urpm, $rpms_todo, $out, $rpms_dir); + + close_xml($out->{$_}) foreach @$xml_media_info; } sub filter_existing_hdlist { @@ -207,20 +217,100 @@ sub add_new_rpms_to_hdlist { } } +sub open_xml_lzma { + my ($file) = @_; + open(my $F, "| lzma -5 > $file") or die "can't open $file\n"; + binmode $F, ':utf8'; + print $F "<media_info>"; + $F; +} + +sub close_xml { + my ($F) = @_; + print $F "</media_info>\n"; +} + +sub ensure_utf8 { + my ($s) = @_; + + Encode::_utf8_on($s); #- this is done on the copy + if (!Encode::is_utf8($s, 1)) { + Encode::_utf8_off($_[0]); + Encode::from_to($_[0], 'iso-8859-15', 'utf8'); + } +} + +sub encode_xml { + my ($s) = @_; + $s =~ s/&/&/g; + $s =~ s/</</g; + $s =~ s/>/>/g; + ensure_utf8($s); + $s; +} +sub encode_xml_attribute { + my ($s) = @_; + + $s = encode_xml($s); + + $s =~ /'/ or return qq('$s'); + $s =~ /"/ or return qq("$s"); + + # argh!! hum replacing " with '' :-D + $s =~ s/"/''/g; + print STDERR qq(encoding xml attribute: replacing " with '' for $s\n); + + qq("$s"); +} + sub add_pkg { my ($out, $pkg) = @_; - add_pkg_header($out->{hdlist}, $pkg); + my $fullname = $pkg->fullname; + + add_pkg_header($out->{hdlist}, $pkg, $fullname); + + if ($out->{files}) { + my $F = $out->{files}; + print $F qq(<files fn="$fullname">\n); + print $F encode_xml($_), "\n" foreach $pkg->files; + print $F qq(</files>); + } + + if ($out->{info}) { + my $F = $out->{info}; + print $F qq(<info fn="$fullname"); + printf $F qq(\n $_=%s), encode_xml_attribute($pkg->$_) foreach qw(sourcerpm url license); + print $F qq(>\n); + print $F encode_xml($pkg->description), "\n"; + print $F qq(</info>); + } + + if ($out->{changelog} && $pkg->changelog_name) { + my $F = $out->{changelog}; + my @ti = $pkg->changelog_time; + my @na = $pkg->changelog_name; + my @te = $pkg->changelog_text; + + print $F qq(<changelogs fn="$fullname">\n); + foreach (0 .. $#ti) { + print $F qq(<log time="$ti[$_]">\n); + print $F qq(<log_name>), encode_xml($na[$_]), qq(</log_name>\n); + print $F qq(<log_text>), encode_xml($te[$_]), qq(</log_text>\n); + print $F qq(</log>); + } + print $F qq(</changelogs>); + } } sub add_pkg_header { - my ($out, $pkg) = @_; + my ($out, $pkg, $fullname) = @_; { open(my $fh, ">", $tmp_header); $pkg->build_header(fileno $fh); } { open(my $fh, "<", $tmp_header); - $out->add_virtual('f', scalar($pkg->fullname), $fh); + $out->add_virtual('f', $fullname, $fh); } unlink $tmp_header; } |