view release on metacpan or  search on metacpan

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

sub view    { my $self = shift; $self->_run($self->viewCmd(@_))    }
sub compose { my $self = shift; $self->_run($self->composeCmd(@_)) }
sub edit    { my $self = shift; $self->_run($self->editCmd(@_))    }
sub print   { my $self = shift; $self->_run($self->printCmd(@_))   }

sub _run($)
{   my ($self, $cmd) = @_;
    defined $cmd or return 0;

    system $cmd;
    1;
}

#------------------

sub viewCmd    { shift->_createCommand(view    => @_) }
sub composeCmd { shift->_createCommand(compose => @_) }
sub editCmd    { shift->_createCommand(edit    => @_) }
sub printCmd   { shift->_createCommand(print   => @_) }

sub _createCommand($$$)
{   my ($self, $method, $type, $file) = @_;
    my $entry = $self->getEntry($type, $file);

    $entry && exists $entry->{$method}
        or return undef;

    $self->expandPercentMacros($entry->{$method}, $type, $file);
}

sub makeName($$)
{   my ($self, $type, $basename) = @_;
    my $template = $self->nametemplate($type)
        or return $basename;

    $template =~ s/%s/$basename/g;
    $template;
}

#------------------

sub field($$)
{   my($self, $type, $field) = @_;
    my $entry = $self->getEntry($type);
    $entry->{$field};
}


sub description     { shift->field(shift, 'description');     }
sub textualnewlines { shift->field(shift, 'textualnewlines'); }
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 $?;
        }
        $entry = { %$_ };  # make copy
        last;
    }
    $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}
        local $^W = 0;  # avoid warnings when expanding %params
        $text =~ s/%\{\s*(.*?)\s*\}/$params{$1}/g;
    }
    $text =~ s/\0/%/g;
    $text;
}

# This following procedures can be useful for debugging purposes

sub dumpEntry
{   my($hash, $prefix) = @_;
    defined $prefix or $prefix = "";
    print "$prefix$_ = $hash->{$_}\n"
        for sort keys %$hash;
}

sub dump
{   my $self = shift;
    foreach (keys %$self)
    {   next if /^_/;
        print "$_\n";
        foreach (@{$self->{$_}})
        {   dumpEntry($_, "\t");
            print "\n";
        }
    }

    if(exists $self->{_cache})
    {   print "Cached types\n";
        print "\t$_\n"
            for keys %{$self->{_cache}};
    }
}

1;