# 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 <{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 %s.}; $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