The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# TEST.PL for the Win32::Internet Package
# Version 0.08
# by Aldo Calpini (dada@perl.it)

use Win32::Internet;

print "\nWin32::Internet TEST\n\n";

$I = new Win32::Internet();
# [dada] technical info...
# print "I.handle=".$I->{'handle'}."\n";

($v_package, $v_dll) = $I->Version();

print "Package Version: $v_package\n";
#if($v_package ne "0.08") {
#    print "*** WARNING: Your Win32::Internet package is outdated!\n".
#          "    The latest version is 0.08.\n".
#          "    Please download and install Win32Internet-0.08.zip\n".
#          "    from: http://www.divinf.it/dada/perl/internet...\n\n";
#}

print "DLL Version: $v_dll\n";
#if($v_dll ne "4.70.1215") {
#    print "*** WARNING: Your WININET.DLL is outdated!\n".
#          "    The latest version is 4.70.1215.\n".
#          "    Please download and install WinInet.zip\n".
#          "    from: http://www.divinf.it/dada/perl/internet...\n\n";
#}

print "\n--- CONNECTION INFO --------------------\n";

$whoami = $I->UserAgent();

$I->ConnectTimeout(10000); # sets 10 seconds max timeout
$I->ConnectRetries(1);     # sets 1 retry

print "UserAgent: $whoami\n";
print "ConnectTimeout: ",        $I->ConnectTimeout(),        "\n";
print "ConnectRetries: ",        $I->ConnectRetries(),        "\n";
print "ConnectBackoff: ",        $I->ConnectBackoff(),        "\n";
print "DataSendTimeout: ",       $I->DataSendTimeout(),       "\n";
print "DataReceiveTimeout: ",    $I->DataReceiveTimeout(),    "\n";
print "ControlSendTimeout: ",    $I->ControlSendTimeout(),    "\n";
print "ControlReceiveTimeout: ", $I->ControlReceiveTimeout(), "\n";
print "----------------------------------------\n";


##############################################################################
# GENERIC URL FETCHER

# [dada] this works... 1MB on screen
# $file = $I->FetchURL("ftp://ftp.divinf.it/pub/perl/110-i86.zip");

$URL = "http://www.yahoo.com";

# [dada] for my LAN testing
# $URL = "http://intra.sisnet.it";

print "Fetching URL '$URL'...\n";
$file = $I->FetchURL($URL);
$err = $I->Error();
print "*** Error: $err\n" if !$file;
if($file) {
    print "    File is ".length($file)." bytes long.\n";
    # print "----------------------------------\n";
    # print $file;
    # print "----------------------------------\n";
}
print "\n";

# [dada] An alternative way is...
#
# $result = $I->OpenURL($U, $URL);
# $file = $U->ReadEntireFile();
# $U->Close();


##############################################################################
# FTP STUFF

$host = "ftp.activestate.com";
$user = "anonymous";
$pass = "libwin32\@automated-tests.com";

# [dada] for my LAN testing
# $host = "192.2.3.1";

print "Opening FTP connection to '$host' as '$user', '$pass'...\n";
$I->FTP($FTP, $host, $user, $pass);

if(!$FTP) {

    ($num, $text) = $I->Error();
    print "*** Error: [$num] $text\n";

} else {

    # print "    FTP.handle=" . $FTP->{'handle'} . "\n";

    print "    Pasvmode is:   ", $FTP->Pasv(), "\n";
    print "    Binamode is:   ", $FTP->Mode(), "\n";
    print "--- Server replied -----------------------\n";
    print $FTP->GetResponse();
    print "\n----------------------------------------\n";
    
    $path = $FTP->Pwd();
    $err = $FTP->Error();
    print "    Error: $err\n";
    print "    Current directory is '$path'\n" if ! $result;
    
    $dir = "/contrib";
    print "Trying 'cd $dir'...\n";
    $result = $FTP->Cd($dir);
    $err = $FTP->Error();
    print "*** Error: $err\n" if ! $result;

    $path = $FTP->Pwd();
    if($path) {
        print "    Current directory is '$path'\n";
    } else {
        $err=$FTP->Error();
        print "*** Error: $err\n";
    }

    print "    Trying 'ls *.*' (method 1)...\n";
    @files = $FTP->List("*.*");
    $err = $FTP->Error();
    print "*** Error: $err\n" if ! @files;
    print "    Found $#files files.\n";
    if($#files>0) {
        foreach $file (@files) {
            print $file." ";
        }
        print "\n";
    }    

    print "    Trying 'ls *.*' (method 2)...\n";
    @files = $FTP->List("*.*", 2);
    $err = $FTP->Error();
    print "*** Error: $err\n" if ! @files;
    for($i = 0; $i <= $#files; $i += 7) {
        ($s, $m, $h, $D, $M, $Y) = split(",", $files[$i+6]);
        printf("%02d/%02d/%04d %02d:%02d:%02d ", $D, $M, $Y, $h, $m, $s);
        $size = $files[$i+2];
        printf("%12d ",$size);
        print $files[$i]."\n";
    }  

    print "    Trying 'ls *.*' (method 3)...\n";
    @files = $FTP->List("*.*", 3);
    $err = $FTP->Error();
    print "*** Error: $err\n" if ! @files;

    print "    Found $#files files.\n";
    if($#files>0) {
        foreach $file (@files) {
            print "-------------------------\n";
            print "Name    = $file->{'name'}\n";
            print "Altname = $file->{'altname'}\n";
            print "Size    = $file->{'size'}\n";
            print "Attr    = $file->{'attr'} (";
            print join(" ",$FTP->FileAttrInfo($file->{'attr'}));
            print ")\n";
            print "Ctime   = ";
            ($s, $m, $h, $D, $M, $Y) = split(",", $file->{'ctime'});
            printf("%02d/%02d/%04d %02d:%02d:%02d\n", $D, $M, $Y, $h, $m, $s);
            print "Atime   = ";
            ($s, $m, $h, $D, $M, $Y) = split(",", $file->{'atime'});
            printf("%02d/%02d/%04d %02d:%02d:%02d\n", $D, $M, $Y, $h, $m, $s);
            print "Mtime   = ";
            ($s, $m, $h, $D, $M, $Y) = split(",", $file->{'mtime'});
            printf("%02d/%02d/%04d %02d:%02d:%02d\n",$D, $M, $Y, $h, $m, $s);
        }
    }

    print "    Setting ASCII mode...\n";
    $FTP->Ascii();
    print "    Mode is now ",$FTP->Mode(),"\n";

    print "    Setting BINARY mode...\n";
    $FTP->Binary();
    print "    Mode is now ",$FTP->Mode(),"\n";

    print "    Trying 'get dde.zip'...\n";
    $result = $FTP->Get("dde.zip","dde.zip");
    $err = $FTP->Error();
    print "*** Error: $err\n" if ! $result;

    print "    Trying 'put test.pl'...\n";
    $result = $FTP->Put("test.pl","test.pl");
    $err = $FTP->Error();
    print "*** Error: $err\n" if ! $result;

    print "    Trying 'mkdir internet_testing'...\n";
    $result = $FTP->Mkdir("internet_testing");
    $err = $FTP->Error();
    print "*** Error: $err\n" if ! $result;

    print "    Trying 'rmdir internet_testing'...\n";
    $result = $FTP->Rmdir("internet_testing");
    $err = $FTP->Error();
    print "*** Error: $err\n" if ! $result;

    print "    Trying 'ren test.pl test.xxx'...\n";
    $result = $FTP->Rename("test.pl", "test.xxx");
    $err = $FTP->Error();
    print "*** Error: $err\n" if ! $result;

    print "    Trying 'del test.pl'...\n";
    $result = $FTP->Delete("test.pl");
    $err = $FTP->Error();
    print "*** Error: $err\n" if ! $result;

    print "    Trying 'del test.xxx'...\n";
    $result = $FTP->Del("test.xxx");
    $err = $FTP->Error();
    print "*** Error: $err\n" if ! $result;

    $FTP->Close();
}

##############################################################################
# HTTP STUFF

exit; # 25Aug2000 Jan Dubois
# Dada's server is often unavailalble, so we skip these test for the time being

$host = "www.divinf.it";
$user = "anonymous";
$pass = "dada\@perl.it";

# for my LAN testing
# $host = "intra.sisnet.it";

print "Opening HTTP connection to '$host' as '$user', '$pass'...\n";
$I->HTTP($HTTP, $host, $user, $pass);

if(!$HTTP) {
    ($num, $text)=$I->Error();
    print "*** Error: [$num] $text\n";

} else {

    # print "    HTTP.handle=".$HTTP->{'handle'}."\n";

    print "Requesting for '/'...\n";
    ($statuscode, $headers, $file) = $HTTP->Request("/");
    print "    Status Code=$statuscode\n";
    print "--- Headers ------------------------------\n";
    print $headers;
    print "\n----------------------------------------\n";
    print "    File is ",length($file)," bytes long.\n";

    # Alternatively:

    print "\nRequesting for '/' (with headers control)...\n";
    ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime();
    $ifmod = sprintf(qq/%s, %02d-%s-%02d %02d:%02d:%02d GMT/,
                     ("Sunday", "Monday", "Tuesday", "Wednesday",
                      "Thursday", "Friday", "Saturday")[$wday],
                     $mday,
                     ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
                      "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")[$mon],
                     $year,
                     $hour-1,
                     $min,
                     $sec);

    $result = $HTTP->OpenRequest($HREQ, "/");

    $result = $HREQ->AddHeader("If-Modified-Since: $ifmod\r\n");

    $result = $HREQ->SendRequest();

    $status = $HREQ->QueryInfo("",HTTP_QUERY_STATUS_CODE);
    print "    Status Code=$status\n";
    
    $agent = $HREQ->UserAgent();
    print "    Agent=$agent\n";

    $method = $HREQ->QueryInfo("",HTTP_QUERY_REQUEST_METHOD | HTTP_QUERY_FLAG_REQUEST_HEADERS);
    print "    Method=$method\n";

    $header = $HREQ->QueryInfo("",HTTP_QUERY_LAST_MODIFIED);
    # [dada] or: $header = $HREQ->QueryInfo("Last-Modified");
    print "    Last-Modified=$header\n";

    $header = $HREQ->QueryInfo("",HTTP_QUERY_SERVER);
    print "    Server=$header\n";

    $file = $HREQ->ReadEntireFile();

    print "    File is ",length($file)," bytes long.\n";
    $HREQ->Close();

}



##############################################################################
# EXITING

$host = "www.divinf.it";
$user = "anonymous";
$pass = "dada\@perl.it";

# [dada] for my LAN testing
# $host = "intra.sisnet.it";

$I->FTP($another, $host, $user, $pass); if($another) { ; }
$I->FTP($andanother, $host, $user, $pass); if($andanother) { ; }
$I->HTTP($andyetanother, $host, $user, $pass); if($andyetanother) { ; }

print "\nExiting with ", $I->Connections(), " open connections...\n";

# all connections left open will automatically be closed.
# if you don't trust me ;) use:
# $I->Close();