view release on metacpan or  search on metacpan

examples/update100.pl  view on Meta::CPAN

#!/usr/bin/perl
use warnings;
use strict;
$|++;

my $VERSION = '1.05';

#----------------------------------------------------------------------------

=head1 NAME

update100.pl - preps the OneHundred module for release, if required.

=head1 SYNOPSIS

  perl update100.pl

=head1 DESCRIPTION

Downloads the latest copy of the backpan100.csv file from CPAN Testers 
Statistics site. Compares with the previous download, and if there is a change,
takes the module template and inserts the appropriate data ready for the next 
release.

=cut

# -------------------------------------
# Library Modules

use CPAN::Changes;
#use Data::Dumper;
use DateTime;
use File::Basename;
use Getopt::Long;
use IO::File;
use Template;
use WWW::Mechanize;

# -------------------------------------
# Variables

my (%options,%old,%new,%tvars,%pause,%changes);
my $changed = 0;
my $max = 4;

my @files = qw(
    lib/Acme/CPANAuthors/BackPAN/OneHundred.pm
    LICENSE
    META.json
    META.yml
    README
    t/10cpanauthor.t
);

my %config = (                              # default config info
    RELATIVE        => 1,
    ABSOLUTE        => 1,
    INTERPOLATE     => 0,
    POST_CHOMP      => 1,
    TRIM            => 0,
    INCLUDE_PATH    => 'templates',
    OUTPUT_PATH     => '..'
);

my %groups = (
    'insert' => 'New Authors',
    'update' => 'Updated Counts',
    'delete' => 'See You Again?',
);

# -------------------------------------
# Program

GetOptions(\%options, 'local', 'build', 'release') or die "Usage: $0 [--local] [--build] [--release]\n";

my $base = dirname($0);
chdir($base);
#print "dir=$base\n";

unless($options{local}) {
    my $mech = WWW::Mechanize->new();
    my $source = 'http://stats.cpantesters.org/stats/backpan100.csv';
    my $target = basename($source);
    $mech->mirror($source,$target);
}

# read old file
my $inx = 0;
my $file = 'data/backpan100.csv';
if(my $fh = IO::File->new($file,'r')) {
    while(<$fh>) {
        s/\s+$//;
        next    if(not $_ or $_ =~ /^#/);
        my ($pause,$cnt,$name) = split(/,/);
        next unless($pause);

        $inx++;
        $old{$inx} = { count => $cnt, pause => $pause, name => $name };
        $pause{$pause} = $cnt;
    }
    $fh->close;
}

#print "pause=" . Dumper(\%pause);
#print "old=" . Dumper(\%old);

# read new file
$inx = 0;
$file = 'backpan100.csv';
my $fh = IO::File->new($file,'r') or die "Cannot open file [$file]: $!\n";
while(<$fh>) {
    s/\s+$//;

    if($_ && $_ =~ /^# DATE: (.*)/) {
        $tvars{WHEN} = $1;