Skip to content

@wchristian /.minicpanrc_example
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
automatically update a darkpan
# where the cpan mirror lives
local: c:/dpan/mini
# where to mirror from
remote: http://cpan.perl.org
# where to prepare the inserted modules
repository: c:/dpan/mymodules
#!/usr/bin/perl
use strict;
use warnings;
package Automatic;
use Moose;
use CPAN::Mini::Inject;
use App::Cache;
use File::Slurp;
use CPAN::ParseDistribution;
use Try::Tiny;
use LockFile::Simple qw( trylock unlock );
has in_dir => ( isa => 'Str', is => 'ro', default => "in" );
has cfg_file => ( isa => 'Str', is => 'ro', default => ".minicpanrc" );
has local_author => ( isa => 'Str', is => 'ro', default => "TFX" );
has cache => ( isa => 'App::Cache', is => 'ro', builder => '_init_cache' );
has inject => ( isa => 'CPAN::Mini::Inject', is => 'ro', builder => '_init_mcpi' );
has new_dists => ( isa => 'Int', is => 'rw', default => 0 );
sub _init_cache { App::Cache->new({ ttl => 32_000_000, directory => 'cache' }) }
sub _init_mcpi { CPAN::Mini::Inject->new }
sub run {
my ( $self ) = @_;
my $lock = trylock( "Automatic.lock" );
return $self->update_local_mirror if $lock;
print "Lockfile exists, skipping update.";
return;
}
sub update_local_mirror {
my ( $self ) = @_;
try {
my $inject = $self->inject;
$inject->parsecfg($self->cfg_file);
$inject->config->set( 'dirmode', '0777' );
$self->add_directory;
$inject->writelist;
$self->update_from_remote;
$inject->inject( 'verbose' ) if $self->new_dists;
}
finally {
unlock( "Automatic.lock" );
}
catch {
print "Error: $_";
};
return;
}
sub update_from_remote {
my ( $self ) = @_;
return if $self->remote_is_fresh;
my $inject = $self->inject;
$inject->update_mirror( trace => $inject->{config}{trace} );
$self->cache->set( 'last_remote_update', time );
return;
}
sub remote_is_fresh {
my ( $self ) = @_;
my $last_update = $self->cache->get( 'last_remote_update') || 0;
return 1 if $last_update > ( time - 60*60 );
return 0;
}
sub add_directory {
my ( $self ) = @_;
my $dir = $self->in_dir;
my @dists = sort @{ read_dir( $dir ) };
my $known_dists = $self->cache->get("known_dists") || {};
my $need_all_dists = !$self->remote_is_fresh;
my @new_dists = grep { $need_all_dists or !$known_dists->{$_} } @dists;
for my $dist ( @new_dists ) {
my $success = try { $self->add_dist( "$dir/$dist" ) };
next if !$success;
print "added $dist\n";
$known_dists->{$dist} = 1;
$self->new_dists(1);
}
$self->cache->set( "known_dists", $known_dists );
return;
}
sub add_dist {
my ( $self, $file ) = @_;
print "adding $file\n";
my $dist = CPAN::ParseDistribution->new( $file );
my %modules = %{$dist->modules};
for ( keys %modules ) {
$self->inject->add(
module => $_,
authorid => $self->local_author,
version => $modules{$_},
file => $file
);
}
return 1;
}
1;
#!/usr/bin/perl
use strict;
use warnings;
package inject;
BEGIN {
umask 0;
use CGI::Carp qw(carpout);
open my $LOG, ">>inject_error.log" or die "Unable to open mycgi-log: $!\n";
carpout($LOG);
CGI::Carp->import( 'fatalsToBrowser' ) if !@ARGV;
if ( @ARGV ) {
use FindBin;
chdir $FindBin::Bin;
}
}
use Capture::Tiny qw' tee_merged capture_merged ';
use File::Slurp;
use Automatic;
$|++;
my $normal_log_file = 'inject.log';
append_file $normal_log_file, localtime()."\nStarted CPAN mirror update.\n";
my $result;
$result = capture_merged { Automatic->new->run; } if !@ARGV;
$result = tee_merged { Automatic->new->run; } if @ARGV;
$result .= "done updating\n" if $result;
$result ||= "Nothing to do.\n";
append_file $normal_log_file, "$result\n".localtime()."\n";
exit if @ARGV;
my $file = "mini/authors/01mailrc.txt.gz";
my $file_size = -s $file;
print "Content-Type:application/octet-stream\n";
print "Content-Disposition:attachment;filename=01mailrc.txt.gz\n";
print "Content-Length:$file_size\n\n";
binmode STDOUT;
print read_file $file, binmode => ':raw';
exit;
#!/usr/bin/perl
use strict;
use warnings;
package dpan_upload;
BEGIN {
umask 0;
use CGI::Carp qw(carpout);
open my $LOG, ">>upload_error.log" or die "Unable to open mycgi-log: $!\n";
carpout($LOG);
}
use CGI 'header';
use CGI::Upload;
use File::Slurp qw( read_file write_file );
receive_file();
print header();
print 'uploaded';
exit;
sub receive_file {
my $upload = CGI::Upload->new;
my $file_name = $upload->query->param('pause99_add_uri_upload');
my $fh = $upload->file_handle('pause99_add_uri_httpupload');
my $data = read_file( $fh, binmode => ':raw' );
unlink "in/$file_name" if -e "in/$file_name";
write_file( "in/$file_name", $data, { binmode => ':raw' } );
return;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.