## Scott Wiersdorf
## Created: Thu Jan 24 11:29:59 MST 2002
## $Id: Procmailrc.pm,v 1.12 2002/07/30 17:59:19 scottw Exp $
##################################
package Mail::Procmailrc;
##################################
use strict;
use Carp qw(carp);
use vars qw( $VERSION $Debug %RE );
$VERSION = '1.09';
$Debug = 0;
%RE = (
'flags' => qr/^\s*:0/o, ## flags
'flagsm' => qr/^\s*(:0.*)$/o, ## flags match
'var' => qr/^\s*[^#\$=]+=.*/o, ## var
'varm' => qr/^\s*([^#\$=]+=.*)$/o, ## var match
'varmlq' => qr/^[^\"]+=[^\"]*"[^\"]*$/so, ## var multiline quote
'blklinem' => qr/^\s*\{\s*(.*?)\s*\}\s*$/o, ## block line match
'blkopen' => qr/^\s*\{/o, ## block open
'blkclose' => qr/^\s*\}/o, ## block close
'blank' => qr/^\s*$/o, ## blank line
'cont' => qr/\\$/o, ## continuation
'comt' => qr/^\s*\#/o, ## comment
'comm' => qr/^\s*(\#.*)$/o, ## comment match
'condm' => qr/^\s*(\*.*)$/o, ## condition match
);
sub new {
my $self = bless { }, shift;
my $data = shift;
$self->init($data);
return $self;
}
sub init {
my $self = shift;
my $data = shift;
## initialize data array
$self->rc([]); ## our internal keeper of the data
#########################################
## set parameters
#########################################
## named parameters
if( 'HASH' eq ref($data) ) {
$self->read( $data->{'file'} );
$self->level( $data->{'level'} );
$self->parse( $data->{'data'} ) if $data->{'data'};
}
## just a filename
else {
$self->read($data);
}
return 1;
}
sub read {
my $self = shift;
my $file = shift;
## reset file
return unless $file = $self->file($file);
return unless -f $file;
## FIXME: advisory lock here?
open FILE, $file
or do {
carp( "Error reading file '$file': $!\n" );
return;
};
## FIXME: this is bad... Should pass in a typeglob instead...
$self->parse( [<FILE>] );
close FILE;
}
sub parse {
my $self = shift;
my $data = shift; ## this may be a string or array reference
my @data = (); ## chunks to hand off to object creators
## state
my %ST = ( FILE => 0, 0 => 'FILE',
VARIABLE => 1, 1 => 'VARIABLE',
RECIPE => 2, 2 => 'RECIPE',
LITERAL => 3, 3 => 'LITERAL',
);
my @state = ( $ST{FILE} );
## initialize our data
$self->rc([]);
## make sure we're using an array reference
if( 'ARRAY' eq ref($data) ) {
chomp @$data;
}
else {
## we don't know how to handle other kinds of refs here
return if ref($data);
## split the data (implicit chomping)
$data = [split(/\n/, $data)];
}
## this is the procmailrc parser
my $line;
while( defined ($line = shift @$data) ) {
gubed( "LINE: $line" );
## block line gets rewritten (but noted with $obj->blockline(1))
if( $line =~ s/$RE{'blklinem'}/$1/ ) {
## if $line is now an empty line (or whitespace only),
## we'll take that into consideration in the blank line
## case below
$self->blockline(1);
}
## found a recipe
if( $line =~ s/$RE{'flagsm'}/$1/ ) {
unshift @$data, $line;
$self->push( Mail::Procmailrc::Recipe->new($data, {'level' => $self->level} ) );
}
## found a variable assignment
elsif( $line =~ s/$RE{'varm'}/$1/ ) {
unshift @$data, $line;
$self->push( Mail::Procmailrc::Variable->new($data, {'level' => $self->level}) );
}
## a comment between chunks
elsif( $line =~ /$RE{'comm'}/ ) {
$self->push( Mail::Procmailrc::Literal->new($line, {'level' => $self->level}) );
}
## completely blank line
elsif( $line =~ /$RE{'blank'}/ ) {
## if the next line is blank too...
if( defined $data->[0] && $data->[0] =~ /$RE{'blank'}/ ) {
## skip blank lines (unless this line is a block line)
next unless $self->blockline;
}
$self->push( Mail::Procmailrc::Literal->new($line, {'level' => $self->level}) );
}
## open block triggers special behavior for the object
elsif( $line =~ /$RE{'blkopen'}/ ) {
$self->push( Mail::Procmailrc::Literal->new($line, {'level' => $self->level}) );
$self->level($self->level + 1);
}
## close block triggers special behavior for the object
elsif( $line =~ /$RE{'blkclose'}/ ) {
$self->level($self->level - 1);
$self->push( Mail::Procmailrc::Literal->new($line, {'level' => $self->level}) );
last;
}
## something else
else {
## do nothing? Could push a literal here...
}
## bail if we only expected one line
last if $self->blockline;
}
return 1;
}
## FIXME: should be checks here for array refs/lists
sub rc {
my $self = shift;
my $data = shift;
return ( defined $data
? $self->{RCDATA} = $data
: $self->{RCDATA} );
}
sub recipes {
my $self = shift;
return [ grep { $_->isa('Mail::Procmailrc::Recipe') } @{$self->rc} ];
}
sub variables {
my $self = shift;
return [ grep { $_->isa('Mail::Procmailrc::Variable') } @{$self->rc} ];
}
sub literals {
my $self = shift;
return [ grep { $_->isa('Mail::Procmailrc::Literal') } @{$self->rc} ];
}
sub push {
my $self = shift;
CORE::push @{$self->rc}, @_;
}
## FIXME: would be nice to do this w/o temporary arrays
sub delete {
my $self = shift;
my $seek = shift;
my $found = 0;
return unless $seek && ref($seek);
my @tmp = ();
for my $obj ( @{$self->rc} ) {
CORE::push @tmp, $obj;
next if $found;
next unless $obj == $seek;
pop @tmp;
$found++;
}
$self->rc(\@tmp);
}
sub stringify {
return $_[0]->dump;
}
sub dump {
my $self = shift;
my $output = '';
my $sp = ( defined $self->level ? $self->level * 2 : 0 );
## only one element in our list
if( $self->blockline ) {
$output .= (' ' x $sp) . "\{ " . $self->rc->[0]->stringify . ' }';
$output =~ s/\{\s*\}/{ }/; ## squeeze empties
}
## dump our stack
else {
for my $elem ( @{$self->rc} ) {
next unless defined $elem;
$output .= $elem->dump;
}
}
return $output;
}
sub flush {
my $self = shift;
my $file = shift;
## reset the file attribute
$file = $self->file($file);
## flush the object to disk
if( $file ) {
open FILE, ">$file"
or do {
carp "Could not open '$file' for write: $!\n";
return;
};
}
## no file, flush to stdout
else {
open FILE, ">&STDOUT" unless $file;
}
print FILE $self->dump;
close FILE;
return 1;
}
sub debug {
my $self = shift;
my $debug = shift;
return ( defined $debug ? $Debug = $debug : $Debug );
}
sub file {
my $self = shift;
my $file = shift;
return ( defined $file ? $self->{File} = $file : $self->{File} );
}
sub level {
my $self = shift;
my $level = shift;
return ( defined $level
? $self->{Level} = $level
: ( defined $self->{Level}
? $self->{Level}
: 0 ) );
}
sub blockline {
my $self = shift;
my $blockline = shift;
return ( defined $blockline ? $self->{Blockline} = $blockline : $self->{Blockline} );
}
sub gubed {
return unless $Debug;
my $msg = shift;
chomp $msg;
print STDERR "$msg\n";
}
##################################
package Mail::Procmailrc::Literal;
##################################
sub new {
my $self = bless { }, shift;
my $data = shift;
my $defs = shift;
## set defaults
$self->defaults($defs) if ref $defs;
## FIXME: would be simple to make a super object and have literal,
## variable, and recipe inherit from it... Or recipe components
## inherit from it... I should be careful here and in documenting
## it so that I only mention the minimum necessary to keep a
## consistent interface.
$self->literal($data);
return $self;
}
sub defaults {
my $self = shift;
my $defaults = shift;
my $value = shift;
## nada: return whole hashref
unless( $defaults ) {
return $self->{DEFAULTS};
}
## no hashref: return element of hashref
unless( ref($defaults) ) {
return ( defined $self->{DEFAULTS}->{$defaults}
? ( defined $value
? $self->{DEFAULTS}->{$defaults} = $value
: $self->{DEFAULTS}->{$defaults} )
: undef );
}
## hashref: assign hashref
return $self->{DEFAULTS} = $defaults;
}
sub literal {
my $self = shift;
my $data = shift;
## clean data
chomp $data if $data;
$data =~ s/^\s*// if $data;
$data =~ s/\s*$// if $data;
return ( defined $data ?
$self->{DATA} = $data
: ( $self->{DATA} ? $self->{DATA} : '' ) );
}
sub stringify {
return $_[0]->literal;
}
sub dump {
my $self = shift;
my $sp = ( defined $self->defaults('level') ? $self->defaults('level') * 2 : 0 );
return (' ' x $sp) . $self->stringify . "\n";
}
##################################
package Mail::Procmailrc::Variable;
##################################
use Carp qw(carp);
## FIXME: handle comments on the assignment line
use vars qw($Debug); $Debug = 0;
sub new {
my $self = bless { }, shift;
my $data = shift;
my $defs = shift; ## defaults
$self->defaults($defs) if $defs;
$self->init($data);
return $self;
}
sub defaults {
my $self = shift;
my $defaults = shift;
my $value = shift;
## nada: return whole hashref
unless( $defaults ) {
return $self->{DEFAULTS};
}
## no hashref: return element of hashref
unless( ref($defaults) ) {
return ( defined $self->{DEFAULTS}->{$defaults}
? ( defined $value
? $self->{DEFAULTS}->{$defaults} = $value
: $self->{DEFAULTS}->{$defaults} )
: undef );
}
## hashref: assign hashref
return $self->{DEFAULTS} = $defaults;
}
sub init {
my $self = shift;
my $data = shift;
my $line;
return unless defined $data;
## get a variable declaration
$line .= shift @$data;
## check assignment
unless( $line =~ /$Mail::Procmailrc::RE{'var'}/ ) {
carp "Could not init: bad pattern in '$line'\n";
return;
}
## check for multiline quote
if( $line =~ $Mail::Procmailrc::RE{'varmlq'} ) {
while( @$data && $line =~ $Mail::Procmailrc::RE{'varmlq'} ) {
$line .= "\n";
$line .= shift @$data;
}
}
else {
## check for continuation
while( $line =~ /$Mail::Procmailrc::RE{'cont'}/ ) {
$line .= "\n";
$line .= shift @$data;
}
}
$self->variable($line);
return 1;
}
sub lval {
my $self = shift;
my $data = shift;
chomp $data if $data;
return ( defined $data ? $self->{LVAL} = $data : $self->{LVAL} );
}
sub rval {
my $self = shift;
my $data = shift;
chomp $data if $data;
return ( defined $data ? $self->{RVAL} = $data : $self->{RVAL} );
}
sub variable {
my $self = shift;
my $data = shift;
if( $data ) {
chomp $data;
my( $lval, $rval ) = split(/=/, $data, 2);
$self->lval($lval);
$self->rval($rval);
}
return join('=', $self->lval, $self->rval);
}
sub stringify {
return $_[0]->variable;
}
sub dump {
my $self = shift;
my $sp = ( defined $self->defaults('level') ? $self->defaults('level') * 2 : 0 );
return (' ' x $sp) . $self->stringify . "\n";
}
## debug output
sub gubed {
return unless $Debug;
my $msg = shift;
chomp $msg;
print STDERR "$msg\n";
}
##################################
package Mail::Procmailrc::Recipe;
##################################
## FIXME: handle comments on the flags line
use Carp qw(carp);
sub new {
my $self = bless { }, shift;
my $data = shift;
my $defs = shift; ## defaults
$self->defaults($defs) if $defs;
$self->init($data);
return $self;
}
sub defaults {
my $self = shift;
my $defaults = shift;
my $value = shift;
## nada: return whole hashref
unless( $defaults ) {
return $self->{DEFAULTS};
}
## no hashref: return element of hashref
unless( ref($defaults) ) {
return ( defined $self->{DEFAULTS}->{$defaults}
? ( defined $value
? $self->{DEFAULTS}->{$defaults} = $value
: $self->{DEFAULTS}->{$defaults} )
: undef );
}
## hashref: assign hashref
return $self->{DEFAULTS} = $defaults;
}
sub init {
my $self = shift;
my $data = shift;
my $line;
$self->{FLAGS} = undef;
$self->{INFO} = undef;
$self->{CONDITIONS} = undef;
$self->{ACTION} = undef;
## init members
$self->flags('');
$self->info([]);
$self->conditions([]);
$self->action('');
return unless defined $data;
if( 'ARRAY' eq ref($data) ) {
chomp @$data;
}
else {
## we don't know how to handle other kinds of refs here
return if ref($data);
## split the data (implicit chomping)
$data = [split(/\n/, $data)];
}
## required: FLAGS
FLAGS: {
$line = shift @$data;
$line =~ s/^\s*//;
unless( $line =~ /$Mail::Procmailrc::RE{'flags'}/ ) {
carp( "Not a recipe: $line\n" );
return;
}
$self->flags($line);
}
## optional: INFO
INFO: {
## get a line
$line = shift @$data;
last INFO unless defined $line;
$line =~ s/^\s*//;
## comment/info
if( $line =~ s/$Mail::Procmailrc::RE{'comm'}/$1/ ) {
push @{$self->info}, $line;
redo INFO;
}
## skip empty lines
if( $line =~ /$Mail::Procmailrc::RE{'blank'}/ ) {
redo INFO;
}
## a non-empty, non-comment line. Maybe it's a condition...
unshift @$data, $line;
}
## optional: CONDITIONS
CONDITIONS: {
## get a line
$line = shift @$data;
last CONDITIONS unless defined $line;
$line =~ s/^\s*//;
## check for condition
if( $line =~ s/$Mail::Procmailrc::RE{'condm'}/$1/ ) {
while( $line =~ /$Mail::Procmailrc::RE{'cont'}/ ) {
$line .= "\n"; ## tack on the newline for quoted lines
$line .= shift @$data;
}
push @{$self->conditions}, $line;
redo CONDITIONS;
}
## check for embedded comments and skip them
if( $line =~ /$Mail::Procmailrc::RE{'comt'}/ ) {
redo CONDITIONS;
}
## check for empty lines and skip them
if( $line =~ /$Mail::Procmailrc::RE{'blank'}/ ) {
redo CONDITIONS;
}
## non-empty, non-comment, non-condition. Maybe it's an action...
unshift @$data, $line;
}
## required: ACTION
ACTION: {
## get a line
$line = shift @$data;
last ACTION unless defined $line;
$line =~ s/^\s*//;
## if contains a '{' we pass it to Procmailrc
if( $line =~ /$Mail::Procmailrc::RE{'blkopen'}/ ) {
unshift @$data, $line;
$self->action( Mail::Procmailrc->new( { 'data' => $data,
'level' => $self->defaults('level') } ));
}
## this is a plain old action line
else {
while( $line =~ /$Mail::Procmailrc::RE{'cont'}/ ) {
$line .= "\n";
$line .= shift @$data;
}
$self->action($line);
}
}
return 1;
}
sub stringify {
my $self = shift;
my $output = '';
$output = $self->flags . "\n";
$output .= ( scalar(@{$self->info})
? join( "\n", @{$self->info} ) . "\n"
: '' );
$output .= ( scalar(@{$self->conditions})
? join( "\n", @{$self->conditions} ) . "\n"
: '' );
$output .= ( ref($self->action)
? $self->action->stringify
: $self->action );
return $output;
}
sub dump {
my $self = shift;
my $sp = ( defined $self->defaults('level') ? $self->defaults('level') * 2 : 0 );
my $output = '';
## flags
$output = (' ' x $sp) . $self->flags . "\n";
## info
$output .= ( scalar(@{$self->info})
? (' ' x $sp) . join( "\n" . (' ' x $sp), @{$self->info} ) . "\n"
: '' );
## conditions
$output .= ( scalar(@{$self->conditions})
? (' ' x $sp) . join( "\n" . (' ' x $sp), @{$self->conditions} ) . "\n"
: '' );
## action
$output .= ( ref($self->action)
? $self->action->dump
: (' ' x $sp) . $self->action );
## kludge: we do this because sometimes the action object is
## dumped and other times it is just a string. When we nest a few
## of these, the newlines pile up and leave a lot of whitespace
## at the end of the recipe dump.
chomp $output;
$output .= "\n";
return $output;
}
## data will be a scalar like :0B:
sub flags {
my $self = shift;
my $data = shift;
return ( defined $data
? $self->{FLAGS} = Mail::Procmailrc::Literal->new($data)
: $self->{FLAGS}->stringify );
}
## data will be an array ref; if the data is a scalar, split it and
## make it a list ref
sub info {
my $self = shift;
my $data = shift;
if( defined $data && !ref($data) ) {
$data = [split(/\n/, $data)];
}
return ( defined $data ? $self->{INFO} = $data : $self->{INFO} );
}
## data will be an array ref upon which we push lines like '* 1^0 foo'
## FIXME: do we want to split scalars like we do for 'info'?
sub conditions {
my $self = shift;
my $data = shift;
return ( defined $data ? $self->{CONDITIONS} = $data : $self->{CONDITIONS} );
}
## data will be scalar, possibly multiline; could be another rc object
sub action {
my $self = shift;
my $data = shift;
chomp $data if $data && !ref($data);
return ( defined $data ? $self->{ACTION} = $data : $self->{ACTION} );
}
1;
__END__
=head1 NAME
Mail::Procmailrc - An interface to Procmail recipe files
=head1 SYNOPSIS
use Mail::Procmailrc;
## create a new procmailrc object and initialize it
$pmrc = new Mail::Procmailrc("$HOME/.procmail/rc.spam");
## add a new variable
$pmrc->push( new Mail::Procmailrc::Variable(["FOO=bar"]) );
## add a new recipe
$recipe =<<'_RECIPE_';
:0B:
## this will catch evil email messages
* 1^0 xxx
* 1^0 evil things
* 1^0 porn and other wickedness
* 1^0 all kinds of cursing
* 1^0 lewdness, filth, etc\.
/var/mail/evil
_RECIPE_
## add this new recipe to our procmail rc file
$pmrc->push( new Mail::Procmailrc::Recipe($recipe) );
## add another condition to our recipe (we shoulda left a scalar
## handle lying around, but this illustrates something useful)
for my $obj ( @{$pmrc->rc} ) {
## find the recipe we just added by its 'info' string
next unless $obj->stringify =~ /^\#\# this will catch evil email messages/m;
## we want to block emails about censorship, too ;o)
push @{$obj->conditions}, '* 1^0 censor(ship|ing)?'
}
## write this object to disk
$pmrc->flush;
=head1 DESCRIPTION
B<Mail::Procmailrc> can parse B<procmail> recipe files and store the
contents in an object which can be later manipulated and saved (see
L</"CAVEATS"> and L</"BUGS/TODO"> for limitations and special
conditions).
You may also start with a fresh, empty B<Mail::Procmailrc> object,
populate it with recipes and/or variables and write it to file.
Recipes and variables are written to the file in the order they're
parsed and added. If you want to re-order the recipes you may do so
by getting a handle on the variable or recipe list and ordering them
yourself.
The B<Mail::Procmailrc> object is primarily a list of B<procmail>
component objects (see below). When B<Mail::Procmailrc> parses a
B<procmail> rc file, it decides which lines are variable assignments,
which lines are comments, and which lines are recipes. It preserves
the order in which it encounters these B<procmail> components and
stores them as a list of objects in the main B<Mail::Procmailrc>
object.
=over 4
=item B<new>
Creates a new Mail::Procmailrc object.
Examples:
## 1. in memory object
my $pmrc = new Mail::Procmailrc;
## 2. parses /etc/procmailrc
my $pmrc = new Mail::Procmailrc("/etc/procmailrc");
## 3. parses /etc/procmailrc, makes backup
my $pmrc = new Mail::Procmailrc("/etc/procmailrc");
$pmrc->file("/etc/procmailrc.bak");
$pmrc->flush; ## create a backup
$pmrc->file("/etc/procmailrc"); ## future flushes will go here
## 4. alternative syntax: filename specified in hashref
my $pmrc = new Mail::Procmailrc( { 'file' => '/etc/procmailrc' } );
## 5. alternative syntax: scalar
my $rc =<<_FOO_;
:0B
* 1^0 this is not spam
/dev/null
_FOO_
my $pmrc = new Mail::Procmailrc( { 'data' => $rc } );
## 6. alternative syntax: array reference
my $rc =<<'_RCFILE_';
:0c:
/var/mail/copy
_RCFILE_
my @rc = map { "$_\n" } split(/\n/, $rcfile);
$pmrc = new Mail::Procmailrc( { 'data' => \@rc } );
=item B<read>
Sets the object's file attribute and parses the given file. If the
file is not readable, returns undef. Normally not invoked directly.
Example:
## set $pmrc->file and parse
unless( $pmrc->read('/etc/procmailrc') ) {
die "Could not parse '/etc/procmailrc!\n";
}
=item B<parse>
Takes an array or string reference and populates the object with it.
Example:
my $chunk =<<_RECIPE_;
## begin foo section
TMPLOGFILE=\$LOGFILE
TMPLOGABSTRACT=\$LOGABSTRACT
TMPVERBOSE=\$VERBOSE
LOGFILE=/var/log/foolog
LOGABSTRACT=yes
VERBOSE=no
## process the mail via foo
:0fw
|/usr/local/bin/foo -c /etc/mail/foo.conf
LOGFILE=\$TMPLOGFILE
LOGABSTRACT=\$TMPLOGABSTRACT
VERBOSE=\$TMPVERBOSE
## end spamassassin vinstall (do not remove these comments)
_RECIPE_
## make a new in-memory procmailrc file
my $new_pmrc = new Mail::Procmailrc;
$new_pmrc->parse($chunk);
## add this new procmailrc file to our existing procmailrc file
$pmrc->push(@{$new_pmrc->rc});
$pmrc->flush;
Alternatively, you can pass an array reference to B<parse>:
$new_pmrc->parse([split("\n", $chunk)]);
=item B<rc>
Returns a list reference. Each item in the list is either a Variable,
Literal, or Recipe object. Items are returned in the order they were
originally parsed. You may assign to B<rc> and rewrite the
B<Mail::Procmailrc> object thereby.
Example:
## remove foo section from recipe file
my @tmp_rc = ();
my $foo_section = 0;
for my $pm_obj ( @{$pmrc->rc} ) {
if( $pm_obj->stringify =~ /^\#\# begin foo recipes/m ) {
$foo_section = 1;
next;
}
elsif( $pm_obj->stringify =~ /^\#\# end foo recipes/m ) {
$foo_section = 0;
next;
}
elsif( $foo_section ) {
next;
}
push @tmp_rc, $rc_obj;
}
$pmrc->rc(\@tmp_rc);
$pmrc->flush;
=item B<recipes>
Returns a listref of recipes in this object.
=item B<variables>
Returns a listref of variables in this object.
=item B<literals>
Returns a listref of literals in this object.
=item B<push>
Pushes the dat(a|um) onto this object's internal object list. If the
object being pushed is another Mail::Procmailrc object, that object's
B<rc> method is invoked first and the results are pushed.
Example:
my $rc_objs = $old_pmrc->rc;
$pmrc->push( @$rc_objs );
=item B<delete>
Deletes an object from the main Mail::Procmailrc object:
for my $obj ( @{$pmrc->rc} ) {
next unless $obj->isa('Mail::Procmailrc::Recipe');
## I lost all my enemies when I switched to the Perl Artistic License...
next unless $obj->info->[0] =~ /^\#\# block email from enemies/;
$pmrc->delete($obj);
last;
}
=item B<file>
Returns the path where this object will write when B<flush> is
invoked. If B<file> is given an argument, the object's internal
I<file> attribute is set to this path.
=item B<flush>
Writes the procmail object to disk in the file specified by the
B<file> attribute. If the B<file> attribute is not set, B<flush>
writes to STDOUT. If a filename is given as an argument, it is set as
the objects B<file> attribute.
Examples:
## 1. flushes to whatever $pmrc->file is set to (STDOUT if file is unset)
$pmrc->flush;
## 2. flushes to a specific file; future flushes will also go here
$pmrc->flush('/backup/etc/procmailrc');
=item B<stringify>
Returns the object in string representation.
=item B<dump>
Like B<stringify> but with nicer formatting (indentation, newlines,
etc.). Suitable for inclusion in procmail rc files.
=back
=head1 Mail::Procmailrc::Variable Objects
B<Mail::Procmailrc::Variable> objects are easy to create and use.
Normally, the B<Variable> constructor is invoked by
B<Mail::Procmailrc> during parsing. If you are creating or modifying
an existing B<procmail> rc file, you might do something like this:
my $var = new Mail::Procmailrc::Variable(["VERBOSE=off"]);
or you might wish to do it another way:
my $var = new Mail::Procmailrc::Variable;
$var->lval('VERBOSE');
$var->rval('off');
You may get a handle on all B<Variable> objects in an rc file with
the B<variables> method:
## change to verbose mode
for my $var ( @{$pmrc->variables} ) {
next unless $var->lval eq 'VERBOSE';
$var->rval('yes');
last;
}
=head2 Mail::Procmailrc::Variable Methods
=over 4
=item B<variable([$string])>
I<$string>, if present, is split on the first '='. The left half is
assigned to B<lval> and the right half to B<rval>. If I<$string> is
false, B<lval> and B<rval> are concatenated with '=' and returned as
a single string.
=item B<lval([$val])>
Returns the current lvalue of the variable assignment, optionally
setting it if I<$val> is present.
=item B<rval([$val])>
Returns the current rvalue of the variable assignment, optionally
setting it if I<$val> is present.
=item B<stringify>
Returns the output of B<variable>. Provides a consistent interface to
all Mail::Procmailrc::* subclasses.
=item B<dump>
Returns the output of B<stringify> with a trailing newline. Suitable
for inserting into a B<procmail> rc file.
=item B<defaults([\%defaults [, $elem]])>
Returns some internal object settings, currently not very useful or
interesting except when parsing deeply nested recipes. Included here
for completeness.
=item B<init(\@data)>
Normally invoked by the constructor (B<new>), but may be used to
re-initialize an object.
=back
=head1 Mail::Procmailrc::Literal Objects
B<Mail::Procmailrc::Literal> objects are even easier to create and
use than B<Variable> objects. A B<Mail::Procmailrc::Literal> is simply
a I<string> with a few methods wrapped around it for convenient
printing.
You may get a handle on all B<Literal> objects in an rc file with the
B<literals> method:
## change a comment in the rc file
for my $lit ( @{$pmrc->literals} ) {
next unless $lit->literal =~ /## spam follows/i;
$lit->literal('## this is a nice spam recipe');
last;
}
Here is how to create a new literal:
## create a new literal
my $lit = new Mail::Procmailrc::Literal('## this file is for filtering spam');
## same as above
my $lit = new Mail::Procmailrc::Literal;
$lit->literal('## this file is for filtering spam');
## print it
$lit->dump;
=head2 Mail::Procmailrc::Literal Methods
=over 4
=item B<literal([$string])>
Get or set the literal object contents.
=item B<dump>
Dump the contents of the object with a trailing newline.
=back
=head1 Mail::Procmailrc::Recipe Objects
A recipe object is made up of a flags object, zero or more literal
(comments or vertical whitespace) objects, zero or more condition
objects, and an action object. A B<Mail::Procmailrc::Recipe> object
is made of four parts:
=over 4
=item * flags (required)
=item * info/comment (optional)
=item * conditions (optional)
=item * action (required)
=back
Normally, the B<Recipe> object is created automatically during
parsing. However, if you are constructing a new rc file or want to
modify an existing procmailrc file, you will need to know a little
about the B<Recipe> object.
To create a recipe object from a string, you may do something like
this:
$recipe =<<'_RECIPE_';
:0B:
## block indecent emails
* 1^0 people talking dirty
* 1^0 dirty persian poetry
* 1^0 dirty pictures
* 1^0 xxx
/dev/null
_RECIPE_
$recipe_obj = new Mail::Procmailrc::Recipe($recipe);
or the more obtuse (if you happen to already have an array or
reference):
$recipe_obj = new Mail::Procmailrc::Recipe([split("\n", $recipe)]);
The entire recipe in I<$recipe> is now contained in the
I<$recipe_obj>. You could also piece together an object part by part:
$recipe_obj = new Mail::Procmailrc::Recipe;
$recipe_obj->flags(':0B');
$recipe_obj->info([q(## block indecent emails)]);
$recipe_obj->conditions([q(* 1^0 people talking dirty),
q(* 1^0 dirty persian poetry),
q(* 1^0 dirty pictures),
q(* 1^0 xxx),]);
$recipe_obj->action('/dev/null');
You can get a handle on all recipes in an rc file with the B<recipes> method:
my $conditions;
for my $recipe ( @{$pmrc->recipes} ) {
next unless $recipe->info->[0] =~ /^\s*\#\# this recipe is for spam/io;
$conditions = $recipe->conditions;
last;
}
push @$conditions, '* 1^0 this is not SPAM'; ## add another condition
$pmrc->flush; ## write out to file
=head2 Important Note about I<info>
The B<info> method of the B<Recipe> object is really just a procmail
comment (or B<literal> elsewhere in this document), but because it
appears between the B<flags> line (e.g., ':0fw') and the conditions
(e.g., * 1^0 foo), it becomes part of the recipe itself. This is
terribly convenient usage because it allows you to "index" your
recipes and find them later.
=head1 EXAMPLES
The F<eg> directory in the B<Mail::Procmailrc> distribution contains
at least one useful program illustrating the several uses of this
module. Other examples may appear here in future releases as well as
the F<eg> directory of the distribution.
=head1 CAVEATS
Parsing is I<lossy> in two senses. Some formatting and stray lines
may be lost. Also, array references fed to constructors will not be
returned intact (i.e., data will be shifted out of them).
=head1 BUGS/TODO
Please let the author/maintainer know if you find any bugs (providing
a regression test would also be helpful; see the testing format in
the 't' directory).
=over 4
=item *
We can't parse old-style "counting" syntax (before v2.90, 1993/07/01):
:2:
^Subject:.*foo
From:.*foo@bar\.com
/tmp/eli/foo
Thanks to <eli@panix.com> (8 Oct 2002) for finding this bug.
=item *
We don't use any advisory locking on the B<procmail> rc files. This
wouldn't be hard to fix, but I'm not sure it is needed.
=item *
We suck in the entire procmailrc file into memory. This could be done
more efficiently with a typeglob and reading the file line by line.
=item *
Comments on the flags line (e.g., ":0B ## parse body") or on an
assignment line (e.g., "VAR=FOO ## make FOO be known") are quietly
dropped when the rc file is parsed and they are not replaced when the
file is rewritten. If you want to keep comments around, put them on
a separate line.
=item *
We don't recursively parse file INCLUDE directives. This could be
construed as a safety feature. The INCLUDE directives will show up,
however, as B<Variable> objects, so you could provide the recursion
pretty easily yourself.
=back
=head1 ACKNOWLEDGEMENTS
=over 4
=item 5 Feb 2003
Erwin Lansing (erwin@lansing.dk) for 5.00503 patch and doc typo.
Danke!
=back
=head1 COPYRIGHT
Copyright 2002 Scott Wiersdorf.
This library is free software; you can redistribute it and/or modify
it under the terms of the Perl Artistic License.
=head1 AUTHOR
Scott Wiersdorf <scott@perlcode.org>
=head1 SEE ALSO
L<procmail>, L<procmailrc(5)>, L<procmailex(5)>, L<procmailsc(5)>
=cut