#!/usr/bin/perl

use File::stat;
use FileHandle;
use strict 'refs';
#use RPMQ;		# FIXME: a local copy of RPM.pm is here.

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,@LANGUAGES,%SEEN_PACKAGE,%IGNORE_PACKAGE);
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";

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" ) { $ignore_dir = shift @ARGV ; }
  elsif ( $arg eq "-I" ) { $ignore_file = shift @ARGV ; }
  elsif ( $arg eq "-o" ) { $output_dir = 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"; }
  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 "	[-i IGNORE_DIR ] [-I IGNORE_FILE ]\n";
	 print "	[-l LANG1 [-l LANG2 [... ] ]    (default english)\n";
	 print "	[-o OUTPUT_DIR ]                (default cwd/setup/descr)\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";
	 die ("unknown parameter\n");
  }
}

if ( $ignore_symlinks eq "1" ) {
  $with_links = "-type f";
} else {
  $with_links = "";
}

push @DATADIRS , "." unless ( @DATADIRS );
push @LANGUAGES , "english" unless ( @LANGUAGES );
$output_dir = "./setup/descr/" unless ( $output_dir );

print "\n\nusing settings:\n";
print "datadirs: ".join(",",@DATADIRS)."\n";
print "languages: ".join(",",@LANGUAGES)."\n";
print "output dir: $output_dir\n";
if ( -d $pdb_data_dir ) {
  print "pdb data: $pdb_data_dir\n";
} else {
  print "$pdb_data_dir is not a directory: ignoring\n";
  $pdb_data_dir = "";
}

unless ( -d $output_dir ) {
	print "creating output directory $output_dir\n";
	mkdir_p($output_dir);
}

if ( $extra_provides ) {
  if ( -f $extra_provides ) {
    print "extra_provides: $extra_provides\n";
    %xprovlist = %{ReadFileToHash( $extra_provides )};
  } else {
    print "extra_provides: file $extra_provides not found!\n";
  }
} else {
    print "extra_provides: not specified\n";
    print "WARNING: this means all provides like /bin/sh will be missing\n";
}

if ( $ignore_dir ) {
  if ( -d $ignore_dir && opendir ( IGNDIR, "$ignore_dir") ) {
    while ( $ign = readdir( IGNDIR ) ) {
      next if ( $ign =~ /^\./ );
      $IGNORE_PACKAGE{$ign} = "yes";
    }
    closedir ( IGNDIR );
    print "ignoring packages listed in dir $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 "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;
$dotcounter = 0;
$allcounter = 0;
foreach $datapath (@DATADIRS) {
  $media_number++;
  open ( FIND, "find $datapath $with_links -maxdepth 2 -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) {
   #print "found $package\n";
   $dotcounter++;
   $allcounter++;
   if ( $dotcounter == 10 ) {
      print ".";
      $dotcounter = 0;
   }
   $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 = RPM::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
   RPM::rpmq_add_flagsvers(\%res, 1047, 1112, 1113); # provides
   RPM::rpmq_add_flagsvers(\%res, 1090, 1114, 1115); # obsoletes
   RPM::rpmq_add_flagsvers(\%res, 1054, 1053, 1055); # conflicts
   RPM::rpmq_add_flagsvers(\%res, 1156, 1158, 1157); # suggests
   RPM::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 $checksum = "";
   my $dummy = "";
   ($checksum,$dummy) = split('\s+',`sha1sum $package`) if ($do_checksums eq "1");
   $srcrpm = $res{1044}[0];
   $srcrpm =~ s/^(.*)-([^-]*)-([^-]*)\.([^\.]*)\.rpm$/$1 $2 $3 $4/;
   if ( $res{1044}[0] ) {
	@DULIST = RpmToDulist(\%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(\%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);
     }
   }

    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") {
		require "$pdb_data_dir/$pac_rpm_name.pl";
	    } else {
		# no pdb data for this package, use rpm summary
		print "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"} =~ /\n/ ) {
		warn ("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"}} );
	    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 ("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}});
				}
			}
		}
	    }
	} 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 " done\nprocessed $allcounter packages\n";
if ( $ignored_packages ) {
    print "following packages were ignored: $ignored_packages\n";
}

close ( $pkg_main );
foreach $lang (@LANGUAGES) {
  close ( $pkg_lang{$lang} );
}
close ( $pkg_du );

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

sub RpmToDulist {
  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;
    next if $seen{"$dev $ino"};
    $seen{"$dev $ino"} = 1;
    $name =~ s/^\///;
    $name = "$prefix$name";
    $first = 1;
    $size = int ($size / 1024) + 1;
    while ($name ne '') {
      $name = '' unless $name =~ s/\/[^\/]*$//;
      if ($first) {
	$dirsize{"$name/"} += $size;
	$dirnum{"$name/"} += 1;
	$subdirsize{"$name/"} ||= 0;	# so we get all keys
      } else {
	$subdirsize{"$name/"} += $size;
	$subdirnum{"$name/"} += 1;
      }
      $first = 0;
    }
  }
  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 RpmToDulist {
#    local ($filename,$prefix) = @_;
#    local (%dirsize, %subdirsize, %dirnum, %subdirnum, @dulist);
#    local (%seen_node);
#    open ( FILES, "rpm -qp --qf '[%{FILEMODES:perms} %{FILESIZES} %{FILEDEVICES} %{FILEINODES} %{FILENAMES}\n]' $filename |") || die "cant open infile $filename";
#
#    while (<FILES>) {
#        # rights is not used, but start of $_ in the if below
#        ($rights , $size, $f_dev, $f_node, $name ) = split( ' ', $_ );
#        $size = int ( $size / 1024 ) + 1;
#        if ( $rights =~ /^\-/ ) {
#	    next if ( $seen_node{"$f_dev $f_node"} );
#	    $seen_node{"$f_dev $f_node"} = "yes";
#	    $name = $prefix.$name;
#            @path = split ( '/', $name );
#            pop ( @path );
#            $rpath = join('/',@path) ;
#            $dirsize{$rpath} += $size;
#            $dirnum{$rpath} += 1;
#            $subdirsize{$rpath} += 0;
#            $subdirnum{$rpath} += 0;
#            while (pop(@path)) {
#                $rpath = join('/',@path) ;
#                $subdirsize{$rpath} += $size;
#                $subdirnum{$rpath} += 1;
#            }
#        }
#    }
#    close (FILES);
#
#    foreach $dir ( sort ( keys (%subdirsize) ) ) {
#        if ( $dirsize{$dir} || $subdirsize{$dir} ) {
#            $prdir = $dir;
#            $prdir =~ s/^\///;
#	    $curline = "$prdir/ ";
#	    $curline .= $dirsize{$dir} ? "$dirsize{$dir} " : "0 ";
#            $curline .= $subdirsize{$dir} ? "$subdirsize{$dir} " : "0 ";
#            $curline .= $dirnum{$dir} ? "$dirnum{$dir} " : "0 ";
#            $curline .= $subdirnum{$dir} ? "$subdirnum{$dir} " : "0 ";
#	    push @dulist, $curline;
#        }
#    }
#    return @dulist;
#}

####################### copied from RPM.pm by mls #################################
package RPM;

sub rpmpq {
  my $rpm = shift;
  local *RPM;

  return undef unless open(RPM, "< $rpm");
  my $head;
  if (sysread(RPM, $head, 75) < 11) {
    close RPM;
    return undef;
  }
  close RPM;
  return unpack('@10Z65', $head);
}

sub rpmq {
  my $rpm = shift;
  my $stag = shift;

  my %ret = rpmq_many($rpm, $stag);
  return @{$ret{0+$stag} || [undef]};
}

sub rpmq_many {
  my $rpm = shift;
  my @stags = @_;

  my %stags = map {0+$_ => 1} @stags;

  my ($magic, $sigtype, $headmagic, $cnt, $cntdata, $lead, $head, $index, $data, $tag, $type, $offset, $count);

  local *RPM;
  return () unless open(RPM, "<$rpm");
  if (read(RPM, $lead, 96) != 96) {
    warn("Bad rpm $rpm\n");
    close RPM;
    return ();
  }

  ($magic, $sigtype) = unpack('N@78n', $lead);
  if ($magic != 0xedabeedb || $sigtype != 5) {
    warn("Bad rpm $rpm\n");
    close RPM;
    return ();
  }

  if (read(RPM, $head, 16) != 16) {
    warn("Bad rpm $rpm\n");
    close RPM;
    return ();
  }
  ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
  if ($headmagic != 0x8eade801) {
    warn("Bad rpm $rpm\n");
    close RPM;
    return ();
  }
  if (read(RPM, $index, $cnt * 16) != $cnt * 16) {
    warn("Bad rpm $rpm\n");
    close RPM;
    return ();
  }
  $cntdata = ($cntdata + 7) & ~7;
  if (read(RPM, $data, $cntdata) != $cntdata) {
    warn("Bad rpm $rpm\n");
    close RPM;
    return ();
  }

  if (read(RPM, $head, 16) != 16) {
    warn("Bad rpm $rpm\n");
    close RPM;
    return ();
  }
  ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
  if ($headmagic != 0x8eade801) {
    warn("Bad rpm $rpm\n");
    close RPM;
    return ();
  }
  if (read(RPM, $index, $cnt * 16) != $cnt * 16) {
    warn("Bad rpm $rpm\n");
    close RPM;
    return ();
  }
  if (read(RPM, $data, $cntdata) != $cntdata) {
    warn("Bad rpm $rpm\n");
    close RPM;
    return ();
  }
  close RPM;

  my %res = ();
  while($cnt-- > 0) {
    ($tag, $type, $offset, $count, $index) = unpack('N4a*', $index);
    $tag = 0+$tag;
    if ($stags{$tag}) {
      eval {
	if ($type == 0) {
	  $res{$tag} = [ '' ];
	} elsif ($type == 1) {
	  $res{$tag} = [ unpack("\@${offset}c$count", $data) ];
	} elsif ($type == 2) {
	  $res{$tag} = [ unpack("\@${offset}c$count", $data) ];
	} elsif ($type == 3) {
	  $res{$tag} = [ unpack("\@${offset}n$count", $data) ];
	} elsif ($type == 4) {
	  $res{$tag} = [ unpack("\@${offset}N$count", $data) ];
	} elsif ($type == 5) {
	  $res{$tag} = [ undef ];
	} elsif ($type == 6) {
	  $res{$tag} = [ unpack("\@${offset}Z*", $data) ];
	} elsif ($type == 7) {
	  $res{$tag} = [ unpack("\@${offset}a$count", $data) ];
	} elsif ($type == 8 || $type == 9) {
	  my $d = unpack("\@${offset}a*", $data);
	  my @res = split("\0", $d, $count + 1);
	  $res{$tag} = [ splice @res, 0, $count ];
	} else {
	  $res{$tag} = [ undef ];
	}
      };
      if ($@) {
	warn("Bad rpm $rpm: $@\n");
        return ();
      }
    }
  }
  return %res;
}

sub rpmq_add_flagsvers {
  my $res = shift;
  my $name = shift;
  my $flags = shift;
  my $vers = shift;

  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]";
    }
    shift @flags;
    shift @vers;
  }
}

sub rpmq_provreq {
  my $rpm = shift;

  my @prov = ();
  my @req = ();
  my $r;
  my %res = rpmq_many($rpm, 1047, 1049, 1048, 1050, 1112, 1113);
  rpmq_add_flagsvers(\%res, 1047, 1112, 1113);
  rpmq_add_flagsvers(\%res, 1049, 1048, 1050);
  return $res{1047}, $res{1049};
}

1;