view release on metacpan or  search on metacpan

script/cpan2aur  view on Meta::CPAN

        tt_to_pkgbuild() if ( -f 'PKGBUILD.tt' );

        error( <<'END_ERR' ) unless ( -f 'PKGBUILD' );
There is no PKGBUILD in the directory and no file or module names specified on
the command line.  Unable to upload anything.
END_ERR

        my $makepkg_cmd = 'makepkg --source --force --clean';
        substatus qq{Running '$makepkg_cmd'...};
        my $output = `$makepkg_cmd 2>&1`;

        unless ( $? == 0 ) {
            my $msg =
                ( $? & 127
                  ? ( sprintf 'makepkg failed, signal %d',      $? & 127 )
                  : ( sprintf 'makepkg failed, error code %d.', $? >> 8  ));
            error( $msg );
        }

        # We can only parse the output of makepkg to find the filename...
        my @pkginfo = $output =~ /Making package: ([\w-]+) ([\d.-]+)/
            or error( "makepkg returned unexpected output: $output" );

        $pkgpath = ( join q{-}, @pkginfo ) . '.src.tar.gz';
    };

    # Make sure we restore the cwd...
    chdir $oldcwd;
    die $EVAL_ERROR if ( $EVAL_ERROR );

    $pkgpath = "$pkgdir/$pkgpath";
    status "Created $pkgpath source package...";

    return $pkgpath;
}

sub create_new_pkgdir
{
    my $mod_name = shift;

    status "Creating a new package directory for $mod_name...";

    my $mod_obj  = find_module( $mod_name ) or return;
    my $dist_obj = create_dist_arch( $mod_obj, 'prepare' );

    new_tt_file( $dist_obj );
    status( sprintf 'Created %s source package directory.',
            pkgdir( $dist_obj ));

    return;
}

## AUR PACKAGE UPLOAD
##############################################################################

# Loads the last login username & session ID used.
sub _load_last_login
{
    return () unless ( -f $CFGPATH );

    die q{Please 'chmod 600 ~/.cpan2aur', it is not readable}
        unless ( -r $CFGPATH );

    my ($user, $sid);
    open my $cfgfile, q{<}, $CFGPATH or die "open $CFGPATH: $!";
    while (<$cfgfile>) {
        chomp;
        ($user, $sid) = split /:/;
        last; # only want first line
    }
    close $cfgfile;

    return () unless ( $user && $sid && $sid =~ /\A[a-fA-F0-9]+\z/ );

    # If the user specified a --name flag, make sure it matches the cached...
    return () if ( $NAME && ( lc $user ne lc $NAME ));

    chomp $sid;
    return ($user, $sid);
}

# Save the username & session ID for later.
sub _save_last_login
{
    my ($username, $sid) = @_;

    # Set umask to keep this file private...
    my $oldmask = umask 0077;
    $username   = lc $username;

    open my $cfgfile, '>', $CFGPATH or die "open $CFGPATH: $!";
    print $cfgfile "$username:$sid\n";
    close $cfgfile or die "close $CFGPATH: $!";

    umask $oldmask;
    return;
}

# Login to AUR to get a fresh session ID cookie.
# Params:  $ua - LWP::UserAgent object
#                (this gets a new cookie jar with a new session cookie)
#          $username - Username to login AUR.
#          $password - Password to login AUR.
# Returns: a new session ID
sub _new_login_sid
{
    my ($ua, $username, $passwd) = @_;

    # Get a fresh session ID cookie...
    $ua->cookie_jar( HTTP::Cookies->new() );
    my $resp = $ua->post( AUR_LOGIN_URI,
                          [ user        => $username,
                            passwd      => $passwd,
                            remember_me => 1, # probably not needed
                           ] );

    # Check for problems...
    error( 'Bad username or password' )
        if ( $resp->content =~ /$BAD_LOGIN_MSG/ );

    error( "AUR login expected status code 302.