The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

package AddressBook;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw( getaddresses );

$VERSION = sprintf "%d.%02d", q$Revision: 1.0 $ =~ m#(\d+)\.(\d+)#;

use Carp;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};

	$self->{SETUP} = {};

	$self->{BOOKNAME} = shift; # Which address book
	$self->{FIELDS} = {}; # Field names and array positions
	$self->{BOOK} = []; # The addressbook contents

    bless $self, $class;

	open (FMT,"<$self->{BOOKNAME}.dat.fmt") || die "Can't open format file,$!\n";
	while (<FMT>) {
		chomp;
		if (/^\d+/) {
			my ($num, $name) = (split(/\s+/,$_));
			$self->{FIELDS}{$name} = $num;
		}
		elsif (/^label\d+/) {
			s/^label//;
			my $num = (split(/\s+/,$_))[0];
			my $label = $_;
			$label =~ s/\d+\s+//;
			$label =~ s/"//g;
			$self->{FIELDS}{"$label"} = $self->{FIELDS}{"other".$num};
			$self->{FIELDS}{"other".$num} = undef;
		}
	}
	close FMT;

	open (DAT,"<$self->{BOOKNAME}.dat") || die "Can't open data file,$!\n";
	while (<DAT>) {
		chomp;
		push @{$self->{BOOK}},$_;
	}

     return $self;
}

# ****************************************************************
#	return a subset of the addressbook
sub getaddresses {
    my $self = shift;
	my $field = shift;
	my $tag = shift;

	my $selected;

	foreach (@{$self->{BOOK}}) {
		my @record = (split(';',$_));
		my $index = $self->{FIELDS}{$field};
		if (defined $record[$index] && $tag =~ /$record[$index]/) {
			push @{$selected},\@record;
		}
	}

    return $selected;
}


1;
__END__

=head1 NAME

AddressBook.pm - Read and select from an ASCII address book as defined
				 by http://home.pages.de/~clemens and his Tcl/Tk
				 addressbook software.
				 Moved to http://addressbook.home.pages.de or
				 http://www.red.roses.de/~clemens/addressbook/
                         

=head1 SYNOPSIS

  use AddressBook;

  my $book = "$ENV{HOME}/addresses_private";

  	#	set the addressbook and open it

	my $addr = AddressBook->new($book);

	#	Get all addresses in which the 'remark' field equals 'EFM'

	my $data = $addr->getaddresses('remark','EFM');

	#	Print out a list of addresses

	foreach (sort {$a->[1] cmp $b->[1]} @{$data}) {
		print "$_->[0] $_->[1]\n",
			  "$_->[3] \n",
			  "$_->[5], $_->[6]  $_->[7]\n",
			  "$_->[10]\n",
			  "$_->[13]\n\n";
	}


=head1 DESCRIPTION

	Open an address database and select entries. Need to add stuff like
	"list the available fieldnames", "generate statistics on fields &
	values", and similar databasey type stuff.

	Primarily built to build data for my PostScript::MailLabels modules
	so I can print my Christmas Card mailing labels. 8-)

=head1 AUTHOR

    Alan Jackson
    November 1999
    alan@ajackson.org


=head1 SEE ALSO

=cut