internet.pm

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

                ( $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__