The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

=head1 NAME

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

=head1 SYNOPSIS

  rtx-shredder --plugin list
  rtx-shredder --plugin help-Tickets
  rtx-shredder --plugin 'Tickets=status,deleted;queue,general'

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

=head1 DESCRIPTION

rtx-shredder - is script that allow you to wipe out objects
from RT DB. This script uses API that RTx::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 delete.

=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/RTx-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 variouse 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<RTx::Shredder>

=cut

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

### after: use lib qw(@RT_LIB_PATH@);
use lib qw(/opt/rt3/local/lib /opt/rt3/lib);

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

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

our %opt;
parse_args();

RTx::Shredder::Init( %opt );
my $shredder = new RTx::Shredder;

{
    local $@;
    my ($file, $fh) = eval { $shredder->SetFile( FileName => $opt{'sqldump'}, FromStorage => 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 '$file'\n";
    }
}

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

$shredder->PutObjects( Objects => $_ ) foreach @objs;
eval { $shredder->WipeoutAll };
if( $@ ) {
    require RTx::Shredder::Exceptions;
    if( my $e = RTx::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 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 RTx::Shredder::POD;
	RTx::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 @res;
	my $shredder = shift;
	foreach my $str( @{ $opt{'plugin'} } ) {
		my $plugin = new RTx::Shredder::Plugin;
		my( $status, $msg ) = $plugin->LoadByString( $str );
		unless( $status ) {
			print STDERR "Couldn't load plugin\n";
			print STDERR "Error: $msg\n";
			exit(1);
		}
		
		my @objs = ();
		($status, @objs) = $plugin->Run;
		unless( $status ) {
			print STDERR "Couldn't run plugin\n";
			print STDERR "Error: $objs[1]\n";
			exit(1);
		}

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

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 RTx::Shredder::POD;
	unless( $plugins{ $name } ) {
		print "Couldn't find plugin '$name'\n";
		show_plugin_list();
	}
	RTx::Shredder::POD::plugin_cli( $plugins{'Base'}, \*STDOUT, 1 );
	RTx::Shredder::POD::plugin_cli( $plugins{ $name }, \*STDOUT );
	exit(1);
}

exit(0);