MailTools

 view release on metacpan or  search on metacpan

lib/Mail/Cap.pm  view on Meta::CPAN

sub x11_bitmap      { shift->field(shift, 'x11-bitmap');      }
sub nametemplate    { shift->field(shift, 'nametemplate');    }

sub getEntry
{   my($self, $origtype, $file) = @_;

    return $self->{_cache}{$origtype}
        if $useCache && exists $self->{_cache}{$origtype};

    my ($fulltype, @params) = split /\s*;\s*/, $origtype;
    my ($type, $subtype)    = split m[/], $fulltype, 2;
    $subtype ||= '';

    my $entry;
    foreach (@{$self->{"$type/$subtype"}}, @{$self->{"$type/*"}})
    {   if(exists $_->{'test'})
        {   # must run test to see if it applies
            my $test = $self->expandPercentMacros($_->{'test'},
        					  $origtype, $file);
            system $test;
            next if $?;

lib/Mail/Cap.pm  view on Meta::CPAN

    $self->{_cache}{$origtype} = $entry if $useCache;
    $entry;
}

sub expandPercentMacros
{   my ($self, $text, $type, $file) = @_;
    defined $type or return $text;
    defined $file or $file = "";

    my ($fulltype, @params) = split /\s*;\s*/, $type;
    ($type, my $subtype)    = split m[/], $fulltype, 2;

    my %params;
    foreach (@params)
    {   my($key, $val) = split /\s*=\s*/, $_, 2;
        $params{$key} = $val;
    }
    $text =~ s/\\%/\0/g;        # hide all escaped %'s
    $text =~ s/%t/$fulltype/g;  # expand %t
    $text =~ s/%s/$file/g;      # expand %s
    {   # expand %{field}

lib/Mail/Header.pm  view on Meta::CPAN

# In general, this change of capitalization is a bad idea, but it is in
# the code for ages, and therefore probably crucial for existing
# applications.

sub _tag_case
{   my $tag = shift;
    $tag =~ s/\:$//;
    join '-'
      , map { /^[b-df-hj-np-tv-z]+$|^(?:MIME|SWE|SOAP|LDAP|ID)$/i
              ? uc($_) : ucfirst(lc($_))
            } split m/\-/, $tag, -1;
}

# format a complete line
#  ensure line starts with the given tag
#  ensure tag is correct case
#  change the 'From ' tag as required
#  fold the line

sub _fmt_line
{   my ($self, $tag, $line, $modify) = @_;



( run in 1.190 second using v1.01-cache-2.11-cpan-71847e10f99 )