windows-xp/Source/XPSP1/NT/enduser/speech/lib/perl/win32/internet.pm

#######################################################################
#
# Win32::Internet - Perl Module for Internet Extensions
# ^^^^^^^^^^^^^^^
# This module creates an object oriented interface to the Win32
# Internet Functions (WININET.DLL).
#
# Version: 0.08 (14 Feb 1997)
#
#######################################################################

# changes:
# - fixed 2 bugs in Option(s) related subs
# - works with build 30x also

package Win32::Internet;

require Exporter;       # to export the constants to the main:: space
require DynaLoader;     # to dynuhlode the module.

# use Win32::WinError;    # for windows constants.

@ISA= qw( Exporter DynaLoader );
@EXPORT = qw(
    HTTP_ADDREQ_FLAG_ADD
    HTTP_ADDREQ_FLAG_REPLACE
    HTTP_QUERY_ALLOW
    HTTP_QUERY_CONTENT_DESCRIPTION
    HTTP_QUERY_CONTENT_ID
    HTTP_QUERY_CONTENT_LENGTH
    HTTP_QUERY_CONTENT_TRANSFER_ENCODING
    HTTP_QUERY_CONTENT_TYPE
    HTTP_QUERY_COST
    HTTP_QUERY_CUSTOM
    HTTP_QUERY_DATE
    HTTP_QUERY_DERIVED_FROM
    HTTP_QUERY_EXPIRES
    HTTP_QUERY_FLAG_REQUEST_HEADERS
    HTTP_QUERY_FLAG_SYSTEMTIME
    HTTP_QUERY_LANGUAGE
    HTTP_QUERY_LAST_MODIFIED
    HTTP_QUERY_MESSAGE_ID
    HTTP_QUERY_MIME_VERSION
    HTTP_QUERY_PRAGMA
    HTTP_QUERY_PUBLIC
    HTTP_QUERY_RAW_HEADERS
    HTTP_QUERY_RAW_HEADERS_CRLF
    HTTP_QUERY_REQUEST_METHOD
    HTTP_QUERY_SERVER
    HTTP_QUERY_STATUS_CODE
    HTTP_QUERY_STATUS_TEXT
    HTTP_QUERY_URI
    HTTP_QUERY_USER_AGENT
    HTTP_QUERY_VERSION
    HTTP_QUERY_WWW_LINK
    ICU_BROWSER_MODE
    ICU_DECODE
    ICU_ENCODE_SPACES_ONLY
    ICU_ESCAPE
    ICU_NO_ENCODE
    ICU_NO_META
    ICU_USERNAME
    INTERNET_CONNECT_FLAG_PASSIVE
    INTERNET_FLAG_ASYNC
    INTERNET_HYPERLINK
    INTERNET_FLAG_KEEP_CONNECTION
    INTERNET_FLAG_MAKE_PERSISTENT
    INTERNET_FLAG_NO_AUTH
    INTERNET_FLAG_NO_AUTO_REDIRECT
    INTERNET_FLAG_NO_CACHE_WRITE
    INTERNET_FLAG_NO_COOKIES
    INTERNET_FLAG_READ_PREFETCH
    INTERNET_FLAG_RELOAD
    INTERNET_FLAG_RESYNCHRONIZE
    INTERNET_FLAG_TRANSFER_ASCII
    INTERNET_FLAG_TRANSFER_BINARY
    INTERNET_INVALID_PORT_NUMBER
    INTERNET_INVALID_STATUS_CALLBACK
    INTERNET_OPEN_TYPE_DIRECT
    INTERNET_OPEN_TYPE_PROXY
    INTERNET_OPEN_TYPE_PROXY_PRECONFIG
    INTERNET_OPTION_CONNECT_BACKOFF
    INTERNET_OPTION_CONNECT_RETRIES
    INTERNET_OPTION_CONNECT_TIMEOUT
    INTERNET_OPTION_CONTROL_SEND_TIMEOUT
    INTERNET_OPTION_CONTROL_RECEIVE_TIMEOUT
    INTERNET_OPTION_DATA_SEND_TIMEOUT
    INTERNET_OPTION_DATA_RECEIVE_TIMEOUT
    INTERNET_OPTION_HANDLE_SIZE
    INTERNET_OPTION_LISTEN_TIMEOUT
    INTERNET_OPTION_PASSWORD
    INTERNET_OPTION_READ_BUFFER_SIZE
    INTERNET_OPTION_USER_AGENT
    INTERNET_OPTION_USERNAME
    INTERNET_OPTION_VERSION
    INTERNET_OPTION_WRITE_BUFFER_SIZE
    INTERNET_SERVICE_FTP
    INTERNET_SERVICE_GOPHER
    INTERNET_SERVICE_HTTP
    INTERNET_STATUS_CLOSING_CONNECTION
    INTERNET_STATUS_CONNECTED_TO_SERVER    
    INTERNET_STATUS_CONNECTING_TO_SERVER
    INTERNET_STATUS_CONNECTION_CLOSED
    INTERNET_STATUS_HANDLE_CLOSING
    INTERNET_STATUS_HANDLE_CREATED
    INTERNET_STATUS_NAME_RESOLVED
    INTERNET_STATUS_RECEIVING_RESPONSE
    INTERNET_STATUS_REDIRECT    
    INTERNET_STATUS_REQUEST_COMPLETE    
    INTERNET_STATUS_REQUEST_SENT    
    INTERNET_STATUS_RESOLVING_NAME    
    INTERNET_STATUS_RESPONSE_RECEIVED
    INTERNET_STATUS_SENDING_REQUEST    
);


#######################################################################
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function.  If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
#

sub AUTOLOAD {
    my($constname);
    ($constname = $AUTOLOAD) =~ s/.*:://;
    #reset $! to zero to reset any current errors.
    $!=0;
    my $val = constant($constname, @_ ? $_[0] : 0);
    if ($! != 0) {

        # [dada] This results in an ugly Autoloader error
        #if ($! =~ /Invalid/) {
        #  $AutoLoader::AUTOLOAD = $AUTOLOAD;
        #  goto &AutoLoader::AUTOLOAD;
        #} else {
      
        # [dada] ... I prefer this one :)
  
            ($pack,$file,$line) = caller; undef $pack;
            die "Win32::Internet::$constname is not defined, used at $file line $line.";
  
        #}
    }
    eval "sub $AUTOLOAD { $val }";
    goto &$AUTOLOAD;
}


#######################################################################
# STATIC OBJECT PROPERTIES
#
$VERSION = "0.08";

%callback_code = ();
%callback_info = ();


#######################################################################
# PUBLIC METHODS
#

#======== ### CLASS CONSTRUCTOR
sub new {
#========
    my($class, $useragent, $opentype, $proxy, $proxybypass, $flags) = @_;
    my $self = {};  

    if(ref($useragent) and ref($useragent) eq "HASH") {
        $opentype       = $useragent->{'opentype'};
        $proxy          = $useragent->{'proxy'};
        $proxybypass    = $useragent->{'proxybypass'};
        $flags          = $useragent->{'flags'};
        my $myuseragent = $useragent->{'useragent'};
        undef $useragent;
        $useragent      = $myuseragent;
    }

    $useragent = "Perl-Win32::Internet/".$VERSION       unless defined($useragent);
    $opentype = constant("INTERNET_OPEN_TYPE_DIRECT",0) unless defined($opentype);
    $proxy = ""                                         unless defined($proxy);
    $proxybypass = ""                                   unless defined($proxybypass);
    $flags = 0                                          unless defined($flags);


    my $handle = InternetOpen($useragent, $opentype, $proxy, $proxybypass, $flags);
    if ($handle) {
        $self->{'connections'} = 0;
        $self->{'pasv'}        = 0;
        $self->{'handle'}      = $handle; 
        $self->{'useragent'}   = $useragent;
        $self->{'proxy'}       = $proxy;
        $self->{'proxybypass'} = $proxybypass;
        $self->{'flags'}       = $flags;
        $self->{'Type'}        = "Internet";
    
        # [dada] I think it's better to call SetStatusCallback explicitly...
        #if($flags & constant("INTERNET_FLAG_ASYNC",0)) {
        #  my $callbackresult=InternetSetStatusCallback($handle);
        #  if($callbackresult==&constant("INTERNET_INVALID_STATUS_CALLBACK",0)) {
        #    $self->{'Error'} = -2;
        #  }
        #}

        bless $self;
    } else {
        $self->{'handle'} = undef;
        bless $self;
    }
    $self;
}  


#============
sub OpenURL {
#============
    my($self,$new,$URL) = @_;
    return undef unless ref($self);

    my $newhandle=InternetOpenUrl($self->{'handle'},$URL,"",0,0,0);
    if(!$newhandle) {
        $self->{'Error'} = "Cannot open URL.";
        return undef;
    } else {
        $self->{'connections'}++;
        $_[1] = _new($newhandle);
        $_[1]->{'Type'} = "URL";
        $_[1]->{'URL'}  = $URL;
        return $newhandle;
    }
}


#================
sub TimeConvert {
#================
    my($self, $sec, $min, $hour, $day, $mon, $year, $wday, $rfc) = @_;
    return undef unless ref($self);

    if(!defined($rfc)) {
        return InternetTimeToSystemTime($sec);
    } else {
        return InternetTimeFromSystemTime($sec, $min, $hour, 
                                          $day, $mon, $year, 
                                          $wday, $rfc);
    }
}


#=======================
sub QueryDataAvailable {
#=======================
    my($self) = @_;
    return undef unless ref($self);
  
    return InternetQueryDataAvailable($self->{'handle'});
}


#=============
sub ReadFile {
#=============
    my($self, $buffersize) = @_;
    return undef unless ref($self);

    my $howmuch = InternetQueryDataAvailable($self->{'handle'});
    $buffersize = $howmuch unless defined($buffersize);
    return InternetReadFile($self->{'handle'}, ($howmuch<$buffersize) ? $howmuch 
                                                                      : $buffersize);
}


#===================
sub ReadEntireFile {
#===================
    my($handle) = @_;
    my $content    = "";
    my $buffersize = 16000;
    my $howmuch    = 0;
    my $buffer     = "";

    $handle = $handle->{'handle'} if defined($handle) and ref($handle);

    $howmuch = InternetQueryDataAvailable($handle);
    # print "\nReadEntireFile: $howmuch bytes to read...\n";
  
    while($howmuch>0) {
        $buffer = InternetReadFile($handle, ($howmuch<$buffersize) ? $howmuch 
                                                                   : $buffersize);
        # print "\nReadEntireFile: ", length($buffer), " bytes read...\n";
    
        if(!defined($buffer)) {
            return undef;
        } else {
            $content .= $buffer;
        }
        $howmuch = InternetQueryDataAvailable($handle);
        # print "\nReadEntireFile: still $howmuch bytes to read...\n";
    
    }
    return $content;
}


#=============
sub FetchURL {
#=============
    # (OpenURL+Read+Close)...
    my($self, $URL) = @_;
    return undef unless ref($self);

    my $newhandle = InternetOpenUrl($self->{'handle'}, $URL, "", 0, 0, 0);
    if(!$newhandle) {
        $self->{'Error'} = "Cannot open URL.";
        return undef;
    } else {
        my $content = ReadEntireFile($newhandle);
        InternetCloseHandle($newhandle);
        return $content;
    }
}


#================
sub Connections {
#================
    my($self) = @_;
    return undef unless ref($self);

    return $self->{'connections'} if $self->{'Type'} eq "Internet";
    return undef;
}


#================
sub GetResponse {
#================
    my($num, $text) = InternetGetLastResponseInfo();
    return $text;
}

#===========
sub Option {
#===========
    my($self, $option, $value) = @_;
    return undef unless ref($self);

    my $retval = 0;

    $option = constant("INTERNET_OPTION_USER_AGENT", 0) unless defined($option);
  
    if(!defined($value)) {
        $retval = InternetQueryOption($self->{'handle'}, $option);
    } else {
        $retval = InternetSetOption($self->{'handle'}, $option, $value);
    }
    return $retval;
}


#==============
sub UserAgent {
#==============
    my($self, $value) = @_;
    return undef unless ref($self);

    return Option($self, constant("INTERNET_OPTION_USER_AGENT", 0), $value);
}


#=============
sub Username {
#=============
    my($self, $value) = @_;
    return undef unless ref($self);
  
    if($self->{'Type'} ne "HTTP" and $self->{'Type'} ne "FTP") {
        $self->{'Error'} = "Username() only on FTP or HTTP sessions.";
        return undef;
    }

    return Option($self, constant("INTERNET_OPTION_USERNAME", 0), $value);
}


#=============
sub Password {
#=============
    my($self, $value)=@_;
    return undef unless ref($self);

    if($self->{'Type'} ne "HTTP" and $self->{'Type'} ne "FTP") {
        $self->{'Error'} = "Password() only on FTP or HTTP sessions.";
        return undef;
    }

    return Option($self, constant("INTERNET_OPTION_PASSWORD", 0), $value);
}


#===================
sub ConnectTimeout {
#===================
    my($self, $value) = @_;
    return undef unless ref($self);

    return Option($self, constant("INTERNET_OPTION_CONNECT_TIMEOUT", 0), $value);
}


#===================
sub ConnectRetries {
#===================
    my($self, $value) = @_;
    return undef unless ref($self);

    return Option($self, constant("INTERNET_OPTION_CONNECT_RETRIES", 0), $value);
}


#===================
sub ConnectBackoff {
#===================
    my($self,$value)=@_;
    return undef unless ref($self);

    return Option($self, constant("INTERNET_OPTION_CONNECT_BACKOFF", 0), $value);
}


#====================
sub DataSendTimeout {
#====================
    my($self,$value) = @_;
    return undef unless ref($self);

    return Option($self, constant("INTERNET_OPTION_DATA_SEND_TIMEOUT", 0), $value);
}


#=======================
sub DataReceiveTimeout {
#=======================
    my($self, $value) = @_;
    return undef unless ref($self);

    return Option($self, constant("INTERNET_OPTION_DATA_RECEIVE_TIMEOUT", 0), $value);
}


#==========================
sub ControlReceiveTimeout {
#==========================
    my($self, $value) = @_;
    return undef unless ref($self);

    return Option($self, constant("INTERNET_OPTION_CONTROL_RECEIVE_TIMEOUT", 0), $value);
}


#=======================
sub ControlSendTimeout {
#=======================
    my($self, $value) = @_;
    return undef unless ref($self);

    return Option($self, constant("INTERNET_OPTION_CONTROL_SEND_TIMEOUT", 0), $value);
}


#================
sub QueryOption {
#================
    my($self, $option) = @_;
    return undef unless ref($self);

    return InternetQueryOption($self->{'handle'}, $option);
}


#==============
sub SetOption {
#==============
    my($self, $option, $value) = @_;
    return undef unless ref($self);

    return InternetSetOption($self->{'handle'}, $option, $value);
}


#=============
sub CrackURL {
#=============
    my($self, $URL, $flags) = @_;
    return undef unless ref($self);

    $flags = constant("ICU_ESCAPE", 0) unless defined($flags);
  
    my @newurl = InternetCrackUrl($URL, $flags);
  
    if(!defined($newurl[0])) {
        $self->{'Error'} = "Cannot crack URL.";
        return undef;
    } else {
        return @newurl;
    }
}


#==============
sub CreateURL {
#==============
    my($self, $scheme, $hostname, $port, 
       $username, $password, 
       $path, $extrainfo, $flags) = @_;
    return undef unless ref($self);

    if(ref($scheme) and ref($scheme) eq "HASH") {
        $flags       = $hostname;
        $hostname    = $scheme->{'hostname'};
        $port        = $scheme->{'port'};
        $username    = $scheme->{'username'};
        $password    = $scheme->{'password'};
        $path        = $scheme->{'path'};
        $extrainfo   = $scheme->{'extrainfo'};
        my $myscheme = $scheme->{'scheme'};
        undef $scheme;
        $scheme      = $myscheme;
    }

    $hostname  = ""                    unless defined($hostname);
    $port      = 0                     unless defined($port);
    $username  = ""                    unless defined($username);
    $password  = ""                    unless defined($password);
    $path      = ""                    unless defined($path);
    $extrainfo = ""                    unless defined($extrainfo);
    $flags = constant("ICU_ESCAPE", 0) unless defined($flags);
  
    my $newurl = InternetCreateUrl($scheme, $hostname, $port,
                                   $username, $password,
                                   $path, $extrainfo, $flags);
    if(!defined($newurl)) {
        $self->{'Error'} = "Cannot create URL.";
        return undef;
    } else {
        return $newurl;
    }
}


#====================
sub CanonicalizeURL {
#====================
    my($self, $URL, $flags) = @_;
    return undef unless ref($self);
  
    my $newurl = InternetCanonicalizeUrl($URL, $flags);
    if(!defined($newurl)) {
        $self->{'Error'} = "Cannot canonicalize URL.";
        return undef;
    } else {
        return $newurl;
    }
}


#===============
sub CombineURL {
#===============
    my($self, $baseURL, $relativeURL, $flags) = @_;
    return undef unless ref($self);
  
    my $newurl = InternetCombineUrl($baseURL, $relativeURL, $flags);
    if(!defined($newurl)) {
        $self->{'Error'} = "Cannot combine URL(s).";
        return undef;
    } else {
        return $newurl;
    }
}


#======================
sub SetStatusCallback {
#======================
    my($self) = @_;
    return undef unless ref($self);
  
    my $callback = InternetSetStatusCallback($self->{'handle'});
    print "callback=$callback, constant=",constant("INTERNET_INVALID_STATUS_CALLBACK", 0), "\n";
    if($callback == constant("INTERNET_INVALID_STATUS_CALLBACK", 0)) {
        return undef;
    } else {
        return $callback;
    }
}


#======================
sub GetStatusCallback {
#======================
    my($self, $context) = @_;
    $context = $self if not defined $context;
    return($callback_code{$context}, $callback_info{$context});
}


#==========
sub Error {
#==========
    my($self) = @_;
    return undef unless ref($self);
  
    my $errtext = "";
    my $tmp     = "";
    my $errnum  = Win32::GetLastError();

    if($errnum < 12000) {
        $errtext =  Win32::FormatMessage($errnum);
        $errtext =~ s/[\r\n]//g;
    } elsif($errnum == 12003) {
        ($tmp, $errtext) = InternetGetLastResponseInfo();
        chomp $errtext;
        1 while($errtext =~ s/(.*)\n//); # the last line should be significative... 
                                         # otherwise call GetResponse() to get it whole
    } elsif($errnum >= 12000) {
        $errtext = FormatMessage($errnum);
        $errtext =~ s/[\r\n]//g;        
    } else {
        $errtext="Error";
    }
    if($errnum == 0 and defined($self->{'Error'})) { 
        if($self->{'Error'} == -2) {
            $errnum  = -2;
            $errtext = "Asynchronous operations not available.";
        } else {
            $errnum  = -1;
            $errtext = $self->{'Error'};
        }
    }
    return (wantarray)? ($errnum, $errtext) : "\[".$errnum."\] ".$errtext;
}


#============
sub Version {
#============
    my $dll =  InternetDllVersion();
       $dll =~ s/\0//g;
    return (wantarray)? ($Win32::Internet::VERSION,    $dll) 
                      :  $Win32::Internet::VERSION."/".$dll;
}


#==========
sub Close {
#==========
    my($self, $handle) = @_;
    if(!defined($handle)) {
        return undef unless ref($self);
        $handle = $self->{'handle'};
    }
    InternetCloseHandle($handle);
}



#######################################################################
# FTP CLASS METHODS
#

#======== ### FTP CONSTRUCTOR
sub FTP {
#========
    my($self, $new, $server, $username, $password, $port, $pasv, $context) = @_;    
    return undef unless ref($self);

    if(ref($server) and ref($server) eq "HASH") {
        $port        = $server->{'port'};
        $username    = $server->{'username'};
        $password    = $password->{'host'};
        my $myserver = $server->{'server'};
        $pasv        = $server->{'pasv'};
        $context     = $server->{'context'};
        undef $server;
        $server      = $myserver;
    }
  
    $server   = ""          unless defined($server);
    $username = "anonymous" unless defined($username);
    $password = ""          unless defined($password);
    $port     = 21          unless defined($port);
    $context  = 0           unless defined($context);

    if(defined($pasv)) {
        $pasv=constant("INTERNET_CONNECT_FLAG_PASSIVE",0) if $pasv ne 0;
    } else {  
        $pasv=$self->{'pasv'};
    }
  
    my $newhandle = InternetConnect($self->{'handle'}, $server, $port,
                                    $username, $password,
                                    constant("INTERNET_SERVICE_FTP", 0),
                                    $pasv, $context);
    if($newhandle) {
        $self->{'connections'}++;
        $_[1] = _new($newhandle);
        $_[1]->{'Type'}     = "FTP";
        $_[1]->{'Mode'}     = "bin";
        $_[1]->{'pasv'}     = $pasv;
        $_[1]->{'username'} = $username;
        $_[1]->{'password'} = $password;
        $_[1]->{'server'}   = $server;
        return $newhandle;
    } else {
        return undef;
    }
}

#========
sub Pwd {
#========
    my($self) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
        $self->{'Error'} = "Pwd() only on FTP sessions.";
        return undef;
    }
  
    return FtpGetCurrentDirectory($self->{'handle'});
}


#=======
sub Cd {
#=======
    my($self, $path) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "FTP" || !defined($self->{'handle'})) {
        $self->{'Error'} = "Cd() only on FTP sessions.";
        return undef;
    }
  
    my $retval = FtpSetCurrentDirectory($self->{'handle'}, $path);
    if(!defined($retval)) {
        return undef;
    } else {
        return $path;
    }
}
#====================
sub Cwd   { Cd(@_); }
sub Chdir { Cd(@_); }
#====================


#==========
sub Mkdir {
#==========
    my($self, $path) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
        $self->{'Error'} = "Mkdir() only on FTP sessions.";
        return undef;
    }
  
    my $retval = FtpCreateDirectory($self->{'handle'}, $path);
    $self->{'Error'} = "Can't create directory." unless defined($retval);
    return $retval;
}
#====================
sub Md { Mkdir(@_); }
#====================


#=========
sub Mode {
#=========
    my($self, $value) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
        $self->{'Error'} = "Mode() only on FTP sessions.";
        return undef;
    }
  
    if(!defined($value)) {
        return $self->{'Mode'};
    } else {
        my $modesub = ($value =~ /^a/i) ? "Ascii" : "Binary";
        $self->$modesub($_[0]);
    }
    return $self->{'Mode'};
}


#==========
sub Rmdir {
#==========
    my($self, $path) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
        $self->{'Error'} = "Rmdir() only on FTP sessions.";
        return undef;
    }
    my $retval = FtpRemoveDirectory($self->{'handle'}, $path);
    $self->{'Error'} = "Can't remove directory." unless defined($retval);
    return $retval;
}
#====================
sub Rd { Rmdir(@_); }
#====================


#=========
sub Pasv {
#=========
    my($self, $value) = @_;
    return undef unless ref($self);

    if(defined($value) and $self->{'Type'} eq "Internet") {
        if($value == 0) {
            $self->{'pasv'} = 0;
        } else {
            $self->{'pasv'} = 1;
        }
    }
    return $self->{'pasv'};
}

#=========
sub List {
#=========
    my($self, $pattern, $retmode) = @_;
    return undef unless ref($self);

    my $retval = "";
    my $size   = ""; 
    my $attr   = ""; 
    my $ctime  = ""; 
    my $atime  = ""; 
    my $mtime  = "";
    my $csec = 0; my $cmin = 0; my $chou = 0; my $cday = 0; my $cmon = 0; my $cyea = 0;
    my $asec = 0; my $amin = 0; my $ahou = 0; my $aday = 0; my $amon = 0; my $ayea = 0;
    my $msec = 0; my $mmin = 0; my $mhou = 0; my $mday = 0; my $mmon = 0; my $myea = 0;
    my $newhandle = 0;
    my $nextfile  = 1;
    my @results   = ();
    my ($filename, $altname, $file);
  
    if($self->{'Type'} ne "FTP") {
        $self->{'Error'} = "List() only on FTP sessions.";
        return undef;
    }
  
    $pattern = "" unless defined($pattern);
    $retmode = 1  unless defined($retmode);

    if($retmode == 2) {
  
        ( $newhandle,$filename, $altname, $size, $attr,         
          $csec, $cmin, $chou, $cday, $cmon, $cyea,
          $asec, $amin, $ahou, $aday, $amon, $ayea,
          $msec, $mmin, $mhou, $mday, $mmon, $myea
        ) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
    
        if(!$newhandle) {
            $self->{'Error'} = "Can't read FTP directory.";
            return undef;
        } else {
    
            while($nextfile) {
                $ctime = join(",", ($csec, $cmin, $chou, $cday, $cmon, $cyea));
                $atime = join(",", ($asec, $amin, $ahou, $aday, $amon, $ayea));
                $mtime = join(",", ($msec, $mmin, $mhou, $mday, $mmon, $myea));
                push(@results, $filename, $altname, $size, $attr, $ctime, $atime, $mtime);
        
                ( $nextfile, $filename, $altname, $size, $attr,
                  $csec, $cmin, $chou, $cday, $cmon, $cyea,
                  $asec, $amin, $ahou, $aday, $amon, $ayea,
                  $msec, $mmin, $mhou, $mday, $mmon, $myea
                ) = InternetFindNextFile($newhandle);      
        
            }
            InternetCloseHandle($newhandle);
            return @results;
      
        }
    
    } elsif($retmode == 3) {
  
        ( $newhandle,$filename, $altname, $size, $attr,
          $csec, $cmin, $chou, $cday, $cmon, $cyea,
          $asec, $amin, $ahou, $aday, $amon, $ayea,
          $msec, $mmin, $mhou, $mday, $mmon, $myea
        ) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
    
        if(!$newhandle) {
            $self->{'Error'} = "Can't read FTP directory.";
            return undef;
       
        } else {
     
            while($nextfile) {
                $ctime = join(",", ($csec, $cmin, $chou, $cday, $cmon, $cyea));
                $atime = join(",", ($asec, $amin, $ahou, $aday, $amon, $ayea));
                $mtime = join(",", ($msec, $mmin, $mhou, $mday, $mmon, $myea));
                $file = { "name"     => $filename,
                          "altname"  => $altname,
                          "size"     => $size,
                          "attr"     => $attr,
                          "ctime"    => $ctime,
                          "atime"    => $atime,
                          "mtime"    => $mtime,
                };
                push(@results, $file);
         
                ( $nextfile, $filename, $altname, $size, $attr,
                  $csec, $cmin, $chou, $cday, $cmon, $cyea,
                  $asec, $amin, $ahou, $aday, $amon, $ayea,
                  $msec, $mmin, $mhou, $mday, $mmon, $myea
                ) = InternetFindNextFile($newhandle);
         
            }
            InternetCloseHandle($newhandle);
            return @results;
        }
    
    } else {
    
        ($newhandle, $filename) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
    
        if(!$newhandle) {
            $self->{'Error'} = "Can't read FTP directory.";
            return undef;
      
        } else {
    
            while($nextfile) {
                push(@results, $filename);
        
                ($nextfile, $filename) = InternetFindNextFile($newhandle);  
                # print "List.no more files\n" if !$nextfile;
        
            }
            InternetCloseHandle($newhandle);
            return @results;
        }
    }
}
#====================
sub Ls  { List(@_); }
sub Dir { List(@_); }
#====================


#=================
sub FileAttrInfo {
#=================
    my($self,$attr) = @_;
    my @attrinfo = ();
    push(@attrinfo, "READONLY")   if $attr & 1;
    push(@attrinfo, "HIDDEN")     if $attr & 2;
    push(@attrinfo, "SYSTEM")     if $attr & 4;
    push(@attrinfo, "DIRECTORY")  if $attr & 16;
    push(@attrinfo, "ARCHIVE")    if $attr & 32;
    push(@attrinfo, "NORMAL")     if $attr & 128;
    push(@attrinfo, "TEMPORARY")  if $attr & 256;
    push(@attrinfo, "COMPRESSED") if $attr & 2048;
    return (wantarray)? @attrinfo : join(" ", @attrinfo);
}


#===========
sub Binary {
#===========
    my($self) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "FTP") {
        $self->{'Error'} = "Binary() only on FTP sessions.";
        return undef;
    }
    $self->{'Mode'} = "bin";
    return undef;
}
#======================
sub Bin { Binary(@_); }
#======================


#==========
sub Ascii {
#==========
    my($self) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "FTP") {
        $self->{'Error'} = "Ascii() only on FTP sessions.";
        return undef;
    }
    $self->{'Mode'} = "asc";
    return undef;
}
#=====================
sub Asc { Ascii(@_); }
#=====================


#========
sub Get {
#========
    my($self, $remote, $local, $overwrite, $flags, $context) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "FTP") {
        $self->{'Error'} = "Get() only on FTP sessions.";
        return undef;
    }
    my $mode = ($self->{'Mode'} eq "asc" ? 1 : 2);
 
    $remote    = ""      unless defined($remote);
    $local     = $remote unless defined($local);
    $overwrite = 0       unless defined($overwrite);
    $flags     = 0       unless defined($flags);
    $context   = 0       unless defined($context);
  
    my $retval = FtpGetFile($self->{'handle'},
                            $remote,
                            $local,
                            $overwrite,
                            $flags,
                            $mode,
                            $context);
    $self->{'Error'} = "Can't get file." unless defined($retval);
    return $retval;
}


#===========
sub Rename {
#===========
    my($self, $oldname, $newname) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "FTP") {
        $self->{'Error'} = "Rename() only on FTP sessions.";
        return undef;
    }

    my $retval = FtpRenameFile($self->{'handle'}, $oldname, $newname);
    $self->{'Error'} = "Can't rename file." unless defined($retval);
    return $retval;
}
#======================
sub Ren { Rename(@_); }
#======================


#===========
sub Delete {
#===========
    my($self, $filename) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "FTP") {
        $self->{'Error'} = "Delete() only on FTP sessions.";
        return undef;
    }
    my $retval = FtpDeleteFile($self->{'handle'}, $filename);
    $self->{'Error'} = "Can't delete file." unless defined($retval);
    return $retval;
}
#======================
sub Del { Delete(@_); }
#======================


#========
sub Put {
#========
    my($self, $local, $remote, $context) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "FTP") {
        $self->{'Error'} = "Put() only on FTP sessions.";
        return undef;
    }
    my $mode = ($self->{'Mode'} eq "asc" ? 1 : 2);

    $context = 0 unless defined($context);
  
    my $retval = FtpPutFile($self->{'handle'}, $local, $remote, $mode, $context);
    $self->{'Error'} = "Can't put file." unless defined($retval);
    return $retval;
}


#######################################################################
# HTTP CLASS METHODS
#

#========= ### HTTP CONSTRUCTOR
sub HTTP {
#=========
    my($self, $new, $server, $username, $password, $port, $flags, $context) = @_;    
    return undef unless ref($self);

    if(ref($server) and ref($server) eq "HASH") {
        my $myserver = $server->{'server'};
        $username    = $server->{'username'};
        $password    = $password->{'host'};
        $port        = $server->{'port'};    
        $flags       = $server->{'flags'};
        $context     = $server->{'context'};
        undef $server;
        $server      = $myserver;
    }

    $server   = ""          unless defined($server);
    $username = "anonymous" unless defined($username);
    $password = ""          unless defined($username);
    $port     = 80          unless defined($port);
    $flags    = 0           unless defined($flags);
    $context  = 0           unless defined($context);
  
    my $newhandle = InternetConnect($self->{'handle'}, $server, $port,
                                    $username, $password,
                                    constant("INTERNET_SERVICE_HTTP", 0),
                                    $flags, $context);
    if($newhandle) {
        $self->{'connections'}++;
        $_[1] = _new($newhandle);
        $_[1]->{'Type'}     = "HTTP";
        $_[1]->{'username'} = $username;
        $_[1]->{'password'} = $password;
        $_[1]->{'server'}   = $server;
        $_[1]->{'accept'}   = "text/*\0image/gif\0image/jpeg";
        return $newhandle;
    } else {
        return undef;
    }
}


#================
sub OpenRequest {
#================
    # alternatively to Request:
    # it creates a new HTTP_Request object
    # you can act upon it with AddHeader, SendRequest, ReadFile, QueryInfo, Close, ...

    my($self, $new, $path, $method, $version, $referer, $accept, $flags, $context) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "HTTP") {
        $self->{'Error'} = "OpenRequest() only on HTTP sessions.";
        return undef;
    }

    if(ref($path) and ref($path) eq "HASH") {
        $method    = $path->{'method'};
        $version   = $path->{'version'};
        $referer   = $path->{'referer'};
        $accept    = $path->{'accept'};
        $flags     = $path->{'flags'};
        $context   = $path->{'context'};
        my $mypath = $path->{'path'};
        undef $path;
        $path      = $mypath;
    }

    $method  = "GET"             unless defined($method);
    $path    = "/"               unless defined($path);
    $version = "HTTP/1.0"        unless defined($version); 
    $referer = ""                unless defined($referer);
    $accept  = $self->{'accept'} unless defined($accept);
    $flags   = 0                 unless defined($flags);
    $context = 0                 unless defined($context);
  
    $path = "/".$path if substr($path,0,1) ne "/";  
  
    my $newhandle = HttpOpenRequest($self->{'handle'},
                                    $method,
                                    $path,
                                    $version,
                                    $referer,
                                    $accept,
                                    $flags,
                                    $context);
    if($newhandle) {
        $_[1] = _new($newhandle);
        $_[1]->{'Type'}    = "HTTP_Request";
        $_[1]->{'method'}  = $method;
        $_[1]->{'request'} = $path;
        $_[1]->{'accept'}  = $accept;
        return $newhandle;
    } else {
        return undef;
    }
}

#================
sub SendRequest {
#================
    my($self, $postdata) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "HTTP_Request") {
        $self->{'Error'} = "SendRequest() only on HTTP requests.";
        return undef;
    }
  
    $postdata = "" unless defined($postdata);

    return HttpSendRequest($self->{'handle'}, "", $postdata);
}


#==============
sub AddHeader {
#==============
    my($self, $header, $flags) = @_;
    return undef unless ref($self);
  
    if($self->{'Type'} ne "HTTP_Request") {
        $self->{'Error'} = "AddHeader() only on HTTP requests.";
        return undef;
    }
  
    $flags = constant("HTTP_ADDREQ_FLAG_ADD", 0) if (!defined($flags) or $flags == 0);

    return HttpAddRequestHeaders($self->{'handle'}, $header, $flags);
}


#==============
sub QueryInfo {
#==============
    my($self, $header, $flags) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "HTTP_Request") {
        $self->{'Error'}="QueryInfo() only on HTTP requests.";
        return undef;
    }
  
    $flags = constant("HTTP_QUERY_CUSTOM", 0) if (!defined($flags) and defined($header));
    my @queryresult = HttpQueryInfo($self->{'handle'}, $flags, $header);
    return (wantarray)? @queryresult : join(" ", @queryresult);
}


#============
sub Request {
#============
    # HttpOpenRequest+HttpAddHeaders+HttpSendRequest+InternetReadFile+HttpQueryInfo
    my($self, $path, $method, $version, $referer, $accept, $flags, $postdata) = @_;
    return undef unless ref($self);

    if($self->{'Type'} ne "HTTP") {
        $self->{'Error'} = "Request() only on HTTP sessions.";
        return undef;
    }

    if(ref($path) and ref($path) eq "HASH") {
        $method    = $path->{'method'};
        $version   = $path->{'version'};
        $referer   = $path->{'referer'};
        $accept    = $path->{'accept'};
        $flags     = $path->{'flags'};
        $postdata  = $path->{'postdata'};
        my $mypath = $path->{'path'};
        undef $path;
        $path      = $mypath;
    }

    my $content     = "";
    my $result      = "";
    my @queryresult = ();
    my $statuscode  = "";
    my $headers     = "";
  
    $path     = "/"               unless defined($path);
    $method   = "GET"             unless defined($method);
    $version  = "HTTP/1.0"        unless defined($version); 
    $referer  = ""                unless defined($referer);
    $accept   = $self->{'accept'} unless defined($accept);
    $flags    = 0                 unless defined($flags);
    $postdata = ""                unless defined($postdata);

    $path = "/".$path if substr($path,0,1) ne "/";  
  
    my $newhandle = HttpOpenRequest($self->{'handle'},
                                    $method,
                                    $path,
                                    $version,
                                    $referer,
                                    $accept,
                                    0,
                                    $flags);

    if($newhandle) {

        $result = HttpSendRequest($newhandle, "", $postdata);

        if(defined($result)) {
            $statuscode = HttpQueryInfo($newhandle,
                                        constant("HTTP_QUERY_STATUS_CODE", 0), "");
            $headers = HttpQueryInfo($newhandle,
                                     constant("HTTP_QUERY_RAW_HEADERS_CRLF", 0), "");
            $content = ReadEntireFile($newhandle);
               
            InternetCloseHandle($newhandle);
      
            return($statuscode, $headers, $content);
        } else {
            return undef;
        }
    } else {
        return undef;
    }
}


#######################################################################
# END OF THE PUBLIC METHODS
#


#========= ### SUB-CLASSES CONSTRUCTOR
sub _new {
#=========
    my $self = {};
    if ($_[0]) {
        $self->{'handle'} = $_[0];
        bless $self;
    } else {
        undef($self);
    }
    $self;
}


#============ ### CLASS DESTRUCTOR
sub DESTROY {
#============
    my($self) = @_;
    # print "Closing handle $self->{'handle'}...\n";
    InternetCloseHandle($self->{'handle'});
    # [dada] rest in peace
}


#=============
sub callback {
#=============
    my($name, $status, $info) = @_;
    $callback_code{$name} = $status;
    $callback_info{$name} = $info;
}

#######################################################################
# dynamically load in the Internet.pll module.
#

bootstrap Win32::Internet;

# Preloaded methods go here.

#Currently Autoloading is not implemented in Perl for win32
# Autoload methods go after __END__, and are processed by the autosplit program.

1;
__END__