view release on metacpan or  search on metacpan

bin/perldolicious  view on Meta::CPAN

use Scalar::Util     ();
use Storable         ();

our $VERSION = '0.011';
$VERSION = eval $VERSION;

sub get_modules {
    my $cpan_package_file = shift;
    die "$cpan_package_file doesn't exist" unless -f $cpan_package_file;

    my $fh = IO::Zlib->new($cpan_package_file, 'r')
      or die "Could not open '$cpan_package_file': $!";

    my $modules;
    while (<$fh>) {
        my @columns = split /\s+/;
        next unless @columns == 3;
        my $module = $columns[0];
        push @$modules, $module;
    }

    return $modules;
}

sub write_modules {
    my ($modules_cache_file, $cpan_package_file) = @_;

    my $modules = get_modules($cpan_package_file);
    Storable::nstore($modules, $modules_cache_file);
}

sub compile_pattern {
    my ($pattern, $p) = @_;
    die "No pattern specified\n" unless $pattern;

    local $@;
    eval { $pattern = $p->{ignore_case} ? qr{$pattern}i : qr{$pattern}; };
    die "Invalid regular expression\n" if $@;

    return $pattern;
}

sub read_json_config {
    my $config_file = shift;

    open my $fh, '<', $config_file
      or die "Could not open '$config_file': $!";

    local $/;
    my $bytes = <$fh>;

    close $fh or die "Could not close '$config_file': $!";
    return Mojo::JSON->new()->decode($bytes);
}

helper setup_modules_file => sub {
    my $cache_file = app->config('modules_cache_file');
    my $limit      = app->config('auto_download');

    die "Configuration auto_download: $limit doesn't look like number\n"
      unless Scalar::Util::looks_like_number($limit);

    # file does not exist or file exists but it's older than the
    # specified limit (in days)
    if (not -f $cache_file
        or -f $cache_file and -M $cache_file > $limit)
    {

        if (-f $cache_file) {
            app->log->info("Deleting cache file $cache_file");
            unlink $cache_file or die $!;
        }

        my $url = 'http://www.cpan.org/modules/02packages.details.txt.gz';

        my $tempfile          = File::Temp->new;
        my $download_location = $tempfile->filename;

        app->log->info("Downloading $url to $download_location");
        Mojo::UserAgent->new->get($url)
          ->res->content->asset->move_to($download_location);

        app->log->info("Caching modules to $cache_file");
        write_modules($cache_file, $download_location);

    }
};

helper setup_log => sub {
    my ($self, $confdir) = @_;
    my $logfile = catfile($confdir, 'server.log');
    my $limit = 2_000_000;    # 2MB
    if (-f $logfile and -s $logfile > $limit) {
        unlink $logfile or die "Could not delete '$logfile'";
        app->log->info("Deleting $logfile");
    }

    app->log->path($logfile) if app->config('quiet');
};

helper initialize => sub {
    # for some reason cpandoc is not installed on some machines, even though
    # Pod::Cpandoc is already listed as a prereq in Build.PL
    die "cpandoc is not installed on your system\n"
      unless File::Which::which('cpandoc');

    my $confdir = $ENV{PERLDOLICIOUS_HOME}
      || catfile($ENV{HOME}, '.perldolicious');

    unless (-d $confdir) {
        File::Path::make_path($confdir)
          or die "Could not create directory $confdir";
    }

    my $confile = catfile($confdir, 'config.json');
    my $conf = {
        modules_cache_file => catfile($confdir, 'modules.storable'),
        auto_download      => 14,               # 2 weeks
        quiet              => 0
    };