4 # Copyright (C) 2002-2003 Jan Kratochvil <project-PerlMail@jankratochvil.net>
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 # Name: Lastname Firstname "nick1" "nick2", dropped text
21 # Company: same as Name to indicate company record
24 use vars qw($VERSION);
25 $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
30 require Mail::Address;
33 Getopt::Long::Configure(
38 die if !Getopt::Long::GetOptions(
43 $type="9000" if $opt_9000;
44 my $class="PerlMail::Contacts::$type";
45 eval "require $class;1;" or die "Cannot load loader $class: $!";
54 $record{$item{"FIELD"}}=$item{"FIELD-DATA"};
55 ($item{"FIELD"} ne "Mail" || !$item{"FIELD-DATA"} ? () : ({
56 "name"=>$record{"Name"},
57 "mail"=>$item{"FIELD-DATA"},
58 "attr"=>$item{"FIELD-NAME"},
59 "iscompany"=>($record{"Name"} && $record{"Company"} && $record{"Name"} eq $record{"Company"}),
65 my($name,$mail,$attr,$iscompany)=map(($data->{$_}),qw(name mail attr iscompany));
69 while ($name=~s/"([^"]*)"([!])?//s) {
74 $name=~s/^(\w+)\s+(\w+)$/$2 $1/s if !$iscompany;
75 push @nicks,$name if !$name_force;
77 $_.=".$attr" if $attr;
82 "obj"=>Mail::Address->new(($name_force || $name),$mail),
87 my $nick=$_->{"nick"};
88 my $dupe=$dupe{$nick}++;
89 $nick.=".$dupe" if $dupe;
90 print "alias $nick ".$_->{"obj"}->format()."\n";