#!/usr/bin/perl
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
#                                          <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
#
#
# LICENSE:
#
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
#
# This work 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., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
#
#
# CONTRIBUTION SUBMISSION POLICY:
#
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
#
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# you are the copyright holder for those contributions and you grant
# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}
=head1 NAME

rt-shredder - Script which wipe out tickets from RT DB

=head1 SYNOPSIS

  rt-shredder --plugin list
  rt-shredder --plugin help-Tickets
  rt-shredder --plugin 'Tickets=query,Queue="general" and Status="deleted"'

  rt-shredder --sqldump unshred.sql --plugin ...
  rt-shredder --force --plugin ...

=head1 DESCRIPTION

rt-shredder - is script that allow you to wipe out objects
from RT DB. This script uses API that L<RT::Shredder> module adds to RT.
Script can be used as example of usage of the shredder API.

=head1 USAGE

You can use several options to control which objects script
should wipeout.

=head1 OPTIONS

=head2 --sqldump <filename>

Outputs INSERT queiries into file. This dump can be used to restore data
after wiping out.

By default creates files
F<< <RT_home>/var/data/RT-Shredder/<ISO_date>-XXXX.sql >>

=head2 --object (DEPRECATED)

Option has been deprecated, use plugin C<Objects> instead.

=head2 --plugin '<plugin name>[=<arg>,<val>[;<arg>,<val>]...]'

You can use plugins to select RT objects with various conditions.
See also --plugin list and --plugin help options.

=head2 --plugin list

Output list of the available plugins.

=head2 --plugin help-<plugin name>

Outputs help for specified plugin.

=head2 --force

Script doesn't ask any questions.

=head1 SEE ALSO

L<RT::Shredder>

=cut

use strict;
use warnings FATAL => 'all';

# fix lib paths, some may be relative
BEGIN {
    require File::Spec;
    my @libs = ("/usr/local/libdata/perl5/site_perl", "/usr/local/libdata/perl5/site_perl");
    my $bin_path;

    for my $lib (@libs) {
        unless ( File::Spec->file_name_is_absolute($lib) ) {
            unless ($bin_path) {
                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
                }
                else {
                    require FindBin;
                    no warnings "once";
                    $bin_path = $FindBin::Bin;
                }
            }
            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
        }
        unshift @INC, $lib;
    }

}

use RT::Shredder ();
use Getopt::Long qw(GetOptions);
use File::Spec ();

use RT::Shredder::Plugin ();
# prefetch list of plugins
our %plugins = RT::Shredder::Plugin->List;

our %opt;
parse_args();

RT::Shredder::Init( %opt );
my $shredder = RT::Shredder->new;

{
    my $plugin = eval { $shredder->AddDumpPlugin( Arguments => {
        file_name    => $opt{'sqldump'},
        from_storage => 0,
    } ) };
	if( $@ ) {
        print STDERR "ERROR: Couldn't open SQL dump file: $@\n";
        exit 1 if $opt{'sqldump'};

        print STDERR "WARNING: It's strongly recommended to use '--sqldump <filename>' option\n";
        unless( $opt{'force'} ) {
            exit 0 unless prompt_yN( "Do you want to proceed?" );
        }
	} else {
        print "SQL dump file is '". $plugin->FileName ."'\n";
    }
}

my @objs = process_plugins( $shredder );
prompt_delete_objs( \@objs ) unless $opt{'force'};

$shredder->PutObjects( Objects => $_ ) foreach @objs;
eval { $shredder->WipeoutAll };
if( $@ ) {
    require RT::Shredder::Exceptions;
    if( my $e = RT::Shredder::Exception::Info->caught ) {
        print "\nERROR: $e\n\n";
        exit 1;
    }
    die $@;
}

sub prompt_delete_objs
{
	my( $objs ) = @_;
	unless( @$objs ) {
		print "Objects list is empty, try refine search options\n";
		exit 0;
	}
	my $list = "Next ". scalar( @$objs ) ." objects would be deleted:\n";
	foreach my $o( @$objs ) {
		$list .= "\t". $o->_AsString ." object\n";
	}
	print $list;
	exit(0) unless prompt_yN( "Do you want to proceed?" );
}

sub prompt_yN
{
	my $text = shift;
	print "$text [y/N] ";
	unless( <STDIN> =~ /^(?:y|yes)$/i ) {
		return 0;
	}
	return 1;
}

sub usage
{
	require RT::Shredder::POD;
	RT::Shredder::POD::shredder_cli( $0, \*STDOUT );
	exit 1;
}

sub parse_args
{
	my $tmp;
	Getopt::Long::Configure( "pass_through" );
	my @objs = ();
	if( GetOptions( 'object=s' => \@objs ) && @objs ) {
		print STDERR "Option --object had been deprecated, use plugin 'Objects' instead\n";
        exit(1);
	}

	my @plugins = ();
	if( GetOptions( 'plugin=s' => \@plugins ) && @plugins ) {
		$opt{'plugin'} = \@plugins;
		foreach my $str( @plugins ) {
			if( $str =~ /^\s*list\s*$/ ) {
				show_plugin_list();
			} elsif( $str =~ /^\s*help-(\w+)\s*$/ ) {
				show_plugin_help( $1 );
			} elsif( $str =~ /^(\w+)(=.*)?$/ && !$plugins{$1} ) {
				print "Couldn't find plugin '$1'\n";
				show_plugin_list();
			}
		}
	}

	# other options make no sense without previouse
	usage() unless keys %opt;

	if( GetOptions( 'force' => \$tmp ) && $tmp ) {
		$opt{'force'}++;
	}
	$tmp = undef;
	if( GetOptions( 'sqldump=s' => \$tmp ) && $tmp ) {
		$opt{'sqldump'} = $tmp;
	}
	return;
}

sub process_plugins
{
	my $shredder = shift;

	my @res;
	foreach my $str( @{ $opt{'plugin'} } ) {
		my $plugin = RT::Shredder::Plugin->new;
		my( $status, $msg ) = $plugin->LoadByString( $str );
		unless( $status ) {
			print STDERR "Couldn't load plugin\n";
			print STDERR "Error: $msg\n";
			exit(1);
		}
        if ( lc $plugin->Type eq 'search' ) {
            push @res, _process_search_plugin( $shredder, $plugin );
        }
        elsif ( lc $plugin->Type eq 'dump' ) {
            _process_dump_plugin( $shredder, $plugin );
        }
	}
	return RT::Shredder->CastObjectsToRecords( Objects => \@res );
}

sub _process_search_plugin {
    my ($shredder, $plugin) = @_;
    my ($status, @objs) = $plugin->Run;
    unless( $status ) {
        print STDERR "Couldn't run plugin\n";
        print STDERR "Error: $objs[1]\n";
        exit(1);
    }

    my $msg;
    ($status, $msg) = $plugin->SetResolvers( Shredder => $shredder );
    unless( $status ) {
        print STDERR "Couldn't set conflicts resolver\n";
        print STDERR "Error: $msg\n";
        exit(1);
    }
    return @objs;
}

sub _process_dump_plugin {
    my ($shredder, $plugin) = @_;
    $shredder->AddDumpPlugin(
        Object => $plugin,
    );
}

sub show_plugin_list
{
	print "Plugins list:\n";
	print "\t$_\n" foreach( grep !/^Base$/, keys %plugins );
	exit(1);
}

sub show_plugin_help
{
	my( $name ) = @_;
	require RT::Shredder::POD;
	unless( $plugins{ $name } ) {
		print "Couldn't find plugin '$name'\n";
		show_plugin_list();
	}
	RT::Shredder::POD::plugin_cli( $plugins{'Base'}, \*STDOUT, 1 );
	RT::Shredder::POD::plugin_cli( $plugins{ $name }, \*STDOUT );
	exit(1);
}

exit(0);
