view release on metacpan or  search on metacpan

lib/App/PAUSE/cleanup.pm  view on Meta::CPAN

package App::PAUSE::cleanup;
our $AUTHORITY = 'cpan:YANICK';
# ABSTRACT: Manage (delete/undelete) your PAUSE files
$App::PAUSE::cleanup::VERSION = '0.0014';
use strict;
use warnings;

use Getopt::Usaginator <<_END_;

Usage: pause-cleanup <options>

    --username <username>   Your PAUSE username
    --password <password>   The password for the above
                            Instead of supplying your identity on the
                            commandline, you can setup \$HOME/.pause like so:

                                user <username>
                                password <password>

    -d, --dump              Dump the list of files to STDOUT
    
    -h, -?, --help          This help

_END_
use Getopt::Long qw/ GetOptions /;


use Term::EditorEdit;
use Config::Identity::PAUSE;
use WWW::Mechanize;
use Web::Query 'wq';


my $agent = WWW::Mechanize->new;

sub run {
    my $self = shift;
    my @arguments = @_;

    my ( $help, $username, $password, $dump );
    {  
        local @ARGV = @arguments;
        GetOptions(
            'username=s' => \$username,
            'password=s' => \$password,
            'dump|d' => \$dump,
            'help|h|?' => \$help,
        );
    }

    usage 0 if $help;

    my %identity = Config::Identity::PAUSE->load;
    $username = $identity{user} unless defined $username;
    $password = $identity{password} unless defined $password;

    usage '! Missing username and/or password' unless
        defined $username && defined $password;

    $agent->credentials( "pause.perl.org:443", "PAUSE", $username, $password );

    print "> Logging in as $username\n";
    
    my $response = $agent->get( 'https://pause.perl.org/pause/authenquery?ACTION=delete_files' );

    my @filelist = $self->parse_filelist( $response->decoded_content );

    if ( $dump ) {
        print join "\n", map { $_->{package_version} } @filelist;
        print "\n";
        return;
    }

    my %package;
    for my $file (@filelist) {
        push @{ $package{$file->{package}} }, $file;
    }

    my @document;
    push @document, <<_END_;
# Logged in as $username
#
# Any line not beginning with 'delete', 'undelete', or 'keep' is ignored
# To take action on a release, remove the leading '#'
#   
#   delete      Delete the .meta, .readme, and .tar.gz associated
#               with the release
#
#   undelete    Undelete the .meta, .readme, and .tar.gz (remove
#               from scheduled deletion
#
#   keep        Ignore the release
#
# By default, the latest version of each release is commented 'keep'
# Older versions are commented 'delete' (or 'undelete')
_END_

    for my $name (sort keys %package) { 
        my @filelist = @{ $package{$name} };
        @filelist = sort { $a->{scheduled} cmp $b->{scheduled} or
                           $b->{tar_gz} cmp $a->{tar_gz} } @filelist;

        push @document, "$name:";

        my @latest = $self->extract_latest( \@filelist );

        for my $latest ( @latest ) {
            if ( $latest->{scheduled} )
                    { push @document, "# undelete $latest->{package_version}" }
            else    { push @document, "# keep $latest->{package_version}" }
        }

        push @document,
            ( map {
                my $operation = $_->{scheduled} ? "undelete" : "delete";
                "# $operation $_->{package_version}"
            } @filelist ),
            '',
        ;
    }