#!/usr/bin/perl # # Copyright (C) 2006 Novell Inc. # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 51 Franklin Street, # Fifth Floor, # Boston, MA 02110-1301, # USA. # # $Id: create_package_descr,v 1.29 2008/06/24 18:42:26 lrupp Exp lrupp $ # BEGIN { $abuild_base_dir = "/work/abuild/lib/abuild"; unshift @INC, "$abuild_base_dir/modules"; } $| = 1; use File::stat; use FileHandle; use strict 'refs'; use RPMQ; use Digest::MD5 (); local (@DATADIRS,@IGNOREDIRS,@LANGUAGES,%SEEN_PACKAGE,%IGNORE_PACKAGE,@SHA_CACHEDIR); my %lang_alias = ( "czech"=>"cs", "english"=>"en", "french"=>"fr", "german"=>"de", "italian"=>"it", "russian" => "ru", "spanish"=>"es", "hungarian"=>"hu" ); my %tag_short = ("description"=>"Des","notice"=>"Ins","delnotice"=>"Del"); my $ignored_packages = ""; my $ignore_sources = "0"; my $ignore_symlinks = "0"; my $prefer_yastdescr = "0"; my $add_licenses = "0"; my $do_checksums = "0"; my $do_keywords = "0"; my $have_sha_cache = 0; my $do_file_list = 0; my $maxdepth = 255; my $src_requires = 0; my $default_lang="english"; my $add_vendor = 0; sub usage { my $exit_code=shift || 1; print "Usage: create_package_descr [OPTIONS]\n"; print " [-d DATADIR1 [-d DATADIR2 [... ] ] ] (default cwd)\n"; print " [-p PDB_DATA_DIR ]\n"; print " [-x EXTRA_PROV_FILE ]\n"; print " [-r EXTRA_REQUIRES_FILE]\n"; print " [-i IGNORE_DIR [ -i IGNORE_DIR [... ] ] ]\n"; print " [-I IGNORE_FILE ]\n"; print " [-l LANG1 [-l LANG2 [... ] ] (default $default_lang)\n"; print " [-o OUTPUT_DIR ] (default `cwd`/setup/descr)\n"; print " [-c CACHE_DIR ] (default none)\n"; print " [-M MAXDEPTH ] (default $maxdepth, depth for du-file)\n"; print " [-T XTAGS_FILE ] (extra hacks)\n"; print " [-Z ] (add_licenses)\n"; print " [-V ] (add_vendor for each rpm)\n"; print " [-S ] (ignore_sources)\n"; print " [-P ] (prefer_yastdescr)\n"; print " [-L ] (ignore_symlinks)\n"; print " [-C ] (do_checksums)\n"; print " [-K ] (do_keywords)\n"; print " [-F ] (do_file_list)\n"; print " [-B ] (add requires for src packages)\n"; exit $exit_code; } sub filter_weak { my ($r, $tn, $tf) = @_; my @tf = @{$r->{$tf} || []}; my @res; for (@{$r->{$tn}}) { push @res, $_ unless (shift @tf) & 0x8000000; } return @res; } sub filter_strong { my ($r, $tn, $tf) = @_; my @tf = @{$r->{$tf} || []}; my @res; for (@{$r->{$tn}}) { push @res, $_ if (shift @tf) & 0x8000000; } return @res; } while ( $arg = shift ( @ARGV ) ) { if ( $arg eq "-d" ) { push @DATADIRS , shift @ARGV ; } elsif ( $arg eq "-B" ) { $src_requires = 1; } elsif ( $arg eq "-V" ) { $add_vendor = 1; } elsif ( $arg eq "-C" ) { $do_checksums = "1"; } elsif ( $arg eq "-F" ) { $do_file_list = 1; } elsif ( $arg eq "-I" ) { $ignore_file = shift @ARGV ; } elsif ( $arg eq "-K" ) { $do_keywords = "1"; } elsif ( $arg eq "-L" ) { $ignore_symlinks = "1"; } elsif ( $arg eq "-M" ) { $maxdepth = shift @ARGV ; } elsif ( $arg eq "-P" ) { $prefer_yastdescr = "1"; } elsif ( $arg eq "-S" ) { $ignore_sources = "1"; } elsif ( $arg eq "-Z" ) { $add_licenses = "1" ; } elsif ( $arg eq "-c" ) { push @SHA_CACHEDIR , shift @ARGV ; } elsif ( $arg eq "-i" ) { push @IGNOREDIRS, shift @ARGV ; } elsif ( $arg eq "-l" ) { push @LANGUAGES , shift @ARGV ; } elsif (( $arg eq "-h" ) || ( $arg eq "--help" )) { shift @ARGV ; usage(0); } elsif ( $arg eq "-o" ) { $output_dir = shift @ARGV ; } elsif ( $arg eq "-p" ) { $pdb_data_dir = shift @ARGV ; } elsif ( $arg eq "-r" ) { $extra_requires = shift @ARGV ; } elsif ( $arg eq "-x" ) { $extra_provides = shift @ARGV ; } elsif ( $arg eq "-T" ) { $extra_tags = shift @ARGV ; } else { print STDERR "\nunknown parameter $arg\n\n"; usage(1); } } if ( $ignore_symlinks eq "1" ) { $with_links = "-type f"; } else { $with_links = ""; } for (@SHA_CACHEDIR) { $have_sha_cache++ if ( -d $_ ); } push @DATADIRS , "." unless ( @DATADIRS ); push @LANGUAGES , "$default_lang" unless ( @LANGUAGES ); $output_dir = "./setup/descr/" unless ( $output_dir ); print "INFO: datadirs : ".join(",",@DATADIRS)."\n"; print "INFO: languages : ".join(",",@LANGUAGES)."\n"; print "INFO: output dir : $output_dir\n"; if ( -d $pdb_data_dir ) { print "INFO: pdb data : $pdb_data_dir\n"; } elsif ( $pdb_data_dir ) { print "$pdb_data_dir is not a directory: ignoring\n"; $pdb_data_dir = ""; } if ( $extra_provides ) { if ( -f $extra_provides ) { print "INFO: extra_provides : $extra_provides\n"; %xprovlist = %{ReadFileToHash( $extra_provides )}; } else { print "WARNING: extra_provides : file $extra_provides not found!\n"; } } else { print "WARNING: -x not specified\n"; print "WARNING: this means all provides like /bin/sh will be missing\n"; } if ( $extra_requires ) { if ( -f $extra_requires ) { print "INFO: extra_requires : $extra_requires\n"; %xreqlist = %{ReadFileToHash( $extra_requires )}; } else { print "WARNING: extra_requires : file $extra_requires not found!\n"; } } if ( $extra_tags ) { if ( -f $extra_tags ) { print "INFO: extra_tags : $extra_tags\n"; %xtaglist = %{ReadFileToHash( $extra_tags )}; } else { print "WARNING: extra_tags : file $extra_tags not found!\n"; } } unless ( -d $output_dir ) { print "INFO: creating output directory $output_dir\n"; mkdir_p($output_dir); } if ( @IGNOREDIRS ) { foreach $ignore_dir (@IGNOREDIRS) { if ( -d $ignore_dir && opendir ( IGNDIR, "$ignore_dir") ) { while ( $ign = readdir( IGNDIR ) ) { next if ( $ign =~ /^\./ ); $IGNORE_PACKAGE{$ign} = "yes"; } closedir ( IGNDIR ); print "INFO: ignoring packages listed in directory $ignore_dir\n"; } } } if ( $ignore_file ) { if ( -f $ignore_file && open ( IGNFILE, "$ignore_file" ) ) { while ( $ign = ) { chomp ( $ign ); $IGNORE_PACKAGE{$ign} = "yes"; } close ( IGNFILE ); print "INFO: ignoring packages listed in file $ignore_file\n"; } } if ( $ignore_sources eq "1" ) { print "WARNING: ignoring all source packages\n"; } $pkg_main = OpenFileWrite ( "$output_dir/packages" ); WriteSEntry( $pkg_main, "Ver", "2.0" ); foreach $lang (@LANGUAGES) { $pkg_lang{$lang} = OpenFileWrite ( "$output_dir/packages.$lang_alias{$lang}" ); WriteSEntry( $pkg_lang{$lang}, "Ver", "2.0" ); } $pkg_du = OpenFileWrite ( "$output_dir/packages.DU" ); $pkg_fl = OpenFileWrite ( "$output_dir/packages.FL" ) if $do_file_list; WriteSEntry( $pkg_du, "Ver", "2.0" ); WriteSEntry( $pkg_fl, "Ver", "2.0" ) if $do_file_list; $media_number = 0; $allcounter = 0; foreach $datapath (@DATADIRS) { $media_number++; open ( FIND, "find $datapath -maxdepth 2 $with_links -name \"*.[rs]pm\" -print | sort |" ); my @pkg_arr = (); my @src_arr = (); while ( ) { chomp ( $_ ); if ( /\.spm$/ || /src\.rpm$/ ) { push @src_arr, $_; } else { push @pkg_arr, $_; } } close ( FIND ); foreach my $package (@pkg_arr,@src_arr) { $allcounter++; print "INFO: CD$media_number - Pkg: $allcounter\r" if ( -t STDOUT ); $filespec = $package; chomp ( $filespec ); $filespec =~ /\/([^\/]*)$/; $filename = $1; $filesize = stat($filespec)->size; # name, version, release, arch, obsolete, requires, provides, # conflicts, copyright, group, buildtime, size, sourcerpm my %res = RPMQ::rpmq_many($package, 1000, 1001, 1002, 1022, 1090, 1114, 1115, 1047, 1112, 1113, 1049, 1048, 1050, 1054, 1053, 1055, 1156, 1157, 1158, 1159, 1160, 1161, 1027, 1116, 1117, 1118, 1030, 1028, 1095, 1096, 1014, 1016, 1006, 1009, 1044, 1004, 1005, 1011); my @depexcl = $res{1054}; my @prereq = rpmq_add_req_flagsvers(\%res, 1049, 1048, 1050); # requires RPMQ::rpmq_add_flagsvers(\%res, 1047, 1112, 1113); # provides RPMQ::rpmq_add_flagsvers(\%res, 1090, 1114, 1115); # obsoletes RPMQ::rpmq_add_flagsvers(\%res, 1054, 1053, 1055); # conflicts RPMQ::rpmq_add_flagsvers(\%res, 1156, 1158, 1157); # suggests RPMQ::rpmq_add_flagsvers(\%res, 1159, 1161, 1160); # enhances $rpm_name = $res{1000}[0]; if ( $IGNORE_PACKAGE{$rpm_name} && $IGNORE_PACKAGE{$rpm_name} eq "yes" ) { $ignored_packages .= " $rpm_name"; next; } my @pack_path = split('/',$package); pop @pack_path; # filename pop @pack_path; # dirname / rpm-arch my $pack_basedir = join('/',@pack_path); my $checksum = ""; my $dummy = ""; my $hash = ""; $srcrpm = $res{1044}[0]; $srcrpm =~ s/^(.*)-([^-]*)-([^-]*)\.([^\.]*)\.rpm$/$1 $2 $3 $4/; if ($do_checksums eq "1") { if ( $have_sha_cache ne "0" ) { my %qq = RPMQ::rpmq_many($package, qw{SIGTAG_GPG SIGTAG_PGP SIGTAG_SHA1}); if ( %qq ) { for (qw{SIGTAG_GPG SIGTAG_PGP SIGTAG_SHA1}) { $hash .= join('', @{$qq{$_} || []}); } $hash = Digest::MD5::md5_hex($hash); } for (@SHA_CACHEDIR) { if ( -f "$_/$rpm_name-$hash" ) { open ( CSC, "< $_/$rpm_name-$hash" ); $checksum = ; chomp ($checksum); close ( CSC ); #print "INFO: re_using checksum for $package ($checksum)\n"; } } } if ( ! $checksum ) { if ( $res{1044}[0] || $ignore_sources eq "0") { ($checksum,$dummy) = split('\s+',`sha1sum $package`); if ( $have_sha_cache eq "1" ) { open ( CSC, "> $SHA_CACHEDIR[0]/$rpm_name-$hash" ); print CSC $checksum; close ( CSC ); #print "INFO: wrote checksum for $package ($checksum)\n"; } } } } if ( $res{1044}[0] ) { ($DULIST,$FLIST) = RpmToDulist($maxdepth, \%res, ''); $file_arch = $res{1022}[0]; } else { next if ( $ignore_sources eq "1" ); # has no source, so it is a source if ( $filename =~ /\.spm$/ ) { $file_arch = "src"; } else { $file_arch = $filename; $file_arch =~ s/^.*\.([^\.]*)\.rpm$/$1/; } ($DULIST,$FLIST) = RpmToDulist($maxdepth, \%res, 'usr/src/packages/'); } my %x_prov = (); if ( $xprovlist{"$rpm_name.$file_arch"} ) { foreach $xprov (split('\s', $xprovlist{"$rpm_name.$file_arch"} )) { $x_prov{$xprov} = 1; } } # should be else if, but merging both is needed right now if ( $xprovlist{$rpm_name} ) { foreach $xprov (split('\s', $xprovlist{$rpm_name} )) { $x_prov{$xprov} = 1; } } # add createrepo-style file provides (/etc/*,*bin/*,/usr/lib/sendmail) foreach $filename (@{$res{1027}}) { $x_prov{$filename} = 1 if ( $filename =~ /^\/etc\// || $filename =~ /bin\// || $filename eq "/usr/lib/sendmail" ); } push @{$res{1047}}, sort keys %x_prov; # adding additional requires for a package (but not for src packages) if ($xreqlist{$rpm_name} && $res{1044}[0]) { foreach $xreq (split('\s', $xreqlist{$rpm_name} )) { push (@{$res{1049}},$xreq); } } WriteSeparator( $pkg_main ); WriteSEntry( $pkg_main, "Pkg", "$res{1000}[0] $res{1001}[0] $res{1002}[0] $file_arch"); WriteSEntry( $pkg_main, "Cks", "SHA1 $checksum") if ($checksum); if ( $res{1044}[0] ) { # has src, so it's a binary package WriteMEntry( $pkg_main, "Req", @{$res{1049}} ); WriteMEntry( $pkg_main, "Prq", @prereq ); WriteMEntry( $pkg_main, "Prv", @{$res{1047}} ); WriteMEntry( $pkg_main, "Con", @{$res{1054}} ); WriteMEntry( $pkg_main, "Obs", @{$res{1090}} ); WriteMEntry( $pkg_main, "Rec", filter_strong(\%res, 1156, 1158)); WriteMEntry( $pkg_main, "Sug", filter_weak(\%res, 1156, 1158)); WriteMEntry( $pkg_main, "Sup", filter_strong(\%res, 1159, 1161)); WriteMEntry( $pkg_main, "Enh", filter_weak(\%res, 1159, 1161)); WriteSEntry( $pkg_main, "Grp", $res{1016}[0] ); WriteSEntry( $pkg_main, "Lic", $res{1014}[0] ); WriteSEntry( $pkg_main, "Vnd", $res{1011}[0] ) if $add_vendor; WriteSEntry( $pkg_main, "Src", $srcrpm ); WriteSEntry( $pkg_main, "Tim", $res{1006}[0] ); WriteSEntry( $pkg_main, "Loc", "$media_number $filename"); } else { WriteMEntry( $pkg_main, "Req", @{$res{1049}} ) if $src_requires; WriteSEntry( $pkg_main, "Loc", "$media_number $filename $file_arch"); } WriteSEntry( $pkg_main, "Siz", "$filesize $res{1009}[0]" ); print $pkg_main $xtaglist{$rpm_name}."\n" if ($xtaglist{$rpm_name} && $res{1044}[0]); if ( $SEEN_PACKAGE{"$rpm_name $res{1001}[0] $res{1002}[0]"} ) { $found_in = $SEEN_PACKAGE{"$rpm_name $res{1001}[0] $res{1002}[0]"}; WriteSEntry( $pkg_main, "Shr", "$res{1000}[0] $res{1001}[0] $res{1002}[0] $found_in"); } else { if ( $pdb_data_dir ) { my $pac_rpm_name = $rpm_name; delete $INC{"$pdb_data_dir/$pac_rpm_name.pl"}; if ( ! -f "$pdb_data_dir/$pac_rpm_name.pl" ) { $pac_rpm_name =~ s/-32bit$//; $pac_rpm_name =~ s/-64bit$//; $pac_rpm_name =~ s/-x86$//; $pac_rpm_name =~ s/-ia32$//; $pac_rpm_name =~ s/-lang$//; $pac_rpm_name =~ s/-debuginfo$//; $pac_rpm_name =~ s/-debugsource$//; $pac_rpm_name =~ s/-kmp-[^-]*$/-KMP/; } if ( -f "$pdb_data_dir/$pac_rpm_name.pl") { require "$pdb_data_dir/$pac_rpm_name.pl"; } else { # no pdb data for this package, use rpm summary warn "ERROR: no pdb data for $pac_rpm_name\n"; $pacdata{$pac_rpm_name}{"$default_lang"}{"label"} = "$res{1004}[0]"; } if ( ! $pacdata{$pac_rpm_name}{"$default_lang"}{"label"} ) { warn "ERROR: no pdb data for $pac_rpm_name received\n"; } if ( $pacdata{$pac_rpm_name}{"$default_lang"}{"label"} =~ /\n/ ) { warn "ERROR: newline in summary for package $pac_rpm_name\n"; $pacdata{$pac_rpm_name}{"$default_lang"}{"label"} =~ s/\n/ /g; } WriteMEntry( $pkg_main, "Aut", @{$pacdata{$pac_rpm_name}{"authorname"}} ); if ( $do_keywords eq "1" && $pacdata{$pac_rpm_name}{"keywords"} ) { WriteMEntry( $pkg_main, "Kwd", @{$pacdata{$pac_rpm_name}{"keywords"}} ); } foreach $lang (@LANGUAGES) { WriteSeparator( $pkg_lang{$lang} ); WriteSEntry( $pkg_lang{$lang}, "Pkg", "$res{1000}[0] $res{1001}[0] $res{1002}[0] $file_arch"); if ( $pacdata{$pac_rpm_name}{$lang}{"label"} ) { if ( $pacdata{$pac_rpm_name}{$lang}{"label"} =~ /\n/ ) { warn "ERROR: newline in $lang summary for package $pac_rpm_name\n"; $pacdata{$pac_rpm_name}{$lang}{"label"} =~ s/\n/ /g; } WriteSEntry( $pkg_lang{$lang}, "Sum", $pacdata{$pac_rpm_name}{$lang}{"label"} ); } else { WriteSEntry( $pkg_lang{$lang}, "Sum", $pacdata{$pac_rpm_name}{"$default_lang"}{"label"} ); } if ( $prefer_yastdescr eq "1" ) { foreach $tag (sort keys (%tag_short)) { if ( $pacdata{$pac_rpm_name}{$lang}{$tag._yast} ) { WriteMEntry( $pkg_lang{$lang}, $tag_short{$tag}, @{$pacdata{$pac_rpm_name}{$lang}{$tag._yast}}); } elsif ( $pacdata{$pac_rpm_name}{$lang}{$tag} ) { WriteMEntry( $pkg_lang{$lang}, $tag_short{$tag}, @{$pacdata{$pac_rpm_name}{$lang}{$tag}}); } elsif ( $pacdata{$pac_rpm_name}{"$default_lang"}{$tag._yast} ) { WriteMEntry( $pkg_lang{$lang}, $tag_short{$tag}, @{$pacdata{$pac_rpm_name}{"$default_lang"}{$tag._yast}}); } else { WriteMEntry( $pkg_lang{$lang}, $tag_short{$tag}, @{$pacdata{$pac_rpm_name}{"$default_lang"}{$tag}}); } } if ( $add_licenses eq "1" ) { if ( $pacdata{$pac_rpm_name}{$lang}{'confirmlic_yast'} ) { WriteMEntry( $pkg_lang{$lang}, "Eul", @{$pacdata{$pac_rpm_name}{$lang}{'confirmlic_yast'}}); } elsif ( $pacdata{$pac_rpm_name}{"$default_lang"}{'confirmlic_yast'} ) { WriteMEntry( $pkg_lang{$lang}, "Eul", @{$pacdata{$pac_rpm_name}{"$default_lang"}{'confirmlic_yast'}}); } } } else { foreach $tag (sort keys (%tag_short)) { if ( $pacdata{$pac_rpm_name}{$lang}{$tag} ) { WriteMEntry( $pkg_lang{$lang}, $tag_short{$tag}, @{$pacdata{$pac_rpm_name}{$lang}{$tag}}); } else { WriteMEntry( $pkg_lang{$lang}, $tag_short{$tag}, @{$pacdata{$pac_rpm_name}{"$default_lang"}{$tag}}); } } if ( $add_licenses eq "1" ) { if ( $pacdata{$pac_rpm_name}{$lang}{'confirmlic'} ) { WriteMEntry( $pkg_lang{$lang}, "Eul", @{$pacdata{$pac_rpm_name}{$lang}{'confirmlic'}}); } elsif ( $pacdata{$pac_rpm_name}{"$default_lang"}{'confirmlic'} ) { WriteMEntry( $pkg_lang{$lang}, "Eul", @{$pacdata{$pac_rpm_name}{"$default_lang"}{'confirmlic'}}); } } } } } else { foreach $lang (@LANGUAGES) { WriteSeparator( $pkg_lang{$lang} ); WriteSEntry( $pkg_lang{$lang}, "Pkg", "$res{1000}[0] $res{1001}[0] $res{1002}[0] $file_arch"); WriteSEntry( $pkg_lang{$lang}, "Sum", "$res{1004}[0]" ); WriteMEntry( $pkg_lang{$lang}, "Des", split('\n', $res{1005}[0] )); } } } WriteSeparator( $pkg_du ); WriteSEntry( $pkg_du, "Pkg", "$res{1000}[0] $res{1001}[0] $res{1002}[0] $file_arch"); WriteMEntry( $pkg_du, "Dir", @{$DULIST} ); if ($do_file_list) { WriteSeparator( $pkg_fl ); WriteSEntry( $pkg_fl, "Pkg", "$res{1000}[0] $res{1001}[0] $res{1002}[0] $file_arch"); WriteMEntry( $pkg_fl, "Fls", @{$FLIST} ); } $SEEN_PACKAGE{"$rpm_name $res{1001}[0] $res{1002}[0]"} = $file_arch unless $SEEN_PACKAGE{"$rpm_name $res{1001}[0] $res{1002}[0]"}; } } print "INFO: processed $allcounter packages in $media_number volumes\n"; if ( $ignored_packages ) { print "INFO: following packages were ignored: $ignored_packages\n"; } close ( $pkg_main ); foreach $lang (@LANGUAGES) { close ( $pkg_lang{$lang} ); } close ( $pkg_du ); close ( $pkg_fl ) if $do_file_list; print "INFO: now recoding to UTF-8: "; foreach $file ("packages","packages.DU") { print "$file "; system ( "recode ISO-8859-1...UTF-8 $output_dir/$file" ); } foreach $lang (@LANGUAGES) { $file = "packages.$lang_alias{$lang}"; print "$file "; if ( $lang eq "czech" || $lang eq "hungarian" ) { system ( "recode ISO-8859-2...UTF-8 $output_dir/$file" ); } else { system ( "recode ISO-8859-1...UTF-8 $output_dir/$file" ); } } print "\n"; ##################################################################### ##################################################################### sub mkdir_p { my $dir = shift; return 1 if -d $dir; if ($dir =~ /^(.*)\//) { mkdir_p($1) || return undef; } return undef if !mkdir($dir, 0777); return 1; } sub OpenFileWrite { my $filename = shift; my ($FH) = new FileHandle; open ($FH, ">$filename") || die "ERROR: can't write output file $filename"; return $FH; } sub OpenFileRead { my $filename = shift; my ($FH) = new FileHandle; open ($FH, "<$filename") || die "ERROR: can't read input file $filename"; return $FH; } sub ReadFileToHash { local ($filename) = @_; local (%temp); my $FH = OpenFileRead( $filename ); while (<$FH>) { chomp ($_); last if ( $_ =~ /^:END/ ); next if ( $_ =~ /^\#/ ); next if ( $_ =~ /^\s$/ ); local ($le,$ri) = split (/:/, $_, 2 ); $le =~ s/^\s*(.*)\s*$/$1/; $ri =~ s/^\s*(.*)\s*$/$1/; $ri =~ s/\\n/\n/g; $temp{$le}=$ri; } close ($FH); \%temp; } sub WriteSeparator { my ($FH) = shift; print $FH "##----------------------------------------\n"; } sub WriteSEntry { my ($FH,$tag,$value) = @_; if ( $value ) { print $FH "=$tag: $value\n"; } } sub WriteMEntry { my ($FH,$tag,@value) = @_; if ( @value && $value[0] ) { print $FH "+$tag:\n"; print $FH join("\n", @value)."\n"; print $FH "-$tag:\n"; } } sub RpmToDulist { my $maxdepth = shift; my $res = shift; my $prefix = shift; if (!$res->{1027}) { my @newfl = (); my @di = @{$res->{1116} || []}; for (@{$res->{1117} || []}) { my $di = shift @di; push @newfl, $res->{1118}->[$di] . $_; } $res->{1027} = [ @newfl ]; } my @modes = @{$res->{1030} || []}; my @devs = @{$res->{1095} || []}; my @inos = @{$res->{1096} || []}; my @names = @{$res->{1027} || []}; my @sizes = @{$res->{1028} || []}; my %seen = (); my %dirnum = (); my %subdirnum = (); my %dirsize = (); my %subdirsize = (); my ($name, $first); my @flist = (); for $name (@names) { my $mode = shift @modes; my $dev = shift @devs; my $ino = shift @inos; my $size = shift @sizes; # strip leading slash # prefix is either empty or ends in / $name =~ s/^\///; $name = "$prefix$name"; push @flist, "/$name"; # check if regular file next if ($mode & 0170000) != 0100000; # don't count hardlinks twice next if $seen{"$dev $ino"}; $seen{"$dev $ino"} = 1; # rounded size in kbytes $size = int ($size / 1024) + 1; $name = '' unless $name =~ s/\/[^\/]*$//; if ( ($name =~ tr/\///) < $maxdepth ) { $dirsize{"$name/"} += $size; $dirnum{"$name/"} += 1; $subdirsize{"$name/"} ||= 0; # so we get all keys } # traverse though path stripping components from the back $name =~ s/\/[^\/]*$// while ( ($name =~ tr/\///) > $maxdepth ); while ($name ne '') { $name = '' unless $name =~ s/\/[^\/]*$//; $subdirsize{"$name/"} += $size; $subdirnum{"$name/"} += 1; } } my @dulist = (); for $name (sort keys %subdirsize) { next unless $dirsize{$name} || $subdirsize{$name}; $dirsize{$name} ||= 0; $subdirsize{$name} ||= 0; $dirnum{$name} ||= 0; $subdirnum{$name} ||= 0; push @dulist, "$name $dirsize{$name} $subdirsize{$name} $dirnum{$name} $subdirnum{$name}"; } return \@dulist,\@flist; } sub rpmq_add_req_flagsvers { my $res = shift; my $name = shift; my $flags = shift; my $vers = shift; my @prereq = (); return unless $res; my @flags = @{$res->{$flags} || []}; my @vers = @{$res->{$vers} || []}; for (@{$res->{$name}}) { if (@flags && ($flags[0] & 0xe) && @vers) { $_ .= ' '; $_ .= '<' if $flags[0] & 2; $_ .= '>' if $flags[0] & 4; $_ .= '=' if $flags[0] & 8; $_ .= " $vers[0]"; } if ( $flags[0] & 64 ) { push ( @prereq, $_ ); } shift @flags; shift @vers; } return @prereq; }