my $self = shift;
my $file;
my $cd = $self->header('Content-Disposition');
if ($cd) {
require HTTP::Headers::Util;
if (my @cd = HTTP::Headers::Util::split_header_words($cd)) {
my ($disposition, undef, %cd_param) = @{$cd[-1]};
$file = $cd_param{filename};
# RFC 2047 encoded?
if ($file && $file =~ /^=\?(.+?)\?(.+?)\?(.+)\?=$/) {
my $charset = $1;
my $encoding = uc($2);
my $encfile = $3;
if ($encoding eq 'Q' || $encoding eq 'B') {
local($SIG{__DIE__});
eval {
if ($encoding eq 'Q') {
$encfile =~ s/_/ /g;
require MIME::QuotedPrint;
$encfile = MIME::QuotedPrint::decode($encfile);
}
else { # $encoding eq 'B'
require MIME::Base64;
$encfile = MIME::Base64::decode($encfile);
}
require Encode;
require encoding;
# This is ugly use of non-public API, but is there
# a better way to accomplish what we want (locally
# as-is usable filename string)?
my $locale_charset = encoding::_get_locale_encoding();
Encode::from_to($encfile, $charset, $locale_charset);
};
$file = $encfile unless $@;
}
}
}
}
my $uri;
unless (defined($file) && length($file)) {
if (my $cl = $self->header('Content-Location')) {
$uri = URI->new($cl);
}
elsif (my $request = $self->request) {
$uri = $request->uri;
}
if ($uri) {
$file = ($uri->path_segments)[-1];
}
}
if ($file) {
$file =~ s,.*[\\/],,; # basename
}
if ($file && !length($file)) {
$file = undef;
}
$file;
}
sub as_string
{
require HTTP::Status;
my $self = shift;
my($eol) = @_;
$eol = "\n" unless defined $eol;
my $status_line = $self->status_line;
my $proto = $self->protocol;
$status_line = "$proto $status_line" if $proto;
return join($eol, $status_line, $self->SUPER::as_string(@_));
}
sub dump
{
my $self = shift;
my $status_line = $self->status_line;
my $proto = $self->protocol;
$status_line = "$proto $status_line" if $proto;
return $self->SUPER::dump(
preheader => $status_line,
@_,
);
}
=2= |