# Copyright 2002-2007 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.
# 
# $Id: deliver.coretag,v 1.8 2007-03-30 23:40:49 pajamian Exp $

UserTag deliver Order     type
UserTag deliver HasEndTag
UserTag deliver addAttr
UserTag deliver Version   $Revision: 1.8 $
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;
	}

	## 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;
	}

	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,
					} );
		}
	}
	$::Pragma->{download} = 1;
	::response($out);
	$Vend::Sent = 1;
	return 1;
}
EOR
