contacts-n9k2mutt

   1 #! /usr/bin/perl
   2 #
   3 #       $Id$
   4 # Copyright (C) 2002-2003 Jan Kratochvil <project-PerlMail@jankratochvil.net>
   5 #
   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.
  10 #
  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.
  15 #
  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
  19
  20 # Name: Lastname Firstname "nick1" "nick2", dropped text
  21 # Company: same as Name to indicate company record
  22
  23
  24 use vars qw($VERSION);
  25 $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
  26 use strict;
  27 use warnings;
  28
  29 require Getopt::Long;
  30 require Mail::Address;
  31
  32
  33 Getopt::Long::Configure(
  34                 "no_ignorecase",
  35                 "bundling",
  36                 );
  37 my $opt_9000;
  38 die if !Getopt::Long::GetOptions(
  39                 "9000"=>\$opt_9000,
  40                 );
  41
  42 my $type="9210";
  43 $type="9000" if $opt_9000;
  44 my $class="PerlMail::Contacts::$type";
  45 eval "require $class;1;" or die "Cannot load loader $class: $!";
  46
  47 undef $/;
  48 while (<>) {
  49         my @data=map({
  50                         my @record=@$_;
  51                         my %record;
  52                         map({
  53                                         my %item=%$_;
  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"}),
  60                                                         }));
  61                                         } @record);
  62                         } $class->in($_));
  63         my @nicked=map({
  64                         my $data=$_;
  65                         my($name,$mail,$attr,$iscompany)=map(($data->{$_}),qw(name mail attr iscompany));
  66                         $name=~s/,.*$//s;
  67                         my @nicks=();
  68                         my $name_force;
  69                         while ($name=~s/"([^"]*)"([!])?//s) {
  70                                 push @nicks,$1;
  71                                 $name_force=$1 if $2;
  72                                 }
  73                         $name=~s/\s*$//s;
  74                         $name=~s/^(\w+)\s+(\w+)$/$2 $1/s if !$iscompany;
  75                         push @nicks,$name if !$name_force;
  76                         for (@nicks) {
  77                                 $_.=".$attr" if $attr;
  78                                 s/\s+/./gs;
  79                                 }
  80                         map({
  81                                         "nick"=>$_,
  82                                         "obj"=>Mail::Address->new(($name_force || $name),$mail),
  83                                         },@nicks);
  84                         } @data);
  85         for (@nicked) {
  86                 print "alias ".$_->{"nick"}." ".$_->{"obj"}->format()."\n";
  87                 }
  88         }