view release on metacpan or  search on metacpan

lib/Net/UpYun.pm  view on Meta::CPAN

has agent => (   isa => 'Str',   is  => 'ro', default => 'Net::UpYun Client/'.$VERSION);

has timeout => (   isa => 'Int',   is  => 'ro', default => 30 );

has response => (
    isa => 'HTTP::Response',
    is  => 'ro',
    lazy_build => 1,
    init_arg => undef,
    writer => '_response',
    handles => {
        is_success => 'is_success',
        is_error => 'is_error',
        res_content => 'content',
        res_header => 'header',
        error_code => 'code',
        error_message => 'message',
    },
);

sub _build_response {
    my ($self) = @_;
    #body
    HTTP::Response->new;
}

sub do_request {
    my ($self,$uri,$method,$headers,$content) = @_;

    my $curl = $self->curl;
    $method = 'GET' unless $method;
    $content = '' unless $content;
    $headers = [] unless $headers;
    my $length = length($content);
    if ($method eq 'POST') {
        $curl->setopt(CURLOPT_CUSTOMREQUEST,undef);
        $curl->setopt(CURLOPT_POST, 1);
        $curl->setopt(CURLOPT_POSTFIELDS, $content);
        $curl->setopt(CURLOPT_POSTFIELDSIZE,length($content));
    }
    elsif ($method eq 'GET') {
        $curl->setopt(CURLOPT_CUSTOMREQUEST,undef);
        $curl->setopt(CURLOPT_HTTPGET, 1);
    }
    elsif ($method eq 'DELETE') {
        $curl->setopt(CURLOPT_CUSTOMREQUEST,'DELETE');
    }

    my $date = time2str( time );
    push @$headers,'Authorization: '.$self->sign($method,$uri,$length,$date);
    push @$headers,'Date: '.$date;

    $curl->setopt(CURLOPT_HTTPHEADER,$headers);
    $curl->setopt(CURLOPT_URL,$self->api_domain.$uri);

    # write buffer
    my ($res_body, $res_head) = ('','');
    open (my $fh_body, ">", \$res_body);
    $curl->setopt(CURLOPT_WRITEDATA,$fh_body);
    open (my $fh_head, ">", \$res_head);
    $curl->setopt(CURLOPT_WRITEHEADER,$fh_head);
    my $retcode = $curl->perform();
    if ($retcode == 0) {
        # say $res_head ."\n".$res_body;
        my $res = HTTP::Response->parse($res_head . "\r" . $res_body);
        $res->content($res_body);
        $self->_response($res);
    }
    else {
        Carp::croak("An error happened: ".$curl->strerror($retcode)." ($retcode)".$curl->errbuf."\n");
    }
}

sub sign {
    my ($self,$method,$uri,$length,$date) = @_;
    $date = time2str( time ) unless defined $date;
    my $sign_str = md5_hex($method.'&'.$uri.'&'.$date.'&'.$length.'&'.md5_hex($self->bucket_password));
    'UpYun '.$self->bucket_account.':'.$sign_str;
}


sub use_bucket {
    my ($self,$bucket,$bucket_account,$bucket_password) = @_;
    $self->_bucket($bucket);
    $self->_bucket_account($bucket_account);
    $self->_bucket_password($bucket_password);
    return $self;
}

sub _uri_path {
    my ($self,$path) = @_;
    '/'.$self->bucket.(substr($path,0,1) eq '/' ? '':'/').uri_escape("$path");
}

sub usage {
    my ($self,$dir) = @_;
    $self->do_request($self->_uri_path($dir || '').'?usage','GET');
    return $self->res_content if $self->is_success;
}

sub mkdir {
    my ($self,$dir) = @_;
    $self->do_request($self->_uri_path($dir),'POST',["folder: true"]);
    return $self->is_success;
}

sub delete {
    my ($self,$key) = @_;
    my $res = $self->do_request($self->_uri_path($key),'DELETE');
    return $self->is_success;
}

sub rmdir {
    my ($self,$dir) = @_;
    $self->do_request($self->_uri_path($dir),'DELETE');
    return $self->is_success;
}

sub put {
    my ($self,$key,$bytes) = @_;
    $self->do_request($self->_uri_path($key),'POST',["Mkdir: true",'Expect: '],$bytes);