sub
new {
my
(
$class
,
%args
) =
@_
;
bless
{
headers
=>
$args
{headers},
tempname
=>
$args
{tempname},
size
=>
$args
{size},
filename
=>
$args
{filename},
},
$class
;
}
sub
filename {
$_
[0]->{filename} }
sub
headers {
$_
[0]->{headers} }
sub
size {
$_
[0]->{size} }
sub
tempname {
$_
[0]->{tempname} }
sub
type {
my
$self
=
shift
;
unless
(
$self
->{headers} &&
$self
->{headers}->can(
'content_type'
)) {
Carp::croak
'Cannot delegate type to content_type because the value of headers is not defined'
;
}
$self
->{headers}->content_type(
@_
);
}
sub
basename {
my
$self
=
shift
;
unless
(
defined
$self
->{basename}) {
my
$basename
=
$self
->{filename};
$basename
=~ s|\\|/|g;
$basename
= ( File::Spec::Unix->splitpath(
$basename
) )[2];
$basename
=~ s|[^\w\.-]+|_|g;
$self
->{basename} =
$basename
;
}
$self
->{basename};
}
sub
fh {
my
$self
=
shift
;
unless
(
defined
$self
->{fh}) {
open
my
$fh
,
'<'
,
$self
->{tempname} or
die
"Can't open '@{[ $self->tempname ]}': '$!'"
;
$self
->{fh} =
$fh
;
}
$self
->{fh};
}
sub
copy_to {
my
$self
=
shift
;
File::Copy::copy(
$self
->{tempname},
@_
);
}
sub
link_to {
my
(
$self
,
$target
) =
@_
;
CORE::
link
(
$self
->{tempname},
$target
);
}
sub
slurp {
my
(
$self
,
$layer
) =
@_
;
$layer
=
':raw'
unless
$layer
;
my
$content
=
undef
;
my
$handle
=
$self
->fh;
binmode
(
$handle
,
$layer
);
while
(
$handle
->
read
(
my
$buffer
, 8192 ) ) {
$content
.=
$buffer
;
}
$content
;
}
1;