#!/usr/bin/perl

#- Copyright (C) 2002 MandrakeSoft (fpons@mandrakesoft.com)
#-
#- 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 qw(subs vars refs);
use urpm;

sub usage {
    print STDERR N("urpmf version %s
Copyright (C) 2002 MandrakeSoft.
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("  --update       - use only update media.
") . N("  --media        - use only the given media, separated by comma.
") . N("  --excludemedia - do not use the given media, separated by comma.
") . N("  --sortmedia    - sort media according to substrings separated by comma.
") . N("  --synthesis    - use the synthesis given instead of urpmi db.
") . N("  --verbose      - verbose mode.
") . N("  --quiet        - do not print tag name (default if no tag given on command
                   line, incompatible with interactive mode).
") . N("  --uniq         - do not print identical lines.
") . N("  --all          - print all tags.
") . N("  --name         - print tag name: rpm filename (assumed if no tag given on
                   command line but without package name).
") . N("  --group        - print tag group: group.
") . N("  --size         - print tag size: size.
") . N("  --epoch        - print tag epoch: epoch.
") . N("  --summary      - print tag summary: summary.
") . N("  --description  - print tag description: description.
") . N("  --sourcerpm    - print tag sourcerpm: source rpm.
") . N("  --packager     - print tag packager: packager.
") . N("  --buildhost    - print tag buildhost: build host.
") . N("  --url          - print tag url: url.
") . N("  --provides     - print tag provides: all provides.
") . N("  --requires     - print tag requires: all requires.
") . N("  --files        - print tag files: all files.
") . N("  --conflicts    - print tag conflicts: all conflicts.
") . N("  --obsoletes    - print tag obsoletes: all obsoletes.
") . N("  --env          - use specific environment (typically a bug
                   report).
") . 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.
my $update = 0;
my $media = '';
my $excludemedia = '';
my $sortmedia = '';
my $synthesis = '';
my $verbose = 0;
my $quiet;
my $uniq = '';
my $pattern = '';
my $full = '';
my $env;
my (%params, %uniq);

#- parse arguments list.
my $expr;
while (defined($_ = shift @ARGV)) {
    /^--help$/ and do { usage; next };
    /^--no-locales$/ and do { undef *N; undef *urpm::N; *N = *urpm::N = sub { sprintf(shift @_, @_) }; next };
    /^--update$/ and do { $update = 1; next };
    /^--media$/ and do { $media = shift @ARGV; next };
    /^--mediums$/ and do { $media = shift @ARGV; next };
    /^--exclude-?media$/ and do { $excludemedia = shift @ARGV; next };
    /^--sort-?media$/ and do { $sortmedia = shift @ARGV; next };
    /^--synthesis$/ and do { $synthesis = shift @ARGV; next };
    /^--verbose$/ and do { $verbose = 1; next };
    /^--quiet$/ and do { $quiet = 1; next };
    /^--uniq$/ and do { $uniq = 1; next };
    /^--all$/ and do { $params{$_} = 1
			 foreach qw(filename group size summary description sourcerpm packager buildhost url
				    provides requires files conflicts obsoletes); next };
    /^--name$/ and do { $params{filename} = 1; next };
    /^--(group|size|epoch|summary|description|sourcerpm|packager|buildhost|url|provides|requires|files|conflicts|obsoletes)$/ and
      do { $params{$1} = 1; next };
    /^--env$/ and do { $env = shift @ARGV; next };
    /^-v$/ and do { $verbose = 1; next };
    /^-q$/ and do { $quiet = 1; next };
    /^-u$/ and do { $uniq = 1; next };
    /^-i$/ and do { $pattern = 'i'; next };
    /^-f$/ and do { $full = 'full'; next };
    /^-e$/ and do { $expr .= '('.(shift @ARGV).')'; next };
    /^-a$/ and do { $expr .= ' && '; next };
    /^-o$/ and do { $expr .= ' || '; next };
    /^[!\(\)]$/ and do { $expr .= $_; next };
    #- assume a regex directly unless a ++ is inside the string, someother to use ?
    /\+\+/ and $_ = quotemeta $_;
    $expr .= 'm{'.$_.'}'.$pattern;
}

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

foreach (scalar(keys %params)) {
    $_ eq 0 and do { defined $quiet or $quiet = 1; $params{files} = 1 };
    $_ eq 1 and do { defined $quiet or $quiet = 1 };
    $_ > 1 and do { defined $quiet or $quiet = 0 };
}

#- build callback according expression.
my $callback = 'sub { my ($urpm, $pkg) = @_; '; #- it is a good start for a sub, no ;-)
foreach (qw(filename group size epoch summary description sourcerpm packager buildhost url
            provides requires files conflicts obsoletes)) {
    $params{$_} and $callback .= '
      foreach my $e ($pkg->'.$_.') {
        local $_ = $pkg->'.$full.'name."'.(!$quiet && ":$_").':$e";
        '.$expr.' or next;
        '.($uniq && 'exists $uniq{$_} and next; $uniq{$_} = undef;
        ').'print "$_\n";
      }';
}
$callback .= '
      1;
}';
$urpm->{log}(N("callback is :\n%s\n", $callback));
$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;
}

$urpm->configure(nocheck_access => 1, noskipping => 1,
		 media => $media,
		 excludemedia => $excludemedia,
		 sortmedia => $sortmedia,
		 synthesis => $synthesis,
		 update => $update,
		 callback => $callback,
		 hdlist => ($params{summary} || $params{description} || $params{sourcerpm} ||
			    $params{packager} || $params{buildhost} || $params{url} || $params{files}),
		);

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