use
5.010;
our
$VERSION
=
'0.06'
;
has
auth
=> (
is
=>
'ro'
,
);
has
bucket
=> (
is
=>
'ro'
,
required
=> 1,
);
has
rsapi
=> (
is
=>
'rw'
,
);
has
ua
=> (
is
=>
'rw'
,
default
=>
sub
{
return
Mojo::UserAgent->new },
);
has
upapi
=> (
is
=>
'rw'
,
);
sub
upload_file {
my
(
$self
,
$token
,
$local_file
,
$key
) =
@_
;
my
$ua
= Mojo::UserAgent->new;
return
$ua
->post(
$self
->
upapi
=>
form
=> {
key
=>
$key
,
token
=>
$token
,
file
=> {
file
=>
$local_file
}}
)->res->json;
}
sub
upload_data {
my
(
$self
,
$token
,
$data
,
$key
) =
@_
;
my
$ua
= Mojo::UserAgent->new;
return
$ua
->post(
$self
->
upapi
=>
form
=> {
key
=>
$key
,
token
=>
$token
,
file
=> {
filename
=>
$key
,
content
=>
$data
,
}}
)->res->json;
}
sub
upload_stream {
my
(
$self
,
$token
,
$local_file
,
$key
,
$mimetype
) =
@_
;
my
$ua
= Mojo::UserAgent->new;
my
$file
= Mojo::Asset::File->new(
path
=>
$local_file
);
my
$length
=
$file
->size;
my
@blocks
= split_range(
$length
);
my
@ctx
;
for
my
$block_nu
( 0 ..
$#blocks
) {
my
$block
=
$blocks
[
$block_nu
];
my
$block_data
=
$file
->get_chunk(
$block
->{start_range},
$block
->{max});
my
$mkblkAPI
=
$self
->upapi .
'/mkblk/'
.
$block
->{end_range};
my
$chunk_data
= Mojo::Asset::Memory->new->add_chunk(
$block_data
);
my
@chunk
= split_range(
$chunk_data
->size, 1 * (1024 ** 2));
my
$result
;
for
my
$nu
(0..
$#chunk
) {
my
$chunk_info
=
$chunk
[
$nu
];
my
$mkblkAPI
=
$self
->upapi .
'/mkblk/'
.
$block
->{max};
if
(
$nu
!= 0) {
$mkblkAPI
=
$self
->upapi .
'/bput/'
.
$result
->{ctx} .
'/'
.
$chunk_info
->{start_range};
}
my
$bput_data
=
$chunk_data
->get_chunk(
$chunk_info
->{start_range},
$chunk_info
->{max});
$result
=
$ua
->post(
$mkblkAPI
=>
{
'Content-Length'
=>
$chunk_info
->{max},
'Content-Type'
=>
'application/octet-stream'
,
'Authorization'
=>
'UpToken '
.
$token
,
},
$bput_data
)->res->json;
$ctx
[
$block_nu
] =
$result
->{ctx};
}
}
my
$mkfile_api
=
$self
->upapi .
'/mkfile/'
.
$length
.
'/key/'
. safe_b64_encode(
$key
);
$mkfile_api
=
defined
$mimetype
?
$mkfile_api
.
"/mimeType/"
. safe_b64_encode(
'video/mp4'
) :
$mkfile_api
;
my
$data
=
join
(
','
,
@ctx
);
return
$ua
->post(
$mkfile_api
=> {
'Content-Type'
=>
'text/plain'
,
'Authorization'
=>
'UpToken '
.
$token
,
} =>
$data
)->res->json;
}
sub
stat
{
my
$self
=
shift
;
my
$op
=
'/stat/'
. encoded_entry_uri(
$self
->bucket,
shift
);
return
$self
->rsget(
$op
);
}
sub
copy {
my
$self
=
shift
;
my
$op
=
'/copy/'
. encoded_entry_uri(
$self
->bucket,
$_
[0]) .
'/'
. encoded_entry_uri(
$self
->bucket,
$_
[1]);
return
$self
->rsget(
$op
);
}
sub
move {
my
$self
=
shift
;
my
$op
=
'/move/'
. encoded_entry_uri(
$self
->bucket,
$_
[0]) .
'/'
. encoded_entry_uri(
$self
->bucket,
$_
[1]);
return
$self
->rsget(
$op
);
}
sub
delete
{
my
$self
=
shift
;
my
$op
=
'/delete/'
. encoded_entry_uri(
$self
->bucket,
shift
);
return
$self
->rsget(
$op
);
}
sub
list {
my
$self
=
shift
;
my
$args
=
shift
;
$args
->{bucket} ||=
$self
->bucket;
my
$params
= Mojo::Parameters->new(
%$args
);
$self
->register_token(
$self
->ua);
my
$tx
=
$self
->ua->post(
$url
);
if
(
my
$res
=
$tx
->success) {
return
$res
->json;
}
else
{
my
$err
=
$tx
->error;
return
"$err->{code} response: $err->{message}"
if
$err
->{code};
return
"Connection error: $err->{message}"
;
}
}
sub
register_token {
my
(
$self
,
$ua
) = (
shift
,
shift
);
$ua
->on(
start
=>
sub
{
my
(
$ua
,
$tx
) =
@_
;
my
$signingStr
=
$tx
->req->url->path_query .
"\n"
;
if
(
$tx
->req->body) {
$signingStr
=
$signingStr
.
"\n"
.
$tx
->req->body;
$tx
->req->headers->header(
'Content-Type'
=>
'application/x-www-form-urlencoded'
);
}
my
$manage_token
=
$self
->auth->manage_token(
$signingStr
);
$tx
->req->headers->header(
'Authorization'
=>
'QBox '
.
$manage_token
);
});
}
sub
rsget {
my
(
$self
,
$op
) =
@_
;
$self
->register_token(
$self
->ua);
my
$opapi
=
$self
->rsapi .
$op
;
return
$self
->ua->post(
$opapi
)->res->json;
}
sub
split_range {
my
(
$length
,
$seg_size
) =
@_
;
$seg_size
||= 4 * (1024 ** 2);
my
$len_remain
=
$length
;
my
@ranges
;
while
(
$len_remain
> 0 ) {
my
$seg_len
=
$seg_size
;
my
$ofs
=
$length
-
$len_remain
;
$len_remain
-=
$seg_len
;
my
$tail
=
$ofs
+
$seg_len
;
if
(
$length
<
$tail
) {
$tail
=
$length
;
}
push
@ranges
, {
start_range
=>
$ofs
,
end_range
=>
$tail
,
max
=>
$tail
-
$ofs
,
};
}
return
@ranges
}
1;