view release on metacpan or  search on metacpan

ExpandAliases.pm  view on Meta::CPAN

            for (@_);
    }
}

# ----------------------------------------------------------------------
# init($file)
#
# Parse file, extracting aliases.  Note that this is a (more or less)
# literal representation of the file; expansion of aliases happens at
# run time, as aliases are requested.
# # ----------------------------------------------------------------------
sub init {
    my $self = shift;
    my $file = shift || $self->[ FILE ];
    return $self unless defined $file;

    # Chapter 24 of the sendmail book
    # (www.oreilly.com/catalog/sendmail/) describes the process of
    # looking for aliases thusly:
    #
    # "The aliases(5) file is composed of lines of text.  Any line that
    # begins with a # is a comment and is ignored.  Empty lines (those
    # that contain only a newline character) are also ignored.  Any
    # lines that begins with a space or tab is joined (appended) to the
    # line above it.  All other lines are text are viewed as alias
    # lines.  The format for an alias line is:
    #
    #   local: alias
    #
    # "The local must begin a line. It is an address in the form of a
    # local recipient address...  The colon follows the local on
    # the same line and may be preceded with spaces or tabs.  If the
    # colon is missing, sendmail prints and syslog(3)'s the following
    # error message and skips that alias line:
    #
    #   missing colon
    #
    # "The alias (to the right of the colon) is one or more addresses on
    # the same line.  Indented continuation lines are permitted.  Each
    # address should be separated from the next by a comma and optional
    # space characters. A typical alias looks like this:
    #
    #   root: jim, sysadmin@server, gunther ^ | indenting whitespace
    #
    # "Here, root is hte local address to be aliases.  When mail is to
    # be locally delivered to root, it is looked up in the aliases(5)
    # file.  If found, root is replaced with the three addresses show
    # earlier, and mail is instead delivered to those other three
    # addresses.
    #
    # "This process of looking up and possibly aliases local recipients
    # is repeated for each recipient until no more aliases are found in
    # the aliases(5) file.  That is, for example, if one of the aliases
    # for root is jim, and if jim also exists to the left of a colon in
    # the aliases file, he too is replaced with his alias:
    #
    #   jim: jim@otherhost
    #
    # "The list of addresses to the right of the colon may be mail
    # addresses (such as gunther or jim@otherhost), the name of a
    # program to run (such as /etc/relocated), the name of a file onto
    # which to append (such as /usr/share/archive), or the name of a
    # file to read for additional addresses (using :include:)."

    $self->debug("Opening alias file '$file'");
    my $fh = File::Aliases->new($file)
        or die "Can't open $file: $!";

    while (my $line = $fh->next) {
        chomp($line);
        next if $line =~ /^#/;
        next if $line =~ /^\s*$/;

        $line =~ s/\s+/ /g;
        my ($orig, $alias, @expandos);

        $orig = $line;
        if ($line =~ s/^([^:]+)\s*:\s*//) {
            $alias = lc $1;
            $self->debug("$. => '$alias'");
        }
        else {
            local $DEBUG = 1;
            $self->debug("$file line $.: missing colon");
            next;
        }

        @expandos =
            #grep !/^$alias$/,
            map { s/^\s*//; s/\s*$//; $_ }
            split /,/, $line;

        $self->debug($alias, map "\t$_", @expandos);
        $self->[ PARSED ]->{ $alias } = \@expandos;
    }

    return $self;
}

# ----------------------------------------------------------------------
# expand($name)
#
# Expands $name to @addresses.  If @addresses is empty, return $name.
# In list context, returns a list of the matching expansions; in
# scalar context, returns a reference to an array of expansions.
# ----------------------------------------------------------------------
sub expand {
    my ($self, $name, $original, $lcname, %answers, @answers, @names, $n);
    $self = shift;
    $name = shift || return $name;
    $original = shift;
    $lcname = lc $name;

    return $name if (defined $original && $name eq $original);

    return @{ $self->[ CACHED ]->{ $lcname } }
        if (defined $self->[ CACHED ]->{ $lcname });

    if (@names = @{ $self->[ PARSED ]->{ $lcname } || [ ] }) {
        my $c = $self->[ CACHED ]->{ $lcname } = [ ];