#!/usr/bin/perl

# $Id$

#- Copyright (C) 2002, 2003, 2004, 2005 MandrakeSoft SA
#- Copyright (C) 2005, 2006 Mandriva SA
#-
#- 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;
use urpm::media;

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

usage: urpmf [options] pattern-expression
", $urpm::VERSION)
   . N("  --help         - print this help message.
") . N("  --version      - print this tool's version number.
") . N("  --env          - use specific environment (typically a bug report).
") . N("  --excludemedia - do not use the given media, separated by comma.
") . N("  --literal, -l  - don't match patterns, use argument as a literal string.
") . N("  --urpmi-root   - use another root for urpmi db & rpm installation.
") . N("  --media        - use only the given media, separated by comma.
") . N("  --sortmedia    - sort media according to substrings separated by comma.
") . N("  --use-distrib  - use the given path to access media
") . N("  --synthesis    - use the given synthesis instead of urpmi db.
") . N("  --uniq         - do not print identical lines twice.
") . N("  --update       - use only update media.
") . N("  --verbose      - verbose mode.
") . N("  -i             - ignore case distinctions in patterns.
") . N("  -I             - honor case distinctions in patterns (default).
") . N("  -F<str>        - change field separator (defaults to ':').
") . N("Pattern expressions:
") . N("  text           - any text is parsed as a regexp, unless -l is used.
") . N("  -e             - include perl code directly as perl -e.
") . N("  -a             - binary AND operator.
") . N("  -o             - binary OR operator.
") . N("  !              - unary NOT.
") . N("  ( )            - left and right parentheses.
") . N("List of tags:
") . N("  --qf           - specify a printf-like output format
") . N("                   example: '%%name:%%files'
") . N("  --arch         - architecture
") . N("  --buildhost    - build host
") . N("  --buildtime    - build time
") . N("  --conffiles    - configuration files
") . N("  --conflicts    - conflict tags
") . N("  --description  - package description
") . N("  --distribution - distribution
") . N("  --epoch        - epoch
") . N("  --filename     - filename of the package
") . N("  --files        - list of files contained in the package
") . N("  --group        - group
") . N("  --license      - license
") . N("  --name         - package name
") . N("  --obsoletes    - obsoletes tags
") . N("  --packager     - packager
") . N("  --provides     - provides tags
") . N("  --requires     - requires tags
") . N("  --size         - installed size
") . N("  --sourcerpm    - source rpm name
") . N("  --suggests     - suggests tags
") . N("  --summary      - summary
") . N("  --url          - url
") . N("  --vendor       - vendor
") . N("  -m             - the media in which the package was found
") . N("  -f             - print version, release and arch with name.
");
    exit(0);
}

#- default options.
our $env;		# bug report directory
our $excludemedia = '';
our $full = '';		# -f : print rpm fullname instead of rpm name
our $literal = 0;	# should we quotemeta the pattern
our $media = '';
our $pattern = '';	# regexp match flags ("i" or "")
our $qf = '%default';	# format string
our $separator = ':';	# default field separator
our $sortmedia = '';
our $synthesis = '';
our $uniq = '';		# --uniq
our $update = 0;	# --update

#- globals used in callback
our $expr;		# regexp to match against
our %uniq;

#- parse arguments list.
my $urpm = new urpm;
urpm::args::parse_cmdline(urpm => $urpm) or exit(1);

if ($qf eq '%default') {
    #- nothing on the command-line : default is to search on file names
    $qf = '%name' . $separator . '%files';
} else {
    #- else default to a leading %name
    $qf =~ s/%default\b/%name/;
}

#- replace first %name by %fullname if -f was specified
if ($full) { $qf =~ s/%name\b/%fullname/ }

#- we really don't want logs on stdout, and remove verbose if not asked.
$urpm->{info} = sub { print STDERR "$_[0]\n" };
$urpm->{log} = sub { print STDERR "$_[0]\n" } if $options{verbose} > 0;

my $multitag = '';
my %multitags = map { $_ => 1 } qw(conffiles conflicts files obsoletes provides requires suggests);
my %usedtags;

(my $proto = $qf) =~ s/%([-\d]*)(\w+)/%${1}s/g;
my $sprintfargs = join(', ', map {
    $usedtags{$_} = 1;
    if ($_ eq 'media') {
	'$urpm::media::currentmedia->{name}';
    } elsif ($_ eq 'fullname') {
	'scalar($pkg->fullname)';
    } elsif ($_ eq 'description') {
	'do { my $d = $pkg->description; $d =~ s/^/\t/mg; "\n$d" }';
    } elsif ($multitags{$_}) {
	$multitag and $urpm->{fatal}->(1, N("Incorrect format: you may use only one multi-valued tag"));
	$multitag = $_;
	"'%s'";
    } else {
	'$pkg->' . $_;
    }
} $qf =~ /%[-\d]*(\w+)/g);

my ($proto_cooked, $sprintfargs_cooked);
if ($multitag) {
    ($proto_cooked, $sprintfargs_cooked) = ($proto, $sprintfargs);
    ($proto, $sprintfargs) = ('$proto_cooked', '$mt');    
}

my $next_st = $multitag ? 'next' : 'return 1';
my @inner = (
    "my \$s = sprintf(qq{$proto}, $sprintfargs);",
    "\$s =~ $expr or $next_st;",
    $uniq ? ('$uniq{$s} and ' . $next_st . ';', '$uniq{$s} = 1;') : (),
    'print $s, "\n";',
);

if ($multitag) {
    @inner = (
	"my \$proto_cooked = sprintf(qq{$proto_cooked}, $sprintfargs_cooked);",
	"foreach my \$mt (\$pkg->$multitag) {", 
	(map { "    $_" } @inner), 
	"}",
    );
}

#- build the callback matching the expression.
my $callback = join("\n", 
    "sub {", 
    (map { "    $_" } 
       'my ($urpm, $pkg) = @_;',
       @inner,
       '0;'),
    "}");

$urpm->{debug}("qf:[$qf]\ncallback:\n$callback") if $urpm->{debug};
$callback = eval $callback;
if ($@) {
    warn "Internal error: $@\n";
    exit(1);
}

if ($env) {
    print 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;
}

my $_lock = urpm::lock::urpmi_db($urpm, '', 'nofatal');
my $need_hdlist = grep { $usedtags{$_} } qw(
    buildhost
    buildtime
    conf_files
    description
    distribution
    files
    license
    packager
    sourcerpm
    url
    vendor
);
urpm::media::configure($urpm,
    nocheck_access => 1,
    no_skiplist => 1,
    no_second_pass => 1,
    media => $media,
    excludemedia => $excludemedia,
    sortmedia => $sortmedia,
    synthesis => $synthesis,
    usedistrib => $urpm::args::options{usedistrib},
    update => $update,
    callback => $callback,
    need_hdlist => $need_hdlist,
);

if ($need_hdlist) {
    my @hdlist_media = grep { !$_->{ignore} && -e urpm::media::any_hdlist($urpm, $_) } @{$urpm->{media}};
    if (!@hdlist_media) {
	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 !$usedtags{name};
    }
}