view release on metacpan or  search on metacpan

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

    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 ),
            '',
        ;
    }

    my $document = join "\n", @document;
    
    my $delete_undelete = Term::EditorEdit->edit( document => $document, process => sub {
        my $edit = shift;
        my ( @delete, @undelete );
        my @content = split m/\n/, $edit->content;
        for my $line ( @content ) {
            next unless $line =~ m/^\s*(delete|undelete)\s*(\S+)/i;
            if ( lc $1 eq 'delete' ) { push @delete, $2 }
            else                     { push @undelete, $2 }
        }
        return { delete => \@delete, undelete => \@undelete };
    } );

    my ( $delete, $undelete ) = @$delete_undelete{qw/ delete undelete /}; 

    if ( @$delete ) {
        print "\n---\n";
        print join "\n", '', ( map { " $_" } @$delete ), '', '';
        print "> Really delete? If you wish to abort, hit ^C (CTRL-C) now!\n";
        print "> Hit return to continue, or cancel with ^C\n";
        my $nil = <STDIN>;
        my $count = scalar @$delete;
        print "> Deleting $count\n";
        $self->_delete( $delete );
    }
    
    if ( @$undelete ) {
        print "\n---\n";
        print join "\n", '', ( map { " $_" } @$undelete ), '', '';
        my $count = scalar @$undelete;
        print "> Undeleting $count\n";
        $self->_undelete( $undelete );
    }

    unless ( @$delete || @$undelete ) {
        print "> Nothing to do\n";
    }
}

sub parse_filelist {
    my( $self, $document ) = @_;

    @{ wq($document)->find('input[name="pause99_delete_files_FILE"]')->map(sub{
        my $tr = $_->parent->parent;
        my $file = $tr->find('.file')->text;

        my $package = $file;
        $package =~ s/-([\d\._]+)\.tar\.gz$//
            or return ();
        my $version = $1;

        return {
            tar_gz          => $file,
            package         => $package,
            package_version => join( '-', $package, $version ),
            version         => $version,
            size            => $tr->find('.size')->text,
            scheduled       => !!($tr->find('.modified') =~ /Scheduled for deletion/),
        };
    }) };


}

sub _delete {