#!/usr/bin/perl
# copher - http://copher.sourceforge.net
# Copyright (C) 2008-2009  Peter Lunicks
#
# This program is free software; you can redistribute it and/or modify
# it under the terms version 2 of the GNU General Public License as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use WWW::Mechanize;
use Carp;
use File::Basename;
use Cwd 'abs_path';

###########
# 'Constants'
use constant {
    TRUE => 1,
    FALSE => 0
};

my %sites = (
    sourceforge => 'https://sourceforge.net',
    rubyforge => 'https://rubyforge.org',
    luaforge => 'https://luaforge.net'
    );

# Urls:
my %urls = (
    sourceforge => {
        login => '/account/login.php',
        login_form_action => '/account/login.php',
        projects => '/projects/',
        home => '',
        # These seem to no longer exist as of 20091013.
        base_newpackage => '/project/admin/editpackages.php',
        base_editpackages => '/project/admin/editpackages.php',
        base_newrelease => '/project/admin/newrelease.php',
        base_editreleases => '/project/admin/editreleases.php',
        base_editrelease => '/project/admin/editreleases.php', # edit a single release
        #
        base_deleterelease => undef, # does not exist in sourceforge
        base_filemanager => '/project/admin/explorer.php', # add e.g. ?group_id=137217
        base_explorerajax => '/project/admin/explorer_ajax.php',
},
    rubyforge => {
        login => '/account/login.php',
        login_form_action => '/account/login.php',
        projects => '/projects/',
        home => '',
        base_newpackage => '/frs/admin/index.php',
        base_editpackages => '/frs/admin/index.php',
        base_newrelease => '/frs/admin/qrs.php',
        base_editreleases => '/frs/admin/showreleases.php',
        base_editrelease => '/frs/admin/editrelease.php', # edit a single release
        base_deleterelease => '/frs/admin/deleterelease.php'
        # "to create a new release click here": http://rubyforge.org/frs/admin/qrs.php?package=&group_id=6619
    }
    );

my $sf_ftp = 'upload.sourceforge.net';
my $sf_ftp_user = 'anonymous';
my @sf_ftp_path = qw(incoming);     # path to enter before uploading file

my $sf_frs = "frs.sourceforge.net";
my $sf_frs_path = "uploads"; # obsolete circa 20091013
my $sf_frs_path_fmt = "/home/frs/project/%s/%s/%s/";

###########
# To be set by the script when they're determined:
my $group_id;
my $package_id;
my $release_id;

###########
# Configuration information

my %user;
my $project_name;
my $package_name;
my $release_name;
my $time = time;
my $current_date = `date +%Y-%m-%d`;
my $current_datetime = `date "+%Y-%m-%d %H:%M"`;
my ($release_date, $release_datetime);
my @release_files;

my ($notes_file, $changelog_file);

my %release_files;
my %opt;
# Some default values:
$opt{release_exists} = 0;           # Default to creating a new release, not editing an existing one (override with -E or -R)
$opt{active} = 1;
$opt{noupload} = 0;
$opt{notice} = 1;                   # Whether to send emailed Release Notice (step 4)
$opt{protocol} = 'rsync';
my $site = 'sourceforge';
my $debug = 0;   # print debugging messages
my $new_release = 0; # set to 1 if a new release is created
###########


sub print_usage {
    print "Usage: " . basename($0) . " [options] [files]\n";
    print "option format: --option=VALUE or -o VALUE\n";
    print "\noptions:\n" .
        "--user, -u         specify login name\n" .
        "--password, -w     specify password\n" .
        "--project, -p      project name (unixname) to work with\n" .
        "--package, -k      name of the package to release in (should already exist)\n" .
        "--release, -r      name for the new or existing release\n" .
        "--date, -d         release date (YYYY-MM-DD)\n" .
        "--group-id, -G     group id (i.e. project id) to use (faster if specified)\n" .
        "--package-id, -P   package id to use (faster if specified)\n" .
        "--release-id, -R   release id of existing release to modify (implies -E)\n" .
        "--exists, -E       don't create a new release, use existing (use with -r)\n" .
        # if name matches > 1 release, what to do? ask, choose first (configurable) TODO
        "--hidden, -H       set release as not visible to the public\n" .                  # -H sets active = 0
        "--active, -A       set release as active [default for new releases]\n" .
        "--notes, -N        file containing release notes\n" .
        "--changelog, -C    file containing changelog\n" .
        "--no-upload        don't upload files (assume they already were)\n" .
        #"--protocol         protocol for uploading files: ftp, rsync, scp, sftp, web, webdav\n" .
        "--no-notice        don't send emailed release notice (step 4) [default: do]\n";
}

sub debug ($) {
    return -1 unless $debug;
    print STDERR shift;
}

sub debugv () {
    return -1 unless $debug;
    my $debug_join = "|";
    print STDERR "debug: " . join($debug_join, @_) . "\n";
    return;
}

###########
# Read in copherrc file in current directory if it exists
# Note that filename arguments can't start with whitespace
if (open(PROJ, "./copherrc")) {
    foreach (<PROJ>) {
        if (/^site\s*[=:\s]\s*(\S*)$/) {
            $site = lc($1);
        } elsif (/^project_name\s*[=:\s]\s*(\S*)$/) {
            $project_name = $1;
        } elsif (/^group_id\s*[=:\s]\s*(\S*)$/) {
            $group_id = $1;
        } elsif (/^package_name\s*[=:\s]\s*(\S*)$/) {
            $package_name = $1;
        } elsif (/^package_id\s*[=:\s]\s*(\S*)$/) {
            $package_id = $1;
        } elsif (/^release_name\s*[=:\s]\s*(\S*)$/) {
            $release_name = $1;
        } elsif (/^release_id\s*[=:\s]\s*(\S*)$/) {
            $release_id = $1;
        } elsif (/^notes\s*[=:\s]\s*(.*)$/) {
            $notes_file = $1;
        } elsif (/^(?:changelog|changes)\s*[=:\s]\s*(.*)$/) {
            $changelog_file = $1;
        } elsif (/^(?:release_)?file\s*[=:\s]\s*(.*)$/) {
            my ($file, $type, $arch) = split '\t', $1;
            push @release_files, $file;
            # TODO: put $type and $arch in %release_files
        }
    }
    close PROJ;
}

# Read in command-line options
use Getopt::Long;
Getopt::Long::Configure(qw(gnu_getopt permute bundling));
GetOptions(
    'help|h' => sub {
        &print_usage;
        exit 0;
    },
    'user|loginname|u:s' => \$user{loginname},
    'password|pw|P:s' => \$user{password},
    'project|pj|j|p:s' => \$project_name,
    'package|pkg|b|k:s' => \$package_name,
    'release|r:s' => \$release_name,
    'date|d:s' => sub {
        $release_date = $_[1];
        die "Release date format must be YYYY-MM-DD. Offending datum: $release_date\n" unless $release_date =~ /\d{4}-\d{2}-\d{2}/;
    },
    'group-id|group_id|gid|G:s' => \$group_id,
    'package-id|package_id|pid|K:s' => \$package_id,
    'release-id|release_id|rid|R:s' => sub { $release_id = $_[1]; $opt{release_exists} = 1; },
    'noupload|no-upload' => \$opt{noupload},       # don't upload files (assume they already were?)
    # 'newpackage'     # force creation of a new package
    # 'newrelease'     # force creation of a new release
    'notes|N:s' => sub {
        if (! -f $_[1]) {
            die "no such file for release notes: $_[1]\n";
        }
        $notes_file = $_[1];
    },
    'changelog|C:s' => sub {
        if (! -f $_[1]) {
            die "no such file for changelog: $_[1]\n";
        }
        $changelog_file = $_[1];
    },
    'active|A' => sub { $opt{active} = 1; },
    'hidden|H' => sub { $opt{active} = 0; },
    'exists|E' => sub { $opt{release_exists} = 1; },
    'no-notice|nonotice|disable-notice' => sub { $opt{notice} = 0; },
    'protocol:s' => sub {
        $opt{protocol} = $_[1];
        unless ($opt{protocol} =~ /^(ftp|rsync|scp|sftp|web|webdav)$/) {
            print STDERR "Error: protocol must be one of ftp, rsync, scp, sftp, web, webdav\n";
            exit(1);
        }
        if ($opt{protocol} =~ /^(ftp|scp)$/) {
            print STDERR "Error: uploading via $opt{protocol} is not supported by sourceforge\n";
            exit(1);
        }
        if ($opt{protocol} =~ /^(web|webdav)$/) {
            print STDERR "Error: uploading via $opt{protocol} is not yet implemented\n";
            exit(1);
        }
        # only rsync is currently implemented
        unless ($opt{protocol} =~ /^(rsync)$/) {
            print STDERR "Error: only rsync upload protocol is supported\n";
            exit(1);
        }
    },
    'debug' => \$debug
    );

debug("$project_name | $group_id | $package_name | $package_id | $release_name | $release_id\n");

if (@ARGV) {    # if there's anything left in the arg list, treat it as a list of files to add to the release
    @release_files = @ARGV;
}

###########
# Read in .netrc file in home directory, if it exists
if (open(RC, "$ENV{HOME}/.netrc")) {
    my $machine;
    foreach (<RC>) {
        if (/^machine (\S+)/) { $machine = $1; next; }
        if (/^\s*login (\S+)/ && $machine eq $site) { $user{loginname} = $1; next; }
        if (/^\s*password (\S+)/ && $machine eq $site) { $user{password} = $1; last; }
    }
    close RC;
}

###########
# Make sure all necessary parameters were specified, either on the command line, in a file,
# or on stdin
if ($user{loginname} eq "" or $user{password} eq "") {
    die "Need loginname (-u) and password (-P) to continue.\n";
}
if ($project_name eq '' and $group_id eq '') {
    die "Need project name (-p) or group id (-G) to continue.\n";
}
if ($package_name eq '' and $package_id eq '') {
    die "Need package name (-k) or package id (-K) for existing package to continue.\n";
}
if ($release_name eq '' and $release_id eq '') {
    die "Need release name (-r) for new or existing release; or release id for existing release.\n";
}

if ($release_id) { # The release already exists (or at least the user thinks it does?)
    $opt{release_exists} = 1;
}

###########
# Note: If the information %type_id and %arch_id is instead stored in a file,
# this file can be updated if changes/additions are detected. [todo]
my %type_id = (
    '.deb' => 1000,
    '.rpm' => 2000,
    '.zip' => 3000,
    '.bz2' => 3001,
    '.gz' => 3002,
    'Source .zip' => 5000,
    'Source .bz2' => 5001,
    'Source .gz' => 5002,
    'Source .rpm' => 5100,
    'Other Source File' => 5900,
    '.jpg' => 8000,
    'text' => 8001,
    'html' => 8002,
    'pdf' => 8003,
    'Other' => 9999,
    '.sit' => 3003,
    '.nbz' => 3004,
    '.exe (DOS)' => 2500,
    '.exe (16-bit Windows)' => 2501,
    '.exe (32-bit Windows)' => 2502,
    '.exe (OS/2)' => 2600,
    '.dmg' => 3005,
    '.jar' => 2601,
    'Source Patch/Diff' => 5901,
    '.prc (PalmOS)' => 2700,
    '.iso' => 3006,
    'Source .Z' => 5003,
    '.bin (MacBinary)' => 2650,
    '.ps (PostScript)' => 8004,
    '.msi (Windows installer)' => 2503,
    'Other Binary Package' => 4000
    );
my %arch_id = (
    'i386' => 1000,
    'IA64' => 6000,
    'Alpha' => 7000,
    'Any' => 8000,
    'PPC' => 2000,
    'MIPS' => 3000,
    'Sparc' => 4000,
    'UltraSparc' => 5000,
    'Other' => 9999,
    'Platform-Independent' => 8500,
    'Platform Independent' => 8500,         # alias for convenience; not in sourceforge's list
    'ARM' => 3001,
    'SH3' => 3002,
    'AMD64' => 6001,
    'PPC64' => 2001
    );

#%release_files         # Each element is a reference to a 'file_struct' type:
# %file_struct = (         # (generic structure definition)
#               index => 0,         # index in @release_files
#       name => 'name',
#       file_id => undef,   # set when it's known
#       added => 0,         # set to 1 when it's confirmed to be added to the release
#       uploaded => 0,      # set to 1 when it's uploaded or known to already have been
#               class               # specified by user; 'Source' iff file is a source file, 'Binary' iff binary; or 'Other'
#       type => 'type',     # e.g. Source .bz2
#       type_id => 1000,    # SF's number for the type (value of the form input) [obsolete]
#       processor => 'arch'      # e.g. Platform-Independent
#       processor_id => 1000,    # SF's number for the arch [obsolete]
#       );

print STDERR "Files in release: @release_files\n";
foreach my $idx (0..$#release_files) {
    my $file = $release_files[$idx];
    my $basename = basename($file);   
    my $class;   # Source/Binary/Other
    
    $class = 'source';    #temp; will be an option defaulting to 'source'
    my $filetype = guess_file_type($file, $class);
    #my $filetype_id = $type_id{$filetype} || '9999';
    my $arch = 'Platform-Independent';
    $release_files{$basename} = {
        index => $idx,
        name => $basename,
        fullpath => $file,
        file_id => undef,
        added => 0,
        uploaded => 0,
        type => $filetype,
        #type_id => $type_id{$filetype},
        processor => $arch,
        #processor_id => $arch_id{$arch}    
    };
    
    #print STDERR "Filetype: $file is a $filetype ($filetype_id)\n";
    print STDERR "Filetype: $file is a $filetype ($arch)\n";
}

###########

sub guess_file_type ($$) {
    my $filename = shift;
    my $class = shift;
    my $type;
    my $ext = $filename;
    $ext =~ s/(.*)\.//; 
    
    my $typemagic = `file $filename`;
    $typemagic =~ s/$filename:\s*//;
    $_ = $typemagic;
    if (/^(bzip2|gzip) compressed data/) {
        $type = ($1 eq 'gzip' ? '.gz' : '.bz2');
        if ($class =~ /source/i) {
            $type = 'Source ' . $type;
        }
    } elsif ($ext eq 'lzma') { # current `file' does not detect LZMA
        if ($class =~ /source/i) {
            $type = 'Other Source File'; # No 'Source .lzma' yet
        } else {
            $type = 'Other';
        }
    } elsif (/^compress\'d data/) {
        $type = '.Z';
        if ($class =~ /source/i) {
            $type = 'Source ' . $type;
        }
        
    } elsif (/^Zip archive data/) {
        $type = '.zip';
        if ($class =~ /source/i) {
            $type = 'Source ' . $type;
        }
        
    } elsif (/^RPM \w+ bin/) {
        $type = '.rpm';
    } elsif (/^RPM/) {
        $type = '.rpm';
        if ($class =~ /source/i) {
            $type = 'Source ' . $type;
        }
    } elsif (/script text executable/i) {
        $type = 'Other Source File';
    } elsif ($class =~ /source/i) {
        $type = 'Other Source File';
    } elsif (/^JPEG/) {
        $type = '.jpg';
    } elsif (/^HTML document text/) {
        $type = 'html';
    } elsif (/^PDF document/) {
        $type = 'pdf';
    } elsif (/^ASCII \w+ text/) { # e.g. ASCII English text
        $type = 'text';
    } elsif (/^\'diff\' output text/) {  # only seems to catch a few patches
        $type = 'Source Patch/Diff';
    } elsif (/^ISO 9660 CD-ROM/) { # ISO 9660 CD-ROM filesystem data
        $type = '.iso';
    } elsif (/^PostScript document/) {
        $type = '.ps';
    } elsif (/^data\s*$/) {
        $type = 'Other Binary Package';
    }
    
    if ($ext eq 'jar' and $type =~ /zip/i) {
        $type = '.jar';
    }

    return $type || 'Other';
}

my $mech = WWW::Mechanize->new(
    autocheck => 1    # autocheck for errors
    );

# Now upload files to be added to the release
if ($site eq 'sourceforge' and !$opt{noupload} and (keys %release_files)) {
    print STDERR "Uploading files...\n";
    &upload_files(\%release_files);
}
exit; ##HERE
#print "Sleeping for 10 seconds to allow sourceforge to notice files...\n";
#sleep 10;

print STDERR "Getting $sites{$site}$urls{$site}->{login}... ";
my $response = $mech->get($sites{$site}.$urls{$site}->{login}); # returns an HTTP::Response object
my $debug_pagenum = 0;
&save_page(sprintf("%02d-loginpage.html", $debug_pagenum++)) if $debug;
print STDERR &check_response($mech, $response, 1) . "\n";


if (!$mech->is_html) {
    die "$sites{$site}$urls{$site}->{login} returned non-html ". $mech->ct() ." content-type";
}

my @forms = $mech->forms();   # a list of HTML::Form objects
my $form_number = 1;   # start at one, then iterate until we have the login form

foreach my $form (@forms) {
    if ($form->action eq $sites{$site}.$urls{$site}->{login_form_action}) {
        last;
    }
    $form_number++;
}

$mech->form_number($form_number);

#$mech->untick('persistent_login', 1); # make sure this is disabled

print STDERR "Submitting form #$form_number to login as $user{loginname}\n";

my $response = $mech->submit_form(
    form_number => $form_number,
    button => 'login',
    fields => {
        form_loginname => $user{loginname},
        form_pw => $user{password}
    },         
    );
&save_page(sprintf("%02d-logged_in.html", $debug_pagenum++)) if $debug;

if ($mech->success) {
    print STDERR "Logged in.\n";
} else {
    die "failed posting login form\n";
}

if (! $group_id) {
    print STDERR "No group_id specified, fetching project page for project $project_name... ";
    my $response = &project_page($mech, $project_name);
    &save_page(sprintf("%02d-project_page.html", $debug_pagenum++)) if $debug;
    print STDERR &check_response($mech, $response, 1) . "\n";
    
    my $admin_link = $mech->find_link(url_regex => qr|^/project/admin/\?group_id=(.+)|);     # "should" still work if text => 'Admin' is added
    $admin_link->url =~ m|^/project/admin/\?group_id=(\d+)|;
    
    $group_id = $1;
    if (!length($group_id)) {
        die "error: no group_id in project page";
    }
}

my %release = (
    id => $release_id,
    date => $release_date || $current_date,
    name => $release_name,
    active => $opt{active},
    notes_file => $notes_file,
    changelog_file => $changelog_file,
    files => \%release_files
    );

if ($site eq 'sourceforge') {
#        notes_file => $notes_file,
#        changelog_file => $changelog_file,
#        files => \%release_files


} else {
    if (! $package_id) {
        print STDERR "No package_id specified, fetching Edit Packages ('File Releases') page with group_id=$group_id... ";
        my $response = &editpackages_php($mech, $group_id);
        &save_page(sprintf("%02d-editpackages.html", $debug_pagenum++)) if $debug;
        print STDERR &check_response($mech, $response, 1) . "\n";

        my @packages = &get_packages($mech);
        foreach my $pkg (@packages) {
            print STDERR "Package: name: " . $pkg->{package_name} .', package_id: '. $pkg->{package_id} .', group_id: '. $pkg->{group_id} ."\n";
            if ($pkg->{package_name} eq $package_name) { # good!
                $package_id = $pkg->{package_id};
                # ensure $pkg->{group_id} eq $group_id? it "should"
                unless ($pkg->{group_id} eq $group_id) {
                    warn $pkg->{group_id} . " doesn't match known group ID " . $group_id . "\n";
                }
            }
        }
        if (!$package_id) {
            print STDERR "Couldn't find a package with package_name $package_name\n";
            # future versions will be able to handle creation of new packages [todo]

            #print STDERR "Creating a new package...\n";
            exit 1;             # not yet
        }
    }

    if (! $release_id) {
        print STDERR "No release_id specified, fetching Edit Releases page with group_id=$group_id, package_id=$package_id... ";
        # or "Fetching list of file releases for $package_name (group_id=$group_id, package_id=$package_id)... ";
        my $response = &editreleases_php($mech, $group_id, $package_id);
        &save_page(sprintf("%02d-editreleases.html", $debug_pagenum++)) if $debug;
        print STDERR &check_response($mech, $response, 1) . "\n";

        my @releases = &get_releases($mech);
        foreach my $rls (@releases) {
            debug("Release: name: " . $rls->{release_name} .', release_id: '. $rls->{release_id} .', package_id: '. $rls->{package_id} ."\n");
            if ($rls->{release_name} eq $release_name) {
                $release_id = $rls->{release_id};
                print STDERR "Found release with name $release_name, release_id is $release_id. Using...\n";
                # sanity-check group_id and package_id
                if ($group_id != $rls->{group_id} or $package_id != $rls->{package_id}) {
                    warn "group_id or package_id mismatch! $rls->{group_id} != $group_id or $rls->{package_id} != $package_id. Probably will fail."
                }
                #last;
            }
        }

        if (!$release_id) {
            if ($opt{exists}) {
                print STDERR "Couldn't find a release with release_name $release_name, exiting (omit -E option to create new release)...\n";
                &close_copher(1);
            } else {
                print STDERR "Couldn't find a release with release_name $release_name, will create one...\n";
            }
        }
    }

    if (! $release_id) {
        print STDERR "No release_id specified, fetching New Release page... ";
        my $response = &newrelease_php($mech, $group_id, $package_id);
        &save_page(sprintf("%02d-newrelease.html", $debug_pagenum++)) if $debug;
        print STDERR &check_response($mech, $response, 1) . "\n";

        print STDERR "Adding new release (submitting form on New Release page)... ";
        my $response =  &add_release($mech, $group_id, $package_id, $release_name);
        $new_release = 1;
        &save_page(sprintf("%02d-added_release.html", $debug_pagenum++)) if $debug;
        print STDERR &check_response($mech, $response, 1) . "\n";

        if ($site eq 'rubyforge') {
            # rubyforge doesn't automatically load the editrelease page next
            if ($mech->content =~ m|<a href="$urls{$site}->{base_editrelease}.*?release_id=(\d+)|) {
                $release_id = $1;
                print STDERR "Fetching Edit Release page, editing release $release_id... ";
                my $response = &editrelease_php($mech, $group_id, $package_id, $release_id);
                &save_page(sprintf("%02d-editrelease.html", $debug_pagenum++)) if $debug;
                print STDERR &check_response($mech, $response, 1) . "\n";
            } else {
                warn "unable to find release_id in output of add_release() -- see out.html\n";
                &close_copher;
            }
        }
    } else {
        print STDERR "Fetching Edit Release page, editing release $release_id... ";
        my $response = &editrelease_php($mech, $group_id, $package_id, $release_id);
        &save_page(sprintf("%02d-editrelease.html", $debug_pagenum++)) if $debug;
        print STDERR &check_response($mech, $response, 1) . "\n";
    }


# Now add files to the release

    if ($site eq 'rubyforge' && $new_release) {
        print STDERR "Skipping Step 1 -- already done.\n";
    } else {
        print STDERR "Carrying out Step 1: Edit Existing Release... ";
        my $response = &edit_release_step1($mech, $group_id, $package_id, \%release);
        &save_page(sprintf("%02d-step1-edit_existing_release.html", $debug_pagenum++)) if $debug;
        print STDERR &check_response($mech, $response, 0) . "\n";
    }

    if (%release_files) {
        if ($site eq 'rubyforge' && $new_release && @release_files == 1) {
            # only file already added in add_release()
            print STDERR "Skipping Step 2 (Add Files To This Releases) -- already done.";
        } elsif ($site eq 'rubyforge' && $opt{noupload}) {
            # since uploading is done in step2 in rubyforge, skip step2 if noupload is set
        } else {
            my $added_all = 0;
            while ($site ne 'rubyforge' || !$added_all) { # run edit_release_step2 once per file for rubyforge
                $added_all = 1;
                for my $f (keys %release_files) {
                    unless ($release_files{$f}->{added}) {
                        $added_all = 0; # (at least) one file left to add
                        last;
                    }
                }
                last if $added_all;

                print STDERR "Carrying out Step 2: Add Files To This Releases... \n";
                my $response = &edit_release_step2($mech, $group_id, $package_id, \%release);
                &save_page(sprintf("%02d-step2-add_files.html", $debug_pagenum++)) if $debug;
                print STDERR &check_response($mech, $response, 0) . "\n";
                if ($mech->content =~ /Error.*That filename already exists in this project space/) {
                    # TODO: optionally delete and re-add the file? the user might have updated it...
                    #       should actually check BEFORE trying to add the file, though...
                    print STDERR "Error: File already added...\n";
                    print STDERR "Fetching Edit Release page, editing release $release_id... ";
                    my $response = &editrelease_php($mech, $group_id, $package_id, $release_id);
                    &save_page(sprintf("%02d-editrelease.html", $debug_pagenum++)) if $debug;
                    print STDERR &check_response($mech, $response, 1) . "\n";
                }
            }
        }
    }

    if ($site eq 'rubyforge' && $new_release && @release_files == 1) {
        # only file already added in add_release()
        print STDERR "Skipping Step 3 (Edit Files To This Releases) -- already done.";
    } else {
        print STDERR "Carrying out Step 3: Edit Files In This Release...\n";
        my $value = &edit_release_step3($mech, $group_id, $package_id, \%release);
        &save_page(sprintf("%02d-step3-edit_files.html", $debug_pagenum++)) if $debug;
        if (!$value) {
            print STDERR "Error doing step 3. $value\n";
        }
    }

    if ($opt{notice} && $site eq 'sourceforge') { # rubyforge does not have this option
        # (apparently sourceforge doesn't either, any more -20091013)
        # Step 4. Email Release Notice
        print STDERR "Carrying out Step 4: Email Release Notice...\n";
        my $response = &edit_release_step4($mech, $group_id, $package_id, \%release);
        &save_page(sprintf("%02d-step4-email_release_notice.html", $debug_pagenum++)) if $debug;
        print STDERR &check_response($mech, $response, 0) . "\n";
    }
}

print STDERR "Finished!\n";

&close_copher;


###############
# Subroutines #
###############

sub save_page {
    my $f = shift || "out.html";
    open(OUT,">$f");
    print OUT $mech->content;
    close OUT;
}

sub close_copher {
    open(OUT,">out.html");
    print OUT $mech->content;
    close OUT;
    
    exit shift;
}

sub check_response ($$) {
    my ($mech, $response, $die_bool) = @_;
    if (!$response) {
        return "NOT found";
        die "no response, link/etc. not found?" if $die_bool;
    } elsif ($mech->success()) {
        return "followed";
    } else {
        return "found? but failed?";
        die "mechanize operation failed" if $die_bool;
    }
}

sub make_url ($) {
    # currently not used by anything
    my %arg = @_;
    if ($arg{type} eq 'newrelease') {
        return "newrelease.php?package_id=$arg{package_id}&group_id=$arg{group_id}";
    }
              }

sub project_page ($$) {
    my ($mech, $project_name) = @_;
    my $base_url = $sites{$site}.$urls{$site}->{projects};
    my $url = $base_url.$project_name.'/';
    $url .= 'develop' if $site eq 'sourceforge';
    my $response = $mech->get($url);
    return $response;
}

sub editpackages_php($$) {
    my ($mech, $group_id) = @_;
    
    my $base_url = $sites{$site}.$urls{$site}->{base_editpackages};
    
    # Warning: any/some of these may be empty; $release_id in fact sometimes will be (?; when checking for what releases exist...)
    return $mech->get($base_url."?group_id=$group_id");
}

sub editreleases_php($$$$) {
    my ($mech, $group_id, $package_id, $release_id) = @_;
    
    my $base_url = $sites{$site}.$urls{$site}->{base_editreleases};
    
    # Warning: any/some of these may be empty; $release_id in fact sometimes will be (?; when checking for what releases exist...)
    return $mech->get($base_url."?group_id=$group_id&package_id=$package_id&release_id=$release_id");
}

sub editrelease_php($$$$) {
    my ($mech, $group_id, $package_id, $release_id) = @_;
    
    my $base_url = $sites{$site}.$urls{$site}->{base_editrelease};
    
    return $mech->get($base_url."?group_id=$group_id&package_id=$package_id&release_id=$release_id");
}

sub newrelease_php($$$) {
    my ($mech, $group_id, $package_id) = @_;

    my $base_url = $sites{$site}.$urls{$site}->{base_newrelease};

    # Warning: any/some of these may be empty
    return $mech->get($base_url."?group_id=$group_id&package_id=$package_id");
}

# TODO:
# for release notes file, call explorerajax_php
#   with release_noteable => 1
# for each (other) file, call explorerajax_php
#   with release_notable => 0,
#        release_notes => $release_notes_filename (path from FRS root, e.g. /$package_name/$release_name/notes)
sub explorerajax_php($$$$@) {
    my ($mech, $group_id, $package_id, $filename);
    ($mech, $group_id, $package_id, $filename, %_) = @_;

    my $base_url = $sites{$site}.$urls{$site}->{base_explorerajax};
    my $url = $base_url."?group_id=$group_id";

    my %defaults = (
        operation => 'save_settings',
        save_settings => 'Save',
        original_filename => $filename,
        filename => $filename,
        filepath => "/$package_name/$release_name/$filename",
        );
    for (keys %defaults) {
        $_{$_} = $defaults{$_} unless defined $_{$_};
    }

    for (keys %_) {
        $url .= "&$_=$_{$_}";
    }

    # Example URL:
    # https://sourceforge.net/project/admin/explorer_ajax.php?group_id=137217&default_download=&filepath=%2Fcopher%2Fcopher-0.2.1%2Fcopher-0.2.1.tar.gz&operation=save_settings&original_filename=copher-0.2.1.tar.gz&filename=copher-0.2.1.tar.gz&download_label=&release_notable=1&default_linux=linux&default_mac=mac&default_windows=windows&default_bsd=bsd&default_solaris=solaris&default_others=others&release_notes=&save_settings=Save

    # returned content should be: { "val": 100, "message": "OK" }
    return $mech->get($url);
}


# Get a list of packages from editpackages.php page (which must already be loaded in $mech)
sub get_packages ($) {
    my $mech = shift;
    my @packages;
    # could use |sig and match to the </A>...
    #$mech->content =~ m|<A HREF="editreleases.php\?package_id=(\d+)&amp;group_id=(\d+)"><B>\[Edit Releases\]</B>|ig
    my @forms = $mech->forms;
    foreach my $form (@forms) {
        (my $action = $form->action) =~ s/\?.*//;
        if ($action eq $sites{$site}.$urls{$site}->{base_editpackages} and (my $func = $form->find_input('func', 'hidden'))) {
            next unless $func->value eq 'update_package';
            
            my ($group_id, $package_id, $package_name);
            
            my $input;
            $input = $form->find_input('group_id', 'hidden');
            if ($input) {
                $group_id = $input->value;
            } else {
                warn "no group_id input?\n";
            }
            $input = $form->find_input('package_id', 'hidden');
            if ($input) {
                $package_id = $input->value;
            } else {
                warn "no package_id input?\n";
            }
            $input = $form->find_input('package_name', 'text');
            if ($input) {
                $package_name = $input->value;
            } else {
                warn "no package_name input?\n";
            }
            
            push @packages, {
                'group_id' => $group_id,
                'package_name' => $package_name,
                'package_id' => $package_id
            };
        }
    }
    return @packages;
                  }

# Get a list of releases from editreleases.php page (which must already be loaded in $mech)
sub get_releases ($) {
    my $mech = shift;
    my @releases;
    my $content = $mech->content;      # This is necessary. Using $mech->content in the while () causes an infinite loop.
    my $regexp;

    my $scriptname = basename $urls{$site}->{base_editrelease};

    # warning: these regular expressions are rather sensitive to minor changes
    if ($site eq 'sourceforge') {
        $regexp = qr|\s*(\S+)\s*<a href="$scriptname\?package_id=(\d+)&amp;release_id=(\d+)&amp;group_id=(\d+)">\[Edit This Release\]</a>|;
    } elsif ($site eq 'rubyforge') {
        $regexp = qr|<a href="$scriptname\?group_id=(\d+)&amp;package_id=(\d+)&amp;release_id=(\d+)">\s*(\S+)\s*\[Edit\]</a>|;
    }
    while ($content =~ /$regexp/g) {
        my ($release_name, $package_id, $release_id, $group_id);
        if ($site eq 'sourceforge') {
            ($release_name, $package_id, $release_id, $group_id) = ($1, $2, $3, $4);
        } elsif ($site eq 'rubyforge') {
            ($release_name, $package_id, $release_id, $group_id) = ($4, $2, $3, $1);
        }
        push @releases, {
            'release_name' => $release_name,
            'package_id' => $package_id,
            'release_id' => $release_id,
            'group_id' => $group_id
        };
    }
    return @releases;
                  }

sub upload_files ($) {
    my $release_files = shift;
    
    my @fullpaths;
    foreach (keys %{$release_files}) {
        push @fullpaths, $release_files->{$_}->{'fullpath'};
    }
    
    print STDERR "Files to upload: @fullpaths.\n";

    if (@fullpaths and !$opt{noupload}) {
        if ($opt{protocol} eq 'ftp') {
            upload_files_ftp($release_files);
        } elsif ($opt{protocol} eq 'rsync') {
            upload_files_rsync($release_files);
        } elsif ($opt{protocol} eq 'scp') {
            upload_files_scp($release_files);
        } elsif ($opt{protocol} eq 'sftp') {
            upload_files_sftp($release_files);
        } elsif ($opt{protocol} eq 'web') {
            upload_files_web($release_files);
        } elsif ($opt{protocol} eq 'webdav') {
            upload_files_webdav($release_files);
        }
    }
                  }

sub upload_files_ftp ($) {
    require Net::FTP;

    my $release_files = shift;  
    my @fullpaths = map { $release_files->{$_}->{'fullpath'} } keys %$release_files;

    print STDERR "Uploading files to $sf_ftp...\n";  

    my $ftp = Net::FTP->new($sf_ftp);
    if (!$ftp) {
        print STDERR "Error creating Net::FTP object: $!\n";    
        die;
    } else {
        $ftp->login($sf_ftp_user, 'anonymous@anonymous.net');
        foreach (@sf_ftp_path) {    # Definitely need error checking here. not here yet, though
            $ftp->cwd($_);
        }
        $ftp->binary();
        foreach my $file (@fullpaths) {
            $ftp->put($file);    # returns remote file name
            print STDERR "Uploaded $file\n";
            $release_files->{basename($file)}->{'uploaded'} = 1;     # keep track of which files we've uploaded
        }
        $ftp->quit;
    }
                      }

sub upload_files_rsync ($) {
    require File::Rsync; # note: this uses the actual rsync executable

    print STDERR "Uploading files to $sf_frs...\n";  

    my $release_files = shift;
    my @fullpaths = map { $release_files->{$_}->{'fullpath'} } keys %$release_files;

    my $obj = File::Rsync->new( { times => 1, rsh => 'ssh', relative => 1, 'omit-dir-times' => 1} );

    require File::Temp;
    my $tmpdir = File::Temp::tempdir();#CLEANUP => 1) or die "Failed to create temporary directory: $!\n";
    print STDERR "\$tmpdir=$tmpdir\n";
    symlink('.', "$tmpdir/$package_name") or die "Failed to create package symlink in $tmpdir: $!\n";

    my $srcpath = "$tmpdir/./$package_name/$release_name";
    my $dstpath = sprintf($sf_frs_path_fmt, 
                       substr($project_name, 0, 1),
                       substr($project_name, 0, 2),
                       $project_name
        );
    print "src path is $srcpath\n";
    print "dst path is $dstpath\n";

    # e.g. final destination path: /home/frs/project/c/co/copher/copher/copher-0.0.0/

    foreach my $file (@fullpaths) {
        print STDERR "Uploading $file... ";
        my $dirname = abs_path(dirname($file));
        my $basename = basename $file;
        unlink("$tmpdir/$release_name") if -l "$tmpdir/$release_name";
        symlink("$dirname", "$tmpdir/$release_name") or die "Failed to create release symlink in $tmpdir: $!\n";

        my $cmd = $obj->getcmd( { src => "$srcpath/$basename", dest => "$user{loginname},$project_name\@$sf_frs:$dstpath" });
        #print STDERR "\n  rsync command: @$cmd\n";
        
        if ($obj->exec( { src => "$srcpath/$basename", dest => "$user{loginname},$project_name\@$sf_frs:$dstpath" } )) {
            print STDERR "Done\n";
        } else {
            print STDERR "Failed: $!.\n";
        }
        $release_files->{basename($file)}->{'uploaded'} = 1;     # keep track of which files we've uploaded
    }
}

sub upload_files_scp ($) {
    # sourceforge says scp is not supported; it doesn't work
    require Net::SCP;
    print STDERR "Uploading files to $sf_frs...\n";
    
    my $release_files = shift;
    my @fullpaths = map { $release_files->{$_}->{'fullpath'} } keys %$release_files;

    my $scp = Net::SCP->new($sf_frs);
    if (!$scp) {
        print STDERR "Error creating Net::SCP object: $!\n";    
        die;
    } else {
        unless ($scp->login($user{loginname})) {
            print STDERR "Failed to login with scp.\n";
            return;
        }
        $scp->cwd($sf_frs_path);
        foreach my $file (@fullpaths) {
            if ($scp->put($file)) {
                print STDERR "Uploaded $file\n";
                $release_files->{basename($file)}->{'uploaded'} = 1;     # keep track of which files we've uploaded
            } else {
                print STDERR "Failed to upload $file: $!\n";
            }
        }
        $scp->quit;
    }
                      }

sub upload_files_sftp ($) {
    require Net::SFTP;
    print STDERR "Uploading files to $sf_frs...\n";
    
    my $release_files = shift;
    my @fullpaths = map { $release_files->{$_}->{'fullpath'} } keys %$release_files;

    my $sftp = Net::SFTP->new($sf_frs, user => $user{loginname}, password => $user{password});
    $sftp->{debug} = 1;
    $sftp->{ssh}->{debug} = 1;

    if (!$sftp) {
        print STDERR "Error creating Net::SFTP object and logging in: $!\n";
        die;
    } else {
        foreach my $file (@fullpaths) {
            print STDERR "Uploading $file... ";
            if ($sftp->put($file, "$sf_frs_path")) {
                print STDERR "Done\n";
                $release_files->{basename($file)}->{'uploaded'} = 1;     # keep track of which files we've uploaded
            } else {
                print STDERR "Failed: $!\n";
            }
        }
    }
                       }

sub upload_files_web ($) {
    # http://alexandria.wiki.sourceforge.net/File+Release+System+-+Offering+Files+for+Download#upload
    # https://frs.sourceforge.net/webupload
    # https login, form to enter filename and upload file
    print STDERR "ERROR: web uploader not yet implemented\n";
                      }

sub upload_files_webdav ($) {
    # http://alexandria.wiki.sourceforge.net/File+Release+System+-+Offering+Files+for+Download#upload
    # https://frs.sourceforge.net/U/US/USERNAME/uploads
    # HTTP::Webdav
    print STDERR "ERROR: webdav uploader not yet implemented\n";
}

# Add a new release by submitting the form on the newrelease.php page
# Pre-condition: $mech->content is the newrelease.php page with correct package_id and group_id
#   passed in as CGI parameters
sub add_release ($$$$) {
    my ($mech, $group_id, $package_id, $release_name) = @_;
    
    my @forms = $mech->forms();
    my $form_number = 1;
    
    my $package_form;
    
    if ($site eq "rubyforge" && !@release_files) {
        die "no files: can't add empty release in rubyforge\n";
    }

    foreach my $form (@forms) {
        (my $action = $form->action) =~ s/\?.*//; # the rubyforge form action includes ?group_id=xxxx
        if ($action eq $sites{$site}.$urls{$site}->{base_newrelease}) {
            last;
        }
        $form_number++;
    }
    
    my $form = $mech->form_number($form_number);

    $mech->select('package_id', $package_id) or warn "can't select $package_id for select package_id";

    my %fields = (release_name => $release_name);

    # extra rubyforge options

    if ($form->find_input('release_date', 'text') && $release_datetime) {
        # rubyforge uses Y-m-d H:M (2008-07-13 19:56) format; timezone should be the same as in rubyforge profile
        $fields{release_date} = $release_datetime;
    }

    if (my $fileinput = $form->find_input('userfile', 'file')) {
        $fileinput->file($release_files[0]); # file with path
        #$fileinput->headers(%hdrs); # headers e.g. Content-Type, etc.

        $release_files{basename($release_files[0])}->{uploaded} = 1;
        $release_files{basename($release_files[0])}->{added} = 1;
    } else {
        warn "no file input in add_release (rubyforge)"
    }

    # set type_id and processor_id
    for my $name ('type_id', 'processor_id') {
        if (my $sel = $form->find_input($name, 'option')) {
            my $filename = basename($release_files[0]);
            my $id = get_type_id($filename, $sel);
            (my $factor = $name) =~ s/_id//;

            print STDERR "$filename $factor is " . $release_files{$filename}->{$factor} . " ($id)\n";
            $mech->select($name, $id) or warn "can't select $name $id";
        } else {
            warn "Couldn't find $name input option when trying to add " . basename($release_files[0]) . " in new release.\n";
        }
    }

    if ($form->find_input('release_notes', 'textarea') && $notes_file) {
        print STDERR "found release_notes, inserting text\n";
        open (IN, $notes_file) or die "can't open release notes file " . $notes_file . "\n";
        local $/ = undef;     # to read the whole file in with <>
        $fields{release_notes} = <IN>;
        close IN;
    }
    if ($form->find_input('release_changes', 'textarea') && $changelog_file) {
        print STDERR "found release_changes, inserting text\n";
        open (IN, $changelog_file) or die "can't open changelog file " . $changelog_file . "\n";
        local $/ = undef;     # to read the whole file in with <>
        $fields{release_changes} = <IN>;
        close IN;
    }

    if ($form->find_input('preformatted', 'checkbox')) {
        $mech->tick('preformatted', 1);
    }

    
    print STDERR "\nSubmitting form #$form_number to add a new release: $release_name... ";

    return $mech->submit_form(
        form_number => $form_number,
        fields => \%fields,
        button => 'submit'
        );
}

# Edit a release by submitting the form on the editreleases.php page which had release_id, etc. passwd in
# But $release_id isn't necessarily set yet (isn't if this is a new release)
# Pre-condition: $mech-content is such a page
# Sets $release_id if $release{id} wasn't set
sub edit_release_step1($$$$) {
    my ($mech, $group_id, $package_id, $release) = @_;
    # %{$release} has: id, date, name, active (bool), notes_file, changelog_file, release_files => \%release_files
    
    my @forms = $mech->forms();
    my $form_number;
    
    for (my $formcount = 1; $formcount <= $#forms + 1; $formcount++) {
        my $form = $forms[$formcount-1];
        (my $action = $form->action) =~ s/\?.*//;
        if ($action eq $sites{$site}.$urls{$site}->{base_editrelease}) {
            if ($form->enctype eq "multipart/form-data" and !$form_number) {
                $form_number = $formcount;   # this is the "Step 1: Edit Existing Release" form
            }
        }
    }
    
    # Now submit the first form
    $mech->form_number($form_number);
    
    if (!$release->{id}) {
        # If we didn't already know the release_id (should never happen)
        $release->{id} = $mech->current_form()->find_input('release_id', 'hidden')->value();    # declared at top
        $release_id = $release->{id};
    }
    
    my %fields;
    
    if ($release->{date} =~ /\d{4}-\d{2}-\d{2}/) {
        # note: release_date is rejected unless it conforms to a certain format, my guess on that format is above
        $fields{release_date} = $release->{date};
    } # otherwise: leave the default (i.e. current date if we're creating the release today) value filled in
    $fields{release_name} = $release->{name};       # this field should already be filled in, but let's make sure
    
    # input type="file" name="uploaded_notes"     -- release notes file to upload
    # input type="file" name="uploaded_changes"   -- changelog file to upload
    # textarea name="release_notes"               -- release notes
    # textarea name="release_changes"             -- changelog
    
    if ($release->{notes_file}) {
        open (IN, $release->{notes_file}) or die "can't open release notes file '" . $release->{notes_file} . "'\n";
        local $/ = undef;     # to read the whole file in with <>
        $fields{release_notes} = <IN>;
        close IN;
    }
    if ($release->{changelog_file}) {
        open (IN, $release->{changelog_file}) or die "can't open changelog file '" . $release->{changelog_file} . "'\n";
        local $/ = undef;     # to read the whole file in with <>
        $fields{release_changes} = <IN>;
        close IN;
    }

    my $preformatted = 1;   # temporary
    $mech->tick('preformatted', 1) if $preformatted;       # to be configurable...
    
    if ($release->{active} == 0) {
        $mech->select('status_id', 3);     # 1 is for Active, 3 is for Hidden (what about 2?)
    } else {
        $mech->select('status_id', 1);
    }
    
    return $mech->submit_form(
        form_number => $form_number,
        fields => \%fields,
        button => 'submit'
        );
    
    # Note: Need to check that our changes were accepted. this is not done here yet
}

# Step 2: Add Files To This Release
sub edit_release_step2 ($$$$) {
    my ($mech, $group_id, $package_id, $release) = @_;
    # %release has: id, date, name, active (bool), notes_file, changelog_file, files => \%release_files
    
    my @forms = $mech->forms();
    my $form_number;
    
    my $release_files = $release->{files};
    
    #for (my $formcount = 1; $formcount <= $#forms + 1; $formcount++) { # worked with souceforge...
    for (my $formcount = 1; $formcount <= $#forms + 1; $formcount++) {
        my $form = $forms[$formcount-1];
        (my $action = $form->action) =~ s/\?.*//;
        if ($action eq $sites{$site}.$urls{$site}->{base_editrelease}) {
            if ($form->find_input('step2', 'hidden')) {
                $form_number = $formcount;   # this is the "Step 2: Add Files To This Release" form
                last;
            }
        }
    }
    unless ($form_number) {
        warn "did not find form number in step2";
        &close_copher;
    }

    my $form = $mech->form_number($form_number);
    
    if ($site eq 'sourceforge') {
        foreach my $filename (keys %{$release_files}) {
            print STDERR "'Ticking' $filename in file list\n";
            # note: *should* check whether this is possible, first
            $mech->tick('file_list[]', $filename);
            $release_files{$filename}->{added} = 1;
        }
    } elsif ($site eq 'rubyforge') {
        # find the first release file not yet added and add it
        # upload one file at a time

        my $filename;
        for my $f (keys %release_files) {
            unless ($release_files{$f}->{added}) {
                $filename = $f;
                last;
            }
        }

        if (my $fileinput = $form->find_input('userfile', 'file')) {
            $fileinput->file($release_files[$release_files{$filename}->{index}]); # full filename with path (hash has basename)
            #$fileinput->headers(%hdrs); # headers e.g. Content-Type, etc.
            
            $release_files{$filename}->{uploaded} = 1;
            $release_files{$filename}->{added} = 1;
        } else {
            $fileinput = $form->find_input('userfile', 'file');
            warn "no file input in step2 (rubyforge)";
            &close_copher;
        }

        # set type_id and processor_id
        for my $name ('type_id', 'processor_id') {
            if (my $sel = $form->find_input($name, 'option')) {
                my $id = get_type_id($filename, $sel);
                (my $factor = $name) =~ s/_id//;

                print STDERR "$filename $factor is " . $release_files{$filename}->{$factor} . " ($id)\n";
                $mech->select($name, $id) or warn "can't select $name $id";
            } else {
                warn "Couldn't find $name input option when trying to add $filename.\n";
            }
        }
    }
    
    print STDERR "Submitting form #$form_number for Step 2: Add Files To This Release... ";
    return $mech->submit_form(
        form_number => $form_number,
        button => 'submit'
        );  
}

# Step 3: Edit Files In This Release
sub edit_release_step3 ($$$$) {
    my ($mech, $group_id, $package_id, $release) = @_;
    # %release has: id, date, name, active (bool), notes_file, changelog_file, files => \%release_files
    
    my $files = $release->{files};
    
    my @form_numbers;
    my @forms = $mech->forms();

    if (!@forms) {
        print STDERR "ERROR: no forms\n";
        return;
    }
    
    for (my $formcount = 1; $formcount <= $#forms + 1; $formcount++) {
        my $form = $forms[$formcount-1];
        (my $action = $form->action) =~ s/\?.*//;
        if ($action eq $sites{$site}.$urls{$site}->{base_editrelease}) {
            if ($form->find_input('step3', 'hidden') and $form->find_input('submit', 'submit')->value() =~ m|Update/Refresh|) {
                push @form_numbers, $formcount;
            }
        }
    }
    
    if (! @form_numbers) {
        print STDERR "no step3 forms\n";
        return undef;
    }
    
# Note that this assumes that the results of submitting one form don't change another form, or the form numbering up to $form_number
    foreach my $form_number (@form_numbers) {
        my $form = $mech->form_number($form_number);
        
        my $file_id = $mech->current_form()->find_input('file_id', 'hidden')->value();
        
        # Extract the filename
        my $filename;
        if ($site eq 'sourceforge' &&
            $mech->content =~ m|<input type="hidden" name="file_id" value="$file_id">.*?\w*?<input type="hidden" name="step3" value="1">.*?\w*?<tr bgcolor="#\w{6}">.*?\w*?<td nowrap><font size="-1">(.*?)</td>|s) {
            $filename = $1;
        } elsif ($site eq 'rubyforge' &&
                 $mech->content =~ m|<input type="hidden" name="file_id" value="$file_id" />.*?\w*?<input type="hidden" name="step3" value="1" />.*?\w*?<tr bgcolor="#\w{6}">.*?\w*?<td nowrap="nowrap"><span.*?>(.*?)</span></td>|s) {
            $filename = $1;
        } else {
            warn "cannot extract filename in step 3";
        }

        # set type_id and processor_id
        for my $name ('type_id', 'processor_id') {
            if (my $sel = $form->find_input($name, 'option')) {
                my $id = get_type_id($filename, $sel);   
                (my $factor = $name) =~ s/_id//;

                print STDERR "$filename $factor is " . $release_files{$filename}->{$factor} . " ($id)\n";
                $mech->select($name, $id) or warn "can't select $name $id";
            } else {
                warn "Couldn't find $name input option when trying to add $filename.\n";
            }
        }
        
        $mech->select('new_release_id', $release{id});    # this should already be selected by default, but let's make sure
        
        my $fields = {};
        if ($site eq 'sourceforge' && $release{date} =~ /\d{4}-\d{2}-\d{2}/) {
            print STDERR "setting release_time to $release{date} for $filename\n";
            # note: release_time probably needs to conform to the same format as release_date (?)
            ${$fields}{release_time} = $release{date};      # why do they call it release_time here?
        } elsif ($site eq 'rubyforge' && $release{date} =~ /\d{4}-\d{2}-\d{2}/) {
            print STDERR "setting release_date to $release{date} for $filename\n";
            ${$fields}{release_date} = $release{date};
        } # otherwise: leave the default (i.e. current date if we're creating the release today) value filled in
        
        print STDERR "Submitting form #$form_number for Step 3: Edit Files In This Release... ";
        my $response = $mech->submit_form(
            form_number => $form_number,
            fields => $fields,
            button => 'submit'
            );
        print STDERR &check_response($mech, $response, 0) . "\n";
        &save_page(sprintf("%02d-step3-edit_files.html", $debug_pagenum++)) if $debug;
    }
    
    return TRUE;
}

# Step 4: Email Release Notice
sub edit_release_step4 ($$$$) {
    my ($mech, $group_id, $package_id, $release) = @_;
    # %release has: id, date, name, active (bool), notes_file, changelog_file, files => \%release_files
    
    my @forms = $mech->forms();
    my $form_number;
    
    for (my $formcount = 1; $formcount <= $#forms + 1; $formcount++) {
        my $form = $forms[$formcount-1];
        (my $action = $form->action) =~ s/\?.*//;
        if ($action eq $sites{$site}.$urls{$site}->{base_editrelease}) {
            if ($form->find_input('step4', 'hidden') and $form->find_input(undef, 'submit')->value() eq 'Send Notice') {
                $form_number = $formcount;   # this is the "Step 1: Edit Existing Release" form
            }
        }
    }
    
    if (! $form_number) {
        print STDERR "no step4 form\n";
        return undef;
    }
    
    $mech->form_number($form_number);
    
    $mech->tick('sure', 1);
    
    print STDERR "Submitting form #$form_number for Step 4: Email Release Notice... ";
    return $mech->submit_form(
        form_number => $form_number
        );  
}

# Delete a file from a release
# Pre-condition: $mech->content holds the edit release page for the release
sub delete_file () {
    # This is a stub. To be implemented later. [todo]
}

# Call delete_file for the next file while there's still file(s) in the release
sub delete_all_files () {
    # [todo]
}

# also works for processor_id
# args:
#       $filename: should be the basename
#       $sel: the HTML::Form object from e.g. find_input('type_id', 'option')
sub get_type_id ($$) {
    my ($filename, $sel) = @_;
    my %ids;

    (my $inputname = $sel->name) =~ /(.*)_id/;
    my $factor = $1; # 'type' or 'processor'
    warn "get_type_id: can't extract factor from '$inputname'" unless $factor;

    # populate type_id list
    for my $ent (@{$sel->{menu}}) {
        $ids{$ent->{name}} = $ent->{value};
    }

    my $type_id;

    # rubyforge: replace Platform-Independent with Any
    if ($factor eq 'processor' && !defined $ids{$release_files{$filename}->{$factor}} &&
        ($release_files{$filename}->{$factor} eq 'Platform-Independent')) {
        $release_files{$filename}->{$factor} = 'Any';
    }

    if (defined $ids{$release_files{$filename}->{$factor}}) {
        $type_id = $ids{$release_files{$filename}->{$factor}};
        $release_files{$filename}->{$inputname} = $type_id;
    }

    return $type_id;
}
