#!/usr/bin/perl
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 1996-2013 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 }}}
#
# This is just a basic script that checks to make sure that all
# the modules needed by RT before you can install it.
#

use strict;
use warnings;
no warnings qw(numeric redefine);
use Getopt::Long;
my %args;
my %deps;
my @orig_argv = @ARGV;
GetOptions(
    \%args,                               'v|verbose',
    'install!',                           'with-MYSQL',
    'with-POSTGRESQL|with-pg|with-pgsql', 'with-SQLITE',
    'with-ORACLE',                        'with-FASTCGI',
    'with-MODPERL1',                      'with-MODPERL2',
    'with-STANDALONE',

    'with-DEV',

    'with-GPG',
    'with-ICAL',
    'with-SMTP',
    'with-GRAPHVIZ',
    'with-GD',
    'with-DASHBOARDS',
    'with-USERLOGO',
    'with-SSL-MAILGATE',
    'with-HTML-DOC',

    'download=s',
    'repository=s',
    'list-deps',
    'help|h',
);

if ( $args{help} ) {
    require Pod::Usage;
    Pod::Usage::pod2usage( { verbose => 2 } );
    exit;
}

# Set up defaults
my %default = (
    'with-MASON' => 1,
    'with-PSGI' => 1,
    'with-CORE' => 1,
    'with-CLI' => 1,
    'with-MAILGATE' => 1, 
    'with-DEV' => 0, 
    'with-GPG' => 0,
    'with-ICAL' => 1,
    'with-SMTP' => 1,
    'with-GRAPHVIZ' => 0,
    'with-GD' => 1,
    'with-DASHBOARDS' => 1,
    'with-USERLOGO' => 1,
    'with-SSL-MAILGATE' => 0,
    'with-HTML-DOC' => 0,
);
$args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default;

{
  my $section;
  my %always_show_sections = (
    perl => 1,
    users => 1,
  );

  sub section {
    my $s = shift;
    $section = $s;
    print "$s:\n" unless $args{'list-deps'};
  }

  sub print_found {
    my $msg = shift;
    my $test = shift;
    my $extra = shift;

    unless ( $args{'list-deps'} ) {
        if ( $args{'v'} or not $test or $always_show_sections{$section} ) {
            print "\t$msg ...";
            print $test ? "found" : "MISSING";
            print "\n";
        }

        print "\t\t$extra\n" if defined $extra;
    }
  }
}

sub conclude {
    my %missing_by_type = @_;

    unless ( $args{'list-deps'} ) {
        unless ( keys %missing_by_type ) {
            print "\nAll dependencies have been found.\n";
            return;
        }

        print "\nSOME DEPENDENCIES WERE MISSING.\n";

        for my $type ( keys %missing_by_type ) {
            my $missing = $missing_by_type{$type};

            print "$type missing dependencies:\n";
            for my $name ( keys %$missing ) {
                my $module  = $missing->{$name};
                my $version = $module->{version};
                my $error = $module->{error};
                print_found( $name . ( $version && !$error ? " >= $version" : "" ),
                    0, $module->{error} );
            }
        }
        exit 1;
    }
}

sub text_to_hash {
    my %hash;
    for my $line ( split /\n/, $_[0] ) {
        my($key, $value) = $line =~ /(\S+)\s*(\S*)/;
        $value ||= '';
        $hash{$key} = $value;
    }

    return %hash;
}

$deps{'CORE'} = [ text_to_hash( << '.') ];
Class::Accessor 0.34
DateTime 0.44
DateTime::Locale 0.40
Digest::base
Digest::MD5 2.27
Digest::SHA
DBI 1.37
Class::ReturnValue 0.40
DBIx::SearchBuilder 1.59
Text::Template 1.44
File::ShareDir
File::Spec 0.8
HTML::Quoted
HTML::Scrubber 0.08
HTML::TreeBuilder
HTML::FormatText
Log::Dispatch 2.23
Sys::Syslog 0.16
Locale::Maketext 1.06
Locale::Maketext::Lexicon 0.32
Locale::Maketext::Fuzzy
MIME::Entity 5.425
Mail::Mailer 1.57
Email::Address
Text::Wrapper 
Time::ParseDate
Time::HiRes 
File::Temp 0.19
Text::Quoted 2.02
Tree::Simple 1.04
UNIVERSAL::require
Regexp::Common
Scalar::Util
Module::Versions::Report 1.05
Cache::Simple::TimedExpiry
Encode 2.39
CSS::Squish 0.06
File::Glob
Devel::StackTrace 1.19
Text::Password::Pronounceable
Devel::GlobalDestruction
List::MoreUtils
Net::CIDR
Regexp::Common::net::CIDR
Regexp::IPv6
.

$deps{'MASON'} = [ text_to_hash( << '.') ];
HTML::Mason 1.43
Errno
Digest::MD5 2.27
CGI::Cookie 1.20
Storable 2.08
Apache::Session 1.53
XML::RSS 1.05
Text::WikiFormat 0.76
CSS::Squish 0.06
Devel::StackTrace 1.19
JSON
IPC::Run3
.

$deps{'PSGI'} = [ text_to_hash( << '.') ];
CGI 3.38
CGI::PSGI 0.12
HTML::Mason::PSGIHandler 0.52
Plack 0.9971
Plack::Handler::Starlet
CGI::Emulate::PSGI
.

$deps{'MAILGATE'} = [ text_to_hash( << '.') ];
Getopt::Long
LWP::UserAgent
Pod::Usage
.

$deps{'SSL-MAILGATE'} = [ text_to_hash( << '.') ];
Crypt::SSLeay
Net::SSL
LWP::UserAgent 6.0
LWP::Protocol::https
Mozilla::CA
.

$deps{'CLI'} = [ text_to_hash( << '.') ];
Getopt::Long 2.24
LWP
HTTP::Request::Common
Text::ParseWords
Term::ReadLine
Term::ReadKey
.

$deps{'DEV'} = [ text_to_hash( << '.') ];
Email::Abstract
Test::Email
HTML::Form
HTML::TokeParser
WWW::Mechanize 1.52
Test::WWW::Mechanize 1.30
Module::Refresh 0.03
Test::Expect 0.31
XML::Simple
File::Find
Test::Deep 0 # needed for shredder tests
String::ShellQuote 0 # needed for gnupg-incoming.t
Log::Dispatch::Perl
Test::Warn
Test::Builder 0.90 # needed for is_passing
Test::MockTime
Log::Dispatch::Perl
Test::WWW::Mechanize::PSGI
Plack::Middleware::Test::StashWarnings 0.06
Test::LongString
Test::NoWarnings
.

$deps{'FASTCGI'} = [ text_to_hash( << '.') ];
FCGI 0.74
FCGI::ProcManager
.

$deps{'MODPERL1'} = [ text_to_hash( << '.') ];
Apache::Request
Apache::DBI 0.92
.

$deps{'MODPERL2'} = [ text_to_hash( << '.') ];
Apache::DBI
HTML::Mason 1.36
.

$deps{'MYSQL'} = [ text_to_hash( << '.') ];
DBD::mysql 2.1018
.

$deps{'ORACLE'} = [ text_to_hash( << '.') ];
DBD::Oracle
.

$deps{'POSTGRESQL'} = [ text_to_hash( << '.') ];
DBD::Pg 1.43
.

$deps{'SQLITE'} = [ text_to_hash( << '.') ];
DBD::SQLite 1.00
.

$deps{'GPG'} = [ text_to_hash( << '.') ];
GnuPG::Interface
PerlIO::eol
.

$deps{'ICAL'} = [ text_to_hash( << '.') ];
Data::ICal
.

$deps{'SMTP'} = [ text_to_hash( << '.') ];
Net::SMTP
.

$deps{'DASHBOARDS'} = [ text_to_hash( << '.') ];
HTML::RewriteAttributes 0.05
MIME::Types
URI 1.59
.

$deps{'GRAPHVIZ'} = [ text_to_hash( << '.') ];
GraphViz
IPC::Run 0.90
.

$deps{'GD'} = [ text_to_hash( << '.') ];
GD
GD::Graph
GD::Text
.

$deps{'USERLOGO'} = [ text_to_hash( << '.') ];
Convert::Color
.

$deps{'HTML-DOC'} = [ text_to_hash( <<'.') ];
Pod::Simple 3.24
HTML::Entities
.

my %AVOID = (
    'DBD::Oracle' => [qw(1.23)],
    'Email::Address' => [qw(1.893 1.894)],
    'Devel::StackTrace' => [qw(1.28 1.29)],
);

if ($args{'download'}) {
    download_mods();
}


check_perl_version();

check_users();

my %Missing_By_Type = ();
foreach my $type (sort grep $args{$_}, keys %args) {
    next unless ($type =~ /^with-(.*?)$/) and $deps{$1};

    $type = $1;
    section("$type dependencies");

    my @missing;
    my @deps = @{ $deps{$type} };

    my %missing = test_deps(@deps);

    if ( $args{'install'} ) {
        for my $module (keys %missing) {
            resolve_dep($module, $missing{$module}{version});
            my $m = $module . '.pm';
            $m =~ s!::!/!g;
            if ( delete $INC{$m} ) {
                my $symtab = $module . '::';
                no strict 'refs';
                for my $symbol ( keys %{$symtab} ) {
                    next if substr( $symbol, -2, 2 ) eq '::';
                    delete $symtab->{$symbol};
                }
            }
            delete $missing{$module}
                if test_dep($module, $missing{$module}{version}, $AVOID{$module});
        }
    }

    $Missing_By_Type{$type} = \%missing if keys %missing;
}

if ( $args{'install'} && keys %Missing_By_Type ) {
    exec($0, @orig_argv, '--no-install');
}
else {
    conclude(%Missing_By_Type);
}

sub test_deps {
    my @deps = @_;

    my %missing;
    while(@deps) {
        my $module = shift @deps;
        my $version = shift @deps;
        my($test, $error) = test_dep($module, $version, $AVOID{$module});
        my $msg = $module . ($version && !$error ? " >= $version" : '');
        print_found($msg, $test, $error);

        $missing{$module} = { version => $version, error => $error } unless $test;
    }

    return %missing;
}

sub test_dep {
    my $module = shift;
    my $version = shift;
    my $avoid = shift;

    if ( $args{'list-deps'} ) {
        print $module, ': ', $version || 0, "\n"; 
    }
    else {
        eval "use $module $version ()";
        if ( my $error = $@ ) {
            return 0 unless wantarray;

            $error =~ s/\n(.*)$//s;
            $error =~ s/at \(eval \d+\) line \d+\.$//;
            undef $error if $error =~ /this is only/;

            return ( 0, $error );
        }
        
        if ( $avoid ) {
            my $version = $module->VERSION;
            if ( grep $version eq $_, @$avoid ) {
                return 0 unless wantarray;
                return (0, "It's known that there are problems with RT and version '$version' of '$module' module. If it's the latest available version of the module then you have to downgrade manually.");
            }
        }

        return 1;
    }
}

sub resolve_dep {
    my $module = shift;
    my $version = shift;

    print "\nInstall module $module\n";

    my $ext = $ENV{'RT_FIX_DEPS_CMD'} || $ENV{'PERL_PREFER_CPAN_CLIENT'};
    unless( $ext ) {
        my $configured = 1;
        {
            local @INC = @INC;
            if ( $ENV{'HOME'} ) {
                unshift @INC, "$ENV{'HOME'}/.cpan";
            }
            $configured = eval { require CPAN::MyConfig } || eval { require CPAN::Config };
        }
        unless ( $configured ) {
            print <<END;
You haven't configured the CPAN shell yet.
Please run `/usr/bin/perl -MCPAN -e shell` to configure it.
END
            exit(1);
        }
        my $rv = eval { require CPAN; CPAN::Shell->install($module) };
        return $rv unless $@;

        print <<END;
Failed to load module CPAN.

-------- Error ---------
$@
------------------------

When we tried to start installing RT's perl dependencies, 
we were unable to load the CPAN client. This module is usually distributed
with Perl. This usually indicates that your vendor has shipped an unconfigured
or incorrectly configured CPAN client.
The error above may (or may not) give you a hint about what went wrong

You have several choices about how to install dependencies in 
this situatation:

1) use a different tool to install dependencies by running setting the following
   shell environment variable and rerunning this tool:
    RT_FIX_DEPS_CMD='/usr/bin/perl -MCPAN -e"install %s"'
2) Attempt to configure CPAN by running:
   `/usr/bin/perl -MCPAN -e shell` program from shell.
   If this fails, you may have to manually upgrade CPAN (see below)
3) Try to update the CPAN client. Download it from:
   http://search.cpan.org/dist/CPAN and try again
4) Install each dependency manually by downloading them one by one from
   http://search.cpan.org

END
        exit(1);
    }

    if( $ext =~ /\%s/) {
        $ext =~ s/\%s/$module/g; # sprintf( $ext, $module );
    } else {
        $ext .= " $module";
    }
    print "\t\tcommand: '$ext'\n";
    return scalar `$ext 1>&2`;
}

sub download_mods {
    my %modules;
    use CPAN;
    
    foreach my $key (keys %deps) {
        my @deps = (@{$deps{$key}});
        while (@deps) {
            my $mod = shift @deps;
            my $ver = shift @deps;
            next if ($mod =~ /^(DBD-|Apache-Request)/);
            $modules{$mod} = $ver;
        }
    }
    my @mods = keys %modules;
    CPAN::get();
    my $moddir = $args{'download'};
    foreach my $mod (@mods) {
        $CPAN::Config->{'build_dir'} = $moddir;
        CPAN::get($mod);
    }

    opendir(DIR, $moddir);
    while ( my $dir = readdir(DIR)) {
        print "Dir is $dir\n";
        next if ( $dir =~ /^\.\.?$/);

        # Skip things we've previously tagged
        my $out = `svn ls $args{'repository'}/tags/$dir`;
        next if ($out);

        if ($dir =~ /^(.*)-(.*?)$/) {
            `svn_load_dirs -no_user_input -t tags/$dir -v $args{'repository'} dists/$1 $moddir/$dir`;
            `rm -rf $moddir/$dir`;

        }

    }
    closedir(DIR);
    exit;
}

sub check_perl_version {
  section("perl");
  eval {require 5.008003};
  if ($@) {
    print_found("5.8.3", 0,"RT is known to be non-functional on versions of perl older than 5.8.3. Please upgrade to 5.8.3 or newer.");
    exit(1);
  } else {
    print_found( sprintf(">=5.8.3(%vd)", $^V), 1 );
  }
}

sub check_users {
  section("users");
  print_found("rt group (uio-rt)",      defined getgrnam("uio-rt"));
  print_found("bin owner (root)",   defined getpwnam("root"));
  print_found("libs owner (root)", defined getpwnam("root"));
  print_found("libs group (bin)", defined getgrnam("bin"));
  print_found("web owner (httpd)",    defined getpwnam("httpd"));
  print_found("web group (httpd)",   defined getgrnam("httpd"));
}

1;

__END__

=head1 NAME

rt-test-dependencies - test rt's dependencies

=head1 SYNOPSIS

    rt-test-dependencies
    rt-test-dependencies --install
    rt-test-dependencies --with-mysql --with-fastcgi

=head1 DESCRIPTION

by default, C<rt-test-dependencies> determines whether you have installed all
the perl modules RT needs to run.

the "RT_FIX_DEPS_CMD" environment variable, if set, will be used instead of
the standard CPAN shell by --install to install any required modules.  it will
be called with the module name, or, if "RT_FIX_DEPS_CMD" contains a "%s", will
replace the "%s" with the module name before calling the program.

=head1 OPTIONS

=over

=item install

    install missing modules

=item verbose

list the status of all dependencies, rather than just the missing ones.

-v is equal to --verbose

=item specify dependencies

=over

=item --with-mysql

    database interface for mysql

=item --with-postgresql

    database interface for postgresql 

=item with-oracle       
    
    database interface for oracle

=item with-sqlite 

    database interface and driver for sqlite (unsupported)

=item with-fastcgi 

    libraries needed to support the fastcgi handler

=item with-modperl1

    libraries needed to support the modperl 1 handler

=item with-modperl2

    libraries needed to support the modperl 2 handler

=item with-dev

    tools needed for RT development

=back

=back