Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / mhmsgextbody.pl

##---------------------------------------------------------------------------##
##  File:
##	$Id: mhmsgextbody.pl,v 1.3 2001/09/05 15:48:15 ehood Exp $
##  Author:
##      Earl Hood       mhonarc@mhonarc.org
##  Description:
##	Library defines routine to filter message/external-body parts to
##	HTML for MHonArc.
##	Filter routine can be registered with the following:
##          <MIMEFILTERS>
##          message/external-body;m2h_msg_extbody::filter;mhmsgextbody.pl
##          </MIMEFILTERS>
##---------------------------------------------------------------------------##
##    MHonArc -- Internet mail-to-HTML converter
##    Copyright (C) 1999-2001	Earl Hood, mhonarc@mhonarc.org
##
##    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.
##
##    This program is distributed in the hope that it will be useful,
##    but WITHOUT ANY WARRANTY; without even the implied warranty of
##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##    GNU General Public License for more details.
##
##    You should have received a copy of the GNU General Public License
##    along with this program; if not, write to the Free Software
##    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##    02111-1307, USA
##---------------------------------------------------------------------------##

package m2h_msg_extbody;

##---------------------------------------------------------------------------##
##	message/external-body filter for MHonArc.
##	The following filter arguments are recognized ($args):
##
##	local-file	Support local-file access-type.  This option
##			is best used for internal local mail archives
##			where it is known that readers will have
##			direct access to the file.
##
sub filter {
    my($fields, $data, $isdecode, $args) = @_;
    $args = ''  unless defined $args;

    # grab content-type
    my $ctype = $fields->{'content-type'}[0];
    return ''  unless $ctype =~ /\S/;

    # parse argument string
    my $b_lfile = $args =~ /\blocal-file\b/i;

    my $ret = "";
    my $parms = readmail::MAILparse_parameter_str($ctype, 1);
    my $access_type = lc $parms->{'access-type'}{'value'};
       $access_type =~ s/\s//g;
    my $cdesc = $fields->{'content-description'}[0] || "";

    $$data =~ s/\A\s+//;
    my $dfields = readmail::MAILread_header($data);
    my $dctype  = $dfields->{'content-type'}[0] || "";
    my $dcte 	= $dfields->{'content-transfer-encoding'}[0] || "";
    my $dmd5 	= $dfields->{'content-md5'}[0] || "";
    my $size 	= $parms->{'size'}{'value'} || "";
    my $perms 	= $parms->{'permission'}{'value'} || "";
    my $expires	= $parms->{'expiration'}{'value'} || "";
    my $name	= $parms->{'name'}{'value'} || "";

    ATYPE: {
	## FTP, TFTP, ANON-FTP
	if ( $access_type eq 'ftp' ||
	     $access_type eq 'anon-ftp' ||
	     $access_type eq 'tftp' ) {
	    my $site 	 = $parms->{'site'}{'value'};
	    my $dir 	 = $parms->{'directory'}{'value'} || "";
	       $dir	 = '/'.$dir  unless $dir =~ m|^/| || $dir eq "";
	    my $mode 	 = $parms->{'mode'}{'value'} || "";
	    my $proto	 = $access_type eq 'tftp' ? 'tftp' : 'ftp';
	    my $url	 = "$proto://" .
			   mhonarc::urlize($site) .
			   $dir . '/' .
			   mhonarc::urlize($name);
	    $ret	 = '<dl><dt>';
	    $ret	.= qq|<a href="$url">$cdesc</a><br>\n|
			    if $cdesc;
	    $ret	.= qq|<a href="$url">&lt;$url&gt;</a></dt><dd>\n|;
	    $ret	.= qq|Content-type: <tt>$dctype</tt><br>\n|
			    if $dctype;
	    $ret	.= qq|MD5: <tt>$dmd5</tt><br>\n|
			    if $dmd5;
	    $ret	.= qq|Size: $size bytes<br>\n|
			    if $size;
	    $ret	.= qq|Transfer-mode: <tt>$mode</tt><br>\n|
			    if $mode;
	    $ret	.= qq|Expires: <tt>$expires</tt><br>\n|
			    if $expires;
	    $ret	.= qq|Username/password may be required.<br>\n|
			    if $access_type eq 'ftp';
	    $ret	.= "</dd></dl>\n";
	    last ATYPE;
	}

	## Local file
	if ($access_type eq 'local-file') {
	    last ATYPE  unless $b_lfile;
	    my $site 	 = $parms->{'site'}{'value'} || "";
	    my $url	 = mhonarc::urlize("file://$name");
	    $ret	 = '<dl><dt>';
	    $ret	.= qq|<a href="$url">$cdesc</a><br>\n|  if $cdesc;
	    $ret	.= qq|<a href="$url">&lt;$url&gt;</a></dt><dd>\n|;
	    $ret	.= qq|Content-type: <tt>$dctype</tt><br>\n|
			    if $dctype;
	    $ret	.= qq|MD5: <tt>$dmd5</tt><br>\n|
			    if $dmd5;
	    $ret	.= qq|Size: $size bytes<br>\n|  	if $size;
	    $ret	.= qq|Expires: <tt>$expires</tt><br>\n|
			    if $expires;
	    $ret	.= qq|File accessible from the following domain: | .
			   qq|$site<br>\n|  if $site;
	    $ret	.= "</dd></dl>\n";
	    last ATYPE;
	}

	## Mail server
	if ($access_type eq 'mail-server') {
	    # not supported
	    last ATYPE;
	}

	## URL
	if ($access_type eq 'url') {
	    my $url 	 = $parms->{'url'}{'value'};
	       $url =~ s/\s+//g;
	    $ret	 = '<dl><dt>';
	    $ret	.= qq|<a href="$url">$cdesc</a><br>\n|  if $cdesc;
	    $ret	.= qq|<a href="$url">&lt;$url&gt;</a></dt><dd>\n|;
	    $ret	.= qq|Content-type: <tt>$dctype</tt><br>\n|
			    if $dctype;
	    $ret	.= qq|MD5: <tt>$dmd5</tt><br>\n|
			    if $dmd5;
	    $ret	.= qq|Size: $size bytes<br>\n|
			    if $size;
	    $ret	.= qq|Expires: <tt>$expires</tt><br>\n|
			    if $expires;
	    $ret	.= "</dd></dl>\n";
	    last ATYPE;
	}

	last ATYPE;
    }

    ($ret);
}

##---------------------------------------------------------------------------##
1;