ro
=> [
qw(buckets storage_path)
]
;
sub
new {
my
(
$class
,
%args
) =
@_
;
$args
{storage_path} ||= File::Temp::tempdir(
CLEANUP
=> 1 );
bless
{
buckets
=> {},
%args
},
$class
;
}
sub
start_request {}
sub
create_bucket {
my
(
$self
,
$args
) =
@_
;
my
$dir
= File::Spec->catdir(
$self
->storage_path,
$args
->{bucket_name} );
if
( ! -d
$dir
) {
if
(! File::Path::make_path(
$dir
, {
mode
=> 0755 } ) ) {
Carp::croak(
"Failed to create $dir: $!"
);
}
}
return
1;
}
sub
get_bucket {
my
(
$self
,
$args
) =
@_
;
my
$dir
= File::Spec->catdir(
$self
->storage_path,
$args
->{bucket_name} );
return
$dir
if
-d
$dir
;
}
sub
delete_bucket {
my
(
$self
,
$args
) =
@_
;
my
$dir
=
$args
->{bucket};
return
File::Path::remove_tree(
$dir
);
}
sub
create_object {
my
(
$self
,
$args
) =
@_
;
my
$input
=
$args
->{input};
my
$content
=
$args
->{content};
my
$file
= File::Spec->catfile(
$args
->{bucket},
$args
->{object_name} );
my
$dir
= File::Basename::dirname(
$file
);
if
(! -d
$dir
) {
if
(! File::Path::make_path(
$dir
, {
mode
=> 0755 } ) ) {
Carp::croak(
"Failed to create directory $dir: $!"
);
}
}
open
my
$fh
,
'>'
,
$file
or
Carp::croak(
"Failed to open file $file for writing: $!"
);
print
$fh
$input
?
do
{
local
$/; <
$input
> } :
$content
;
close
(
$fh
);
1;
}
sub
is_valid_object {
my
(
$self
,
$args
) =
@_
;
my
$file
= File::Spec->catfile(
$args
->{bucket},
$args
->{object_name} );
return
-f
$file
;
}
sub
get_object {
my
(
$self
,
$args
) =
@_
;
my
$file
= File::Spec->catfile(
$args
->{bucket},
$args
->{object_name} );
return
unless
-f
$file
;
my
@stat
=
stat
(
$file
);
if
(
my
$ims
=
$args
->{request}->header(
'if-modified-since'
) ) {
if
(
$stat
[9] > HTTP::Date::str2time(
$ims
) ) {
return
STF::Dispatcher::PSGI::HTTPException->throw( 304, [], [] );
}
}
open
my
$fh
,
'<'
,
$file
or Carp::croak(
"Failed to open file $file for reading: $!"
);
return
STF::Dispatcher::Impl::File::Object->new(
modified_on
=>
$stat
[9],
content
=>
do
{
local
$/; <
$fh
> },
);
}
sub
modify_object {
return
1;
}
sub
delete_object {
my
(
$self
,
$args
) =
@_
;
my
$file
= File::Spec->catfile(
$args
->{bucket},
$args
->{object_name} );
return
unless
-f
$file
;
unlink
$file
;
}
package
STF::Dispatcher::Impl::File::Object;
new
=> 1,
ro
=> [
qw(content_type content modified_on)
]
;
1;