root/bin/pl-list

#!/usr/bin/perl

=head1 NAME

pl-list - Enumerate subscribers of a Lancelot list

=head1 SYNOPSIS

  pl-list [-adlnrv?] [-s SEPARATOR] [--all] [--[no]digest] [--full]
            [--[no]mail] [--name] [--[no]regular] [--separator=SEPARATOR]
            [--verbose] list@domain [pattern]

=head1 OVERVIEW

The B<pl-list> command outputs a list of addresses from a Lancelot
list's subscriber database. It can optionally include names and/or
subscription options, and select only those addresses matching a given
pattern.

=head1 DESCRIPTION

The B<pl-list> command displays either all addresses from
I<list@domain>'s subscriber database, or those matching the optional
shepl-style "glob" I<pattern>, which may contain "*", "?", and similar
wild cards.

It supports three different output styles: address-only,
name-and-address, or full, like

  alfred@example.com
  "Alfred E. Newman" <alfred@example.com>
  SMdnm alfred@example.com Alfred E. Newman

The first is the default; the second is used if the B<--name> option is
given and the address is associated with a name in the database (otherwise
it defaults to the first); the third is used if the B<--full> option is
given. If there is no name associated with the address, the "full" output
line will end after the address.

If both B<--name> and B<--full> are specified, the output looks like

  SMdnm "Alfred E. Newman" <alfred@example.com>

With "full" output, the six characters at the beginning of the line
signify the status and subscription options of the address. The first
character gives the status, where B<S> is SUBSCRIBED, B<B> is BOUNCING,
and B<X> is BLACKLIST. The next five characters, respectively, refer to the
subscription options B<admin>, B<moderator>, B<digest>, B<nomail>, and
B<moderated>; a letter implies that the option in question is set,
while a dash ("-") signifies that it is not set.

With "full" output, the fields are normally separated by spaces; for easier
processing with programs like B<cut> or B<sort> an alternative separator may
be defined using the B<--separator> (or B<-s>) option.

=head1 OPTIONS

=over 4

=item B<--all>, B<-a>

Outputs all subscribers (regular, digest, and nomail).

=item B<--digest>, B<-d>

Includes "digest" subscribers in the output. (Default.)

=item B<--full>, B<-l>

Produces "full" output including subscriber state and options.

=item B<--help>, B<-?>

Causes the program to output a brief usage explanation and exit.

=item B<--name>, B<-n>

Includes subscriber names in the output where available.

=item B<--nomail>

Includes "non-receiving" subscribers in the output.

=item B<--nodigest>

Excludes "digest" subscribers from the output.

=item B<--nonomail>

Excludes "non-receiving" subscribers from the output. (Default.)

=item B<--noregular>

Excludes "regular" subscribers from the output.

=item B<--regular>, B<-r>

Includes "regular" subscribers in the output. (Default.)

=item B<--separator>=I<separator>, B<-s> I<separator>

Uses I<separator> to delimit columns in "full" output instead of a space.

=item B<--verbose>, B<-v>

Causes the program to output messages about its progress to the
standard error channel.

=back

=head1 SEE ALSO

pl-conf(1), pl-init(1), pl-subchange(1), pl-subscribe(1), pl-unsubscribe(1)

=head1 AUTHOR

Anselm Lingnau <anselm@anselms.net>

=head1 COPYRIGHT AND LICENSE

Copyright 2004 by Anselm Lingnau. This program is free software; you
may 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, refer to
<URL:http://www.gnu.org/copyleft/gpl.html>. You may also obtain it by
writing to the Free Software Foundation, Inc., 59 Temple Place - Suite
330, Boston, MA 02111-1307, USA.

=cut

use strict;

# Make Binary find it's libraries for non standard installations ...
use Config;
use File::Basename;
use vars qw($g_base_dir);
BEGIN {
    use FindBin qw($Bin);
    $g_base_dir = dirname ($Bin);
}
use lib "$g_base_dir/lib";
use lib "$g_base_dir/lib/perl5/$Config{version}";
use lib "$g_base_dir/lib/perl5/site_perl/$Config{version}";

use Lancelot::GetOpt qw/GetOptions/;
use Lancelot::DB;
use Lancelot::Log qw/log/;

my (%status) = qw/SUBSCRIBED S BOUNCING B BLACKLIST X UNCONFIRMED U/;

my (%opts) = ( regular => 1, unconfirmed => 0 );

GetOptions(\%opts,
           -argvmin => 1, "no list address specified",
           -argvmax => 2, "too many arguments",
           "all|a!",
           "digest|d!", "regular|r!", "nomail!",
           "unconfirmed|u!",
           "name|n?", "full|l?",
           "order|O=",
           "separator|s=");

$opts{digest} = $opts{regular} = $opts{nomail}
    = $opts{unconfirmed} = 1 if $opts{all};

my $listaddr = shift;
my $pattern = shift || "*";

my $db = new Lancelot::DB $listaddr
    or die "$0: error accessing list $listaddr\n";

my $optspec = {};
$optspec->{order} = $opts{order} if $opts{order};

foreach my $a ($db->get_addresses($pattern, $optspec)) {
    log "debug", $a;
    my $optref = $db->get_address_options($a);
    next if $optref->{status} eq "UNCONFIRMED" && !$opts{unconfirmed};
    next if $optref->{digest} == 1 && !$opts{digest};
    next if $optref->{digest} == 0 && !$opts{regular};
    next if $optref->{nomail} == 1 && !$opts{nomail};
    delete $optref->{name} if $optref->{name} eq $a;
    if ($opts{full}) {
        # Full output
        print $status{$optref->{status}};
        print ($optref->{admin} ? "A" : "-");
        print ($optref->{moderator} ? "M" : "-");
        print ($optref->{digest} ? "d" : "-");
        print ($optref->{nomail} ? "n" : "-");
        print ($optref->{moderated} ? "m" : "-");
        my $s = $opts{separator} || ' ';
        if ($opts{name}) {
            if ($optref->{name}) {
                print qq|$s"$optref->{name}" <$a>|;
            } else {
                print "$s$a";
            }
        } else {
            print "$s$a";
            print "$s$optref->{name}" if $optref->{name};
        }
    } elsif ($opts{name}) {
        # Address and name
        if ($optref->{name}) {
            print qq|"$optref->{name}" <$a>|;
        } else {
            print $a;
        }
    } else {
        # Just the address
        print $a;
    }
    print "\n";
}