#!/usr/bin/perl -w

use strict;
use warnings;
use Test::Repocop::Log;
use Test::Repocop::Common;
use Test::Repocop::Workdir;
use Test::Repocop::SQL;
use Test::Repocop::TestDB;
use Test::Repocop::CLI::Base;
use Test::Repocop::CLI::Datadir;
use Test::Repocop::CLI::Report;
use Test::Repocop::CLI::IN::PkgId;
our @ISA=qw/Test::Repocop::CLI/;
our @LONGOPT_POD2USAGE=qw/-verbose 1 -exitval 1/;

my $cmd_tail=substr($0, -6);
$Repocop::arg::except=$cmd_tail eq "except";
$Repocop::arg::except=0 if $cmd_tail eq "-given";
$Test::Repocop::Log::verbose=1;
my $repocop_arg_vacuum_db=1;
our @LONGOPT=(
    # do not merge in one option (was? bug in Getopt::Long)
    "db-vacuum!"  => \$repocop_arg_vacuum_db,
    "vacuum!"  => \$repocop_arg_vacuum_db,
);
__PACKAGE__->get_and_process_cli_options();
&Test::Repocop::Workdir::die_if_nothing_to_report();
&Test::Repocop::CLI::IN::PkgId::process_arguments();

my @pkg_keylist_to_purge=&Repocop::arg::pkg_keylist();
exec "pod2usage --exit=2 $0" unless @pkg_keylist_to_purge;

my $locker=Test::Repocop::Workdir::get_locker();
$locker->lock() or die "locking $repocop_workdir failed.\n";

&repocop_note("'except' mode") if $Repocop::arg::except;
&repocop_note("purging testdb...");
Test::Repocop::TestDB->new()->purge();

my $repocop_test_dbdir="$repocop_workdir/db";
&repocop_note("purging databases in $repocop_test_dbdir...");
my @in_pkgids=&Repocop::arg::pkg_keylist();
foreach my $dbfile (glob "$repocop_test_dbdir/*.db") {
    my $testname=$dbfile;
    $testname=~s/\.db$//;
    $testname=~s!^$repocop_test_dbdir/!!;
    my $testdir=&Test::Repocop::Common::find_test_dir($testname);
    my $purge_sql=$testdir.'/purge.sql';
    $purge_sql=undef unless -e $purge_sql;
    &repocop_note("purge $dbfile".($purge_sql ? " [using $purge_sql]":'').".");
    &Test::Repocop::SQL::purge_db($dbfile, $Repocop::arg::except, \@in_pkgids, $purge_sql);
    if ($repocop_arg_vacuum_db) {
	&repocop_note("vacuum $dbfile.");
	&repocop_note("[note: vacuuming can be skipped with --novacuum option].");
	&Test::Repocop::SQL::vacuum_db($dbfile);
    }
}

foreach my $testpurge (&Test::Repocop::Common::glob_tests('purge', @Repocop::datadir::tests_dir)) {
    my $testname=&Test::Repocop::Common::filepath2testname($testpurge);
    &Test::Repocop::Common::set_test_environment($testname);
    &Test::Repocop::Common::mkdir_test_environment($testname);
    &repocop_note("trying [purge] $testname");
    my $purgearg = $Repocop::arg::except? '--except':'--given';

    if (-x $testpurge) {
	open (PURGECMD,'|-',$testpurge, $purgearg) or die "opening purge script $testpurge failed: $?";
	map {print PURGECMD $_,"\n"} @pkg_keylist_to_purge;
    }
    close(PURGECMD) or die "closing pipe to purge script $testpurge failed: $?";
    &Test::Repocop::Common::cleanup_test_environment($testname);
}

&repocop_note("done.");
$locker->unlock() or die "unlocking $repocop_workdir failed.\n";

__END__

=head1	NAME

repocop-purge-except, repocop-purge-given - purge repocop cache from obsolete results.

=head1	SYNOPSIS

B<repocop-purge-except, repocop-purge-given>
[B<--vacuum>]
[B<-h|--help>]
[B<-v|--verbose>]
[B<-q|--quiet>]
[B<--workdir> I<workdir>]
[B<--pkgcollectors-dir> I<comma separated list of local collectors' dirs>]
[B<--srccollectors-dir> I<comma separated list of local collectors' dirs>]
[B<--pkgtests-dir> I<comma separated list of local tests' dirs>]
[B<--srctests-dir> I<comma separated list of local tests' dirs>]
[B<--exclude-test> I<comma separated list of tests>]
[B<--include-test> I<comma separated list of tests>]
[B<--report> I<warn|fail|skip|experimental|ok>]
[B<--report-et|--report-exclude-test> I<comma separated list of tests>]
[B<--report-it|--report-include-test> I<comma separated list of tests>]
[B<--report-include-distrotests>]
[B<--except>]
[B<--given>]
[B<--last-run>]
[B<--by-src-name> name ...]
[dir|rpm file|repocop_id ...]

=head1	DESCRIPTION

B<repocop-purge-except, repocop-purge-given>
purge repocop cache from obsolete results. There are two modes of that
utility: repocop-purge-except removes all data except about packages
given as its arguments (or from last run, -l option).
repocop-purge-given removes all data about given packages.


=head1 ARGUMENTS

The arguments are the set of repocop ids. Repocop IDs can be extracted
from rpm files, so you can use an argument like /path/to/rpm/files/*.rpm
or just /path/to/rpm/files.

Note that repocop ids are used for internal representation of rpm packages.
They differ from pkgids used in repocop reports.

Repocop report package ids are used in repocop reports to
identify packages in a human readable way.
The repocop report package ID is a string
<NAME>-<VERSION>-<RELEASE>.ARCH for binary rpm packages and is a string
<NAME>-<VERSION>-<RELEASE>.src for source rpm packages.

Internal Repocop ids are subject to change; current repocop ID is a string
<NAME>-<VERSION>-<RELEASE>.ARCH@timestamp for binary rpm packages and is a string
<NAME>-<VERSION>-<RELEASE>.src for source rpm packages.


=head1	OPTIONS

=over

=item B<--vacuum>

Vacuum SQL database after purge. Disabled by B<--novacuum>.
Default is to vacuum.

=item	B<--workdir> I<dir>

Provides alternative location for the Repocop workdir. Repocop workdir
is a place where test results and packages metadata information are stored.
Default is I<~/.repocop>.

=item	B<-h, --help>

Display this help and exit.

=item	B<-v, --verbose>, B<-q, --quiet>

Verbosity level. Multiple -v increase the verbosity level, -q sets it to 0.



=item [B<--pkgcollectors-dir> I<comma separated list of local collectors' dirs>]

=item [B<--srccollectors-dir> I<comma separated list of local collectors' dirs>]

=item [B<--pkgtests-dir> I<comma separated list of local tests' dirs>]

=item [B<--srctests-dir> I<comma separated list of local tests' dirs>]

Append user's local tests and collectors to repocop.
Those options do not disable or override loading of default tests
found in /usr/lib*/repocop and /usr/share/repocop.

=item [B<--exclude-test> I<comma separated list of tests>]

=item [B<--include-test> I<comma separated list of tests>]

Include/exclude tests for repocop-run.
Those options accept all kinds of repocop tests, including unittests, collectors and distrotests.




=item	B<--except>, B<--given>

Control processing of rpm id arguments.
B<--given> (default) means processing only given rpm arguments.
B<--except>  means processing all data except given rpm arguments.

=item	B<-l, --last-run>

Use the repocop ids of packages processed at last run as an input.

=item	B<--by-src-name>

Input arguments are expected to be src.rpm names, not repocop ids.
Repocop ids are calculated from given src.rpm names.


=back

=head1	AUTHOR

Written by Igor Vlasenko <viy@altlinux.org>.

=head1	ACKNOWLEGEMENTS

To Alexey Torbin <at@altlinux.org>, whose qa-robot package
had a strong influence on repocop.

=head1	COPYING

Copyright (c) 2008-2022 Igor Vlasenko, ALT Linux Team.

This 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.

=cut

