internet.pm

ARM上的如果你对底层感兴趣

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);