view release on metacpan or  search on metacpan

script/ucpan  view on Meta::CPAN

    my $f = $CONFIG->{cfg_file};
    do { warn "$f not exist...ABORT!!"; exit; } unless -f $f;
    my $c = _load_yaml($f);
    my $count;
    for ( keys %{ $c->{SKIP} } ) {
        if ( $c->{SKIP}->{$_}->{fail_at} =~ /^(?:UNKNOWN|\?)$/ ) {
            delete $c->{SKIP}->{$_};
            $count++;
        }
    }
    if ($count) {
        print STDERR "Backup $f...$/";
        File::Copy::copy( $f, $f . '-BACKUP' )
            or die "Can't rename $f to -BACKUP";
        print STDERR "Saving $f...";
        eval { YAML::DumpFile $f, $c }
            or die "$/Can't save config-file: $f: $@";
        print STDERR "Done!!(purged $count entries)";
    }
    else {
        print STDERR "$f: up-to-date.";
    }
}

sub load_config {
    $CONFIG->{user_setting}
        = -r $CONFIG->{cfg_file} ? _load_yaml( $CONFIG->{cfg_file} ) : {};
}

#== Custom STDERR
my $FH_ORG_STDERR;
open $FH_ORG_STDERR, '>&STDERR';
$FH_ORG_STDERR->autoflush;
close STDERR unless WIN32;
# make doing warn() correctly
local $SIG{__WARN__} = sub {
    *STDERR = $FH_ORG_STDERR;
    CORE::warn(@_);
};

my %outdated;
my %added;

my $pr_colored = sub {
    my $color = join ' ', @_;
    return sub {
        print colored( join( $,, @_ ), $color );
    };
};
sub pr_black;
sub pr_red;
sub pr_green;
sub pr_yellow;
sub pr_blue;
sub pr_magenta;
sub pr_cyan;
sub pr_white;
{
    no strict 'refs';
    for my $color (qw/red green yellow blue magenta cyan white /) {
        *{ __PACKAGE__ . '::pr_' . $color } = $pr_colored->( 'bold', $color );
    }
    *{ __PACKAGE__ . '::pr_black' } = sub {
        my $tail = pop @_;
        my $nl   = chomp($tail) ? $/ : '';
        print color('black on_white'), @_, $tail;
        print color('reset'), $nl;
    };
}

## common vars
my $skip_entries;

my ( $fn, $fc, $fl, $fs );
( $fn, $fc, $fl ) = qw/32 10 10/;
$fs = $screenX - ( 2 * 3 + 1 ) - $fn - $fc - $fl;
my $output_format_3 = sprintf qq{%%%d.%ds %%%d.%ds %%%d.%ds$/},
    ($fn) x 2, ($fc) x 2, ($fl) x 2;
my $output_format_4 = sprintf qq{%%%d.%ds %%%d.%ds %%%d.%ds %%%d.%ds$/},
    ($fn) x 2, ($fc) x 2, ($fl) x 2, ($fs) x 2;
my $output_format_fold_head = "%s$/";

## set foldize
my $fold_mod = Foldize->new( width => $fn, delimiter => "::" );

sub make_table_row {
    my $e = shift;
    my $r = '';
    my ( $mod, $current, $new, $phase );
    $mod     = $fold_mod->parse( $e->{module} );
    $current = $e->{current};
    $new     = $e->{new};
    $phase   = $e->{fail_at};
    while ( $mod->length > 1 ) {
        $r .= sprintf( $output_format_fold_head, $mod->get );
    }
    my $format = $phase ? $output_format_4 : $output_format_3;
    $r .= sprintf(
        $format, $mod->get,
        $current => $new,
        $phase
    );
    return $r;
}

## Show Skips
sub show_skips {
    pr_black qq|>>> Show FAILED Modules...$/|;
    my $skips = $CONFIG->{user_setting}->{SKIP};

    my @mods;
    @mods = sort { $a->{module} cmp $b->{module} }
        map {
        my @a = @{ $skips->{$_}->{modules} };
        my $f = $skips->{$_}->{fail_at};
        $_->{fail_at} = $f for @a;
        @a
        } keys %$skips;
    pr_cyan
        sprintf( $output_format_4, 'Name', 'Current', 'Latest',
        'Fail at...' );