/usr/bin/yahoo2mbox

#!/usr/bin/perl -w
###############################################################################
# Purpose: retrieves and saves messages from Yahoo! Groups archive
# Usage:   give the group name to process on the command line, output will go
#          to the file with the same name or the one specified with 'o' option
# Author:  Vadim Zeitlin <vadim@wxwindows.org>
# License: Public domain
# Created: June 25, 2001
# Version: 0.24
# RCS-Id:  $Id: yahoo2mbox.pl,v 1.56 2007-10-22 20:14:46 zeitlin Exp $
###############################################################################

use strict;

use Getopt::Long ();
use HTML::Entities ();
use HTML::HeadParser ();
use HTML::TokeParser ();
use HTTP::Request::Common qw(GET POST);
use HTTP::Cookies ();
use LWP::UserAgent ();
use LWP::Simple ();

# turn this on for tons of debugging messages
#use LWP::Debug qw(+);

# global hash for localized yahoo groups support
my %lang;

# boolean option: add X-Yahoo-Message-Num header to the downloaded messages?
my $x_yahoo_hdr = 1;

# the name of the header to add
my $x_yahoo_hdr_name = "X-Yahoo-Message-Num";

# boolean option: keep Yahoo post ids in the saved messages?
my $keepPostIds = 1;

# enable some debugging code in this script itself
my $debug = 0;


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

# extract the text of the message itself as plain text from the HTML page for
# the message
sub ParseMessagePage($) {
    my $html = $_[0];
    my $htmlParser = HTML::TokeParser->new(\$html);

    # to avoid finding the wrong tag below, first skip to the special comment
    # which Yahoo inserts shortly before the message text
    my $specialComment = '<!-- start content include -->';
    my $token;
    while ( $token = $htmlParser->get_token ) {
        last if $token->[0] eq 'C' &&
                $token->[1] eq $specialComment
    }

    # currently (as of 2006-03-18) Yahoo uses <pre> for the main site but <tt>
    # for the other countries (fr.groups.yahoo.com uses it, at least) so we
    # need to recognize both
    my $startMarkerFound;
    if ( $token ) {
        $startMarkerFound = 1;
        $token = $htmlParser->get_tag('pre', 'tt');
    }

    if ( !$token ) {
        if ( $html =~ /$lang{badmsg}/ ) {
            # this means that the message doesn't exist in the archive, not an
            # error -- simply skip it by returning a special value to indicate
            # this
            return "";
        }
        elsif ( $html =~ /$lang{dllimit}/ ) {
            warn "\nYahoo Groups download limit reached.\n";
            warn "Please wait for some time and then restart the program.\n";
            exit 1;
        }

        # some other error, we want to know about it
        my $warnMsg = "Start of message text not found: ";
        if ( !$startMarkerFound ) {
            $warnMsg .= "special comment \"$specialComment\" not found"
        }
        else {
            $warnMsg .= "neither <pre> nor <tt> tag found"
        }

        warn "$warnMsg.\n";

        if ( $debug ) {
            my $bad_file = "bad_${main::msg}.html";
            open(BAD, ">$bad_file") or die "Can't make debug output $bad_file. $!\n";
            print BAD $html;

            warn "Message text saved to file $bad_file for debugging.\n"
        }

        return undef
    };

    my $usingPre = $token->[0] eq 'pre';
    my $msgText;
    while ( $token = $htmlParser->get_token ) {
        my $type = $token->[0];
        if ( $type eq 'T' ) {
            # text
            $msgText .= HTML::Entities::decode($token->[1]);
        }
        elsif ( $type eq 'S' ) {
            # tag start
            my $tag = lc($token->[1]);
            if ( $tag eq 'a' ) {
                # what we do here is turn hyper-linked addresses of the form
                # <a href="/group/boost/post?postID=random_string">name@...</a>
                # into just name@postid.yahoo.invalid
                my $postID = $token->[2]{'href'};
                $postID =~ s/^.*\/post\?postID=//;

                $token = $htmlParser->get_token;
                if ( $token->[0] ne 'T' ) {
                    warn "Expected text after <a> tag, skipping entire tag.\n";
                }
                else {
                    my $addr = HTML::Entities::decode($token->[1]);

                    $token = $htmlParser->get_token;
                    if ( $token->[0] ne 'E' or lc($token->[1]) ne 'a' ) {
                        warn "Expected closing </a> tag, skipping entire <a> tag.\n";
                    }
                    else {
                        if ( $addr =~ s/\.\.\.$// ) {
                            $msgText .= $addr;
                            $msgText .= $postID . "." if $keepPostIds;
                            $msgText .= "yahoo.invalid"
                        }
                        else { # not obfuscated address or another URL, keep as is
                            $msgText .= $addr
                        }
                    }
                }
            }
            elsif ( $tag eq 'i' ) {
                # used by Yahoo around "Attachment content not displayed", ignore
            }
            else {
                # <br> tag should be ignored and, inside <pre>, <tt> should be
                # ignored as well
                if ( ($tag ne 'br') && (!$usingPre || ($tag ne 'tt')) ) {
                    warn "Unexpected tag $tag inside the message text ignored.\n";
                }
            }
        }
        elsif ( $type eq 'E' ) {
            # tag end
            my $tag = lc($token->[1]);
            if ( $tag eq 'i' ) {
                # see above for <i>
            }
            elsif ( $tag eq ($usingPre ? 'pre' : 'td') ) {
                # the end of the message
                last
            }
        }
        else {
            warn "Unexpected HTML construct inside the message text ignored.\n";
        }
    }

    return $msgText;
}

# The message is garbled in the HTML page: the leading whitespace is lost for
# some reason and we have to restore it to make it a valid MBOX file.
#
# We also have to quote the lines starting with "From" in the body to prevent
# them from being parsed as the start of new message by the naive MBOX readers
#
# Finally this routine also unmangles the addresses if we have a list of known
# addresses from some other source: see the --address option
sub MBOXify($) {
    my $inmsg = $_[0];

    # the MBOXified message
    my $msg = "";

    # initially we are not in the message - deal with rubbish before "From "
    my $inMsg = 0;

    # First we expect to be in the header
    my $inHdr = 1;

    # process the message line by line
    foreach my $line ( $inmsg =~ m/^.*$/ogm ) {
        if ( !$inMsg ) {
            # the first header line is supposed to be "From ", as usual
            if ( $line =~ /^From / ) {
                $inMsg = 1;
            }
            else {
                if ( $line !~ /^\s*$/ ) {
                    warn "Ignoring unexpected text (\"$line\") before the message start."
                }

                # ignore everything before the beginning of the real message
                next
            }
        }

        if ( $inHdr ) {
            if ( $line =~ /^\s*$/ ) {
                # end of header
                $inHdr = 0;

                # fix the line between headers and body to be really empty
                $line = "";

                # add our header at the end of the original ones if needed
                $msg .= "$x_yahoo_hdr_name: $main::msg\n" if $x_yahoo_hdr;
            }
            elsif ( $line !~ /^\s+/ &&
                        $line !~ /^[\w-]+: / &&
                            $line !~ /^From / ) {
                # looks like a header continuation from which Yahoo ate the
                # leading space -- restore it
                $line = "  " . $line;
            }
        }
        else { # in body
            if ( $line =~ /^>*From / ) {
                # quote it
                $line = ">" . $line;
            }
        }

        $msg .= $line . "\n";
    }

    # messages are separated by blank lines in MBOX
    $msg .= "\n";

    return $msg;
}

# return the URL we're redirected to
sub GetRedirectUrl($) {
    my $response = $_[0];

    my $url = $response->header('Location') || return undef;

    # the Location URL is sometimes non-absolute which is not allowed, fix it
    local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
    my $base = $response->base;
    $url = $HTTP::URI_CLASS->new($url, $base)->abs($base);

    return $url;
}

sub DieWrongSyntax($);
sub DieConflictingOptions($$);

###############################################################################
# Main program
###############################################################################

# command line options parsing
###############################################################################

my $VERSION_STRING = "0.24";

# boolean: if true, suppress messages
my $quiet = 0;

# the name of the group to get messages from
my $groupname;

# the output file name
my $mboxname;

# the start and end messages (end == 0 means max) or the number of last
# messages to retrieve or the number of messages to get since the last one
my $msgFirst = 0;
my $msgLast;
my $msgCountFromEnd;
my $msgCountNext;

# was msgFirst set by user or computed by ourselves?
my $msgFirstGivenByUser = 1;

# resume from the last message retrieved?
#
# bool values mean usual thing, -1 means to resume if mailbox already exists
my $resume = -1;

# retry getting the messages we failed to retrieve the last time?
my $retry   = 0;

my @msgs   = ();
my %msgSeen = ();

# authentification info
my ($username, $password);

# file to store cookies in (netscape means netscape browser file)
my $cookie_file = 'none';

# the proxy to use
my $proxy = "";

# the localized yahoo group country code to use
my $country = '';

# interval in seconds to sleep between message reqests, don't sleep if
# undefined or 0
my $delay;

# booleans: version/help requested from cmd line?
my $version = 0;
my $help = 0;

# extract the program basename
my $progname = $0;
$progname =~ s@^.*[\\/]@@;
$progname =~ s/.pl$//;

my $usage = <<EOF
$progname [options] [-o <mbox>] <groupname>

Retrieves all messages in the archive of the given group from Yahoo
and stores them in the specified local MBOX file. If the file exists,
the messages not already in the file are appended to it.

--help          give the usage message showing the program options
--version       show the program version and exit
--verbose       give verbose informational messages (default)
--debug         turns on debug output and saves messages script failed to parse
--quiet         be silent, only error messages are given
-o mbox         save the message to mbox instead of file named groupname
--start=n       start retrieving messages at index n instead of 1
--end=n         stop retrieving messages at index n instead of the last one
--next=n        retrieve next n messages after the last retrieved one
--last=n        retrieve last n messages from the list
--resume        resumes previously interrupted downloading, needed if --start
                is used, otherwise is automatic if mailbox already exists
--noresume      don't resume, **overwrites** the existing output file if any
--retry         resumes and tries to download the missing messages
--user=name     login to eGroups using this username (default: guest login)
--pass=pass     the password to use for login (default: none)
--cookies=xxx   file to use to store cookies (default: none, 'netscape' uses
                netscape cookies file).
--proxy=url     use the given proxy, if 'no' don't use proxy at all (even not
                the environment variable http_proxy which is used by default),
                may use http://username:password\@full.host.name/ notation
--country=xx    use the given country code in order to access localized yahoo
                groups (default: none; supported: ar,br,de,dk,es,fr,it,mx)
--no-x-yahoo    don't add $x_yahoo_hdr_name header to the downloaded messages
--no-post-id    remove Yahoo post ids from the saved addresses
--delay=n       sleep for n seconds between each message request (may be used
                allow the script to run continuously without hitting the
                Yahoo bytes/hour download limit)
EOF
;

# main program start
###############################################################################

# don't forget to modify the usage section above if you add more options!
Getopt::Long::GetOptions
(
    'debug'         => sub { $debug = 1 },
    'verbose'       => sub { $quiet = 0 },
    'quiet'         => \$quiet,
    'version'       => \$version,
    'help'          => \$help,
    'o=s'           => \$mboxname,
    'start=i'       => \$msgFirst,
    'end=i'         => \$msgLast,
    'next=i'        => \$msgCountNext,
    'last=i'        => \$msgCountFromEnd,
    'noresume'      => sub { $resume = 0 },
    'resume'        => sub { $resume = 1 },
    'retry'         => sub { $resume = 1; $retry = 1;},
    'user=s'        => \$username,
    'pass=s'        => \$password,
    'cookies=s'     => \$cookie_file,
    'proxy=s'       => \$proxy,
    'country=s'     => \$country,
    'delay=s'       => \$delay,
    'x-yahoo'       => sub { }, # ignore for backwards compatibility
    'no-x-yahoo'    => sub { $x_yahoo_hdr = 0 },
    'no-post-id'    => sub { $keepPostIds = 0 },
    '<>'            => sub {
                        if ( $groupname ) {
                            die "Only one groupname argument allowed.\n" . $usage
                        }
                        $groupname = $_[0]
                       }
) || die $usage;

if ( $version || $help ) {
    if ( $version ) {
        print "yahoo2mbox version $VERSION_STRING, " .
              "written by Vadim Zeitlin <vadim\@wxwindows.org>\n";
    }
    else {
        print $usage;
    }

    exit 0;
}

DieWrongSyntax("Required argument \"groupname\" is missing.") if !$groupname;

DieConflictingOptions('start', 'last') if $msgFirst && $msgCountFromEnd;
DieConflictingOptions('end', 'last') if $msgLast && $msgCountFromEnd;
DieConflictingOptions('end', 'next') if $msgLast && $msgCountNext;
DieConflictingOptions('next', 'last') if $msgCountNext && $msgCountFromEnd;

if ( $password && !$username ) {
    $username = $ENV{'USER'};

    # ok, so we could try to use getpwnam() but why bother
    DieWrongSyntax("Please specify the username or set USER environment variable.")
        if !$username;
}

if ( $username && !$password ) {
    my $hasReadKey = eval { require Term::ReadKey; };
    if ( !$hasReadKey ) {
        warn "Please install Term::ReadKey to avoid echoing the password!\n";
    }

    print "Password for $username: ";

    if ( $hasReadKey ) {
        Term::ReadKey::ReadMode('noecho');
        $password = Term::ReadKey::ReadLine(0); # 0 means normal read
        Term::ReadKey::ReadMode('restore');
    }
    else {
        $password = <STDIN>
    }

    chomp $password;

    print "\n";
}

$mboxname ||= $groupname;

# Localized yahoo groups have their home at "$country.groups.yahoo.com" and
# have localized (translated) error messages.
#
# To use yahoo2mbox with localized group you must run it with --country=xx
# option and add define all elements of the %lang ahsh for the country "xx"

# the lang hash contains all localized messages, when adding support for
# another country it should be enough to simply provide the values for all of
# its elements and here is where to find them:
#   - "badgroup" is used to detect errors on page, this is the string shown
#     when you try to access an invalid page on Yahoo
#   - "badmsg" is used to detect messages missing from the archive
#   - "dllimit" is given by Yahoo when we download the messages too quickly,
#     apparently (I don't know how quickly is too quickly though): there are 2
#     messages because one corresponds to a per host limit and the other to a
#     per group one
#   - "of" is used in the title of the page saying how many messages are there
#     in the group
#   - "I_accept" is used for the confirmation needed for adult Yahoo groups

# TODO: I don't have the translations for these messages, please help!
$lang{badmsg} = 'does not exist in';
$lang{dllimit} = <<EOF
(This page is currently unavailable|\
The message you requested is temporarily unavailable|\
Sorry, Unable to process request at this time -- error 999)
EOF
;

if ( !$country || $country =~ /(en|us|uk|none|com)/i) {
    $country = '';
    $lang{badgroup} = 'There is no group called';
    $lang{of} = 'of';
    $lang{I_accept} = 'I%20Accept';
}
else {
    if ($country eq 'de') {
        $lang{badgroup} = 'existiert nicht';
        $lang{of} = 'von';
        $lang{I_accept} = 'I%20Accept';
    }
    elsif ($country eq 'fr') {
        $lang{badgroup} = 'n\'existe pas';
        $lang{of} = '/';
        $lang{I_accept} = 'Je%20suis%20majeur';
    }
    elsif ($country eq 'es' || $country eq 'ar' || $country eq 'mx') {
        $lang{badgroup} = 'No existe ningún Grupo llamado';
        $lang{of} = 'de';
        $lang{I_accept} = 'Acepto';
    }
    elsif ($country eq 'it') {
        $lang{badgroup} = 'Non esiste un gruppo denominato';
        $lang{of} = 'di';
        $lang{I_accept} = 'Accetto';
    }
    elsif ($country eq 'br') {
        $lang{badgroup} = 'Não existe nenhum grupo chamado';
        $lang{of} = 'de';
        $lang{I_accept} = 'Eu%20aceito';
    }
    elsif ($country eq 'dk') {
        $lang{badgroup} = 'Der findes ingen gruppe ved navn';
        $lang{of} = 'af';
        $lang{I_accept} = 'Jeg%20accepterer';
    }
    elsif ($country eq 'tw') {
        $lang{badgroup} = '³oÓÁp·ù\('; # Full = "³oÓÁp·ù(badgroup)¤£¦s¦b¡C"
        $lang{of} = '¡A¦@';
        $lang{I_accept} = 'I%20Accept'; # Unknown!
        $lang{badmsg} = '¨S¦³¡u'; # Full = "¨S¦³¡ubad_number¡v³o½g¤å³¹"
        $lang{dllimit} = '±z¼È®ÉµLªkÅª¨ú'; # Full = "±z¼È®ÉµLªkÅª¨ú¥»¤å³¹"
    }
    else {
        warn "Country code $country currently unsupported and probably won't work\n";
    }
    $country .= '.';
}

# these may change at Yahoo and so may have to be edited
my $baseurl = 'http://' . $country . "groups.yahoo.com/group/$groupname/";
my $idxext = "messages";
my $msgext = "message/%d?source=1\&unwrap=1\&var=0";

# determine the first message to retrieve if it wasn't specified explicitly or
# even if it was but --resume was given explicitly as well
if ( $resume && -r $mboxname && ($msgFirst == 0 || $resume == 1) ) {
    open MBOX, $mboxname || die "Failed to resume: can't open $mboxname: $!\n";

    $msgFirstGivenByUser = 0; # don't complain about it if it's not users fault

    $msgFirst = 1 unless $msgFirst;
    my $numYahoo = 0;
    while (<MBOX>) {
        # if we have our special header with Yahoo message number, use it as it
        # can be more correct if any messages were deleted from the archive
        if (/^From /) {
            $msgFirst++;
        }
        elsif (/^$x_yahoo_hdr_name: (\d+)$/) {
            $msgSeen{$1}++;
            # messages can be out of order in the mailbox (some mail clients do
            # this, apparently) so take the largest value, not the last one
            $numYahoo = $1 if $1 > $numYahoo;
        }
    }

    if ($numYahoo > $msgFirst) {
        $msgFirst = $numYahoo + 1;
    }

    if ( !$retry ) {
        print "Will resume at message $msgFirst\n" unless $quiet;
    }
}

# we need to "login" to the service first: for this we need to get the cookie
# which is set by the page we are redirected to when we initially try to
# access the archive
#
# NB: we do it before the main loop below for simplicity, although we could
#     only do it during the first loop iteration
my $ua = LWP::UserAgent->new;
$ua->agent("yahoo2mbox/$VERSION_STRING");
if ( $proxy ) {
    $ua->proxy('http', $proxy);
}
elsif ( $proxy ne 'no' ) {
    # use http_proxy env var if set
    $ua->env_proxy();
}
#else: don't use proxy at all

# determine where, if anywhere, to store cookies
my $cookie_jar;
if ($cookie_file eq 'netscape') {
    if ( eval { require Config; } ) {
        if ( $Config::Config{'osname'} =~ /MSWin32/ ) {
            warn "Netscape cookies file support is not implemented under Windows.\n";
        }

        # suppress stupid warning about possible typo in Config::Config() by
        # using it twice and not once
        my $cc = $Config::Config{'cc'};

        $cookie_jar = HTTP::Cookies->new();
    }
    else {
        # assume Unix
        $cookie_jar = HTTP::Cookies::Netscape->new
                                               (
                                                file => '~/.netscape/cookies',
                                                autosave => 1
                                               );
    }
}
elsif ($cookie_file eq 'none') {
    $cookie_jar = HTTP::Cookies->new();
}
elsif ($cookie_file) {
    $cookie_jar = HTTP::Cookies->new(file => $cookie_file, autosave => 1);
}
$ua->cookie_jar($cookie_jar);

print "Logging in " . ($username ? "as $username" : "anonymously") . "... "
    unless $quiet;

my $request;
if ( $username ) {
    $request = POST 'http://login.yahoo.com/config/login',
               [
                   ".tries" => '1',
                  #".done"  => 'URL to go to later',
                   ".src"   => 'grp',
                   ".intl"  => 'us',
                   "login"  => $username,
                   "passwd" => $password,
               ];

    $request->content_type('application/x-www-form-urlencoded');
    $request->header('Accept' => '*/*');
    $request->header('Allowed' => 'GET HEAD PUT');
}
else { # pseudo-login
    $request = GET $baseurl . $idxext;
}

my $response = $ua->simple_request($request);
while ( $response->is_redirect ) {
    # although simple_request() adds the cookies for us we should extract
    # them from the response we get manually
    $cookie_jar->extract_cookies($response);

    my $url = GetRedirectUrl($response);

    # go to the new page
    $request = GET $url;
    $response = $ua->simple_request($request);
}

if ( !$response->is_success ) {
    print "Failed!\n" unless $quiet;

    if ( $username ) {
        die "Probably wrong username/password.\n"
    }
    else {
        die "The Yahoo! Groups page structure has probably changed,\n" .
            "please use a newer version of this program (if any)\n";
    }
}

print "ok.\n" unless $quiet;

# Yahoo are using differently named servers for specific subjects areas
# now so we may be redirected, recreating the baseurl increases speed later
$request = GET $baseurl;
$response = $ua->simple_request($request);
while ( $response->is_redirect ) {
    $cookie_jar->extract_cookies($response);

    # TODO: when redirected to xx.groups.yahoo.com we should behave as if
    #       --country=xx had been given (at least if xx is a known country)
    print "Redirected from $baseurl to " unless $quiet;
    $baseurl = GetRedirectUrl($response);

    # are we asked for a confirmation before accessing an adult group?
    if ( $baseurl =~ /adultconf/ ) {
      $baseurl .= "&accept=" . $lang{I_accept};
    }
    print "$baseurl\n" unless $quiet;
    $request = GET $baseurl;
    $response = $ua->simple_request($request) ||
        die "Bad redirect, exiting.\n";
}

# determine the last message to retrieve (must be done after login)
print "Getting number of messages in group $groupname...\n" unless $quiet;

# determine the number of messages to retrieve
#
# TODO: we could get only the start of the document - would be faster
$request = GET $baseurl . $idxext;
$response = $ua->simple_request($request) ||
   die "Failed to get the messages page for group $groupname.\n";

# parse the header
my $messagesPage = $response->content;
my $headerParser = HTML::HeadParser->new;

$headerParser->parse($messagesPage);
$_ = $headerParser->header('title') || "";
if ( !/\d+-(\d+) $lang{of} (\d+)/ ) {
    # try to see why did it happen
    if ( $messagesPage =~ /$lang{badgroup}/i ) {
        die "The group $groupname doesn't seem to exist.\n";
    }
    elsif ( !$_ ) {
        my $err = "Failed to access group page,";
        if ( !$username ) {
            die "$err you might need a valid username.\n";
        }
        else {
            die "$err please check if you have specified valid password.\n";
        }
    }
    else {
        #open(PAGE, ">page.html") or die; print PAGE $messagesPage;

        die "Unexpected title page format ($_).\n";
    }
};

if ( $1 < $2 ) {
    print "Warning: " . ($2 - $1) .
          " messages in this group seem to be missing.\n" unless $quiet;
}

my $msgCount = $1;

if ( !$msgLast ) {
    $msgLast = $msgCount;
}

if ( $msgCountFromEnd && $msgCountFromEnd < $msgLast ) {
    $msgFirst = $msgLast - $msgCountFromEnd + 1;
}
elsif ( !$msgFirst ) {
    $msgFirstGivenByUser = 0;
    $msgFirst = 1;
}

if ( $msgFirst > $msgLast ) {
    if ( $msgFirstGivenByUser ) {
        # this can't be intentional, can it?
        die "Start message is out of range 1..$msgLast.\n";
    }

    print "No messages to retrieve in $groupname.\n" unless $quiet;

    exit 0;
}

# limit ourselves to only msgCountNext next messages if specified
if ( $msgCountNext ) {
    $msgLast = $msgFirst + $msgCountNext - 1;
}

if ( $msgLast > $msgCount ) {
    printf "Warning: index of the last message to retrieve ($msgLast) " .
           "is greater than the number of messages in the group ($msgCount).\n"
           unless $quiet;
    $msgLast = $msgCount;
}

# append to the file, don't overwrite it
open(OUTPUT, ">>$mboxname") || die "Failed to open $mboxname for writing: $!\n";

# the progress display data
my $msgsok = 0;
my $progressWidth = 45;
my $progressStep = ((($msgLast - $msgFirst) + $progressWidth)/$progressWidth);

# we want the progress display to appear immediately, so unbuffer it
select((select(STDOUT), $| = 1)[0]);

# we also want to tell the user where should he restart should we be
# interrupted
sub DieOnInterrupt
{
    my ($sig) = @_;
    die "\nTerminating on SIG$sig, use \"--s $main::msg\" or --resume next time.\n";
};

$main::msg = 0;
$SIG{'INT'} = \&DieOnInterrupt;

if ( $msgLast < $msgFirst ) {
    print "No messages to download!\n" unless $quiet;
    exit 0
}

my $ok = 1;

# retry to get the missing messages if requested
if ( $retry ) {
    my $missing = 0;
    for ( my $j = 1; $j < $msgFirst; $j++ ) {
       next if defined $msgSeen{$j};
       $missing++;
       push @msgs, $j;
    }

    if ( !$missing ) {
        print "No missing messages to retrieve.\n" unless $quiet;
        exit 0
    }

    print "Retrying to retrieve $missing missing messages: " unless $quiet;
}
else {
    print "Retrieving messages $msgFirst..$msgLast: " unless $quiet;

    # get all messages in order
    for ( my $i = $msgFirst; $i <= $msgLast; $i++ ) {
        push @msgs, $i;
    }
}

warn "\n" if $debug;  # newline for debug output

# the main loop over the messages
MAINLOOP:
for $main::msg (@msgs) {
    my $msgUrl = $baseurl . sprintf($msgext, $main::msg);

    warn "Downloading message $main::msg" if $debug;

    my $request = GET $msgUrl;
    my $response = $ua->simple_request($request);

    if ( $response->status_line =~ /999/ ) {
        warn "Yahoo download limit probably reached, please try again later.\n";
        last
    }

    # deal with the advertisement pages to which we're sometimes redirected:
    # follow the redirect and then go to the link we need again
    while ( $response->is_redirect ) {
        for ( my $redirectCount = 0; ;$redirectCount++ ) {
            # sanity check: don't allow more than a certain number of redirects
            if ( $redirectCount == 10 ) {
                print "\n" unless $quiet;
                warn "Endless redirect loop detected while " .
                        "retrieving message $main::msg.\n";
                print "This error is often due to using incorrect case in " .
                        "the group name.\n" unless $quiet;

                # set the error flag to suppress "done!" below
                $ok = 0;

                last MAINLOOP;
            }

            $cookie_jar->extract_cookies($response);

            my $url = GetRedirectUrl($response);

            last if !$url;

            # go to the new page
            $request->uri($url);
            $response = $ua->simple_request($request);
        }

        $request->uri($msgUrl);
        $response = $ua->simple_request($request);
    }

    if ( !$response->is_success ) {
        # there is some perl weirdness going on here: pressing Ctrl-C while
        # the program is running doesn't invoke our SIG{INT} but just makes
        # LWP methods fail with 500 error code and our error message :-(
        if ( $response->as_string =~ /Terminating on SIG([A-Z]+)/ ) {
            DieOnInterrupt $1
        }

        warn "Failed to retrieve the message $main::msg.\n";
        next;
    }

    my $msgText = ParseMessagePage($response->content);
    if ( !$msgText ) {
        # this is unexpected and may mean that Yahoo display format changed
        if ( !defined($msgText) ) {
            warn "Failed to parse the message $main::msg, skipping.\n";
        }

        next;
    }

    # before putting the messages in the MBOX file we need to ensure that they
    # are in valid format
    print OUTPUT MBOXify($msgText) or die "Error writing to $mboxname: $!\n";

    if ( !(++$msgsok % $progressStep) ) {
        print "." unless $quiet;
    }

    if ( defined($delay) && $delay > 0 ) {
        sleep($delay);
    }
};

close(OUTPUT) || warn "Error closing output file: $!\n";

print " done!\n" unless $quiet || !$ok;
print "Saved $msgsok message(s) in $mboxname.\n" unless $quiet;
exit 0;

# die with an error message about incorrect command line syntax
sub DieWrongSyntax($) {
    my ($err) = @_;
    die "Error: $err\nUsage: $usage"
}

# die with an error message about conflicting options
sub DieConflictingOptions($$) {
    my ($o1, $o2) = @_;
    DieWrongSyntax("--$o1 and --$o2 options can't be both specified at once.")
}

# History:
#
# 0.24  Add --retry resume option to reget any missing messages (Max Baker)
#       Save separate bad.html for each bad response to aid in debugging
#       Added --debug as CLI option
#
# 0.23  handle messages beyond the last one correctly (Michael Kielsky)
#       corrected missing blank lines between messages
#
# 0.22  updated to deal with the new format of Yahoo pages
#
# 0.21  deal correctly with --x-yahoo even if mailbox messages are out of order
#       (Daniel Sutcliffe)
#       --x-yahoo is now on by default, use --no-x-yahoo to turn it off
#       fixed the script to handle extra blanks in Yahoo pages correctly
#
# 0.20  added --next option (Brett D. Estrade)
#       restored old Yahoo page format handling
#       added --no-post-id option
#       added another error message shown when the download limit is reached
#       (Emmanuel Chantreau)
#
# 0.19  save Yahoo post ids for all address links in the messages
#
# 0.18  fixed the script after Yahoo changed their pages format around
#       2006-02-05
#       use X-Yahoo-Message-Num header for detecting where to resume if it
#       exists in the mailbox (Josef Angstenberger)
#
# 0.17  try harder to detect download limit exhaustion (Paul Telford)
#       added --last=n option (Joshua Ellis)
#       removed address unmangling code -- doesn't work any longer
#       make --start argument apply to --resume as well
#       handle groups with mismatching number of messages in title
#       quiet mode is now more quiet
#
# 0.16  added tw groups support (Henry H. Tan-Tenn)
#       added --delay option (Malcolm Heath)
#
# 0.15  updated unmangle table (Robert Zierer)
#       updated the script to work with the new Yahoo page layout
#
# 0.14  fixed ads pages skipping after Yahoo changes
#       other minor bug fixes
#
# 0.13  added automatic addres decoding (Zainul M Charbiwala),
#       added --x-yahoo option (David Jaquay),
#       fixed bug in handling --start option,
#       better handling of "missing x-html" error message
#
# 0.12  support for adult groups, --country=ar and mx support (JHB)
#
# 0.11  redirection of some classified Yahoo groups could break access to
#       the message count.  The fix accounts for this but also is more
#       generic as it will recreate the baseurl for later use to increase
#       speed.  (Daniel Sutcliffe <dansut@tcnow.com>)
#
#       fixed warnings from Perl 5.8
#
# 0.10  fixed %oops initialization _again_, added --country=br support
#       (Murilo Saraiva de Queiroz <murilo@vettatech.com>)
#
# 0.09  fixed %oops initialization broken in 0.08 (wasn't done at all unless
#       --country switch was given)
#
# 0.08  --country option and initial localized yahoo groups support for
#       uk, de, fr, es, it and dk (Daniel Roethlisberger <daniel@roe.ch>)
#
# 0.07  --address option and address unmangling code (Per Bolmstedt)
#
# 0.06  added proxy support, better header wrapping handling, From stuff
#       the messages as eGroups doesn't do it any longer
#
# 0.05  added option to determine which (if any) cookie file to actually use.
#       (version 0.04 used cookies but never saved them) (MRW)
#
# 0.04
#       support using netscape cookies file to access to the member-only
#       archives
#
# 0.03  update to support redirection now used by groups.yahoo.com and the
#       format changes in the site layout
#
#       new --resume option (Dan Libby)
#
# 0.02
#       retrieve only some message, start/stop options
#       improved error detection
#
# 0.01:
#       initial barely functional release

# vi: set ts=4 sw=4 et cin:
yahoo2mbox 0.24-1 / usr / bin / yahoo2mbox
