#!/usr/bin/perl

# $Id$

#- Copyright (C) 2002, 2003, 2004 Mandriva
#-
#- 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, 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

use strict;
use urpm;
use urpm::args;
use urpm::msg;

sub usage {
    print N("urpmf version %s
Copyright (C) 2002-2004 Mandriva.
This is free software and may be redistributed under the terms of the GNU GPL.

usage:
", $urpm::VERSION) . N("  --help         - print this help message.
") . N("  --all          - print all tags.
") . N("  --buildhost    - print tag buildhost: build host.
") . N("  --conflicts    - print tag conflicts: all conflicts.
") . N("  --description  - print tag description: description.
") . N("  --env          - use specific environment (typically a bug
                   report).
") . N("  --epoch        - print tag epoch: epoch.
") . N("  --excludemedia - do not use the given media, separated by comma.
") . N("  --files        - print tag files: all files.
") . N("  --group        - print tag group: group.
") . N("  --literal      - don't match patterns, but use argument as a literal string
") . N("  --media        - use only the given media, separated by comma.
") . N("  --name         - print only package names.
") . N("  --obsoletes    - print tag obsoletes: all obsoletes.
") . N("  --packager     - print tag packager: packager.
") . N("  --provides     - print tag provides: all provides.
") . N("  --requires     - print tag requires: all requires.
") . N("  --size         - print tag size: size.
") . N("  --sortmedia    - sort media according to substrings separated by comma.
") . N("  --sourcerpm    - print tag sourcerpm: source rpm.
") . N("  --summary      - print tag summary: summary.
") . N("  --synthesis    - use the synthesis given instead of urpmi db.
") . N("  --uniq         - do not print identical lines.
") . N("  --update       - use only update media.
") . N("  --url          - print tag url: url.
") . N("  --verbose      - verbose mode.
") . N("  -m             - print the media in which the package was found.
") . N("  -i             - ignore case distinctions in every pattern.
") . N("  -f             - print version, release and arch with name.
") . N("  -e             - include perl code directly as perl -e.
") . N("  -a             - binary AND operator, true if both expression are true.
") . N("  -o             - binary OR operator, true if one expression is true.
") . N("  !              - unary NOT, true if expression is false.
") . N("  (              - left parenthesis to open group expression.
") . N("  )              - right parenthesis to close group expression.
");
    exit(0);
}

#- default options.
our $update = 0;
our $media = '';
our $excludemedia = '';
our $sortmedia = '';
our $synthesis = '';
our $verbose = 0;
our $uniq = '';
our $pattern = ''; # regexp match flags ("i" or "")
our $full = ''; # -f : print rpm fullname instead of rpm name
our $literal = 0; # should we quotemeta the pattern
our $env;
our (%params, %uniq);

#- parse arguments list.
our $expr;
urpm::args::parse_cmdline();

my $urpm = new urpm;
$verbose or $urpm->{log} = sub {};

unless (scalar(grep defined, values %params)) {
    #- nothing on the command-line : default is to search on file names
    $params{files} = 1;
}

#- build the callback matching the expression.
my $callback = 'sub { my ($urpm, $pkg) = @_; '; #- it is a good start for a sub, no ;-)
foreach my $tag (qw(
    buildhost
    conflicts
    description
    epoch
    filename
    files
    group
    media
    obsoletes
    packager
    provides
    requires
    size
    sourcerpm
    summary
    url
)) {
    if ($params{$tag}) {
	my $fi = $tag eq 'media' ? '$urpm::currentmedia->{name}' : '$pkg->' . $tag;
	$callback .= '
      foreach my $e (' . $fi . ') {
        local $_ = $pkg->' . $full . 'name.":' . $tag . ':$e";
        ' . $expr . ' or next;
        ' . ($uniq && 'exists $uniq{$_} and next; $uniq{$_} = undef;
        ') . 'print "$_\n";
      }';
    }
}
$callback .= '
      1;
}';
$urpm->{error}(N("callback is:\n%s\n", $callback)) if our $debug;
$callback = eval $callback;
$@ and usage;

if ($env) {
    print STDERR N("using specific environment on %s\n", $env);
    #- setting new environment.
    $urpm->{config} = "$env/urpmi.cfg";
    $urpm->{skiplist} = "$env/skip.list";
    $urpm->{instlist} = "$env/inst.list";
    $urpm->{statedir} = $env;
}

{
    #- lock to avoid concurrent media updates,
    #- but don't die if it doesn't work
    local $urpm->{fatal} = sub { printf STDERR "%s\n", $_[0] };
    $urpm->shlock_urpmi_db;
}
my $use_hdlist = ($params{description} ||
    $params{sourcerpm} || $params{packager} || $params{buildhost} ||
    $params{url} || $params{files});
$urpm->configure(
    nocheck_access => 1,
    noskipping => 1,
    media => $media,
    excludemedia => $excludemedia,
    sortmedia => $sortmedia,
    synthesis => $synthesis,
    update => $update,
    callback => $callback,
    call_back_only_once => 1,
    hdlist => $use_hdlist,
);
$urpm->unlock_urpmi_db;

if ($use_hdlist) {
    # @hdmedia is the list of all media searched that use hdlists
    my @hdmedia = grep {
	!$_->{synthesis} && !$_->{removable} && !$_->{ignore};
    } @{ $urpm->{media} };
    if (!@hdmedia) {
	print N("Note: since no media searched uses hdlists, urpmf was unable to return any result\n");
	print N("You may want to use --name to search for package names.\n") if !$params{filename};
    }
}

#- that'all! all has been done by callback above.