Initial commit of OpenSPARC T2 design and verification files.

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

##---------------------------------------------------------------------------##
##  File:
##	$Id: mhdysub.pl,v 2.6 2002/06/07 17:45:09 ehood Exp $
##  Author:
##      Earl Hood       mhonarc@mhonarc.org
##  Description:
##      Definition of create_routines() that creates routines are
##	runtime.
##---------------------------------------------------------------------------##
##    MHonArc -- Internet mail-to-HTML converter
##    Copyright (C) 1996-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., 675 Mass Ave, Cambridge, MA 02139, USA.
##---------------------------------------------------------------------------##

package mhonarc;

my $_sub_eval_cnt = 0;

##---------------------------------------------------------------------------
##	create_routines is used to dynamically create routines that
##	would benefit from being create at run-time.  Routines
##	that have to check against several regular expressions
##	are candidates.
##
sub create_routines {
    my($sub) = '';

    ##-----------------------------------------------------------------------
    ## exclude_field: Used to determine if field should be excluded from
    ## message header
    ##
    $sub  =<<'EndOfRoutine';
    sub exclude_field {
	my($f) = shift;
	my $ret = 0;
	EXC_FIELD_SW: {
EndOfRoutine

    # Create switch block for checking field against regular
    # expressions (a large || statement could also work).
    my $pat;
    foreach $pat (keys %HFieldsExc) {
	$sub .= join('',
		     'if ($f =~ /^',
		     $pat,
		     '/i) { $ret = 1;  last EXC_FIELD_SW; }',
		     "\n");
    }

    $sub .=<<'EndOfRoutine';
	}
	$ret;
    }
EndOfRoutine

    $sub .= "# $_sub_eval_cnt\n";  ++$_sub_eval_cnt;
    eval $sub;
    die("ERROR: Unable to create exclude_field routine:\n$@\n") if $@;

    ##-----------------------------------------------------------------------
    ## subject_strip: Used to apply user-defined s/// operations on
    ## message subjects as they are read;
    ##
    $sub  =<<EndOfRoutine;
    sub subject_strip {
	local(\$_) = shift;
	$SubStripCode;
	\$_;
    }
EndOfRoutine

    $sub .= "# $_sub_eval_cnt\n";  ++$_sub_eval_cnt;
    eval $sub;
    die("ERROR: Unable to create subject_strip routine:\n$@\n") if $@;

    ##-----------------------------------------------------------------------
    ##	Routine to determine last message number in use.
    ##
    $sub =<<'EndOfRoutine';
    sub get_last_msg_num {
	opendir(DIR, $OUTDIR) || die("ERROR: Unable to open $OUTDIR\n");
	my($max) = -1;
	my $msgrex = '^'.
		     "\Q$MsgPrefix".
		     '(\d+)\.'.
		     "\Q$HtmlExt".
		     '$';
	chop $msgrex  if ($HtmlExt =~ /html$/i);

	foreach (readdir(DIR)) {
	    if (/$msgrex/io) { $max = int($1)  if $1 > $max; }
	}
	close(DIR);
	$max;
    }
EndOfRoutine

    $sub .= "# $_sub_eval_cnt\n";  ++$_sub_eval_cnt;
    eval $sub;
    die("ERROR: Unable to create get_last_msg_num routine:\n$@\n") if $@;

    ##-----------------------------------------------------------------------
    ##	Routine to get base subject text from index
    ##
    $sub =<<'EndOfRoutine';
    sub get_base_subject {
	my($ret) = ($Subject{$_[0]});
	1 while $ret =~ s/$SubReplyRxp//io;
	if ($ret eq "") {
	    return $NoSubjectTxt;
	}
	$ret;
    }
EndOfRoutine

    $sub .= "# $_sub_eval_cnt\n";  ++$_sub_eval_cnt;
    eval $sub;
    die("ERROR: Unable to create get_base_subject routine:\n$@\n") if $@;

    ##-----------------------------------------------------------------------
    ##	Routine to rewrite mail addresses in message header
    ##
    $sub =<<EndOfRoutine;
    sub rewrite_address {
	local \$_ = shift;
	$AddressModify;
	\$_;
    }
EndOfRoutine

    $sub .= "# $_sub_eval_cnt\n";  ++$_sub_eval_cnt;
    eval $sub;
    die("ERROR: Unable to create rewrite_address routine:\n$@\n") if $@;

    ##-----------------------------------------------------------------------
    ## message_exclude: User-defined code to check if a message should
    ## be added or not.
    ##
    $sub  =<<EndOfRoutine;
    sub message_exclude {
	package mhonarc::Pkg_message_exclude;
	local(\$_) = shift;
	$MsgExcFilter;
    }
EndOfRoutine

    $sub .= "# $_sub_eval_cnt\n";  ++$_sub_eval_cnt;
    eval $sub;
    die("ERROR: Unable to create subject_strip routine:\n$@\n") if $@;

}

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