#!/usr/local/bin/perl -w
##    -*-perl-*-
##    ubh - The Usenet Binary Harvester - Perl console application which 
##          automatically discovers, downloads, and decodes single-part 
##          and multi-part Usenet binaries.
##
##    Copyright (C) 2000-2002  Gerard Lanois
##                             gerard@users.sourceforge.net
##                             P.O. Box 507264
##                             San Diego, CA 92150-7264
##
##    This program is free software; you can redistribute it and/or modify
##    it under the terms of the GNU General Public License as published by
##    the Free Software Foundation; either version 2 of the License, or
##    (at your option) any later version.
##
##    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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;

############################################################################

package Ubh::PercentComplete;

use strict;
use vars qw($VERSION);
$VERSION = "2.5";

sub new
{
    my $class = shift;
    my %args = @_;

    my $total = (defined $args{total} ? $args{total} : 100);

    my $obj = bless {
        _progress => defined $args{progress} ? $args{progress} : 0,
        _total    => $total,
        _width    => defined $args{width} ? $args{width} : 40,
        _every    => defined $args{every} ? $args{every} : int($total/100)+1,
        _count    => 0
        }, $class;

    return $obj;
}

sub update
{
    my $self = shift;
    my $progress = shift;
    my $delta = $progress - $self->{_progress};
    $self->{_progress} = $progress;

    if ($self->{_count} >= $self->{_every}) {
        my $frac = $self->{_progress}/$self->{_total};
        my $percent= sprintf('%.1f', $frac * 100);
        my $barlength = int($frac * $self->{_width} + 0.5);
        my $blklength = $self->{_width} - $barlength;
        print "\r    |";
        print '=' x $barlength;
        print ' ' x $blklength;
        print "| ", $percent, '%', "\b\b\b\b\b\b";
        $self->{_count} = 0;
    }
    else {
        $self->{_count} += $delta;
    }
}



############################################################################

package Ubh::Platform;

use strict;
use vars qw($VERSION);
$VERSION = "2.5";

use Config;

sub new
{
    my ($class) = @_;

    my $ubhrcname;
    my $newsrcname;
    my $datadir;
    my $max_filename_length;
    my $separator;

    if ($Config{'osname'} =~ /^macos/i) {
        # Macintosh MacPerl
        $ubhrcname  = "hda:ubh:ubhrc"; #  suggest unquoted 'FORCEDIR = forced'
        $newsrcname = "hda:ubh:newsrc";
        $datadir    = "hda:ubh:data";
        $max_filename_length = 32;
        $separator  = ':'; 

        # This wacky statment prevents a warning about this variable
        # only being used once when running on the other platforms.
        1 if ($MacPerl::Version);

        # MacOS is GUI, so we need an elegant method to set @ARGV unless MPW tool
        if ($MacPerl::Version =~ /Application$/) {
            # We're running from the app  
            # (see http://www.macperl.com/depts/MacPerlFAQ.html section 5.3.3 )      
            my( $cmdLine, @args );
            $cmdLine = &MacPerl::Ask( "-arguments e.g. -A -n -C (-u for usage summary.)" );
            if ($cmdLine) {
                require "shellwords.pl";
                @args = &shellwords( $cmdLine );
                unshift( @ARGV, @args );
            }
        }
    }
    elsif ($Config{'osname'} =~ /^mswin/i) {
        # Windows
        $ubhrcname  = "ubhrc";
        $newsrcname = "newsrc";
        $datadir    = "data";
        $max_filename_length = 255;
        $separator   = '/';
    }
    else { 
        #Linux, Unix, MacOS X, all others 
        my $home = $ENV{'HOME'}; 
        $home .= "/" if ($home); 
        $ubhrcname = "${home}.ubhrc"; 
        $newsrcname = "${home}.newsrc";
        $datadir    = "data";
        $max_filename_length = 255;
        $separator  = '/';
    }

    # dependent assignments after OS configuration.
    my $tempdir = $datadir;
    my $tempfilename = $tempdir . $separator . "ubhparts." . $$;

    bless {
        _ubhrcname           => $ubhrcname,
        _newsrcname          => $newsrcname,
        _datadir             => $datadir,
        _max_filename_length => $max_filename_length,
        _separator           => $separator,
        _tempdir             => $tempdir,
        _tempfilename        => $tempfilename,
        _cachedir            => undef
        }, $class;
}

sub get_ubhrcname
{ 
    $_[0]->{_ubhrcname}
}

sub set_ubhrcname
{
    my ($self, $ubhrcname) = @_;
    $self->{_ubhrcname} = $ubhrcname if ($ubhrcname);
}

sub get_newsrcname 
{ 
    $_[0]->{_newsrcname}  
}

sub get_datadir    
{ 
    $_[0]->{_datadir}
}

sub set_datadir
{
    my ($self, $datadir) = @_;
    $self->{_datadir} = $datadir if ($datadir);
}

sub get_max_filename_length
{ 
    $_[0]->{_max_filename_length}
}

sub set_max_filename_length
{
    my ($self, $max_filename_length) = @_;
    $self->{_max_filename_length} = $max_filename_length if ($max_filename_length);
}

sub get_separator
{ 
    $_[0]->{_separator}     
}

sub set_separator
{
    my ($self, $separator) = @_;
    $self->{_separator} = $separator if ($separator);
}

sub get_tempdir
{ 
    $_[0]->{_tempdir}     
}

sub set_tempdir
{
    my ($self, $tempdir) = @_;
    if ($tempdir) {
        $self->{_tempdir} = $tempdir;
        $self->{_tempfilename} = $tempdir . $self->{_separator} . "ubhparts." . $$;
    }
}

sub get_tempfilename   
{ 
    $_[0]->{_tempfilename}    
}


sub get_cachedir
{
    $_[0]->{_cachedir}
}

sub set_cachedir
{
    my ($self, $cachedir) = @_;
    if ($cachedir) {
        $self->{_cachedir} = $cachedir;
    }
}

############################################################################

package Ubh::NNTP;

# This class acts much like a Net::NNTP, with the added benefit of
# automatically re-connecting a dropped connection.
#
# This class wraps an instance of a Net::NNTP via AUTOLOAD which
# sets up automatic delegation to the contained Net::NNTP instance, 
# in the manner prescribed by perlbot.
#
# This was necessary because I needed to re-generate the Net::NNTP
# object on-the-fly in order to reconnect a dropped connection.

use strict;
use vars qw($VERSION $AUTOLOAD);
$VERSION = "2.5";

use Net::NNTP;

############### P R I V A T E ###############
sub _connect 
{
    my $self = shift;

    print "Connecting to ", $self->{_host}, ":", $self->{_port}, "...";
        
    my $try = 0;
    my $connected = 0;
    my $nntp;
    while ($try < $self->{_retries} && !$connected) {
        if ($nntp = Net::NNTP->new($self->{_host}, Port => $self->{_port})) {
            $connected = 1;
        }
        else {
            print "\n   WARNING: Net::NNTP->new(", $self->{_host}, ") failed.";
            print "\n  Trying again.\n";
            sleep 1;
            $try++;
        }
    }

    if (!$connected) {
        print "\n   ERROR: Net::NNTP->new(", $self->{_host}, ") failed.";
        print "\n  Giving up.\n";
        exit(-1);
    }
    else {
        print "done.\n";

        # Authenticate user if necessary.
        if (defined $self->{_account} && 
            defined $self->{_password}) {
            print "Authenticating...";
            $nntp->authinfo($self->{_account}, $self->{_password}); 
            my $code = $nntp->code();
            if ($code eq "502") {
                # Login failed - probably due to wrong USER/PASS.
                die "\nERROR: Net::NNTP->authinfo() failed: ".$code." - ", $nntp->message."\n";
            }
            elsif ($code eq "000" ||
                   !defined fileno($nntp)) {
                die "ERROR: Net::NNTP->authinfo() failed ($code).\n";
            }
            else {
                print "done.\n";
            }
        }
    }

    $self->{_nntp} = $nntp;
}

sub _testconn {
    my $self  = shift;
    my $try   = shift;
    my $group = shift;

    # There is a bug in Net::Cmd which does not set the code
    # when there is a disconnect.  Thus, we have to check
    # for defined fileno directly ourselves.
    if ($self->{_nntp}->code() eq "000" ||
        !defined fileno($self->{_nntp})) {
        # No response was recieved, so we've probably lost connection.
        undef $self->{_nntp};
        $self->_connect();
        $group && $self->{_nntp}->group($self->{_group});
        $$try = 0;
    }
    else {
        $$try++;
    }
}

############### P U B L I C ###############
sub body
{
    my $self = shift;

    my $num = shift;

    my $try = 0;
    my $gotit = 0;
    my $body;
    my $time_start = time();
    while ($try < $self->{_retries} && !$gotit) {
        if ($body = $self->{_nntp}->body($num)) {
            $gotit = 1;
        }
        else {
            print "\n   WARNING: Net::NNTP->body($num) failed.\n";
            $self->_testconn(\$try, 1);
        }
    }

    if (!$gotit) {
        print "\n   ERROR: Net::NNTP->body($num) failed.  Giving up.\n";
        return undef;
    }

    # Calculate and report data rate for this body.
    my $bytes = 0;
    my $delta = (time() - $time_start);
    for (@{$body}) {
        $bytes += length($_);
    }

    # Add to grand total too.
    $self->{_bytes} += $bytes;

    my $rate;
    if ($delta > 0) {
        $rate = ($bytes / 1024.0) / ($delta);
    } else {
        $rate = 0.0;
    }
    print "    [bytes = $bytes  secs = $delta  rate = " . sprintf("%.03f",$rate) . " KB/sec]\n";

    return $body;
}


sub article
{
    my $self = shift;

    my $num = shift;

    my $try = 0;
    my $gotit = 0;
    my $article;
    my $time_start = time();
    while ($try < $self->{_retries} && !$gotit) {
        if ($article = $self->{_nntp}->article($num)) {
            $gotit = 1;
        }
        else {
            print "\n   WARNING: Net::NNTP->article($num) failed.\n";
            $self->_testconn(\$try, 1);
        }
    }

    if (!$gotit) {
        print "\n   ERROR: Net::NNTP->article($num) failed.  Giving up.\n";
        return undef;
    }

    # Calculate and report data rate for this article.
    my $bytes = 0;
    my $delta = (time() - $time_start);
    for (@{$article}) {
        $bytes += length($_);
    }

    # Add to grand total too.
    $self->{_bytes} += $bytes;

    my $rate;
    if ($delta > 0) {
        $rate = ($bytes / 1024.0) / ($delta);
    } else {
        $rate = 0.0;
    }
    print "    [bytes = $bytes  secs = $delta  rate = " . sprintf("%.03f",$rate) . " KB/sec]\n";

    return $article;
}


sub group 
{
    my $self = shift;

    $self->{_group} = shift;

    my $try = 0;
    my $gotgroup = 0;
    my $num_articles;
    my $first;
    my $last;
    while ($try < $self->{_retries} && !$gotgroup) {
        if (($num_articles, $first, $last) = $self->{_nntp}->group($self->{_group})) {
            $gotgroup = 1;
        }
        else {
            print "\n   WARNING: Net::NNTP->group($self->{_group}) failed.\n";
            $self->_testconn(\$try, 0);
        }
    }

    return ($num_articles, $first, $last) if ($gotgroup);

    print "\n   ERROR: Net::NNTP->group($self->{_group}) failed.  Giving up.\n";
    return undef;
}

sub xhdr 
{
    my $self = shift;

    my $try = 0;
    my $gotxhdr = 0;
    my $xhdr;
    while ($try < $self->{_retries} && !$gotxhdr) {
        if ($xhdr = $self->{_nntp}->xhdr(@_)) {
            $gotxhdr = 1;
        }
        else {
            print "\n   WARNING: Net::NNTP->xhdr() failed.\n";
            $self->_testconn(\$try, 1);
        }
    }

    return $xhdr if ($gotxhdr);

    print "\n   ERROR: Net::NNTP->xhdr() failed.  Giving up.\n";
    return undef;
}

sub xover 
{
    my $self = shift;

    my $try = 0;
    my $gotxover = 0;
    my $xover;
    while ($try < $self->{_retries} && !$gotxover) {
        if ($xover = $self->{_nntp}->xover(@_)) {
            $gotxover = 1;
        }
        else {
            print "\n   WARNING: Net::NNTP->xover() failed.\n";
            $self->_testconn(\$try, 1);
        }
    }

    return $xover if ($gotxover);

    print "\n   ERROR: Net::NNTP->xover() failed.  Giving up.\n";
    return undef;
}

sub head 
{
    my $self = shift;

    my $try = 0;
    my $gothead = 0;
    my $head;
    while ($try < $self->{_retries} && !$gothead) {
        if ($head = $self->{_nntp}->head(@_)) {
            $gothead = 1;
        }
        else {
            print "\n   WARNING: Net::NNTP->head() failed.\n";
            $self->_testconn(\$try, 1);
        }
    }

    return $head if ($gothead);

    print "\n   ERROR: Net::NNTP->head() failed.  Giving up.\n";
    return undef;
}

sub new
{
    my $self = shift;
    my %arg  = @_;

    my $ref = bless {
        _nntp     => undef,
        _port     => $arg{port},
        _account  => $arg{account},
        _password => $arg{password},
        _host     => $arg{host},
        _retries  => $arg{retries},
        _group    => undef,
        _bytes    => 0,
        _time     => time()
    }, $self;

    $ref->_connect();

    return $ref;
}


sub get_host
{
    my $self = shift;

    return $self->{_host};
}

sub get_stats
{
    my $self = shift;

    my $delta = time() - $self->{_time};
    my $rate;
    if ($delta > 0) {
        $rate = ($self->{_bytes} / 1024.0) / ($delta);
    } else {
        $rate = 0.0;
    }
    return ($self->{_bytes}, $delta, $rate);
}


sub reset_stats
{
    my $self = shift;
    $self->{_time} = time();
    $self->{_bytes} = 0;
}


sub AUTOLOAD
{
    my $self = shift;

    # Take care not to delegate DESTROY.  Only $self->DESTROY() should
    # call the contained instance's DESTROY, if necessary.
    return if $AUTOLOAD =~ /::DESTROY$/;

    # The $AUTOLOAD variable contains the method name prepended by 
    # the package name, so strip that stuff off, leaving just the
    # method name.
    $AUTOLOAD =~ s/^Ubh::NNTP:://;

    # Now delegate the method call to the contained instance.
    $self->{_nntp}->$AUTOLOAD(@_);
}

############################################################################

package Ubh::Cache;

# This package takes care of updating the .ubhcache file(s).

use strict;
use vars qw($VERSION);
$VERSION = "2.5";

use File::Copy qw(move);

sub _print_headers
{
    my $fh = shift;
    my %args = @_;
    print $fh 
        $args{msgid},    '|',
        $args{article},  '|',
        $args{xref},     '|',
        $args{subject},  "\n";
}

sub _add_articles_xhdr($$$$$)
{
    my $nntp      = shift;
    my $first     = shift;
    my $last      = shift;
    my $fh        = shift;
    my $num_added = shift;

    my %headers;
    foreach my $h (qw(Subject Xref Message-ID)) {
        $headers{$h} = $nntp->xhdr($h, "$first-$last");
    }

    foreach my $i (sort keys %{$headers{'Message-ID'}}) {
        my $msgid    = $headers{'Message-ID'}->{$i};
        my $article  = $i;
        my $subject  = $headers{'Subject'}->{$i};
        my $xref     = "";
        if (defined $headers{'Xref'}->{$i} && length $headers{'Xref'}->{$i}) {
            # Only do it if more than one group is referenced.
            # This saves alot of memory and disk space.
            my ($server, @refs) = split(' ', $headers{'Xref'}->{$i}); 
            $xref = $headers{'Xref'}->{$i} if (@refs > 1);
        }

        _print_headers(
                      $fh,
                      msgid   => $msgid,
                      article => $article,
                      xref    => $xref,
                      subject => $subject);

        ${$num_added}++;
    }
}

sub _add_articles_xover($$$$$)
{
    my $nntp      = shift;
    my $first     = shift;
    my $last      = shift;
    my $fh        = shift;
    my $num_added = shift;

    # This code to retrieve the headers via xover is from Greg Bacon,
    # posted to comp.lang.perl.misc in Message-ID
    #     <7db5hp$n9k$1@info2.uah.edu>#1/1
    my %oview_fmt;
    my $i = 0;
    for ( @{ $nntp->overview_fmt } ) {
        $oview_fmt{$_} = $i++;
    }
        
    # This retrieves the overview records.  $o is a reference
    # to a hash.  The keys to this hash are the article numbers.
    # The values in the hash are array references.  The arrays
    # contain the article headers, and are indexed according to
    # the overview_fmt hash (see above).
    my $o = $nntp->xover("$first-$last");
    if (defined $o) {
        foreach my $article (sort keys %$o) {
            my $xrefs = "";
            if (defined $oview_fmt{"Xref:full"}) {
                my $xref = $$o{$article}->[$oview_fmt{"Xref:full"}];

                # Hmmmm... interesting.  It seems that this header
                # has the leading 'Xref: ' on it.  Well, strip it out.
                $xref =~ s/^Xref: //;

                # Only do it if more than one group is referenced.
                # This saves alot of memory and disk space.
                my ($server, @refs) = split(' ', $xref); 
                $xrefs = $xref if (@refs > 1);
            }
            my $subject = $$o{$article}->[$oview_fmt{"Subject:"}];
            my $msgid   = $$o{$article}->[$oview_fmt{"Message-ID:"}];

            _print_headers(
                           $fh,
                           msgid   => $msgid,
                           article => $article,
                           xref    => $xrefs,
                           subject => $subject);
            
            ${$num_added}++;
        }
    }
}

sub _add_articles_head($$$$$)
{
    my $nntp      = shift;
    my $first     = shift;
    my $last      = shift;
    my $fh        = shift;
    my $num_added = shift;

    my %headers;
    foreach my $article ($first..$last) {
        # Check for valid article first.
        next if (!defined $nntp->nntpstat($article));

        # It's a valid article, so get its headers.
        if (my $head = $nntp->head($article)) {
            my %headers;
            foreach my $h (qw(Subject Message-ID Xref)) {
                if (my $hdr = (grep(/^$h: /, @{$head}))[0]) {
                    $headers{$h} = (split(' ', $hdr, 2))[1];
                    $headers{$h} =~ s/\s+$//;
                }
            }
            my $msgid   = $headers{'Message-ID'};
            $msgid = "" if (!defined $msgid);
            my $subject = $headers{'Subject'};
            $subject = "" if (!defined $subject);

            my $xref = "";
            if (defined $headers{'Xref'} && length $headers{'Xref'}) {
                # Only do it if more than one group is referenced.
                # This saves alot of memory and disk space.
                my ($server, @refs) = split(' ', $headers{'Xref'}); 
                $xref = $headers{'Xref'} if (@refs > 1);
            }

            _print_headers(
                           $fh,
                           msgid   => $msgid,
                           article => $article,
                           xref    => $xref,
                           subject => $subject);
            
            ${$num_added}++;
        }
    }
}

sub _add_articles($$$$$$)
{
    my $nntp      = shift;
    my $method    = shift;
    my $first     = shift;
    my $last      = shift;
    my $fh        = shift;
    my $num_added = shift;

    if ($method eq "XHDR") {
        _add_articles_xhdr($nntp, $first, $last, $fh, $num_added);
    }
    elsif ($method eq "XOVER") {
        _add_articles_xover($nntp, $first, $last, $fh, $num_added);
    }
    else {
        _add_articles_head($nntp, $first, $last, $fh, $num_added);
    }
}

sub refresh($$$)
{
    my $server    = shift;
    my $group     = shift;
    my $cachefile = shift;

    my $newsrc   = $server->newsrc;
    my $nntp     = $server->nntp;
    my $sipsize  = $server->hdrsip;

    print "Updating cached headers for server ", $server->name, "...\n";

    my ($num_articles, $first_server, $last_server) = $nntp->group($group);
    print $group, " allegedly has ", $num_articles;
    print " articles from ", $first_server, " to ", $last_server, "\n";

    print "   Copying cache...";
    my $first_wanted = $first_server;
    if (open(INCACHE, "< $cachefile") && open(OUTCACHE, "> $cachefile-new")) {
        my $expiring = 0;
        while (<INCACHE>) {
            chomp;
            my ($msgid, $article, $xref, $subject) = split('\|', $_, 4);

            # Expire old headers by copying only those headers
            # which are still on the server.
            if ($article < $first_server) {
                if (!$expiring) {
                    $expiring = 1;
                    print "\n      Expiring obsolete headers from cache first...";
                }
            }
            else {
                if ($expiring) {
                    print "done.\n";
                    $expiring = 0;
                }
                $first_wanted = $article + 1;
                _print_headers(
                               \*OUTCACHE,
                               msgid   => $msgid,
                               article => $article,
                               xref    => $xref,
                               subject => $subject);
                
            }
        }
        close INCACHE;
        close OUTCACHE;
        move $cachefile."-new", $cachefile;
    }
    print "done.\n";

    if (!open(OUTCACHE, ">> $cachefile")) {
        die "ERROR: failed to open $cachefile for writing.\n";
    }
    else {
        # The Net::NNTP 'X' methods return undef if the method fails.
        # Take advantage of this to select a faster way of downloading
        # the headers, (XHDR or XOVER) if available.  If not, just get 
        # them manually (via HEAD).

        # There is a really good chance that $last_server
        # is a valid article on the server, so use to try
        # to determine the most efficient available header
        # download method for this server.
        my $method;
        if (defined $nntp->xhdr("Subject", "$last_server")) {
            # XHDR command is the fastest way.
            $method = "XHDR";
        }
        elsif (defined $nntp->xover($last_server)) {
            # Use NNTP server XOVER command to retrieve subjects.
            # This saves a little time, as only the overview
            # headers are transferred.
            $method = "XOVER";
        }
        else {
            # The server supports neither XHDR nor XOVER.
            # So, have to manually collect subjects directly from headers.
            # This is alot slower, as *all* headers for each article
            # need to be requested and downloaded.
            $method = "HEAD";
        }

        # Now go download, using the method we just decided upon.
        my $num_download = $last_server - $first_wanted + 1;
        print "   Downloading $num_download articles from $first_wanted to $last_server using $method.\n";

        my $numsips = int($num_download / $sipsize);
        print "      $numsips full sips of $sipsize headers.\n";

        my $begin_sip = $first_wanted;
        my $end_sip;
        my $num_added  = 0;
        for (1..$numsips) {
            $end_sip = $begin_sip + $sipsize - 1;
            print "       Full sip $_ of $numsips, from $begin_sip to $end_sip\n";

            _add_articles(
                          $nntp, 
                          $method, 
                          $begin_sip, 
                          $end_sip, 
                          \*OUTCACHE, 
                          \$num_added);

            $begin_sip = $begin_sip + $sipsize;
        }
        if ($begin_sip <= $last_server) {
            my $partial_sip = $last_server - $begin_sip + 1;
            print "      Partial sip of $partial_sip headers, from $begin_sip to $last_server\n";
            _add_articles(
                          $nntp, 
                          $method, 
                          $begin_sip, 
                          $last_server, 
                          \*OUTCACHE, 
                          \$num_added);
        }
        print "   Added $num_added articles.\n";

        close OUTCACHE;
    }
}

############################################################################

package Ubh::Headers;

# This package takes care of retrieving, caching, and inclusion/exclusion
# filtering of the article headers.

use strict;
use vars qw($VERSION);
$VERSION = "2.5";

############### P R I V A T E ###############

sub _add_subject
{
    my $self     = shift;
    my $id       = shift;
    my $server   = shift;
    my $num      = shift;
    my $subject  = shift;
    my $xref     = shift;

    $self->{_subjects}->{$id} = {
        server  => $server,
        num     => $num,
        subject => $subject,
        xref    => $xref};
}

sub _merge_subjects
{
    my $self     = shift;
    my $opt      = shift;
    my $server   = shift;
    my $groupdir = shift;
    my $first    = shift;
    my $last     = shift;

    my $platform = $self->{_platform};
    my $newsrc   = $server->newsrc;
    my $nntp     = $server->nntp;
    my $group    = $self->{_group};

    my $sep = $platform->get_separator;
    my $cachedir = 
        (defined $platform->get_cachedir) ? 
            $platform->get_cachedir :
                $groupdir;

    my $cachefile = $cachedir.$sep.$nntp->get_host.'-'.$group.'.ubhcache';

    Ubh::Cache::refresh($server, $group, $cachefile);

    print "   Filtering headers from $cachefile...\n";
    if (open(CACHEIN, "< $cachefile")) {
        my $firstcache;
        my $lastcache;
        my $firstwanted = $first;
        my $lastwanted  = $last;
        my @cachesize = stat $cachefile;
        my $progbar = Ubh::PercentComplete->new(total => $cachesize[7]);
        my $num_passed_headers = 0;
        while (<CACHEIN>) {
            chomp;
            my ($id, $num, $xref, $subject) = split('\|', $_, 4);

            # Consider this message-id if it hasn't already been added.
            if (!exists $self->{_subjects}->{$id}) {

                # Do the newsrc test only if not doing all articles,
                # and not just logging the subjects.
                next if (!$opt->{'a'} && !$opt->{'s'} && 
                         $server->newsrc->marked($group, $num));
                
                # Skip it if there is a batch file and it isn't mentioned.
                next if (defined $self->{_batchfile} &&
                         !$self->{_batchfile}->contains($subject));

                # Inclusion/exclusion filtering.
                # Skip subjects that don't match the inclusion filter.
                # Skip subjects that do match the exclusion filter.
                if (($opt->{'I'} && $subject !~ /$opt->{'I'}/o) ||
                    ($opt->{'X'} && $subject =~ /$opt->{'X'}/o)) {

                    # It was either not included or was excluded.
                    if ($opt->{'z'}) {
                        # Mark it as read, and all crossposts too.
                        $server->newsrc->mark($group, $num);
                        $self->eliminate_crossposts($group, $id);
                    }
                    next;
                }

                # It was either included or not excluded.
                $num_passed_headers++;
                $self->_add_subject(
                                    $id,
                                    $server,
                                    $num,
                                    $subject,
                                    length($xref) ? $xref : undef);
            }

            $progbar->update(tell CACHEIN);

            $lastcache = $num;
        }
        close CACHEIN;
        print "done.\n";
        print "   $num_passed_headers headers passed inclusion/exclusion\n";
    }
}


############### P U B L I C ###############

sub new
{
    my ($class, %args) = @_;

    bless {
        _platform  => $args{platform},
        _servers   => $args{servers},
        _group     => $args{group},
        _batchfile => $args{batchfile},
        _subjects  => {}
        }, $class;
}

sub load 
{
    my $self     = shift;
    my $opt      = shift;
    my $groupdir = shift;

    my $servers  = $self->{_servers};
    my $group    = $self->{_group};

    print "------------------------------------------------------------\n";
    print "Group ", $group, "\n";

    foreach my $server (@$servers) {

        # Make sure the desired group is carried by this server.
        defined $server->nntp->group($group) or last;

        my ($num_articles, $first, $last) = $server->nntp->group($group);

        if ($num_articles > 0) {

            print "   Server ", $server->name, " has ", $num_articles;
            print " articles, from ", $first, " to ", $last, "\n";

            # Clean up the newsrc file a bit, mark articles that have expired.
            if ($first > 1) {
                $server->newsrc->mark_range($group, 1, $first-1);
                $server->newsrc->save;
            }

            # Adjust $first and $last as required.
            # (Consider all headers unless -f or -l are in effect.)
            if ($opt->{'f'} && ($first + $opt->{'f'} <= $last)) {
                $last = $first + $opt->{'f'};
            }
            if ($opt->{'l'} && ($last - $opt->{'l'} >= 0)) {
                $first = $last - $opt->{'l'};
            }

            print "   Considering ", $last-$first, " articles from ";
            print "$first to $last\n";

            # Merge in subjects from this server.
            $self->_merge_subjects(
                                   $opt,
                                   $server, 
                                   $groupdir, 
                                   $first, 
                                   $last);
        }
    }
}

sub get_servers
{
    my $self = shift;
    return $self->{_servers};
}

sub get_subjects
{
    my $self = shift;
    return $self->{_subjects};
}

sub get_subject
{
    my $self = shift;
    my $id   = shift;
    return $self->{_subjects}->{$id}->{subject};
}

sub get_xref
{
    my $self = shift;
    my $id   = shift;
    return $self->{_subjects}->{$id}->{xref};
}

sub eliminate_crossposts($$$)
{
    my $self   = shift;
    my $group  = shift;
    my $id     = shift;

    # Mark all cross-referenced articles on this server as read.

    # Only do it if this article has an Xref: header.
    my $xref = $self->get_xref($id);
    return if (!defined $xref);

    my ($xref_server, @refs) = split(' ', $xref); 

    # Only do it if posted to more than one group.
    if (@refs > 1) {
        my $server = $self->get_subjects->{$id}->{server};
        my $newsrc = $server->newsrc;
        foreach my $ref (@refs) {
            my ($cgroup, $cnum) = split(':', $ref);

            if (!($cgroup eq $group)) {
                # Only do it to groups if it is not the current group,
                # if the crossposted group is in the newsgroup,
                # and we are subscribed to the crossposted group.
                if (($cgroup cmp $group) &&
                    $newsrc->exists($cgroup) && 
                    $newsrc->subscribed($cgroup)) {
                    print "      Marking crossposted article $cnum in group $cgroup as read in ", $server->newsrcname, "\n";
                    $newsrc->mark($cgroup, $cnum);
                }
            }
        }
    }
}


############################################################################

package Ubh::Server;

# Encapsulates information about a single server.

use strict;
use vars qw($VERSION);
$VERSION = "2.5";

sub new
{
    my ($class, %args) = @_;

    bless {
        _name       => $args{name},
        _port       => $args{port},
        _account    => $args{account},
        _password   => $args{password},
        _retries    => $args{retries},
        _hdrsip     => $args{hdrsip},
        _newsrcname => $args{newsrcname},
        _nntp       => undef,
        _newsrc     => undef
        }, $class;
}

sub name {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_name} = $value;
    }
    return $self->{_name};
}

sub port {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_port} = $value;
    }
    return $self->{_port};
}

sub account {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_account} = $value;
    }
    return $self->{_account};
}

sub password {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_password} = $value;
    }
    return $self->{_password};
}

sub retries {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_retries} = $value;
    }
    return $self->{_retries};
}

sub hdrsip {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_hdrsip} = $value;
    }
    return $self->{_hdrsip};
}

sub newsrcname {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_newsrcname} = $value;
    }
    return $self->{_newsrcname};
}

sub nntp {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_nntp} = $value;
    }
    return $self->{_nntp};
}

sub newsrc {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_newsrc} = $value;
    }
    return $self->{_newsrc};
}

############################################################################

package Ubh::Multipart;

# Structure to assemble the pieces of a multi-part binary.

use strict;
use vars qw($VERSION);
$VERSION = "2.5";

sub new
{
    my ($class, %args) = @_;

    bless {
        _numparts => $args{numparts}, # Number of parts assembled thus far.
        _gotparts => 0,               # 1 if all parts were found.
        _articles => {},              # Hash of the message IDs for the parts.
        }, $class;
}

sub numparts {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_numparts} = $value;
    }
    return $self->{_numparts};
}

sub gotparts {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_gotparts} = $value;
    }
    return $self->{_gotparts};
}

sub articles {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{_articles} = $value;
    }
    return $self->{_articles};
}


############################################################################

package Ubh::EvilFilename;

# For security reasons, it is very important to filter certain
# characters out of the filenames.
#
# Imagine the consequences of someone trying to sneak a file
# called "/vmlinuz" or "C:\COMMAND.COM" onto your hard drive.

use strict;
use vars qw($VERSION);
$VERSION = "2.5";

sub new
{
    my $class = shift;
    my %arg  = @_;

    bless {
        _evilchar => (defined $arg{evilchar} ? $arg{evilchar} : "\_")
        }, $class;
}

sub alphanumeric($$) 
{
    my $self     = shift;
    my $filename = shift;
    my $ec = $self->{_evilchar};
    
    # Convert all non-alphanumeric to the evil char.
    $filename =~ s/([^\w.\/\_\-])/$ec/g;
    
    # Now kill all leading non-alphanumeric.
    $filename =~ s/^[\W\-\_\.\+]+//g;

    return $filename;
}

sub mandatory($$) 
{
    my $self     = shift;
    my $filename = shift;
    my $ec = $self->{_evilchar};
    
    # Mandatory cleanups.
    $filename =~ tr/\"//d;

    # Have to eval because tr cannot take a variable expression
    # for either pattern.
    $filename = eval "\$filename =~ tr/\\\\/$ec/d; \$filename;";
    die $@ if $@;
    $filename = eval "\$filename =~ tr/\\//$ec/d; \$filename;";
    die $@ if $@;
    $filename = eval "\$filename =~ tr/:/$ec/d; \$filename;";
    die $@ if $@;
    $filename = eval "\$filename =~ tr/=/$ec/d; \$filename;";
    die $@ if $@;
    $filename = eval "\$filename =~ tr/?/$ec/d; \$filename;";
    die $@ if $@;
    $filename = eval "\$filename =~ tr/</$ec/d; \$filename;";
    die $@ if $@;
    $filename = eval "\$filename =~ tr/>/$ec/d; \$filename;";
    die $@ if $@;

    return $filename;
}

############################################################################

package Ubh::BatchFile;

# An array of titles to download.

use strict;
use vars qw($VERSION);
$VERSION = "2.5";

sub new
{
    my $class = shift;
    my %arg  = @_;

    bless {
        _filename => $arg{filename},
        _titles   => []
    }, $class;
}

sub load($) 
{
    my $self     = shift;
    my $filename = $self->{_filename};
    
    open(BATCH_FILE, "<$filename") or die "Can't open batch file $filename.";
    while (<BATCH_FILE>) {
        chomp;
        my $quoted = quotemeta($_);
        push(@{$self->{_titles}}, $quoted);
    }
    close(BATCH_FILE);
}

sub contains {
    my $self = shift;
    my $subject = shift;

    foreach (@{$self->{_titles}}) {
        if ($subject =~ /$_/) {
            return 1;
        }
    }
    return 0;
}


############################################################################

package main;

use POSIX;
use Getopt::Std;
use News::Newsrc;
use MIME::Tools;
use MIME::Parser;
use MIME::Entity;
use String::CRC32;
use File::Basename;
use File::Copy;
use File::Path;
        
# ----------------------------------------------------------------------
# Global configuration variables.  These are default values.
# ----------------------------------------------------------------------
my @servers = ();
my $forcedir   = undef;
my $evilchar   = "\_";
my $decoder = undef;

my $perms = 0777;
my $multi_ext   = '(?i)asf|avi|gif|jpg|mov|mpg|mpeg|rm|[cdeprstu]\d\d|rar|ace|zip|\d\d\d|nfo|sfv|mp3|wma|wmv';
my $single_ext  = '(?i)asf|avi|gif|jpg|mov|mpg|mpeg|rm|[cdeprstu]\d\d|rar|ace|zip|\d\d\d|nfo|sfv|mp3|wma|wmv';

# ----------------------------------------------------------------------
# Global variables.
# ----------------------------------------------------------------------
my $version = "2.5";
my $platform;
my $batchfile;
my %opt;
my $exit_code = 0;
$SIG{INT} = \&grace;
$SIG{HUP} = \&grace;
my $intsig = 0;

# ----------------------------------------------------------------------
# Miscellaneous subroutines.
# ----------------------------------------------------------------------

sub welcome() {
    print "------------------------------------------------------------------------------\n";
    print "ubh ", $version, ", (C) 2000-2002 Gerard Lanois\n";
    print "This software comes with ABSOLUTELY NO WARRANTY; ";
    print "for details use -w.\n";
    print "This is free software, and you are welcome to redistribute\n";
    print "it under certain conditions; see the file LICENSE for details.\n";
    print "------------------------------------------------------------------------------\n";
}


sub yesno($) {
    my $question = shift;

    print $question, " (y/n/q) [n]: ";
    my $key = <>;
    print "\n";

    if ($key =~ /^q/i) {
        return 2;
    }
    elsif ($key =~ /^y/i) {
        return 1;
    }
    else {
        return 0;
    }
}


sub print_warranty() {
    print << "EOW";
------------------------------------------------------------------------------
BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.

IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
EOW
}


sub print_usage() {
    print << "EOU";
Usage: ubh [switches]

These options apply to single-part article processing:
    -S  Process only single part articles.
    -g  Greedy - download and process article even if the subject
        does not have a filename match.

These options apply to multi-part article processing:
    -M  Process only multiple part articles.
    -i  Interactive preselection of multipart articles.

These options apply to both single and multi part processing:
    -A Assemble articles on disk rather than in memory.
    -b <file> Batch mode. <file> should contain a list of article 
       subjects (from .log files; see -s), one per line, to be downloaded.
    -d Diagnostic mode; dumps all raw articles in group.
    -D Multipart diagnostic mode; dumps all parts of selected 
       multipart articles
    -c <file> Use file as config file instead of default (ubhrc).
    -G <group> Process this one group.
    -a Process all articles (disregards newsrc).
    -f <num> Consider the first num articles.
    -l <num> Consider the last num articles.
    -n Updates newsrc after every article.
    -s Logs all subjects to subjects.log and complete binary subjects
       multiparts.log (disregards newsrc).  Does not download anything.
    -I <regexp> Inclusion search filter (double quote on command line)
    -X <regexp> Exclusion search filter (double quote on command line)
    -C Clean filenames (change all non alphanumeric to '_')
    -L Long filenames (use subject as the filename)
    -O [yes|no|skip] Overwrite strategy
    -z Mark articles that do not pass inclusion/exclusion
    -y chmod 0666 all output files
    -u Print out usage summary and exit.
    -w Print out warranty information.

Examples:
    ubh -i -M -I "(?i)rem|r\\.e\\.m\\."
    ubh -S -l 1000
EOU
}


sub process_options() {
    my $error = !getopts('ugiAb:dDc:G:af:l:nsSMI:X:wCO:Lyz', \%opt);

    if ($opt{'c'}) {
        $platform->set_ubhrcname($opt{'c'});
    }

    my $count = 0;
    $count++ if ($opt{'a'});
    $count++ if ($opt{'s'});
    if ($count > 1) {
        print "ERROR: Can only specify one of -a, -s, -f, or -l\n";
        $error = 1;
    }

    if ($opt{'i'} && $opt{'S'}) {
        print "ERROR: Can't specify both -i and -S\n";
        $error = 1;
    }

    if ($opt{'M'} && $opt{'S'}) {
        print "ERROR: Can only specify one of either -M or -S\n";
        $error = 1;
    }

    if ($opt{'I'}) {
        eval { "" =~ /$opt{'I'}/ };
        if ($@) {
            print "ERROR: invalid -I pattern: ", $@, "\n";
            $error = 1;
        }
    }
    
    if ($opt{'X'}) {
        eval { "" =~ /$opt{'X'}/ };
        if ($@) {
            print "ERROR: invalid -X pattern: ", $@, "\n";
            $error = 1;
        }
    }

    if ($opt{'w'}) {
        print_warranty();
        exit(-1);
    }

    if ($error || $opt{'u'}) {
        print_usage();
        exit(-1);
    }

    $opt{'O'} = "no" if (!defined $opt{'O'});

    if ($opt{'b'}) {
        $batchfile = Ubh::BatchFile->new(filename => $opt{'b'});
        $batchfile->load();
    }
}


sub read_config() {
    open(UBHRC, "< ".$platform->get_ubhrcname) 
        or die "ERROR: open(".$platform->get_ubhrcname.") failed.\n";

    my %default_server = (
                          name       => "news",
                          port       => 119,
                          account    => undef,
                          password   => undef,
                          retries    => 3,
                          hdrsip     => 2500,
                          newsrcname => $platform->get_newsrcname);
    my %current_server = %default_server;

    while (<UBHRC>) {
        chomp;


        next if (/\s*\#.*/);

        if (m/(\w+)\s*(=\s*(.*))?$/) {

            my $keyword = $1;
            my $value   = $3;

            if (defined $value) {
                # That .* grabbed everything to the end-of-line, including
                # any trailing whitespace, so eat any such trailing whitespace.
                # (See Perl Cookbook, recipe 1.14 "Trimming Blanks from the
                # Ends of a String".)
                $value =~ s/\s+$//;
            }

            if ($keyword =~ /NNTPSERVER/) {
                # Add this to the list of servers.
                # Note how this uses the default values, not the current ones.
                push @servers, 
                    Ubh::Server->new(
                                    name       => $value,
                                    port       => $default_server{port},
                                    account    => $default_server{account},
                                    password   => $default_server{password},
                                    retries    => $default_server{retries},
                                    hdrsip     => $default_server{hdrsip},
                                    newsrcname => $default_server{newsrcname});
            }
            elsif ($keyword =~ /NNTPPORT/) {
                if (@servers) {
                    $servers[$#servers]->port($value);
                }
                else {
                    # Save for later.
                    $current_server{port} = $value;
                }
            }
            elsif ($keyword =~ /ACCOUNT/) {
                if (@servers) {
                    $servers[$#servers]->account($value);
                }
                else {
                    # Save for later.
                    $current_server{account} = $value;
                }
            }
            elsif ($keyword =~ /PASSWORD/) {
                if (@servers) {
                    $servers[$#servers]->password($value);
                }
                else {
                    # Save for later.
                    $current_server{password} = $value;
                }
            }
            elsif ($keyword =~ /NNTPRETRIES/) {
                # Always want to try at least once.
                $value = ($value <= 0) ? 1 : $value;
                if (@servers) {
                    $servers[$#servers]->retries($value);
                }
                else {
                    # Save for later.
                    $current_server{retries} = $value;
                }
            }
            elsif ($keyword =~ /NNTPHDRSIP/) {
                # Always want to get at least one header per sip.
                $value = ($value <= 0) ? 1 : $value;
                if (@servers) {
                    $servers[$#servers]->hdrsip($value);
                }
                else {
                    # Save for later.
                    $current_server{hdrsip} = $value;
                }
            }
            elsif ($keyword =~ /NEWSRCNAME/) {
                if (@servers) {
                    $servers[$#servers]->newsrcname($value);
                }
                else {
                    # Save for later.
                    $current_server{newsrcname} = $value;
                }
            }
            elsif ($keyword =~ /DATADIR/) {
                $platform->set_datadir($value);
            }
            elsif ($keyword =~ /FORCEDIR/) {
                $forcedir = $value;
            }
            elsif ($keyword =~ /EXTENSIONS/) {
                $multi_ext = $value;
                $single_ext = $value;
            }
            elsif ($keyword =~ /MULTI_EXT/) {
                $multi_ext = $value;
            }
            elsif ($keyword =~ /SINGLE_EXT/) {
                $single_ext = $value;
            }
            elsif ($keyword =~ /TEMPDIR/) {
                $platform->set_tempdir($value);
            }
            elsif ($keyword =~ /CACHEDIR/) {
                $platform->set_cachedir($value);
            }
            elsif ($keyword =~ /PERMISSION/) {
                $perms = oct($value);
            }
            elsif ($keyword =~ /EVILCHAR/) {
                $evilchar = $value;
            }
            elsif ($keyword =~ /DECODER/) {
                $decoder = $value;
                # Force -A if it isn't on already.
                $opt{'A'} = 1;
            }
            elsif ($keyword =~ /OPT_g/) {
                $opt{'g'} = 1;
            }
            elsif ($keyword =~ /OPT_i/) {
                $opt{'i'} = 1;
            }
            elsif ($keyword =~ /OPT_A/) {
                $opt{'A'} = 1;
            }
            elsif ($keyword =~ /OPT_b/) {
                $opt{'b'} = $value;
            }
            elsif ($keyword =~ /OPT_d/) {
                $opt{'d'} = 1;
            }
            elsif ($keyword =~ /OPT_D/) {
                $opt{'D'} = 1;
            }
            elsif ($keyword =~ /OPT_G/) {
                $opt{'G'} = $value;
            }
            elsif ($keyword =~ /OPT_a/) {
                $opt{'a'} = 1;
            }
            elsif ($keyword =~ /OPT_f/) {
                $opt{'f'} = $value;
            }
            elsif ($keyword =~ /OPT_l/) {
                $opt{'l'} = $value;
            }
            elsif ($keyword =~ /OPT_n/) {
                $opt{'n'} = 1;
            }
            elsif ($keyword =~ /OPT_s/) {
                $opt{'s'} = 1;
            }
            elsif ($keyword =~ /OPT_S/) {
                $opt{'S'} = 1;
            }
            elsif ($keyword =~ /OPT_M/) {
                $opt{'M'} = 1;
            }
            elsif ($keyword =~ /OPT_I/) {
                $opt{'I'} = $value;
            }
            elsif ($keyword =~ /OPT_X/) {
                $opt{'X'} = $value;
            }
            elsif ($keyword =~ /OPT_C/) {
                $opt{'C'} = 1;
            }
            elsif ($keyword =~ /OPT_L/) {
                $opt{'L'} = 1;
            }
            elsif ($keyword =~ /OPT_O/) {
                $opt{'O'} = $value;
            }
            elsif ($keyword =~ /OPT_z/) {
                $opt{'z'} = 1;
            }
            elsif ($keyword =~ /OPT_y/) {
                $opt{'y'} = 1;
            }
        }
    }
    close(UBHRC);


    if (!@servers) {
        # No servers defined; set up a default server.
        # Use the default server name, plus any possibly
        # modified parameters.
        push @servers, 
            Ubh::Server->new(
                            name       => $default_server{name},
                            port       => $current_server{port},
                            account    => $current_server{account},
                            password   => $current_server{password},
                            retries    => $current_server{retries},
                            hdrsip     => $current_server{hdrsip},
                            newsrcname => $current_server{newsrcname});
    }

    my $error = 0;
    foreach my $server (@servers) {
        if ((defined $server->account && !defined $server->password) || 
            (!defined $server->account && defined $server->password)) {
            print "ERROR: Server ", $server->name;
            print " need to specify both ACCOUNT and PASSWORD in ";
            print $platform->get_ubhrcname, "\n";
            $error = 1;
        }
    }
    if ($error) {
        exit(-1);
    }
}

# ----------------------------------------------------------------------
# Main routine.
# ----------------------------------------------------------------------

sub main() {
    $| = 1;

    welcome();

    $platform = Ubh::Platform->new;

    process_options();

    read_config();

    process_options();

    # Ensure data subdirectory exists.
    if (! -d $platform->get_datadir) {
        mkdir($platform->get_datadir, $perms) 
            or die "ERROR: mkdir(".$platform->get_datadir.") failed: $!\n";
    }

    # Ensure temp subdirectory exists.
    if ($opt{'A'} && ! -d $platform->get_tempdir) {
        mkdir($platform->get_tempdir, $perms) 
            or die "ERROR: mkdir(".$platform->get_tempdir.") failed: $!\n";
    }

    # Establish connection(s) to server(s) and load corresponding
    # newsrc's.
    foreach my $server (@servers) {
        $server->nntp(Ubh::NNTP->new(
                                     host     => $server->name,
                                     port     => $server->port,
                                     account  => $server->account,
                                     password => $server->password,
                                     retries  => $server->retries,
                                     sipsize  => $server->hdrsip));
        my $newsrc = new News::Newsrc 
            or die "ERROR: new News::Newsrc failed.\n";
        $server->newsrc($newsrc);
        $server->newsrc->load($server->newsrcname)
            or die "ERROR: News::Newsrc->load(".$server->newsrcname.") failed.\n";
    }

    process_servers();

    # Close connection(s) to server(s).
    foreach my $server (@servers) {
        print "Disconnecting from server ", $server->name, "...";
        $server->nntp->quit;
        print " done.\n";
    }

    clean_up();

    exit($exit_code);
}


sub evil_filename($) {
    my $filename = shift;

    my $evil = Ubh::EvilFilename->new(evilchar => $evilchar);

    # It's amazing the shit people specify as file names.
    # It's not uncommon to occasionally see full DOS path names,
    # complete with C:.
    $filename = $evil->mandatory($filename);

    if ($opt{'C'}) {
        # Convert all non-alphanumeric.
        $filename = $evil->alphanumeric($filename);

        # Force to all lowercase.
        $filename = lc($filename);
    }

    # check and fix filenames that are too long
    if (length($filename) > $platform->get_max_filename_length) {
        if ($filename =~ /^(.*)\.(.*)$/) {
            my $base = $1;
            my $ext = $2;
            if ($ext >= $platform->get_max_filename_length) {
                print "\n   WARNING: Cannot fix filename length (extension is too long).\n";
            } else {
                $base = substr $base, 0, ($platform->get_max_filename_length - length($ext) - 1);
                $filename = "$base.$ext";
            }
        } else {
            print "\n   WARNING: Cannot fix filename length (extension not found).\n";
        }
    }

    return $filename;
}


sub download_article($$$)
{
    my $hdrs    = shift;
    my $id      = shift;
    my $article = shift; # 1 == get whole article, 0 == just the body.

    # First, try to get it from the original server by article number.
    my $num  = $hdrs->get_subjects->{$id}->{num};
    my $orig_server = $hdrs->get_subjects->{$id}->{server};
    my $nntp = $orig_server->nntp;
    my $part = $article ? $nntp->article($num) : $nntp->body($num);
    if (!defined $part) {
        # Failed, so try get it by article ID from one of the other servers.
        print "\nWARNING: Failed to download article from ", $orig_server->name, "\n";
        foreach my $server (@{$hdrs->get_servers}) {
            if ($server != $orig_server) {
                print "   Trying to download article from ", $server->name, "\n";
                $nntp = $server->nntp;
                $part = $article ? $nntp->article($id) : $nntp->body($id);
                last if (defined $part);
            }
        }
    }
    return $part;
}

sub process_multiparts($$$) {
    my $group    = shift;
    my $hdrs     = shift;
    my $groupdir = shift;

    # Captures the pieces of the articles we are assembling.
    my %assembler;

    # Pass 1 - assemble list of parts.
    print "Pass 1: Assembling...\n";
    while (my ($id, $subject) = each %{$hdrs->get_subjects}) {

        if (defined $subject && $subject->{subject} =~ /(.+\.($multi_ext))/) {

            my $match = $1;

            # Process single part articles in the single-parts pass.
            # (Look for last [x/y] or (x/y) in the subject)
            next if (!($subject->{subject} =~ /^.*[\(\[](\d+)\/(\d+)[\)\]]/));

            my ($part, $total) = ($1, $2);

            # Process multi-part articles consisting of a single part 
            # in the single-parts pass.
            next if ($total == 1);
            
            # Consider multipart articles if they are being processed
            # during this run.
            if (!$opt{'S'}) {
                
                # Kill leading zeros.
                $part =~ s/^0+(\d+)$/$1/;
                
                if ($part == 0) {
                    # Maybe someday save part 0 off as a text file?
                    # For now, just skip part 0's.
                    
                    # MBSlater - save 0 file
                }
                else {
                    
                    if (!exists($assembler{$match})) {
                        # Start a new multipart article.
                        $assembler{$match} = 
                          Ubh::Multipart->new(numparts => $total);
                    }
                    
                    $assembler{$match}->articles->{$part} = $id;

                    # How many parts have we collected thus far?
                    my $num_collected = keys %{$assembler{$match}->articles};

                    # How many do we need?
                    my $num_parts = $assembler{$match}->numparts;

                    if ($num_collected == $num_parts) {
                        # We got 'em all.
                        $assembler{$match}->gotparts(1);
                    }
                }
            }
        }
    }
    print " done.\n";

    if ($opt{'s'}) {
        # Just log the multipart subject hits for posterity.
        my $msubfile = $groupdir.$platform->get_separator;
        if (defined $forcedir) {
            $msubfile .= $group."-";
        }
        $msubfile .= "multiparts.log";

        print "Writing complete multipart subjects to ", $msubfile, " ...\n";
        my $num_multiparts = 0;
        open(MSUBJECTS, "> $msubfile") 
            or die "ERROR: open($msubfile) failed.\n";
        my @assemblerkeys = sort keys %assembler;
        my $progbar = Ubh::PercentComplete->new (total => scalar @assemblerkeys);
        foreach my $match (@assemblerkeys) {
            if ($assembler{$match}->gotparts) {
                $progbar->update($num_multiparts++);
                print MSUBJECTS $match, "\n";
            }
        }        
        close(MSUBJECTS);
        print " done.\n";
        return;
    }

    # [OPTIONAL] - prompt to see if they want binaries.
    # This is only used for when doing interactive multipart 
    # selection (opt{'i'}).
    # The key is the name, the value is 1 if they want this
    # article.  Otherwise, assume all multipart articles are
    # wanted.
    my %wanted;
    
    # Eliminate incompletes, since the prompting and sorting depends on the
    # existence of part 1 of every binary.
    foreach my $match (keys %assembler) {
        if (!$assembler{$match}->gotparts) {
            my $items = keys(%{$assembler{$match}->articles});
            my $titems = $assembler{$match}->numparts;
            print "   Not complete: [$match] ($items of $titems)\n";
            delete $assembler{$match};
        }
    }
    
    if ($opt{'i'}) {
        print "Pass 2: Prompting...";
        foreach my $match (
                           sort {
                               $hdrs->get_subjects->{
                                   $assembler{$a}->articles->{1}}->{num}
                                       <=>
                                           $hdrs->get_subjects->{
                                               $assembler{$b}->articles->{1}}->{num}}
                           keys %assembler) {
            
            if ($assembler{$match}->gotparts) {
                print "Got all ", $assembler{$match}->numparts;
                print " parts of ", $match, "\n";
                my $wanted = yesno("Want it?");
                last if ($wanted == 2); # Escape and get started downloading.
                $wanted{$match} = $wanted;
            }
        }
        print " done.\n";
    }
    
    # Pass 3 - download parts and assemble articles.
    if ($opt{'i'}) {
        print "Pass 3: Retrieval...\n";
    }
    else {
        print "Pass 2: Retrieval...\n";
    }
    
    # At this point the only articles that remain are complete.
    my $num_art = scalar keys %assembler;
    my $curr_art = 0;
    my $subjects = $hdrs->get_subjects;
    foreach my $match (
                       sort {
                           $subjects->{$assembler{$a}->articles->{1}}->{num}
                                   <=>
                           $subjects->{$assembler{$b}->articles->{1}}->{num}}
                       keys %assembler) {

        $curr_art++;
        
        # Skip unwanted articles in interactive mode.
        next if ($opt{'i'} && (!defined $wanted{$match} || !$wanted{$match}));
        
        # Retrieve article parts in order.
        print "Retrieving: [$curr_art of $num_art] ", $match, "\n";
        my $subject = $hdrs->get_subject($assembler{$match}->articles->{1});
        print "   Subject: [" . $subject . "]\n";
        
        my $newfilename = $match;   
        
        my @mark_list;
        my @parts;
        my $gotparts = 0;
        
        if ($opt{'A'}) {
            # Create empty parts file.
            open(PARTSFILE, "> ".$platform->get_tempfilename) 
                or die "ERROR: open(".$platform->get_tempfilename.") failed.\n";
            close(PARTSFILE);
        }

      PARTS: foreach my $tpart (sort { $a <=> $b } keys %{$assembler{$match}->articles}) {
          if ($opt{'A'}) {
              # Append this part to the parts file.
              open(PARTSFILE, ">> ".$platform->get_tempfilename) 
                  or die "ERROR: open(".$platform->get_tempfilename.") failed.\n";       
          }
          my $id = $assembler{$match}->articles->{$tpart};
          my $num  = $hdrs->get_subjects->{$id}->{num};
          print "Retrieving part ", $tpart, " of ", $assembler{$match}->numparts, "\n";
          
          print "   server = ", $hdrs->get_subjects->{$id}->{server}->name, "\n";
          print "    group = ", $group, "\n";
          print "   number = ", $num, "\n";
          print "       id = ", $id, "\n";
          my $p = download_article($hdrs, $id, ($tpart == 1));
          if (!defined $p) {
              warn "\nWARNING: Could not download $id\n";
              warn "\nWARNING: Skipping $match\n";
              close(PARTSFILE) if ($opt{'A'});
              last PARTS;
          }
          else {

              # If duplicate file name skipping is desired, look through the body 
              # of the first part for a uuencoded file name.  If found, then skip
              # the rest of the parts of this binary.
              if (($opt{'O'} =~ /^skip/i) && $tpart == 1) {
                  # Skip uuencoded files if file with this name already exists.
                  for (@{$p}) {
                      if (/(?i)^begin\s+(\d+)\s+(.+)/) {
                          my $mode = $1;
                          my $file = $2;
                          if ($opt{'L'} && length($newfilename) > 0) {
                              $file = $newfilename; 
                          }
                          $file = evil_filename($file);
                          my $filepath = $groupdir.$platform->get_separator.$file;
                          if (-f $filepath) {
                              print "Skipping duplicate file: $filepath\n";

                              # Mark this part as read to prevent re-processing on 
                              # subsequent runs.
                              my $subject = $hdrs->get_subjects->{$id};
                              my $newsrc = $subject->{server}->newsrc;
                              my $num = $subject->{num};
                              $newsrc->mark($group, $num);
                              $hdrs->eliminate_crossposts($group, $id);
                              $newsrc->save if ($opt{'n'});

                              # Don't download any more parts.
                              close(PARTSFILE) if ($opt{'A'});
                              last PARTS;
                          }
                      }
                  }
              }

              push(@mark_list, $id);
              if ($opt{'A'}) {
                  # Write this part out to the parts file.
                  print PARTSFILE @{$p};
              }
              else {
                  push(@parts, @{$p});
              }
              $gotparts++;
          }
          close(PARTSFILE) if ($opt{'A'});
      }
        
        if ($gotparts == $assembler{$match}->numparts) {
            # Notice how this passes the message ID of the first part.
            my $id = $assembler{$match}->articles->{1};
            if ($opt{'A'}) {
                if ($opt{'D'}) {
                    dump_article(
                                 $groupdir, 
                                 $id, 
                                 1,
                                 $platform->get_tempfilename);
                }
                else {
                    decode_file(
                                $hdrs,
                                $id, 
                                $groupdir, 
                                $newfilename, 
                                1,
                                $platform->get_tempfilename,
                                $multi_ext);
                }
            }
            else {
                if ($opt{'D'}) {
                    dump_article(
                                 $groupdir, 
                                 $id, 
                                 0,
                                 \@parts);
                }
                else {
                    decode_file(
                                $hdrs,
                                $id, 
                                $groupdir, 
                                $newfilename, 
                                0,
                                \@parts,
                                $multi_ext);
                }
            }

            print "Marking downloaded article parts as read...";
            # Mark the articles as read, even if the decode fails, 
            # We got what we got.
            my %newsrcs; # So we only save newsrc's once if $opt{'n'} is in effect.
            foreach my $id (@mark_list) {
                my $subject = $hdrs->get_subjects->{$id};
                my $newsrc = $subject->{server}->newsrc;
                my $num = $subject->{num};
                $newsrc->mark($group, $num);
                $hdrs->eliminate_crossposts($group, $id);
                
                # See perlfaq 4 "How do I use a reference as a hash key?"
                # and perlref's section "WARNING".
                $newsrcs{$newsrc} = $newsrc;
            }
            
            if ($opt{'n'}) {
                # Save all the newsrc's that had articles that were marked.
                foreach my $key (keys %newsrcs) {
                    $newsrcs{$key}->save;
                }
            }
            print "done.\n";
        }
    }
}


sub dump_article($$$$)
{
    my $groupdir   = shift;
    my $id         = shift;
    my $isfile     = shift;
    my $body       = shift;

    print "Dumping ", $id, "...\n";
    my $dumppath = $groupdir.$platform->get_separator.evil_filename($id).".dump";
    open(DUMPARTICLE, "> $dumppath") or warn "Can't open $dumppath: $!";

    if ($isfile) {
        open(DUMPFILE, "< $body") 
            or die "ERROR: open($body) failed.\n";       
        while (<DUMPFILE>) {
            print DUMPARTICLE $_;
        }
        close DUMPFILE;
    }
    else {
        print DUMPARTICLE @{$body};
    }
    close DUMPARTICLE;
}


sub dump_articles($$) {
    my $groupdir = shift;
    my $hdrs     = shift;
    
    foreach my $id (keys %{$hdrs->get_subjects}) {
        my $subject = $hdrs->get_subjects->{$id};
        next if (!defined $subject);
        
        my $article = download_article($hdrs, $id, 1);
        if (!defined $article) {
            warn "\nWARNING: Could not download $id\n";
            warn "\nWARNING: Skipping $subject\n";
        }
        else {
            dump_article($groupdir, $id, 0, $article);
        }
    }
}


sub save_file($$$$$$)
{
    my $outfile     = shift;
    my $path        = shift;
    my $id          = shift;
    my $groupdir    = shift;
    my $newfilename = shift;
    my $extensions  = shift;

    my $filename;
    if ($opt{'L'} && length($newfilename) > 0) {
        # Use the provided file name (the name extracted from the Subject).
        $filename = $newfilename; 
    }
    else {
        # Use the recommended filename, extracted from the path.
        my ($f, $p, $e) = fileparse($path, '\.[^.]*');
        $filename = $f.$e;
    }
    $filename = evil_filename($filename);

    # Now, make sure to only take those extensions we are
    # interested in.  This will stop you from getting
    # .txt, .html, and spurious .exe's you didn't ask
    # for, especially in MIME multipart/mixed messages.
    my ($f, $p, $e) = fileparse($path, '\.[^.]*');
    if ($e =~ /\.$extensions/) {
        my $sep = $platform->get_separator;
        my $targetpath = $groupdir.$sep.$filename;
        my $skipdup = 0;
        if (-f $targetpath) {
            if ($opt{'O'} =~ /^no/i) {
                # File exists.  Create a unique filename by
                # appending the article ID.
                ($f, $p, $e) = fileparse($targetpath, '\.[^.]*');
                my $targetfile = evil_filename($f."-".$id.$e);
                $targetpath = $p.$targetfile;
            }
            elsif ($opt{'O'} =~ /^skip/i) {
                print "Skipping duplicate filename: ";
                print $targetpath, "\n";
                $skipdup = 1;
            }
        }
        if (!$skipdup) {
            print "Saving ", $targetpath, " ...";
            move($outfile, $targetpath);
            print "done.\n";
        }
    }
    else {
        print "Skipping file with unwanted extension: ";
        print $f.$e, "\n";
    }
}


sub decode_file_yEnc_data($$$$$$$)
{
    my $infile      = shift;
    my $sep         = shift;
    my $tempdir     = shift;
    my $id          = shift;
    my $groupdir    = shift;
    my $newfilename = shift;
    my $extensions  = shift;

    my $size;
    my $name;
    my $part;
    my $offset;
    my $pSize;
    my $decoded;
    my $decoding = 0;
    my $outfile;

    open(YENC, "< $infile")
        or die "ERROR: open(".$infile.") failed.\n";
    binmode YENC;
    while(<YENC>) {
        chomp;
        if (!$decoding) {
            if (/^=ybegin/) {
                if (/ size=(\d+)/) {
                    $size = $1;
                } 
                else {
                    die "ERROR: yEnc size field in ybegin is mandatory.\n";
                }

                if (/ part=(\d+)/) {
                    $part = $1;
                } 
                else {
                    undef $part;
                }

                if (/ name=(.*)$/) {
                    $name = $1;
                    $name =~ s/\s+$//g;
                    print "yEnc Found attachment $name of size $size.\n";
                } 
                else {
                    die "ERROR: yEnc name field in ybegin is mandatory.\n";
                }

                if (defined $part) {
                    my $line = <YENC>;
                    chomp $line;
                    $line =~ s/\s+$//g;
                    if ($line =~ /^=ypart/) {
                        if ($line =~ / begin=(\d+)/) {
                            $offset = $1 - 1;
                        } 
                        else {
                            print "yEnc Part $part has no begin field - ignoring.\n";
                            undef $part;
                        }
                        if ($line =~ / end=(\d+)/) {
                            $pSize = $1 - $offset;
                        } 
                        else {
                            print "yEnc Part $part has no end field - ignoring.\n";
                            undef $part;
                        }
                        print "yEnc File $name is multipart.\n" if ($part == 1);
                        print "yEnc Processing part $part.\n";
                    } 
                    else {
                        print "yEnc ybegin with part= field not followed"
                            ." by ypart=.  Treating as a single part.\n";
                        undef $part;
                    }
                }
                
                undef $decoded;    
                $decoding = 1 if (defined $size);
            }
        } 
        else {
            if (/^=yend/) {
                $decoding = 0;

                my $endSize;
                if (/size=(\d+)/) {
                    $endSize = $1;
                } 
                else {
                    print "yEnc Size is mandatory in yend, ignoring encoded stuff.\n";
                    next;
                }

                my $crc;
                if (defined $part) {
                    if (/ pcrc32=([0-9a-f]+)/i) {
                        $crc = $1;
                    }
                } 
                else {
                    if (/ crc32=([0-9a-f]+)/i) {
                        $crc = $1;
                    }
                }

                if (defined $crc) {
                    my $realCRC = crc32($decoded);
                    if (hex($crc) != $realCRC) {
                        print "ERROR: yEnc CRCs mismatch.  Expected ", $crc;
                        print ", got ",
                        print sprintf("0x%x", $realCRC), ".\n";
                        next;
                    }
                }

                # Temporary output file name.
                $outfile = $tempdir.$sep.evil_filename($name);

                my $decodedSize = length($decoded);
                if (defined $part) {    
                    if ($decodedSize != $pSize) {
                        die "ERROR: yEnc Size mismatch.  Expected $pSize, got $decodedSize.\n";
                    }

                    print "yEnc Writing part $part to $outfile...";
                    if ($part == 1) {
                        open(FH,"> $outfile") 
                            or die "ERROR: yEnc Can't write to file $outfile\n";
                    } 
                    else {
                        open(FH,"+< $outfile") 
                            or die "ERROR: yEnc Can't append to $outfile\n";
                    }
                    binmode(FH);
                    seek(FH, $offset, 0);
                    print FH $decoded;
                    close(FH);
                    print "done.\n";
                } 
                else {
                    if ($endSize != $size) {
                        die "ERROR: yEnc begin/end size mismatch.  Expected $size, got $endSize.\n";
                    }
                    if ($decodedSize != $endSize) {
                        die "ERROR: yEnc Size mismatch.  Expected $endSize, got $decodedSize.\n";
                    }

                    print "yEnc Writing $outfile...";
                    open(FH, "> $outfile") 
                        or die "ERROR: yEnc Can't write to file $outfile\n";
                    binmode(FH);
                    print FH $decoded;
                    close(FH);
                    print "done.\n";
                }
            } 
            else {
                my $line = $_;

                # Remove extraneous trailing 0x0d's, if possible.
                $line =~ s/\x0d$//;

                $line =~ s/=(.)/chr(ord($1) - 64)/egs;
                $line =~ s/(.)/my $o = ord($1)-42; $o+=256 if ($o<0); chr($o)/egs;
                $decoded .= $line;
            }
        }
    }
    close YENC;

    if (defined $outfile) {
        # OK, save the file off where they want it.
        save_file(
                  $outfile,
                  $name,
                  $id, 
                  $groupdir, 
                  $newfilename, 
                  $extensions);
    }
}

sub decode_file_yEnc($$$$$$$)
{
    my $hdrs        = shift;
    my $id          = shift;
    my $groupdir    = shift;
    my $newfilename = shift;
    my $is_file     = shift;
    my $article     = shift;
    my $extensions  = shift;

    my $sep = $platform->get_separator;
    my $tempdir = $platform->get_tempdir.$sep.evil_filename($id);
    mkdir($tempdir, $perms);
    if (!-d $tempdir) {
        print "ERROR: Could not create temporary directory $tempdir\n";
    }
    else {
        my $subject = $hdrs->get_subjects->{$id}->{subject};
        print "yEnc Subject: ", $subject, "\n";
        my $entity;
        if (!$is_file) {
            # Dump it out to a file first (necessary because
            # yEnc decoder only converts files).
            my $yenctemp = $tempdir.$sep."yenc_article.txt";
            open(YENCTEMP, "> $yenctemp")
                or die "ERROR: open(".$yenctemp.") failed.\n";
            binmode YENCTEMP;
            foreach (@{$article}) {
                print YENCTEMP;
            }
            close YENCTEMP;

            # Save filename we just wrote to.
            $article = $yenctemp;
        }

        decode_file_yEnc_data(
                              $article,
                              $sep,
                              $tempdir,
                              $id,
                              $groupdir,
                              $newfilename,
                              $extensions);

        # Remove the temporary working directory.
        # Using rmtree here in case purge didn't work.
        rmtree $tempdir;
    }
}


sub process_MIME_entity
{
    my $entity      = shift;
    my $id          = shift;
    my $groupdir    = shift;
    my $newfilename = shift;
    my $extensions  = shift;


    # If there are evil chars in the bodyhandle path, then MIME::Parser
    # will choke and give a null file name, but the recommended file name
    # will always have the file name, evil characters included.
    # Also, when MIME::Parser wants to give you the text at the top
    # of the message, it will give a null recommended file name, but
    # it will make up a nice filename with a .txt extension and put
    # that name in the bodyhandle->path.
    my $path = $entity->head->recommended_filename;
    if (!$path) {
        $path = $entity->bodyhandle->path;
    }

    save_file(
              $entity->bodyhandle->path,
              $path, 
              $id, 
              $groupdir, 
              $newfilename, 
              $extensions);
}


sub decode_file_MIME($$$$$$$)
{
    my $hdrs        = shift;
    my $id          = shift;
    my $groupdir    = shift;
    my $newfilename = shift;
    my $is_file     = shift;
    my $article     = shift;
    my $extensions  = shift;

    # Turn this on for a long narrative during the decode.
    # MIME::Tools->debugging(0);

    my $parser = MIME::Parser->new;
    $parser->extract_uuencode(1);

    my $sep = $platform->get_separator;
    my $tempdir = $platform->get_tempdir.$sep.evil_filename($id);
    mkdir($tempdir, $perms);
    if (!-d $tempdir) {
        print "ERROR: Could not create temporary directory $tempdir\n";
    }
    else {
        $parser->output_dir($tempdir);

        my $subject = $hdrs->get_subjects->{$id}->{subject};
        print "MIME Subject: ", $subject, "\n";
        my $entity;
        if ($is_file) {
            $entity = $parser->parse_open($article);
        }
        else {
            # Pass array to be decoded.
            $entity = $parser->parse_data($article);
        }

        if (!$entity) {
            # This shouldn't really ever happen.  At the very least,
            # MIME::Parser will create a .txt file.
            print "   Could not parse article.\n";
        }
        else {
            # Uncomment this for MIME::Parser overview of contents.
            # $entity->dump_skeleton(\*STDOUT);
            
            foreach my $part ($entity->parts_DFS) {
                # Process only those entities which have bodies.
                next if (!$part->bodyhandle);

                process_MIME_entity(
                                    $part, 
                                    $id, 
                                    $groupdir, 
                                    $newfilename, 
                                    $extensions);
            }
        }
        
        # Clean up any remaining files.
        $parser->filer->purge;

        # Remove the temporary working directory.
        # Using rmtree here in case purge didn't work.
        rmtree $tempdir;
    }
}


sub decode_file_custom($$$)
{
    my $decoder   = shift;
    my $directory = shift;
    my $filename  = shift;

    $decoder =~ s/\%d/$directory/g;
    $decoder =~ s/\%f/$filename/g;

    print "Using external decoder: ", $decoder, "\n";

    # Using an array skips the use of the shell.
    # See perldoc -f system for details.
    my @decoder = split(/ /, $decoder);
    system(@decoder);
}


sub decode_file($$$$$$$)
{
    my $hdrs        = shift;
    my $id          = shift;
    my $groupdir    = shift;
    my $newfilename = shift;
    my $is_file     = shift;
    my $article     = shift;
    my $extensions  = shift;

    if (defined $decoder && $is_file) {
        # Invoke the external decoder.
        decode_file_custom($decoder, $groupdir, $article);
    }
    else {
        # Figure out what kind of file it is.
        my $is_yenc = 0;
        if ($is_file) {
            open(DF, "< $article")
                or die "ERROR: open(".$article.") failed.\n";
            my $line = 0;
            while (<DF>) {
                last if (++$line > 500);
                if (/^=ybegin/) {
                    $is_yenc = 1;
                    last;
                }
            }
            close DF;
        }
        else {
            my $line = 0;
            foreach (@{$article}) {
                last if (++$line > 500);
                if (/^=ybegin/) {
                    $is_yenc = 1;
                    last;
                }
            }
        }

        if ($is_yenc) {
            decode_file_yEnc(
                             $hdrs,
                             $id,
                             $groupdir,
                             $newfilename,
                             $is_file,
                             $article,
                             $extensions);
        }
        else {
            # Use MIME::Parser internally.
            decode_file_MIME(
                             $hdrs,
                             $id,
                             $groupdir,
                             $newfilename,
                             $is_file,
                             $article,
                             $extensions);
        }
    }
}


sub process_article_MIME($$$$$) {
    my $hdrs        = shift;
    my $id          = shift;
    my $groupdir    = shift;
    my $newfilename = shift;
    my $group       = shift;

    my $num  = $hdrs->get_subjects->{$id}->{num};
    my $subject = $hdrs->get_subjects->{$id}->{subject};
    print "\n\nRetrieving single-part article:\n";
    print "    server = ", $hdrs->get_subjects->{$id}->{server}->name, "\n";
    print "     group = ", $group, "\n";
    print "    number = ", $num, "\n";
    print "        id = ", $id, "\n";
    print "   subject = ", $subject, "\n";
    my $article = download_article($hdrs, $id, 1);
    if (!defined $article) {
        warn "\nWARNING: Could not download $id\n";
        warn "\nWARNING: Skipping $subject\n";
    }
    else {
        if ($opt{'A'}) {
            # Save body to disk file, and decode that.
            my $mimefilename = $platform->get_tempfilename;
            open(SINGFILE, "> ".$mimefilename)
                or die "ERROR: open(".$mimefilename.") failed.\n";       
            print SINGFILE @{$article};
            close SINGFILE;

            if ($opt{'D'}) {
                dump_article(
                             $groupdir, 
                             $id, 
                             1,
                             $mimefilename);
            }
            else {
                decode_file(
                            $hdrs,
                            $id, 
                            $groupdir, 
                            $newfilename, 
                            1, 
                            $mimefilename,
                            $single_ext);
            }
        }
        else {
            if ($opt{'D'}) {
                dump_article(
                             $groupdir, 
                             $id, 
                             0,
                             $article);
            }
            else {
                decode_file(
                            $hdrs,
                            $id, 
                            $groupdir, 
                            $newfilename, 
                            0, 
                            $article,
                            $single_ext);
            }
        }
    }
}


sub sort_subjects($$)
{
    my $subjects = shift;
    my $sorted   = shift;
    
    print "Sorting subjects by server and article number...";
    while (my ($id, $subject) = each %{$subjects}) {

        # Filter out any multipart subjects.
        # [1/1] and (1/1) are considered single part articles. 
        if ($subject->{subject} =~ /^.*[\(\[](\d+)\/(\d+)[\)\]]/) {
            my ($part, $total) = ($1, $2);
            next if ($total > 1);
        }
            
        my $name = $subject->{server}->name;
        if (!defined $sorted->{$name}) {
            $sorted->{$name} = {
                bounds => { 
                    min => $subject->{num},
                    max => $subject->{num} },
                articles => {} };
        }
        $sorted->{$name}{articles}{$subject->{num}} = $id;

        my $bounds = $sorted->{$name}{bounds};
        $bounds->{min} = ($subject->{num} < $bounds->{min}) ? 
                $subject->{num} : $bounds->{min};
        $bounds->{max} = ($subject->{num} > $bounds->{max}) ? 
                $subject->{num} : $bounds->{max};
    }
    print "done.\n";
}



sub process_singles($$$$) {
    my $group    = shift;
    my $hdrs     = shift;
    my $groupdir = shift;
    my $servers  = shift;

    my $subjects = $hdrs->get_subjects;

    # Sort the subjects by server and article number order.
    my %sorted;
    sort_subjects($subjects, \%sorted);

    if ($opt{'s'}) {
        # Just log the raw subjects for posterity.
        my $subfile = $groupdir.$platform->get_separator;
        if (defined $forcedir) {
            $subfile .= $group."-";
        }
        $subfile .= "subjects.log";

        print "Writing subjects to ", $subfile, "...";
        open(SUBJECTS, "> $subfile") 
            or die "ERROR: open($subfile) failed.\n";
        foreach my $server (@{$servers}) {
            next if (!defined $sorted{$server->name});
            my $min = $sorted{$server->name}{bounds}{min};
            my $max = $sorted{$server->name}{bounds}{max};
            foreach my $num ($min..$max) {
                next if (!defined $sorted{$server->name}{articles}{$num});

                my $id = $sorted{$server->name}{articles}{$num};
                my $subject = $hdrs->get_subject($id);
                if (defined $subject) {
                    print SUBJECTS $id, "|", $subject, "\n";
                }
            }
        }        
        close(SUBJECTS);
        print "done.\n";
    }
    else {
        foreach my $server (@{$servers}) {
            next if (!defined $sorted{$server->name});
            my $min = $sorted{$server->name}{bounds}{min};
            my $max = $sorted{$server->name}{bounds}{max};
            foreach my $num ($min..$max) {
                next if (!defined $sorted{$server->name}{articles}{$num});

                my $id = $sorted{$server->name}{articles}{$num};
                my $subject = $subjects->{$id};

                next if (!defined $subject);

                if ($subject->{subject} =~ /(.+\.($single_ext))/) {
                        
                    my $match = $1;

                    process_article_MIME($hdrs, $id, $groupdir, $match, $group);
                }
                elsif ($opt{'g'}) {

                    # Nothing interesting in the header.  Maybe
                    # there is an article in the body, so go ahead
                    # and process the body as a single part article.
                    process_article_MIME($hdrs, $id, $groupdir, "", $group);
                }
                $subject->{server}->newsrc->mark($group, $subject->{num});
                $hdrs->eliminate_crossposts($group, $id);
                $subject->{server}->newsrc->save if ($opt{'n'});
            }
        }
    }
}


# ------------------------------------------------------------
# Group processing.
# ------------------------------------------------------------
sub process_group($$$) {

    my $servers  = shift;
    my $group    = shift;
    my $groupdir = shift;

    my $hdrs = Ubh::Headers->new(
                                 platform => $platform,
                                 servers  => \@servers,
                                 group    => $group,
                                 batchfile => $batchfile);
    $hdrs->load(\%opt, $groupdir);

    if ($opt{'d'}) {
        # Dump everything raw straight to the disk.
        dump_articles($groupdir, $hdrs);
    }
    else {

        foreach my $server (@{$servers}) {
            $server->nntp->reset_stats();
        }

        if (!$opt{'S'}) { 
            process_multiparts(
                               $group, 
                               $hdrs, 
                               $groupdir);
        }

        if (!$opt{'M'}) { 
            process_singles(
                            $group, 
                            $hdrs,
                            $groupdir,
                            \@servers);
        }

        foreach my $server (@{$servers}) {
            if (!$opt{'a'} && !$opt{'s'}) {
                # Don't catch up if just logging the subjects,
                # or if scanning all articles.
                # Otherwise, save all the marks we have made.
                print "Updating newsrc ", $server->newsrcname;
                print " for server ", $server->name, " ...";
                $server->newsrc->save;
                print "done.\n";
            }
        }
    }

    foreach my $server (@{$servers}) {
        my ($bytes, $delta, $rate) = $server->nntp->get_stats();
        print "STATS: ", $server->name;
        print "  total bytes = $bytes";
        print "  secs = $delta";
        print "  rate = " . sprintf("%.03f",$rate) . " KB/sec\n";
    }
}


sub process_servers() {

    # Process all the groups subscribed on the first server.
    my $server = $servers[0];

    # Access the newsrc.
    my $newsrc = $server->newsrc;

    # Construct list of groups to process.
    my @groups;
    if ($opt{'G'}) {
        # Just process the one group they specified on the command line.
        if (!$newsrc->exists($opt{'G'})) {
            print "WARNING: $opt{'G'} not in ".$server->newsrcname."\n";
        }
        elsif (!$newsrc->subscribed($opt{'G'})) {
            print "WARNING: $opt{'G'} is not subscribed in ".$server->newsrcname."\n";
        }
        else {
            push @groups, $opt{'G'};
        }
    }
    else {
        # Get list of groups from newsrc.
        @groups = $newsrc->sub_groups();
    }

    if (!@groups) {
        print "WARNING: No groups in ".$server->newsrcname." to process.\n";
    }
    else {
        # Process each group in the newsrc.
        foreach my $group (@groups) {

            # Ensure group subdirectory exists.
            my $groupdir;
            if (defined $forcedir) {
                $groupdir = $forcedir;
            } 
            else {
                $groupdir = $platform->get_datadir.$platform->get_separator.$group;
            }
            if (! -d $groupdir) {
                mkdir($groupdir, $perms) 
                    or die "ERROR: mkdir($groupdir) failed: $!\n";
            }

            process_group(\@servers, $group, $groupdir);

            print "Done processing group ", $group, "\n";
            clean_up();
        }
    }
}

sub grace()
{
    $intsig++; # Tries to clean up on one SIG, will leave the mess on two.
    my $warning = 
        "\nPlease make sure to delete all ubhtemp files in your temp directory.\n";

    if ($intsig <= 1) {
        # Try to exit somewhat gracefully.
        foreach my $server (@servers) {
            $server->newsrc->save;
            $server->nntp->quit;
        }
        clean_up();
        die "\n\nSaved your newsrcs and cleaned your temp directory.".$warning;
    }
    else {
        die "\n\nCaught another SIG, leaving without cleaning.".$warning;
    }
} 

sub clean_up() {
    if (-f $platform->get_tempfilename) {
         my $spacer = unlink $platform->get_tempfilename;
     }
}

main();


