#!/usr/bin/perl -w
###############################################################################
# Name: FetchYahoo
# Purpose: retrieves messages from Yahoo! Mail, saving them to a local spool
# Description:  FetchYahoo is a Perl script that downloads mail from a Yahoo! 
#               webmail account to a local mail spool. It is meant to replace
#               fetchmail for people using Yahoo! mail since Yahoo!'s POP service
#               is no longer free. It downloads messages to a local mail spool, 
#               including all parts and attachments . It then deletes messages
#               unless requested not to. It can also forward messages to another
#               e-mail address
# Author:  Ravi Ramkissoon
# Author's E-mail: ravi_ramkissoon@yahoo.com
# License: Gnu Public License
# Created: 04.12.02
# Modified: 04.28.02
# Version: .1.2
# 
# Installation instructions are in the INSTALL file
#
###############################################################################
# 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.
##################################################################################
# TODO
# 1. Built-in POP3 server - TODO
# 2. Improve usage (prompt for username/password/spool and save to file) - TODO
# 2. --verbose otion, --maxsize option - TODO
####################################################################################

use strict;

use Getopt::Long ();
use HTML::Entities ();
use HTML::HeadParser ();
use HTML::TokeParser ();
use HTTP::Request::Common qw(GET POST);
use HTTP::Cookies ();
use LWP::UserAgent ();
use LWP::Simple ();
use MIME::Entity ();
use MIME::Head ();
use MIME::Body ();
sub GetRedirectUrl($);
sub PopulateMap();
sub ParseConfigFile();
sub Localize($);
sub Clean($);
		   
# MUST configure these
my $username = 'yahoo-user-name';
my $password = 'yahoo-password';

# mail spool, mbox file and procmail configs
my $useSpool  = 1;                    # set this to 0 to disable outputting to a file
my $spoolName = '/var/spool/mail/local-user-name';
my $spoolMode = 'append';             # either 'append', 'pipe' or 'overwrite'
                                      # use 'pipe' for procmail or other filter
# proxy configs
my $useProxy = 0;                     # set this to 1 to enable use of a web proxy
my $proxyHost = 'proxy.hostname.com';
my $proxyPort = 80;

my $useHTTPS = 0;                     # set this to 1 to use https secure connections
                                      # this may require Crypt::SSLeay
# mail forwarding configs
my $useForward = 0;                      # set this to 1 to enable mail forwarding
my $mailHost = 'outgoing.mail.com';   # set this to your smtp outgoing mail server
my $sendToAddress = 'me@myhost.com';  # the e-mail address you want mail forwarded to
my $sendFromAddress = 'me@myhost.com'; # the e-mail address used as the from address
                                       # this should probably be at the same ISP as
		                       # the outgoing smtp mailhost specified above

# both of these below defaults can be overridden from the commandline
my $newOnly = 0;           # download all (0) or just new (1) messages
my $noDelete = 0;          # to not delete messages set this to 1

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


# I may need to edit these in future
my $loginURL = 'http://login.yahoo.com/config/login';
my $HTTPSloginURL = 'https://login.yahoo.com/config/login';
my $homesuff = '/ym/ShowFolder?box=Inbox';
my $msgsuff = '/ym/ShowLetter?box=Inbox&PRINT=1&Nhead=f&toc=1&MsgId=';
my $versionString = "FetchYahoo Version .1.2\n";

# other variables used
my $spool;
my $proxyURL;
my $smtp;

# flag for help and version
my $help = 0;
my $version = 0;

my %map  = ();     # hash for extension->MIMEtype mappings

my $usage = <<EOF
$0 [options] 

Retrieves messages from the inbox of a Yahoo user using the web interface
and stores them in the specified local spool/mbox file. Deletes the messages
downloaded unless requested not to.

Options specified on the commandline take precedence over options specified
in the configuration file, which in turn take precedence over options hardcoded
within the fetchyahoo program file.

--version                      print the version and exit
--help                         give the usage message showing the program options
--newonly                      only download new (i.e. unread) messages
--nodelete                     do not delete messages after downloading them
--configfile=config-file       use config-file as the configuration file
--username=yahoousername       use yahoousername as the login
--password=pass                use pass as the password
--spoolfile=spool-file         use spool-file as the file to spool messages to

NOTE: Username, password and path to mail spool need to be set
by editing fetchyahoo.pl
EOF
;

# S T A R T   M A I N   P R O G R A M

# mapping extensions to mime types
PopulateMap();
		   
# parse input options for an alternate config file
my $altConfigFile;
Getopt::Long::Configure('pass_through');
Getopt::Long::GetOptions ('configfile=s'  => \$altConfigFile);

# config file options take precedence over hardcoded (within-file)  options
ParseConfigFile();

# get other command-line  input options. These options take precedence over all others
Getopt::Long::Configure('no_pass_through');
Getopt::Long::GetOptions
(
 'newOnly'     => \$newOnly,
 'help'        => \$help,
 'version'     => \$version,
 'noDelete'    => \$noDelete,
 'username=s'  => \$username,
 'password=s'  => \$password,
 'spoolfile=s'  => \$spoolName);

# set some required variables
if ($spoolMode eq 'append') {
    $spool = '>>' . $spoolName ; }
elsif ($spoolMode eq 'pipe') {
    $spool = '|' . $spoolName ; }
elsif ($spoolMode eq 'overwrite') {
    $spool = '>' . $spoolName ; }
else { $spool = '>>' . $spoolName ; }     # the default is to append

$proxyURL = 'http://' . $proxyHost . ':' . $proxyPort;
if ($useHTTPS) { 
	$proxyURL = $proxyHost . ':' . $proxyPort;
}

if ($useForward) {
    use Net::SMTP;
    $smtp = Net::SMTP->new($mailHost);
    die "Unable to connect to server $mailHost to forward mail. Terminating!\n" 
	unless $smtp; 
}

if ($useHTTPS) {
	$loginURL = $HTTPSloginURL;
}

# unbuffer STDOUT
select((select(STDOUT), $| = 1)[0]);

# check if help or version was requested
if ($help) { print $versionString . "\n" . $usage; exit; }
if ($version) { print $versionString; exit; }

# check for common errors (forgot to edit variables)
if ($username eq 'yahoo-user-name')  {
    print "You MUST edit fetchyahoo.pl or the configuration file " .
	"before using this program.\n\n";
    print $versionString . "\n" . $usage; exit; 
}

if ( $useSpool && $spoolName eq "/var/spool/mail/local-user-name") {
    print "If you are sending the messages to a file (use-spool=1), you must " .
	"specify the file or spool or program .\n\n";
    print $versionString . "\n" . $usage; exit; 
}

if ( $useForward && $sendToAddress eq 'me@myhost.com') {
    print "If you are forwarding the messages (use-forward=1), you must " .
	"specify the e-mail address to forward to.\n\n";
    print $versionString . "\n" . $usage; exit; 
}

if ( $useProxy && $proxyHost eq "proxy.hostname.com") {
    print "If you are using a web proxy (use-proxy=1), you must " .
	"specify the proxy hostname.\n\n";
    print $versionString . "\n" . $usage; exit; 
}

if ($useHTTPS) { print "Logging in securely via SSL as $username.\n" }
else { print "Logging in insecurely via plaintext as $username.\n" }

if ($useProxy) { print "Using $proxyURL as a webproxy.\n" }


# grab login cookies
my $ua = LWP::UserAgent->new;
$ua->agent('FetchYahoo/.1.1');
if ($useProxy) {
    if ($useHTTPS) {
	$ENV{HTTPS_PROXY} = $proxyURL;
    } else {
    	$ua->proxy('http', $proxyURL);
    }
}
my $cookie_jar = HTTP::Cookies->new();
$ua->cookie_jar($cookie_jar);
my $request = POST 'http://login.yahoo.com/config/login',
    [
     '.tries' => '1',
     #'.done'  => 'URL to go to later',
     '.src'   => 'ym',
     '.intl'  => 'us',
     'login'  => $username,
     'passwd' => $password,
     ];

$request->content_type('application/x-www-form-urlencoded');
$request->header('Accept' => '*/*');
$request->header('Allowed' => 'GET HEAD PUT');
my $response = $ua->simple_request($request);
my $url;
while ( $response->is_redirect ) {
    $cookie_jar->extract_cookies($response);
    $url = GetRedirectUrl($response);
    $request = GET $url;
    $response = $ua->simple_request($request);
}

if ( !$response->is_success ) { print "Failed!\n"; die "Couldn't log in\n"; }

if ( ($response->content) =~ /Invalid Password/ ) {
    print "Failed!\n"; die "Wrong password entered for $username\n"; }

if ( ($response->content) =~ /ID does not exist/ ) {
    print "Failed!\n"; die "Yahoo user $username does not exist\n"; }


print "Successfully logged in as $username.\n"; 

# Detect country code from url (first 2 chars of url, eg http://us.f116.mail.yahoo.com)
$url=~/http:\/\/(.*?)\./;
print "Country code : $1\n";
my %strings = Localize($1);
# Find the localized equivalent of "To:"
my $localizedTo = "To:";
foreach (keys %{$strings{"headers"}} ) {
    if ($strings{"headers"}->{$_} eq "To:") {
        $localizedTo = $_;
        last;
    }
}

# setup URLs
$url =~ /(http:\/\/.*?)\// ;
my $baseurl = $1;
my $homeurl = $baseurl . $homesuff ;
my $msgurl = $baseurl . $msgsuff ; 
my $delurl = $homeurl . "\&DEL=Delete";

# get all message IDs
my $msgcount = 0;
my $pagecount = 0;
my $numMsgs ;
my $startMsg ;
my $endMsg ;
my @msgids ;
my $crumb ;

if ( $newOnly ) {
    print "Only retrieving new messages\n";
    $homeurl = $homeurl . "\&Nview=u";
}

# loop over all inbox summary pages
do {
    
    # get summary page
    my $tmpurl = $homeurl . "\&Npos=$pagecount" ; 
    $request = GET  $tmpurl ;
    $response = $ua->simple_request($request);
    while ( $response->is_redirect ) {
	$cookie_jar->extract_cookies($response); # manually extract cookies
	my $url = GetRedirectUrl($response);     # get new page
	$request = GET $url;                     # go to the new page 
	$response = $ua->simple_request($request);
    }
    
    if ( !$response->is_success ) { print "Failed!\n";
				    die "Couldn't get Inbox listing.\n"; }
    
    #parse for number of messages
    my $mainPage = $response->content;
    if ($mainPage =~ /$strings{'msg_range'}/) { 
	$startMsg = $1 ;
	$endMsg = $2 ;
	$numMsgs = $3;  }
    elsif ($mainPage =~ /$strings{'no_msgs'}/) {
	print "There are no messages to retrieve.\n"; exit; }
    else { print "Failed!\n"; die "Can't retrieve number of messages.\n"; }
    
    $mainPage =~ /name=\".crumb\" value=\"(.*?)\"/ ;
    $crumb = $1;
    print "Getting Message IDs for messages $startMsg - $endMsg.\n";
    
    # parse summary page for message IDs
    foreach my $word (split ' ', $mainPage) {
	if ($word =~ /ShowLetter\?MsgId=([0-9_]+)/ ) { 
	    $msgcount = $msgcount + 1;
	    $msgids[$msgcount-1] = $1 ;
	}
    }
    $pagecount = $pagecount+1 ;            # next summary page
} until $numMsgs == $endMsg ; 

print "Got $msgcount Message IDs\n";
my $delCount = 0;
my $downloadCount = 0;

# loop over all Message IDs
foreach my $msgid (@msgids) { 
    my $tmpurl = $msgurl . $msgid ; 
    my $request = GET  $tmpurl ;
    my $response;

    if ( ! ($response = $ua->simple_request($request))) {
	print "\nFailed to get body of message $msgid. It will be "
	    . "skipped and not deleted.\n";
	next ; }
    my $msgText = $response->content ;

    if ($msgText =~ /$strings{'p_view'}/) {  # sometimes we get a 
	$tmpurl = $msgurl . $msgid ;            # non-printable view
	$request = GET  $tmpurl ;
	if ( ! ($response = $ua->simple_request($request) )) {
	    print "\nFailed to get body of message $msgid. It will be "
		. "skipped and not deleted.\n";
	    next ; }
	$msgText = $response->content ;
    }
    
    # loop over all the message parts, getting their URLs and filenames
    my $partcount = 0 ; 
    my @parturls;
    my @filenames;
    
    foreach my $word (split ' ', $msgText) {
	if ($word =~ /filename=(.*?)&download=1/ ) {
	    $filenames[$partcount] = $1 ;
	    my $parturl = $word ; 
	    $parturl =~ s/href=\"// ;
	    $parturl =~ s/\">// ;
	    $partcount = $partcount + 1;
	    $parturls[$partcount-1] = $parturl ;
	}
    }

    # Parse all headers in message
    # Here we need a header we will find in every message. 
    # "To:" seemed like a good choice. 
    # Reminder : $localizedTo is the local translation of "To:"
    $msgText =~ /.*<table[^>]*>(.*?$localizedTo.*?)<\/table>/si;
 
    my $msgLines = $1;

    # Not pretty, all info is stored in $mimeHead
    # The reason we go through the trouble of constructing the header manually 
    # is to preserve multiple Received: headers, since these are lost when using
    # a hash.

    my $fromString = '-1';
    my $mimeHead = new MIME::Head;
    $msgLines =~ s/X-Apparently-To/\n<\/td><td><\/td><\/tr><tr><td>X-Apparently-To/s ;  
          # ^^ hack to parse 1st field
    while ($msgLines =~ s/<tr[^>]*>\s*<td[^>]*>(.*?)<\/td>\s*<td[^>]*>(.*?)<\/td><\/tr>//si) {
        my $key = $1;
        my $value = $2;      
	# Extract the key as it is defined in the message (possibly translated)
        $key = Clean($1);                                   
	# Translate back to English if necessary
	if (defined $strings{'headers'}->{$key}) {
            $key = $strings{'headers'}->{$key};
        }
        $value = Clean($2);

	if ($key =~ /^From /) { next ; }       # skip the extra From_ line
	if ($key eq '') { next ; }              # skip the any blank fields
	if ($key eq 'From:') { $fromString = $value; }  # to recreate a From_ line later

	$mimeHead->add($key, $value);
    }

    # if we can't parse From: field assume this has failed
    if ( $fromString eq '-1' ) {
	print "\nCan't find message $msgid. It will be skipped and not deleted.\n";
	next;
    }

    my $msg;
    my $noDelete = 0;
    if ($partcount>1) {
	# start building a message to spool
	$msg = MIME::Entity->build('Type' => "multipart/mixed" );

	# create the headers from scratch now
	my $tmpDate = scalar localtime;
	$tmpDate =~ s/ /_/g;
	$mimeHead->replace('Content-Type', "multipart/mixed;" . "Boundary=\"" . 
			   'arbitrary_string_Wheee' . $tmpDate . "\"");
	$msg->head($mimeHead);
	
	# loop over all message parts
	for (my $i = 0; $i < $partcount; $i++) {
	    
	    # get one part of the message
	    $tmpurl = $baseurl . $parturls[$i] ; 
	    $request = GET  $tmpurl ;
	    
	    if ( ! ($response = $ua->simple_request($request) ) ) {
		print " \nFailed to get attachment $filenames[$i]. " 
		    . "Skipping attachment, message will not be deleted.\n" ;
		$noDelete = 1;
		next ; 
	    }
	    
	    my $rawPart = $response->content ;
	    
	    if ($rawPart =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s ) {
		print " \nFailed to get attachment $filenames[$i]. " 
		    . "Skipping attachment, message will not be deleted.\n" ;
		$noDelete = 1;
		next ; 
	    }
	    
            # get extension and derive type and disposition from that
	    $filenames[$i] =~ /.*\.(.*)/ ;
	    my $fileExt = "qqq"; 
	    if (defined ($1) ) { $fileExt = $1 ; } 
	    my $type = $map{lc($fileExt)};
	    if ( ! defined ($type) ) { $type = "text/plain" ; } 
	    my $disp ; 
	    if ( $type =~ "text/plain"  && !($fileExt =~ "qqq")) { $disp = "inline";}
	    else { $disp = "attachment" ; }
	    
	    # attach this part to the message
	    attach $msg Data=>$rawPart,
	    Disposition => $disp,
	    Filename =>$filenames[$i],
	    Type => $type;
	    print "." ;               # output one "." for every part
	}
    }
    else {  # this is a single part message (either text/plain or text/html)

	# get message body
	$tmpurl = $baseurl . $parturls[0] ; 
	$request = GET  $tmpurl ;	

	if ( ! ($response = $ua->simple_request($request) ) ) {
	    print " \nFailed to get message body. " 
		. "Message will be skipped and will not be deleted.\n" ;
	    next ; 
	} 	
	my $msgBody = $response->content ;

	if ($msgBody =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s ) {
	    print " \nFailed to get message body. " 
		. "Message will be skipped and will not be deleted.\n" ;
	    next ; 
	}

	$msg = MIME::Entity->build('Type' => "text/plain" ,
				   'Data' => $msgBody);

	my $contentType;                    # file.txt can be plain or html
        if ( ($msgBody =~ /^\s*<html>/i) or ($msgBody =~ /^\s*<\!DOCTYPE HTML/i) ) {
            $contentType = "text/html"; }
        else { 
            $contentType = "text/plain"; }

	$mimeHead->replace('Content-Type', $contentType);
	$msg->head($mimeHead);
	print "." ;               # output one "." for every part
    }

    if (! $noDelete) {
	$delurl = $delurl . "\&Mid=$msgid";    # add message to deletion list
	$delCount = $delCount+1;
    }
    # create a proper From_ line
    $fromString =~ s/ /_/g ;
    $fromString = "From " . $fromString . " " . scalar localtime() . "\n" ; 
    
    if ($useSpool) {
	# send From_line and created multipart message to the specified spool/file
	open SPOOL, "$spool" or
	    die "Can't open output: $spool";
	print SPOOL "\n" ;
	print SPOOL $fromString ; 
	$msg->print(\*SPOOL);
	print SPOOL "\n\n" ;
	close SPOOL;
    }

    # mail fowarding stuff goes here
    if ($useForward) {
	$smtp->mail($sendFromAddress);
	$smtp->to($sendToAddress);	
	$smtp->data();
	$smtp->datasend($msg->stringify);
	$smtp->dataend();	
    }
    
    $downloadCount = $downloadCount +1 ;
    print $downloadCount%10 ;         # output one digit for every completed message
    
}

if ($useForward) {
    $smtp->quit;  
}

print "\nFinished downloading $downloadCount messages.\n";

if ( ! $noDelete) {    
    $delurl = $delurl . "\&.crumb=$crumb";
    $request = GET  $delurl ;
    $response = $ua->simple_request($request) ||
	die "Failed to delete messages.\n";
    
    # if we fail try again once
    if (($response->content) =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s)
    {
	$response = $ua->simple_request($request) ||
	    die "Failed to delete messages.\n";
	
	if (($response->content) 
	    =~ /<head><title>Yahoo\!\s*-\s*404 Not Found<\/title>/s )
	{ die "Failed to delete messages.\n"; }
    }
    
    print $delCount . " message(s) have been deleted.\n";
} else { print "Messages have not been deleted.\n"; }


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

# return the URL we're redirected to
sub GetRedirectUrl($) {
    my $response = $_[0];
    my $url = $response->header('Location') || return undef;
    
    # the Location URL is sometimes non-absolute which is not allowed, fix it
    local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
    my $base = $response->base;
    $url = $HTTP::URI_CLASS->new($url, $base)->abs($base);
    
    return $url;
}

sub PopulateMap() {

$map{af}  =  "audio/aiff" ;
$map{ai}  =  "application/postscript" ;
$map{aiff}  =  "audio/aiff" ;
$map{asc}  =  "text/plain" ;
$map{au}  =  "audio/basic" ;
$map{au}  =  "audio/x-pn-au" ;
$map{avi}  =  "video/x-msvideo" ;
$map{bcpio}  =  "application/x-bcpio" ;
$map{bin}  =  "application/octet-stream" ;
$map{cdf}  =  "application/x-netcdf" ;
$map{cpio}  =  "application/x-cpio" ;
$map{cpt}  =  "application/mac-compactpro" ;
$map{csh}  =  "application/x-csh" ;
$map{css}  =  "text/css" ;
$map{dcr}  =  "application/x-director" ;
$map{dir}  =  "application/x-director" ;
$map{dms}  =  "application/octet-stream" ;
$map{doc}  =  "application/msword" ;
$map{dvi}  =  "application/x-dvi" ;
$map{dxr}  =  "application/x-director" ;
$map{eps}  =  "application/postscript" ;
$map{etx}  =  "text/x-setext" ;
$map{exe}  =  "application/octet-stream" ;
$map{ez}  =  "application/andrew-inset" ;
$map{gif}  =  "image/gif" ;
$map{gz}  = "application/x-gzip" ;
$map{gtar}  =  "application/x-gtar" ;
$map{hdf}  =  "application/x-hdf" ;
$map{hqx}  =  "application/mac-binhex40" ;
$map{html}  =  "text/html" ;
$map{htm}  =  "text/html" ;
$map{ice}  =  "x-conference/x-cooltalk" ;
$map{ief}  =  "image/ief" ;
$map{iges}  =  "model/iges" ;
$map{igs}  =  "model/iges" ;
$map{jpeg}  =  "image/jpeg" ;
$map{jpe}  =  "image/jpeg" ;
$map{jpg}  =  "image/jpeg" ;
$map{js}  =  "application/x-javascript" ;
$map{kar}  =  "audio/midi" ;
$map{latex}  =  "application/x-latex" ;
$map{lha}  =  "application/octet-stream" ;
$map{lzh}  =  "application/octet-stream" ;
$map{man}  =  "application/x-troff-man" ;
$map{me}  =  "application/x-troff-me" ;
$map{mesh}  =  "model/mesh" ;
$map{mid}  =  "audio/midi" ;
$map{midi}  =  "audio/midi" ;
$map{mif}  =  "application/vnd.mif" ;
$map{movie}  =  "video/x-sgi-movie" ;
$map{mov}  =  "video/quicktime" ;
$map{mp2}  =  "audio/mpeg" ;
$map{mp3}  =  "audio/mpeg" ;
$map{mpeg}  =  "video/mpeg" ;
$map{mpe}  =  "video/mpeg" ;
$map{mpga}  =  "audio/mpeg" ;
$map{mpg}  =  "video/mpeg" ;
$map{ms}  =  "application/x-troff-ms" ;
$map{msh}  =  "model/mesh" ;
$map{nc}  =  "application/x-netcdf" ;
$map{oda}  =  "application/oda" ;
$map{pbm}  =  "image/x-portable-bitmap" ;
$map{pdb}  =  "chemical/x-pdb" ;
$map{pdf}  =  "application/pdf" ;
$map{pgm}  =  "image/x-portable-graymap" ;
$map{pgn}  =  "application/x-chess-pgn" ;
$map{png}  =  "image/png" ;
$map{pnm}  =  "image/x-portable-anymap" ;
$map{ppm}  =  "image/x-portable-pixmap" ;
$map{ppt}  =  "application/vnd.ms-powerpoint" ;
$map{ps}  =  "application/postscript" ;
$map{qt}  =  "video/quicktime" ;
$map{ra}  =  "audio/x-realaudio" ;
$map{ram}  =  "audio/x-pn-realaudio" ;
$map{ras}  =  "image/x-cmu-raster" ;
$map{rf}  =  "image/vnd.rn-realflash" ;
$map{rgb}  =  "image/x-rgb" ;
$map{rm}  =  "application/vnd.rn-realmedia" ;
$map{rmm}  =  "audio/x-pn-realaudio" ;
$map{roff}  =  "application/x-troff" ;
$map{rp}  =  "image/vnd.rn-realpix" ;
$map{rtf}  =  "text/rtf" ;
$map{rt}  =  "text/vnd.rn-realtext" ;
$map{rtx}  =  "text/richtext" ;
$map{rv}  =  "video/vnd.rn-realvideo" ;
$map{sdp}  =  "application/sdp" ;
$map{sgml}  =  "text/sgml" ;
$map{sgm}  =  "text/sgml" ;
$map{sh}  =  "application/x-sh" ;
$map{shar}  =  "application/x-shar" ;
$map{silo}  =  "model/mesh" ;
$map{sit}  =  "application/x-stuffit" ;
$map{skd}  =  "application/x-koan" ;
$map{skm}  =  "application/x-koan" ;
$map{skp}  =  "application/x-koan" ;
$map{skt}  =  "application/x-koan" ;
$map{smi}  =  "application/smil" ;
$map{smil}  =  "application/smil" ;
$map{spl}  =  "application/x-futuresplash" ;
$map{src}  =  "application/x-wais-source" ;
$map{sv4cpio}  =  "application/x-sv4cpio" ;
$map{sv4crc}  =  "application/x-sv4crc" ;
$map{swf}  =  "application/x-shockwave-flash" ;
$map{t}  =  "application/x-troff" ;
$map{tar}  =  "application/x-tar" ;
$map{tcl}  =  "application/x-tcl" ;
$map{tex}  =  "application/x-tex" ;
$map{texi}  =  "application/x-texinfo" ;
$map{texinfo}  =  "application/x-texinfo" ;
$map{tgz}  = "application/x-gzip" ;
$map{tiff}  =  "image/tiff" ;
$map{tif}  =  "image/tiff" ;
$map{tr}  =  "application/x-troff" ;
$map{tsv}  =  "text/tab-separated-values" ;
$map{txt}  =  "text/plain" ;
$map{ustar}  =  "application/x-ustar" ;
$map{vcd}  =  "application/x-cdlink" ;
$map{vrml}  =  "model/vrml" ;
$map{wav}  =  "audio/wav" ;
$map{wdf}  =  "text/x-wdf" ;
$map{wrl}  =  "model/vrml" ;
$map{xbm}  =  "image/x-xbitmap" ;
$map{xml}  =  "text/xml" ;
$map{xpm}  =  "image/x-xpixmap" ;
$map{xwd}  =  "image/x-xwindowdump" ;
$map{xyz}  =  "chemical/x-pdb" ;
$map{zip}  =  "application/zip" ;
}

sub ParseConfigFile() {

    if ($altConfigFile) {
	open(CONFIGFILE,$altConfigFile) || die "Can't open config file $altConfigFile\n" ; 
    }  else {
	open(CONFIGFILE, $ENV{"HOME"} . "/.fetchyahoorc") || 
	    open(CONFIGFILE,"/etc/fetchyahoorc") || return;
    }

    while (<CONFIGFILE>) {
	next if (/^\s*\#/);              # ignore lines with starting with a #

 	if (/username\s*=\s*(.*?)\s*$/i) {
 	    $username = $1;
 	} elsif (/password\s*=\s*(.*?)\s*$/i) {
 	    $password = $1;

 	} elsif (/use-spool\s*=\s*(.*?)\s*$/i) {
 	    $useSpool = $1;
 	} elsif (/spool\s*=\s*(.*?)\s*$/i) {
 	    $spoolName = $1;
	} elsif (/spool-mode\s*=\s*(.*?)\s*$/i) {
 	    $spoolMode = $1;

	} elsif (/use-proxy\s*=\s*(.*?)\s*$/i) {
 	    $useProxy = $1;
 	} elsif (/proxy-host\s*=\s*(.*?)\s*$/i) {
 	    $proxyHost = $1;
	} elsif (/proxy-port\s*=\s*(.*?)\s*$/i) {
 	    $proxyPort = $1;
	
	} elsif (/use-forward\s*=\s*(.*?)\s*$/i) {
 	    $useForward = $1;
 	} elsif (/mail-host\s*=\s*(.*?)\s*$/i) {
 	    $mailHost = $1;
	} elsif (/send-to\s*=\s*(.*?)\s*$/i) {
 	    $sendToAddress = $1;
	} elsif (/send-from\s*=\s*(.*?)\s*$/i) {
 	    $sendFromAddress = $1;
	
 	} elsif (/new-messages-only\s*=\s*(.*?)\s*$/i) {
 	    $newOnly = $1;
 	} elsif (/no-delete\s*=\s*(.*?)\s*$/i) {
 	    $noDelete = $1;
	} elsif (/use-https\s*=\s*(.*?)\s*$/i) {
 	    $useHTTPS = $1;
	}
	
    }
    close(CONFIGFILE);
}

sub Localize($) {
    my ($cc) = @_;
    my $strings;
    my %localized_strings = ('us' => {'msg_range' => 'showing (\d+)-(\d+) of (\d+)',
                                      'no_msgs'   => 'Folder\s*Inbox\s*has\s*no\s+',
                                      'p_view'    => 'Printable\&nbsp;View',
                                      'headers'   => {'To:'              => 'To:',
                                                      'From:'            => 'From:',
                                                      'Subject:'         => 'Subject:',
                                                      'Date:'            => 'Date:',
                                                      'Reply-To:'        => 'Reply-To:'
                                                     }
				     },
                             'fr' => {'msg_range' => '(\d+)-(\d+) sur (\d+)',
                                      'no_msgs'   => 'Dossier\s*Boîte\s*de\s*réception\s*sans\s*messages',
                                      'p_view'    => 'Version\&nbsp;imprimable',
                                      'headers'   => {'À:'          => 'To:',
                                                      'De:'         => 'From:',
                                                      'Objet:'      => 'Subject:',
                                                      'Répondre à:' => 'Reply-To:',
                                                      'Date:'       => 'Date:'
                                                     }
                                     },
                             'es' => {'msg_range' => 'Mostrando (\d+)-(\d+) de (\d+)',
                                      'no_msgs'   => 'La\s*carpeta\s*Bandeja\s*de\s*entrada\s*está\s*vacía',
                                      'p_view'    => 'Vista para imprimir',
                                      'headers'   => {'Para:'        => 'To:',
                                                      'De:'          => 'From:',
                                                      'Asunto:'      => 'Subject:',
                                                      'Responder a:' => 'Reply-To:',
                                                      'Fecha:'       => 'Date:'
                                                     }
                                      },
                             'de' => {'msg_range' => 'werden (\d+)-(\d+) von (\d+)',
                                      'no_msgs'   => 'Der\s*Ordner\s*Posteingang\s*hat\s*keine\s*Nachrichten',
                                      'p_view'    => 'Druckansicht',
                                      'headers'   => {'An:'                 => 'To:',
                                                      'Von:'                => 'From:',
                                                      'Betreff:'            => 'Subject:',
                                                      'Antwort-an-Adresse:' => 'Reply-To:',
                                                      'Datum:'              => 'Date:'
                                                     }
                                     },
                             'it' => {'msg_range' => 'mostra (\d+)-(\d+) di (\d+)',
                                      'no_msgs'   => 'La\s*cartella\s*In\s*arrivo\s*non\s*contiene\s*messaggi',
                                      'p_view'    => 'Anteprima&nbsp;di&nbsp;stampa',
                                      'headers'   => {'A:'        => 'To:',
                                                      'Da:'       => 'From:',
                                                      'Oggetto:'  => 'Subject:',
                                                      'Rispondi:' => 'Reply-To:',
                                                      'Data:'     => 'Date:'
                                                     }
                                     },
                             'br' => {'msg_range' => 'exibindo (\d+)-(\d+) de (\d+)',
                                      'no_msgs'   => 'A\s*pasta\s*Caixa\s*de\s*entrada\s*não',
                                      'p_view'    => 'Visualizar&nbsp;impressão',
                                      'headers'   => {'Para:'           => 'To:',
                                                      'De:'             => 'From:',
                                                      'Assunto:'        => 'Subject:',
                                                      'Responder-para:' => 'Reply-To:',
                                                      'Data:'           => 'Date:'
                                                     }
                                     }
                            );
			 
    if ($strings = $localized_strings{$cc}) {
        return %$strings;
    } else {
        return 0;
    }
}

sub Clean($) {
    my ($string) = @_;

    $string =~ s/<.*?>//gs ;     # strip all raw html tags
    $string =~ s/\&\#34;/\"/g ;  # convert html character codes 
    $string =~ s/\&\#39;/\'/g ;
    $string =~ s/\&\#147;/\"/g ;
    $string =~ s/\&\#148;/\"/g ;
    $string =~ s/\&\#183;/./g ;
    $string =~ s/\&\#8217;/\'/g ;
    $string =~ s/\&\#8220;/\"/g ;
    $string =~ s/\&\#8221;/\"/g ;
    $string =~ s/\&\#8230;/.../g ;
    $string =~ s/\&nbsp;/ /gi ;
    $string =~ s/\&lt;/</gi ; 
    $string =~ s/\&gt;/>/gi ; 
    $string =~ s/\&amp;/\&/gi ;   
    $string =~ s/\&quot;/\"/gi ;
    $string =~ s/^\s+//g;
    return $string;
}