# RPM Package Management System
# Copyright (C) 1995 Red Hat, 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., 675 Mass Ave, Cambridge, MA 02139, USA.

# -*-perl-*-

use GDBM_File;
use Fcntl;

sub opendatabase {
    local ($mode) = @_;

    if (! -d "$rpm{root}/$rpm{libdir}") {
	mkdir("$rpm{root}/$rpm{libdir}", 0755);
    }

    if ($mode eq "rw") {
	$mode = 0102;
    } else {
	$mode = 0;
    }

    &debug("opening db mode $mode");

    tie(%Packages, GDBM_File, "$rpm{root}/$rpm{libdir}/packages", $mode, 0644);
    tie(%PathIndex, GDBM_File, "$rpm{root}/$rpm{libdir}/pathidx", $mode, 0644);
    tie(%NameIndex, GDBM_File, "$rpm{root}/$rpm{libdir}/nameidx", $mode, 0644);
    tie(%IconIndex, GDBM_File, "$rpm{root}/$rpm{libdir}/iconidx", $mode, 0644);
    tie(%GroupIndex, GDBM_File, "$rpm{root}/$rpm{libdir}/groupindex", $mode, 0644);
    tie(%PostIndex, GDBM_File, "$rpm{root}/$rpm{libdir}/postidx", $mode, 0644);

    if ($mode eq "rw") {
	$Packages{"--version--"} = 1;
    }
}

sub closedatabase {
    untie(%Packages);
    untie(%PathIndex);
    untie(%NameIndex);
    untie(%IconIndex);
    untie(%GroupIndex);
    untie(%PostIndex);
}

sub getmatches { 
    local ($label) = @_;
    local (@finallist, $firstrm, $secondrm, $version, $release, $orig);
    local ($packages, $package, $oname, $oversion, $orelease, $num);

    $orig = $label;

    &debug("looking for packages that match $label");

    # try to look this up, if we can't, then erase the rightmost element
    # and try again. When we're done, look at the removed elements and
    # try to use them as release/version restrictions

    &debug("looking for package(s) named $label");
    if (!defined $NameIndex{$label}) {
	($label, $firstrm) = $label =~ /^(.*)-(.*)$/;
	&debug("looking for package(s) named $label");
	if (!defined $NameIndex{$label}) {
	    ($label, $secondrm) = $label =~ /^(.*)-(.*)$/;
	    &debug("looking for package(s) named $label");
	    if (!defined $NameIndex{$label}) {
		&error("package $orig is not installed");
		return @finallist;
	    } else {
		$release = $firstrm;
		$version = $secondrm;
	    }
	} else {
	    $version = $firstrm;
	}
    }

    @packages = split(" ", $NameIndex{$label});
    
    &debug("before narrowing list is: $packages");

    $num = 0;
    foreach $package (@packages) {
	if (defined $version) {
	    ($oname, $oversion, $orelease) = $package =~ /(.*):(.*):(.*)/;
	    if ($version eq $oversion) {
		if (!defined($release) || $release eq $orelease) {
		    $finallist[$num++] = $package;
		}
	    }
	}
	else {
	    $finallist[$num++] = $package;
	}
    }

    debug("patches matching search pattern: @finallist");
    

    return @finallist;
}

# this is a workhorse of both installation and uninstallation
# it compares the database to the spec record passed and returns
# a array of all of the files that are shared between this spec
# and other packages in the database (is $shared) or the files
# that conflict between this spec and the other packages (if ! $shared)
sub findshared { 
    local($shared, $doingupgrade, *configlist, *spec) = @_;
    local($name, $subname, $i, $path, $info, $packagespecstr, $info);
    local($oname, $oversion, $orelease, $ofilenum, $filenum);
    local(%pkgconflicts, %ospec, $version, $release, $olabel);
    local(%conflicts, $label);

    # unnecessary shorthand
    $name = $spec{"name"};
    $subname = $spec{"subpackage:0:name"};
    if ($subname) {
	$name = "$name-$subname";
    }

    $label = "$name:$spec{version}:$spec{release}";
  
    # walk through the files one by one looking for conflicts
    for ( $i = 0; $i < $spec{"subpackage:0:fileC"}; $i++ ) {
	$path = $spec{"subpackage:0:file:$i:path"};
	$whereinstalled = $PathIndex{$path};
	if (!defined($whereinstalled)) { next };

	debug("installed list for $path: $whereinstalled");

	# this file already exists somewhere else 

	$info = $spec{"subpackage:0:file:$i:info"};

	foreach $package (split(" ", $whereinstalled)) {
	    ($oname, $oversion, $orelease, $ofilenum) =
		($package =~ /(.*):(.*):(.*):(.*)/);
	    $lookup = "$oname:$oversion:$orelease";

	    # rather then check the package for conflicts right now
	    # (which we could do), remember that this file could cause
	    # a conflict with this package. We'll then check this whole
	    # package for conflicts at once. Why? Becuase doing strtorec()
	    # for large packages takes a noticeable amount of time. This
	    # way it'll be called far fewer times 

	    if (defined $pkgconflicts{$lookup}) {
		$pkgconflicts{$lookup} = 
		    "$pkgconflicts{$lookup} $i:$ofilenum";
	    } else {
		$pkgconflicts{$lookup} = "$i:$ofilenum";
	    }
	}
    }

    foreach $package (keys(%pkgconflicts)) {
	debug("$package contains shared (possibly conflicting) files");

	$packagespecstr = $Packages{$package};
	if (!defined $packagespecstr) { 
	    &error("RPM database is corrupt. Use --rebuild to ",
		   "reconstruct it ($package not found)");
	}
	%ospec = strtorec($packagespecstr, "all");

	foreach $fileinfo (split(" ", $pkgconflicts{$package})) {
	    ($filenum, $ofilenum) = ($fileinfo =~ /(.*):(.*)/);

	    next unless ($ospec{"subpackage:0:file:$ofilenum:state"} 
			    eq "normal");
		
	    if (&is_config($ospec{"subpackage:0:file:$filenum:info"})) {
		&debug("storing info for config file ", 
		    $spec{"subpackage:0:file:$filenum:path"});
		$configlist{$spec{"subpackage:0:file:$filenum:path"}} =
		    $ospec{"subpackage:0:file:$ofilenum:info"};
	    }

	    next if $label eq $package;

	    $specs_same = specs_same(
		    $spec{"subpackage:0:file:$filenum:info"},
		    $ospec{"subpackage:0:file:$ofilenum:info"});
	    if ($specs_same == $shared) {
		$olabel = "$oname-$oversion-$orelease";

		if (!$shared) {
		    if (!$doingupgrade || ($oname ne $name)) {
			warning($spec{"subpackage:0:file:$filenum:path"}, 
				" conflicts with file from ", "$olabel");
		    }
		}
		
		if (defined $conflicts{$package}) {
		    $conflicts{$package} = "$conflicts{$package} $fileinfo";
		} else {
		    $conflicts{$package} = $fileinfo;
		}
	    }

	}
    }
  
    return %conflicts;
}

sub getmultmatches {
    foreach (@_) {
	push(@an, &getmatches($_));
    }

    return @an;
}

sub whence {
    local (@paths) = @_;
    local ($path, $oldpath, $str, %spec);
    local ($package, $version, $release, $subnum, $filenum, @list);

    foreach $path (@paths) {
	$oldpath = $path = "$ENV{PWD}/$path" unless $path =~ m%^/%;
	do {
	    $oldpath = $path;
	    $path =~ s%//%/%g;
	    $path =~ s%[^/]+/\.\./%%g;
	    $path =~ s%/\./%/%g;
	} until ($oldpath eq $path);

	if (defined $PathIndex{$path}) {
	    foreach $package (split(" ", $PathIndex{$path})) {
		($name, $version, $release, $filenum) =
		    $package =~ /(.*):(.*):(.*):(.*)/;

		push(@list, "$name:$version:$release");
	    }
	} else {
	    warning("$path not found in any package");
	}
    }

    return @list;    
}

1;