aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--NEWS2
-rw-r--r--genhdlist2104
2 files changed, 99 insertions, 7 deletions
diff --git a/NEWS b/NEWS
index d43c34b..94e4b1d 100644
--- a/NEWS
+++ b/NEWS
@@ -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
diff --git a/genhdlist2 b/genhdlist2
index cce5be6..f4452a3 100644
--- a/genhdlist2
+++ b/genhdlist2
@@ -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/&/&amp;/g;
+ $s =~ s/</&lt;/g;
+ $s =~ s/>/&gt;/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;
}