#!/usr/bin/perl -w

#
# apt-file - APT package searching utility -- command-line interface
#
# (c) 2001 Sebastien J. Gross <seb@debian.org>
# $Id: apt-file,v 1.34 2004/01/12 12:13:36 sjg_ Exp $
#
#
# This package 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; version 2 dated June, 1991.
#
# This package 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 package; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
#

use strict;
use Config::File "read_config_file";
use Getopt::Long qw/:config no_ignore_case/;
use Data::Dumper;
use File::Basename;
use AptPkg::Config '$_config';
use constant VERSION => "2.0.8.2";


my $Conf;
my $Version;

sub error($) {
    print STDERR "E: ", shift, $! ? ": $!" : "" ,"\n";
    undef $!;
    exit 1;
}

sub warning($) {
    print STDERR "W: ", shift, $! ? ": $!" : "" ,"\n";
    undef $!;
}

sub debug($;$) {
    return if ! defined $Conf->{verbose};
    my ($msg, $use_errstr) = @_;
    print STDERR "D: ", $msg;
    print STDERR $! ? ": $!" : "" if $use_errstr;
    print STDERR "\n";
    undef $!;
}

sub debug_line($){
    return if ! defined $Conf->{verbose};
    print STDERR shift;
}

sub unique($) {
    my $seen = ();
    return [ grep { ! $seen->{$_}++ } @{(shift)} ];
}

sub reverse_hash($) {
    my $hash = shift;
    my $ret = ();
    foreach my $key (keys %$hash) {
	foreach (@{$hash->{$key}}) {
	    push @{$ret->{$_}}, $key;
	}
    }
    return $ret;
}

# find_command 
# looks through the PATH environment variable for the command named by
# $conf->{$scheme}, if that command doesn't exist, it will look for
# $conf->{${scheme}2}, and so on until it runs out of configured
# commands or an executable is found.
#
sub find_command
{
    my $conf = shift; 
    my $scheme = shift;

    my $i = 1;
    while(1)
    {
	my $key = $scheme;
	$key = $key.$i if $i != 1;
	return unless defined $conf->{$key};
	my $cmd = $conf->{$key};
	$cmd =~ s/ .*//;
	for my $path (split( /:/,$ENV{'PATH'}))
	{
	    return $conf->{$key} if -x ( $path.'/'.$cmd );
	}
	$i = $i+1;
    }
}

sub parse_sources_list($) {
    my $file = shift;
    my $uri;
    my @uri_items;
    my @tmp;
    my $line;
    my $ret;

    my ($cmd, $dest);

    open(SOURCE, "< $file") || error "Can't open $file";
    while(<SOURCE>) {
	next if /^\s*(?:$|\#|(?:deb-|rpm-))/xo;
	chomp;
	my $line = $_;
	debug "got \'$line\'";
	$line =~ s/([^\/])\#.*$/$1/o;
	$line =~ s/^(\S+\s+)\[\S+\]/$1/o;
	$line =~ s/\s+/ /go;
	$line =~ s/^\s+//o;

	# CDROM entry
	if (@tmp = $line =~ m/^([^\[]*)\[([^\]]*)\](.*)$/o) {
	    $tmp[1] =~ s/ /_/g;
	    $line = $tmp[0].'['.$tmp[1].']'.$tmp[2];
	}

	# Handle $(ARCH) in sources.list
	$line =~ s/\$\(ARCH\)/$Conf->{arch}/g;
	debug "kept \'$line\'";

	my( $pkg, $uri, $dist, @extra) = split /\s+/, $line;
	$uri =~ s/\/+$//;
	my($scheme, $user, $passwd, $host, $port, $path, $query,
	   $fragment) =
	       $uri =~
	       m|^
	       (?:([^:/?\#]+):)?           # scheme
	       (?://
		(?:
		 ([^:@]*)                  #username
		 (?::([^@]*))?             #passwd
		 @)?
		([^:/?\#]*)                # host
		(?::(\d+))?                # port
		)?
		([^?\#]*)			# path
		(?:\?([^\#]*))?		# query
		(?:\#(.*))?			# fragment
		|ox;

#	print "$scheme, $user, $passwd, $host, $port, $path, $query, $fragment\n";

	my $fetch=[];

	foreach (@extra) {
	    push @$fetch,  m/(.*?)\/(?:.*)/o ? "$dist/$1" : "$dist";
	}

	foreach (@{(unique $fetch)}) {
	    if (!defined $Conf->{"${scheme}"}) {
		warning "Don't know how to handle $scheme";
		next;
	    }
	    $dist = $_;
	    $cmd = find_command( $Conf, $scheme );
#	    $cmd = $Conf->{"${scheme}"};
	    die "Could not find suitable command for $scheme" unless $cmd;
	    $dest = $Conf->{destination};
	    my $cache = $Conf->{cache};
	    my $arch = $Conf->{arch};
	    my $cdrom = $Conf->{cdrom_mount};
	    foreach my $var (qw/host port user passwd path dist pkg
			     cache arch uri cdrom/) {
		map {
		    $_ =~ s{<$var(?:\|(.+?))?>}{
			defined eval "\$$var" ? eval "\$$var" :
			    defined $1 ? $1 : "";
		    }gsex;
		} ($cmd, $dest)
	    }
	    $dest =~ s/(\/|_)+/_/go;
	    $cmd =~ s/<dest>/$dest/g;
	    my $hash;
	    foreach (qw/host port user passwd path dist pkg uri line
		     dest cmd/) {
		$hash->{$_} = eval "\$$_";
	    }
	    push @$ret, $hash;
	};
    }
    close SOURCE;
    return $ret;
}

sub fetch_files ($) {
    mkdir $Conf->{cache} if ! -d $Conf->{cache};
    error "Can't write in $Conf->{cache}" if ! -w $Conf->{cache};
    foreach (@{(shift)}) {
	debug $_->{cmd};
	qx|$_->{cmd}| if ! defined $Conf->{dummy};
    }
}

sub print_winners ($$) {
    my ($db, $matchfname) = @_;
    my $filtered_db;

    # $db is a hash from package name to array of file names.  It is
    # a superset of the matching cases, so first we filter this by the 
    # real pattern.
    foreach my $key (keys %$db) {
        if ($matchfname || ($key =~ /$Conf->{pattern}/)) {
            $filtered_db->{$key} = $db->{$key};
        }
    }
    
    # Now print the winners
    if (!defined $Conf->{package_only}) {
	foreach my $key (sort keys %$filtered_db) {
	    foreach (sort @{$filtered_db->{$key}}) {
		print "$key: $_\n";
	    }
	}
    } else {
	print map {"$_\n"} (sort keys %$filtered_db);
    }
    exit 0;
}

sub do_grep($$) {
    my ($data, $pattern) = @_;
    my $ret;
    my ($pack, $file);
    debug "regexp: $pattern";
    $|=1;
    my $regexp = eval { $Conf->{ignore_case} ? qr/$pattern/i : qr/$pattern/ };
    error($@) if $@;
    foreach(@$data) {
	my $file = "$Conf->{cache}/$_->{dest}";
	next if (! -f $file);
	$file = quotemeta $file;
	debug "Search in $file";
	open (ZCAT, "zcat $file |") ||
	    warning "Can't zcat $file";
	while(<ZCAT>) {
	    next if ! (($pack, $file) = /$regexp/);
	    debug_line ".";
	    foreach (split /,/, $file) {
		push @{$ret->{$pack}}, basename $_;
	    }
	}
	close ZCAT;
	debug_line "\n";
    }
    return reverse_hash($ret);
}

sub grep_file($) {
    my $data = shift;
    my $pattern = join "", (
			    '^(.*?',
			    $Conf->{pattern},
			    defined $Conf->{fixed_strings} ?
			    ")" : '[^\s]*)',
			    '\s+(\S+)\s*$',
			    );
    my $ret = do_grep $data, $pattern;
    print_winners $ret, 1; 
}

sub grep_package($) {
    my $data = shift;
    # File name may contain spaces, so match template is 
    # ($fname, $pkgs) = (line =~ '^\s*(.*?)\s+(\S+)\s*$')
    my $pattern = join "", (
			    '^\s*(.*?)\s+',
			    '(\S*/',
			    $Conf->{pattern},
			    defined $Conf->{fixed_strings} ?
			    '(,\S*|)' : '\S*',
			    ')\s*$',
			    );
    my $ret = do_grep $data, $pattern;
    print_winners $ret, 0;
}

sub purge_cache($) {
    my $data = shift;
    foreach (@$data) {
	debug "Purging $Conf->{cache}/$_->{dest}";
	next if defined $Conf->{dummy};
	unlink "$Conf->{cache}/$_->{dest}" ||
	    warning "Can't remove $Conf->{cache}/$_->{dest}";
    }
}

sub print_version {
    print <<EOF;
apt-file version $Version
(c) 2002 Sebastien J. Gross <sjg\@debian.org>

EOF
    ;
}

sub print_help {
    my $err_code = shift || 0;

    print_version;
    print <<"EOF";

apt-file [options] action [pattern]

Configuration options:
    --sources-list	-s  <file>	sources.list location
    --cache		-c  <dir>	Cache directory
    --architecture	-a  <arch>	Use specific architecture
    --cdrom-mount	-d  <cdrom>	Use specific cdrom mountpoint
    --package-only	-l		Only display packages name
    --fixed-string	-F		Do not expand pattern
    --ignore-case	-i		Ignore case distinctions
    --regexp		-x		pattern is a regular expression
    --verbose		-v		run in verbose mode
    --dummy		-y		run in dummy mode (no action)
    --help		-h		Show this help.
    --version		-V		Show version number

Action:
    update			Fetch Contents files from apt-sources.
    search|find	<pattern>	Search files in packages
    list|show	<pattern>	List files in packages
    purge			Remove cache files
EOF
;
    exit $err_code;
}

sub get_options() {
    my %options = (
		   "sources-list|s=s" => \$Conf->{sources_list},
		   "cache|c=s" => \$Conf->{cache},
		   "architecture|a=s" => \$Conf->{architecture},
		   "cdrom-mount|d=s" => \$Conf->{cdrom_mount},
		   "verbose|v" => \$Conf->{verbose},
		   "ignore-case|i" => \$Conf->{ignore_case},
		   "regexp|x" => \$Conf->{is_regexp},
		   "dummy|y" => \$Conf->{dummy},
		   "package-only|l" => \$Conf->{package_only},
		   "fixed-string|F" => \$Conf->{fixed_strings},
		   "help|h" => \$Conf->{help},
		   "version|V" => \$Conf->{version},
		   );
    GetOptions(%options) || print_help 1;
}

sub main {
    my $conf_file;
    map { $conf_file = $_ if -f $_ } ("/etc/apt/apt-file.conf",
				      "apt-file.conf",
				      "$ENV{HOME}/.apt-file.conf");

    error "No config file found\n" if ! defined $conf_file;
    debug "Using $conf_file";

    $Conf=read_config_file $conf_file;
    get_options();
    if (defined $Conf->{version}) {
	print_version;
	exit 0;
    }

    $_config->init;
    $Conf->{arch} ||= $_config->{'APT::Architecture'};
    $Conf->{sources_list} ||=  $_config->{'Dir'} .
	$_config->{'Dir::Etc'} . $_config->{'Dir::Etc::sourcelist'};
    $Conf->{cache} ||= $_config->{'Dir'} . $_config->{'Dir::Cache'} . 'apt-file';
    $Conf->{cache} =~ s/\/\s*$//;
    $Conf->{cdrom_mount} ||= $_config->{'Acquire::cdrom::Mount'} ||
	"/cdrom";

    $Conf->{action} = shift @ARGV || "none";
    $Conf->{pattern} = shift @ARGV;
    if(defined $Conf->{pattern}) {
	$Conf->{pattern} =~ s/^\///;
	$Conf->{pattern} = quotemeta($Conf->{pattern}) unless $Conf->{is_regexp};
	if ($Conf->{is_regexp} and $Conf->{pattern} =~ /(\\[zZ]|\$)$/) {
	    $Conf->{pattern} =~ s/(\\[zZ]|\$)$//;
	    $Conf->{fixed_strings} = 1
	}
    }
    undef $!;

    my $actions = {
	update => \&fetch_files,
	search => \&grep_file,
	find => \&grep_file,
	list => \&grep_package,
	show => \&grep_package,
	purge => \&purge_cache,
    };

    $Conf->{help}=2 if $Conf->{action} =~ m/search|list/ &&
    	! defined $Conf->{pattern};
    $Conf->{help}=2 if ! defined $actions->{$Conf->{action}} &&
	! defined $Conf->{help};
    print_help($Conf->{help}-1) if defined $Conf->{help};

    my $sources = parse_sources_list $Conf->{sources_list};
    error "No valid sources in $Conf->{sources_list}" if ! defined
	$sources;

    $actions->{$Conf->{action}}->($sources);
}

BEGIN {
    $Version = VERSION;
    main();
}

END {

}

__END__
