#!/usr/bin/perl
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 1996-2025 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 }}}
use strict;
use warnings;

# fix lib paths, some may be relative
BEGIN {
    require File::Spec;
    my @libs = ("lib", "local/lib");
    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;
RT::LoadConfig();
RT::Init();

@RT::Record::ISA = qw( DBIx::SearchBuilder::Record RT::Base );

use RT::Migrate;
use RT::Migrate::Importer::File;
use Getopt::Long;
use Pod::Usage qw//;
use Time::HiRes qw//;

my %OPT = (resume => 1, 'auto-commit' => 1);
GetOptions(
    \%OPT,
    "help|?",
    "quiet|q!",
    "list|l!",

    "resume!",
    "originalid|i=s",
    "exclude-organization",

    "ask",
    "ignore-errors",

    "auto-commit!",

    "batch-user-principals=i",
    "batch-group-principals=i",
    "batch-size=i",
    "max-processes=i",

    "dump=s@",
) or Pod::Usage::pod2usage();

Pod::Usage::pod2usage(-verbose => 1) if $OPT{help};

Pod::Usage::pod2usage() unless @ARGV == 1;
my ($dir) = @ARGV;
$dir =~ s|/$||;
die "No such directory $dir\n" unless -d $dir;
die "$dir doesn't appear to contain serialized data\n"
    unless -f "$dir/001.dat";

for my $class ( grep m{^RT/\w+\.pm$}, keys %INC ) {
    no warnings 'redefine';
    no strict 'refs';
    $class =~ s!\/!::!;
    $class =~ s!\.pm$!!;
    for my $method (qw/CurrentUserCanSee CurrentUserHasRight/) {
        next unless $class->can($method);
        my $full_name = "${class}::$method";
        *$full_name = sub {1};
    }
}

if ($OPT{dump}) {
    die "Dumping objects only works in conjunction with --list\n"
        unless $OPT{list};

    $OPT{dump} = [ split /,/, join(',', @{$OPT{dump}}) ];
}

my $error_handler;
if ($OPT{ask}) {
    die "Interactive mode (--ask) doesn't work when STDERR and STDIN aren't terminals.\n"
        unless -t STDERR and -t STDIN;

    $error_handler = sub {
        my $importer = shift;
        local $| = 1;
        print STDERR "\n", @_, "\n";
        print STDERR "Hit any key to abort import, or type 'ignore' to continue anyway.\n";
        print STDERR "Continuing may leave you with a corrupt database. > ";
        chomp( my $resp = <STDIN> );
        return lc($resp) eq 'ignore';
    };
}
elsif ($OPT{'ignore-errors'}) {
    $error_handler = sub {
        my $importer = shift;
        warn "Ignoring error: ", @_;
        return 1;
    };
}

my $import = RT::Migrate::Importer::File->new(
    Directory           => $dir,
    OriginalId          => $OPT{originalid},
    ExcludeOrganization => $OPT{'exclude-organization'},
    DumpObjects         => $OPT{dump},
    Resume              => $OPT{resume},
    AutoCommit          => $OPT{'auto-commit'},
    BatchUserPrincipals => $OPT{'batch-user-principals'},
    BatchGroupPrincipals => $OPT{'batch-group-principals'},
    BatchSize           => $OPT{'batch-size'},
    MaxProcesses        => $OPT{'max-processes'} || 10,
    HandleError         => $error_handler,
);

if ($import->Metadata and -t STDOUT and not $OPT{quiet}) {
    $import->Progress(
        RT::Migrate::progress(
            counts => sub { $import->ObjectCount },
            max    => $import->Metadata->{ObjectCount},
        )
    );
}

my $log = RT::Migrate::setup_logging( $dir => 'importer.log' );
print "Logging warnings and errors to $log\n" if $log;

my %counts;
if ($OPT{list}) {
    %counts = $import->List;

    my $org = $import->Organization;
    print "=========== Dump of $org ===========\n\n";
} else {
    %counts = $import->Import;

    my $org = $import->Organization;
    print "========== Import of $org ==========\n\n";
}

print "Total object counts:\n";
for (sort {$counts{$b} <=> $counts{$a}} keys %counts) {
    printf "%8d %s\n", $counts{$_}, $_;
}

my @missing = $import->Missing;
if (@missing) {
    warn "The following UIDs were expected but never observed:\n";
    warn "    $_\n" for @missing;
}

my @invalid = $import->Invalid;
if (@invalid) {
    warn "The following UIDs (serialized => imported) referred to objects missing from the original database:\n";
    for my $info (@invalid) {
        my $uid = delete $info->{uid};
        my $obj = $import->LookupObj($uid);
        warn sprintf "    %s => %s (%s)\n",
                $uid,
                ($obj && $obj->Id ? $obj->UID : '(not imported)'),
                join(", ", map  { "$_ => $info->{$_}" }
                           grep { defined $info->{$_} }
                                sort keys %$info);
    }
}

if ($log and -s $log) {
    print STDERR "\n! Some warnings or errors occurred during import."
                ."\n! Please see $log for details.\n\n";
}

exit @missing;

=head1 NAME

rt-importer - Import a serialized RT database on top of the current one

=head1 SYNOPSIS

    rt-importer path/to/export/directory

This script is used to import the contents of a dump created by
C<rt-serializer>.  It will create all of the objects in the dump in the
current database; this may include users, queues, and tickets.

It is possible to stop the import process with ^C; it can be later
resumed by re-running the importer.

Certain records (notably queues and groups) will have their original
Organization name prepended to them on import. This is primarily to avoid
duplicate names (for example importing a General queue into an RT that
already has one would otherwise cause a name collision error). If you are
confident you won't have any name collisions in queues or groups, you may
suppress this behavior by passing the B<--exclude-organization> flag to
C<rt-importer>.

=head2 OPTIONS

=over

=item B<--list>

Print a summary of the data contained in the dump.

=item B<--quiet>

Suppresses the display of progress bars during an import.  This option is
implied when the output isn't going directly to a terminal.

=item B<--originalid> I<cfname>

Places the original ticket organization and ID into a global custom
field with the given name.  If no global ticket custom field with that
name is found in the current database, it will create one.

=item B<--exclude-organization>

Ordinarily certain records (groups, queues, the B<--originalid> custom field)
include the organization name of the original RT instance. Use this option to
suppress that behavior and use the original name directly.

=item B<--ask>

Prompt for action when an error occurs inserting a record into the
database.  This can often happen when importing data from very old RTs
where some attachments (usually spam) contain invalid UTF-8.

The importer will pause and ask if you want to ignore the error and
continue on or abort (potentially to restart later).  Ignoring errors
will result in missing records in the database, which may cause database
integrity problems later.  If you ignored any errors, you should run
C<rt-validator> after import.

=item B<--ignore-errors>

Ignore all record creation errors and continue on when importing.  This
is equivalent to running with C<--ask> and manually typing "ignore" at
every prompt.  You should always run C<rt-validator> after importing
with errors ignored.

B<This option can be dangerous and leave you with a broken RT!>

=item B<--dump> I<class>[,I<class>]

Prints L<Data::Dumper> representations of the objects of type I<class> in the
serialized data.  This is mostly useful for debugging.

Works only in conjunction with C<--list>.

=item B<--no-auto-commit>

Don't auto commit to database. When this flag is used, it will commit only
once for each data file.  This could boost performance in some cases.

=item B<--batch-user-principals> I<NUMBER>
=item B<--batch-group-principals> I<NUMBER>

The number of user/group principals to create in batch beforehand. Default is 0.
This is to improve performance for not-cloned serialized data of big instances,
usually you don't need to specify this.

=item B<--batch-size> I<BATCH_SIZE>

Create objects in batch. Default is 0, meaning batch processing is not
enabled. This is for data serialized with C<--clone> or C<--all>. For cloned
serialized data, each batch processing will also take place in a separate
child process.

=item B<--max-processes> I<MAX_PROCESSES>

The number of max allowed child processes for batch processing. Default is
10. This is for cloned serialized data only.

=back


=head1 CLONED DATA

Some dumps may have been taken as complete clones of the RT system,
which are only suitable for inserting into a schema with no data in it.
You can setup the required database state for the receiving RT instance
by running:

    /opt/rt5/sbin/rt-setup-database --action create,schema,acl --prompt-for-dba-password

The normal C<make initdb> step will B<not> work because it also inserts
core system data.


=cut
