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

use strict;
use warnings;

use Archive::Tar;
use Clone qw(clone);
use Data::Dumper;
use File::Basename;
use File::Spec;
use File::Temp;
use Net::FTP;
use DBI;

my $ftp_host  = 'ftp.otrs.org';
my $local_dir = File::Temp::tempdir();
my @dirs      = qw(pub otrs);

my $ftp = Net::FTP->new( $ftp_host, Debug => 0 );
$ftp->login();

for my $dir ( @dirs ) {
    $ftp->cwd( $dir );
}

my @files   = $ftp->ls;
my @tar_gz  = grep{ m{ \.tar\.gz \z }xms }@files;
my @no_beta = grep{ !m{ -beta }xms }@tar_gz;

my $db_file   = File::Spec->catfile( dirname( __FILE__ ), '.otrs_modules.sqlite' );
my $db_exists = -e $db_file;
my $dbh       = DBI->connect( "DBI:SQLite:$db_file" ) or die DBI->errstr();

if ( !$db_exists ) {
    $dbh->do( 'CREATE TABLE modules (modname VARCHAR(255), otrs VARCHAR(10), modtype VARCHAR(4), PRIMARY KEY (modname, otrs) )' ); 
}

my $sth = $dbh->prepare( 'SELECT DISTINCT otrs FROM modules' );
$sth->execute;

my %otrs_versions;
while ( my ($otrs) = $sth->fetchrow_array ) {
    $otrs_versions{$otrs} = 1;
}

my $insert_sth = $dbh->prepare( 'INSERT INTO modules (modname, otrs, modtype) VALUES (?,?,?)' );

FILE:
for my $file ( @no_beta ) {
    my ($major,$minor,$patch) = $file =~ m{ \A otrs - (\d+) \. (\d+) \. (\d+) \.tar\.gz  }xms;
    
    next FILE if !(defined $major and defined $minor);
    
    next FILE if $major < 2;
    next FILE if $major == 2 and $minor < 3;

    my $otrs = join '.', $major, $minor, $patch;
    next FILE if $otrs_versions{$otrs};
    
    print STDERR "Try to get $file\n";
    
    my $local_path = File::Spec->catfile( $local_dir, $file );
    
    $ftp->binary;
    $ftp->get( $file, $local_path );
    
    my $tar              = Archive::Tar->new( $local_path, 1 );
    my @files_in_archive = $tar->list_files;
    my @modules          = grep{ m{ \.pm \z }xms }@files_in_archive;
    
    my $version = '';
    
    MODULE:
    for my $module ( @modules ) {
        next MODULE if $module =~ m{/scripts/};
    
        my ($otrs,$modfile) = $module =~ m{ \A otrs-(\d+\.\d+\.\d+)/(.*) }xms;

        next MODULE if !$modfile;

        my $is_cpan = $modfile =~ m{cpan-lib}xms;
        
        my $key = $is_cpan ? 'cpan' : 'core';

        next MODULE if !$modfile;
        
        (my $modulename = $modfile) =~ s{/}{::}g;

        next MODULE if !$modulename;

        $modulename =~ s{\.pm}{}g;
        $modulename =~ s{Kernel::cpan-lib::}{}g if $is_cpan;
        
        $version = $otrs;

        next MODULE if !$otrs;
        next MODULE if !$modulename;

        $insert_sth->execute( $modulename, $otrs, $key );
    }
}

my $versions_sth = $dbh->prepare( 'SELECT COUNT( DISTINCT otrs ) FROM modules' );
$versions_sth->execute;
my $versions_count;
while (my $count = $versions_sth->fetchrow_array ) {
    $versions_count = $count;
}

print STDERR "# Versions: $versions_count\n";

my %global;
my $global_sth = $dbh->prepare( 'SELECT modname, modtype, COUNT(otrs) AS versions FROM modules GROUP BY modname HAVING versions = ' . $versions_count ) or die $dbh->errstr;
$global_sth->execute( ) or die $dbh->errstr;

while ( my ($name,$type,$count) = $global_sth->fetchrow_array ) {
    $global{$type}->{$name} = 1;
}

my %hash;
my $local_sth = $dbh->prepare( 'SELECT modname, modtype, otrs FROM modules' );
$local_sth->execute;

while ( my ($name,$type,$otrs) = $local_sth->fetchrow_array ) {
    next if $global{$type}->{$name};

    $hash{$otrs}->{$type}->{$name} = 1;
}

$Data::Dumper::Sortkeys = 1;


my $dist_ini_content = do{ local (@ARGV,$/) = File::Spec->catfile( dirname( __FILE__ ), '..', 'dist.ini' ); <> };

my ($dist_version)  = $dist_ini_content =~ m{version \s* = \s* (.*?)\n}xms;
my ($dist_author)   = $dist_ini_content =~ m{author \s* = \s* (.*?)\n}xms;
my ($dist_license)  = $dist_ini_content =~ m{license \s* = \s* (.*?)\n}xms;
my ($dist_c_holder) = $dist_ini_content =~ m{copyright_holder \s* = \s* (.*?)\n}xms;
my ($dist_c_year)   = $dist_ini_content =~ m{copyright_year \s* = \s* (.*?)\n}xms;
my $license_class   = 'Software::License::' . $dist_license;
eval "require $license_class;";

my $license_obj = $license_class->new({ holder => $dist_c_holder, year => $dist_c_year });

my $dist_copyright = $license_obj->notice;

if ( open my $fh, '>', 'corelist' ) {
    print $fh q~package Module::OTRS::CoreList;

use strict;
use warnings;

# ABSTRACT: what modules shipped with versions of OTRS (>= 2.3.x)
~;

    print $fh "\n\n";

    print $fh "our \$VERSION = $dist_version;\n\n";

    my $global_dump = Data::Dumper->Dump( [\%global], ['global'] );
    $global_dump =~ s{\$global}{my \$global};
    print $fh $global_dump;

    print $fh "\n";

    my $modules_dump = Data::Dumper->Dump( [\%hash], ['modules'] );
    $modules_dump =~ s{\$modules}{my \$modules};
    print $fh $modules_dump;

    print $fh "\n\n";

    print $fh q#sub shipped {
    my ($class,$version,$module) = @_;

    return if !$version;
    return if $version !~ m{ \A [0-9]+\.[0-9]\.(?:[0-9]+|x) \z }xms;

    $version =~ s{\.}{\.}g;
    $version =~ s{x}{.*};

    my $version_re = qr{ \A $version \z }xms;

    my @versions_with_module;

    OTRSVERSION:
    for my $otrs_version ( sort keys %{$modules} ) {
        next unless $otrs_version =~ $version_re;

        if ( $modules->{$otrs_version}->{core}->{$module} ||
             $modules->{$otrs_version}->{cpan}->{$module} ||
             $global->{core}->{$module} ||
             $global->{cpan}->{$module} ) {
            push @versions_with_module, $otrs_version;
        }
    }

    return @versions_with_module;
}

sub modules {
    my ($class,$version) = @_;

    return if !$version;
    return if $version !~ m{ \A [0-9]+\.[0-9]\.(?:[0-9]+|x) \z }xms;

    $version =~ s{\.}{\.}g;
    $version =~ s{x}{.*};

    my $version_re = qr{ \A $version \z }xms;
    my %modules_in_otrs;

    OTRSVERSION:
    for my $otrs_version ( keys %{$modules} ) {
        next unless $otrs_version =~ $version_re;

        my $hashref = $modules->{$otrs_version}->{core};
        my @modulenames = keys %{$hashref || {}};

        @modules_in_otrs{@modulenames} = (1) x @modulenames;
    }

    if ( $version =~ m{x} || exists $modules->{$version} ) {
        my @global_modules = keys %{ $global->{core} };
        @modules_in_otrs{@global_modules} = (1) x @global_modules;
    }

    return sort keys %modules_in_otrs;
}

sub cpan_modules {
    my ($class,$version) = @_;

    return if !$version || $version !~ m{ \A [0-9]+\.[0-9]\.(?:[0-9]+|x) \z }xms;

    $version =~ s{\.}{\.}g;
    $version =~ s{x}{.*};

    my $version_re = qr{ \A $version \z }xms;

    my %modules_in_otrs;

    OTRSVERSION:
    for my $otrs_version ( keys %{ $modules } ) {
        next unless $otrs_version =~ $version_re;

        my $hashref = $modules->{$otrs_version}->{cpan};
        my @modulenames = keys %{$hashref || {}};

        @modules_in_otrs{@modulenames} = (1) x @modulenames;
    }

    if ( $version =~ m{x} || exists $modules->{$version} ) {
        my @global_modules = keys %{ $global->{cpan} };
        @modules_in_otrs{@global_modules} = (1) x @global_modules;
    }

    return sort keys %modules_in_otrs;
}

1;
#;

print $fh qq~

=pod

=head1 NAME

Module::OTRS::CoreList - what modules shipped with versions of OTRS (>= 2.3.x)

=head1 VERSION

version $dist_version

~;

print $fh q~=head1 SYNOPSIS

 use Module::OTRS::CoreList;

 my @otrs_versions = Module::OTRS::CoreList->shipped(
    '2.4.x',
    'Kernel::System::DB',
 );
 
 # returns (2.4.0, 2.4.1, 2.4.2,...)
 
 my @modules = Module::OTRS::CoreList->modules( '2.4.8' );
 my @modules = Module::OTRS::CoreList->modules( '2.4.x' );
 
 # methods to check for CPAN modules shipped with OTRS
 
 my @cpan_modules = Module::OTRS::CoreList->cpan_modules( '2.4.x' );

 my @otrs_versions = Module::OTRS::CoreList->shipped(
    '3.0.x',
    'CGI',
 );

~;

print $fh qq~
=head1 AUTHOR

$dist_author

=head1 COPYRIGHT AND LICENSE

$dist_copyright
~;

}