Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
100 lines (88 sloc) 2.53 KB
# Copyright 2002-2016 Interchange Development Group and others
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version. See the LICENSE file for details.
UserTag deliver Order type
UserTag deliver HasEndTag
UserTag deliver addAttr
UserTag deliver Version 1.9
UserTag deliver Routine <<EOR
sub {
my ($type, $opt, $body) = @_;
my $out;
use vars qw/$Tag/;
$Tag ||= new Vend::Tags;
if($opt->{file}) {
return undef unless -f $opt->{file};
my ($tmp, %rfopt);
# determine mime type devoid of explicit value
$type ||= Vend::Util::mime_type($opt->{file});
# avoid encoding of binary files
if ($type !~ m{^text/}i) {
$rfopt{encoding} = 'raw';
}
$tmp = readfile($opt->{file}, undef, undef, \%rfopt);
$out = \$tmp;
}
elsif(ref $body) {
$out = $body;
}
elsif(length $body) {
$out = \$body;
}
if($opt->{extra_headers}) {
my @lines = grep /\S/, split /[\r\n]+/, $opt->{extra_headers};
for(@lines) {
my ($header, $val) = split /:/, $_;
$Tag->tag( { op => 'header',
name => $header,
content => $val,
} );
}
}
## This is a bounce, returns
if($opt->{location}) {
$type = Vend::Util::header_data_scrub($type);
$opt->{status} = Vend::Util::header_data_scrub($opt->{status});
$opt->{location} = Vend::Util::header_data_scrub($opt->{location});
$type and $Tag->tag( {
op => 'header',
name => 'Content-Type',
content => $type,
} );
$Tag->tag( { op => 'header',
name => 'Status',
content => $opt->{status} || '302 moved',
} );
$Tag->tag( { op => 'header',
name => 'Location',
content => $opt->{location},
} );
if(! $body) {
$body = qq{Redirecting to <A href="%s">%s</a>.};
$body = errmsg($body, $opt->{location}, $opt->{location});
}
::response($body);
$Vend::Sent = 1;
return 1;
}
$type ||= 'application/octet-stream';
$Tag->tag( { op => 'header', name => 'Status', content => $opt->{status} } )
if $opt->{status};
$Tag->tag( { op => 'header', name => 'Content-Type', content => $type } );
if($opt->{get_encrypted}) {
$opt->{get_encrypted} = 1 unless $opt->{get_encrypted} =~ /^\d+$/;
my $idx = $opt->{get_encrypted};
while ($idx--) {
$$out =~ s/.*?(---+BEGIN PGP MESSAGE--+)/$1/s;
}
$$out =~ s/(---+END PGP MESSAGE---+).*/$1\n/s;
}
$::Pragma->{download} = 1;
::response($out);
$Vend::Sent = 1;
return 1;
}
EOR
You can’t perform that action at this time.