#!/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.26 2007/09/13 22:30:32 root Exp root $
#

BEGIN {
  $abuild_base_dir = "/usr/share/inst-source-utils";
  unshift @INC, "$abuild_base_dir/modules";
}

$| = 1;

use File::stat;
use FileHandle;
use strict 'refs';
use RPMQ;
use Digest::MD5 ();

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;
}

local (@DATADIRS,@IGNOREDIRS,@LANGUAGES,%SEEN_PACKAGE,%IGNORE_PACKAGE,@SHA_CACHEDIR);
my %lang_alias = ("czech"=>"cs","english"=>"en","french"=>"fr","german"=>"de","italian"=>"it","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 $maxdepth = 255;

while ( $arg = shift ( @ARGV ) ) {
  if ( $arg eq "-d" ) { push @DATADIRS , shift @ARGV ; }
  elsif ( $arg eq "-l" ) { push @LANGUAGES , shift @ARGV ; }
  elsif ( $arg eq "-p" ) { $pdb_data_dir = shift @ARGV ; }
  elsif ( $arg eq "-x" ) { $extra_provides = shift @ARGV ; }
  elsif ( $arg eq "-i" ) { push @IGNOREDIRS, shift @ARGV ; }
  elsif ( $arg eq "-I" ) { $ignore_file = shift @ARGV ; }
  elsif ( $arg eq "-o" ) { $output_dir = shift @ARGV ; }
  elsif ( $arg eq "-c" ) { push @SHA_CACHEDIR , shift @ARGV ; }
  elsif ( $arg eq "-r" ) { $extra_requires = shift @ARGV ; }
  elsif ( $arg eq "-M" ) { $maxdepth = shift @ARGV ; }
  elsif ( $arg eq "-Z" ) { $add_licenses = "1" ; }
  elsif ( $arg eq "-S" ) { $ignore_sources = "1"; }
  elsif ( $arg eq "-P" ) { $prefer_yastdescr = "1"; }
  elsif ( $arg eq "-L" ) { $ignore_symlinks = "1"; }
  elsif ( $arg eq "-C" ) { $do_checksums = "1"; }
  elsif ( $arg eq "-K" ) { $do_keywords = "1"; }
  else {
	 print "Usage: create_package_descr\n";
	 print "	[-d DATADIR1 [-d DATADIR2 [... ] ] ] (default cwd)\n";
	 print "	[-p PDB_DATA_DIR ]\n";
	 print "	[-x EXTRA_PROV_FILE ]\n";
	 print "	[-p EXTRA_REQUIRES_FILE]\n";
	 print "	[-i IGNORE_DIR [ -i IGNORE_DIR [... ] ] ]\n";
	 print "        [-I IGNORE_FILE ]\n";
	 print "	[-l LANG1 [-l LANG2 [... ] ]    (default english)\n";
	 print "	[-o OUTPUT_DIR ]                (default cwd/setup/descr)\n";
	 print "	[-c CACHE_DIR ]                 (default none)\n";
	 print "	[-M MAXDEPTH ]                  (default 255, depth for du-file)\n";
	 print "	[-Z ]                           (add_licenses)\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";
	 die ("unknown parameter\n");
  }
}

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 , "english" 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";
  }
}

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 = <IGNFILE> ) {
      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" );

WriteSEntry( $pkg_du, "Ver", "2.0" );

$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 ( <FIND> ) {
    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);

   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 = "";

   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 = <CSC>;
			chomp ($checksum);
			close ( CSC );
			#print "INFO: re_using checksum for $package ($checksum)\n";
		    }
		}
	}
	if ( ! $checksum ) {
		($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";
		}
	}
   }
   $srcrpm = $res{1044}[0];
   $srcrpm =~ s/^(.*)-([^-]*)-([^-]*)\.([^\.]*)\.rpm$/$1 $2 $3 $4/;
   if ( $res{1044}[0] ) {
	@DULIST = 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 = RpmToDulist($maxdepth, \%res, 'usr/src/packages/');
   }
   if ( $xprovlist{"$rpm_name.$file_arch"} ) {
     foreach $xprov (split('\s', $xprovlist{"$rpm_name.$file_arch"} )) {
	push (@{$res{1047}},$xprov);
     }
   }
   # should be else if, but merging both is needed right now
   if ( $xprovlist{$rpm_name} ) {
     foreach $xprov (split('\s', $xprovlist{$rpm_name} )) {
       push (@{$res{1047}},$xprov);
     }
   }
   # adding additional requires for a package
   if ($xreqlist{$rpm_name} ) {
     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, "Src", $srcrpm );
	WriteSEntry( $pkg_main, "Tim", $res{1006}[0] );
        WriteSEntry( $pkg_main, "Loc", "$media_number $filename");
    } else {
        WriteSEntry( $pkg_main, "Loc", "$media_number $filename $file_arch");
    }
    WriteSEntry( $pkg_main, "Siz", "$filesize $res{1009}[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;
	    $pac_rpm_name =~ s/-debuginfo$//;
	    $pac_rpm_name =~ s/-kmp-[^-]*$/-KMP/;
	    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$//;
	    }
	    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 found\n";
		$pacdata{$pac_rpm_name}{'english'}{"label"} = "$res{1004}[0]";
	    }
	    if ( ! $pacdata{$pac_rpm_name}{'english'}{"label"} ) {
		warn "ERROR:   no pdb data for $pac_rpm_name received\n";
	    }
	    if ( $pacdata{$pac_rpm_name}{'english'}{"label"} =~ /\n/ ) {
		warn "ERROR:   newline in summary for package $pac_rpm_name\n";
		$pacdata{$pac_rpm_name}{'english'}{"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}{'english'}{"label"} );
		}
		if ( $prefer_yastdescr eq "1" ) {
			foreach $tag (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}{'english'}{$tag._yast} ) {
					WriteMEntry( $pkg_lang{$lang}, $tag_short{$tag}, @{$pacdata{$pac_rpm_name}{'english'}{$tag._yast}});
				} else {
					WriteMEntry( $pkg_lang{$lang}, $tag_short{$tag}, @{$pacdata{$pac_rpm_name}{'english'}{$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}{'english'}{'confirmlic_yast'} ) {
				WriteMEntry( $pkg_lang{$lang}, "Eul", @{$pacdata{$pac_rpm_name}{'english'}{'confirmlic_yast'}});
			    }
			}
		} else {
			foreach $tag (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}{'english'}{$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}{'english'}{'confirmlic'} ) {
				WriteMEntry( $pkg_lang{$lang}, "Eul", @{$pacdata{$pac_rpm_name}{'english'}{'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 );
    $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 );

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/;
    $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);
  for $name (@names) {
    my $mode = shift @modes;
    my $dev = shift @devs;
    my $ino = shift @inos;
    my $size = shift @sizes;
    # check if regular file
    next if ($mode & 0170000) != 0100000;
    # don't count hardlinks twice
    next if $seen{"$dev $ino"};
    $seen{"$dev $ino"} = 1;
    # strip leading slash
    # prefix is either empty or ends in /
    $name =~ s/^\///;
    $name = "$prefix$name";

    # 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;
}

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;
}

