contacts-n9k2mutt

   1 #! /usr/bin/perl
   2 #
   3 # $Id$
   4
   5 use vars qw($VERSION);
   6 $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
   7 use strict;
   8 use warnings;
   9
  10 require Getopt::Long;
  11 require PrecislovaniLace::Contacts;
  12 require Mail::Address;
  13
  14
  15 Getopt::Long::Configure(
  16                 "no_ignorecase",
  17                 "bundling",
  18                 );
  19 die if !Getopt::Long::GetOptions(
  20                 );
  21
  22 undef $/;
  23 while (<>) {
  24         my @data=map({
  25                         my @record=@$_;
  26                         my %record;
  27                         map({
  28                                         my %item=%$_;
  29                                         $record{$item{"FIELD"}}=$item{"FIELD-DATA"};
  30                                         ($item{"FIELD"} ne "Mail" || !$item{"FIELD-DATA"} ? () : ({
  31                                                         "name"=>$record{"Name"},
  32                                                         "mail"=>$item{"FIELD-DATA"},
  33                                                         "attr"=>$item{"FIELD-NAME"},
  34                                                         "iscompany"=>($record{"Name"} && $record{"Company"} && $record{"Name"} eq $record{"Company"}),
  35                                                         }));
  36                                         } @record);
  37                         } PrecislovaniLace::Contacts->import($_));
  38         my @nicked=map({
  39                         my $data=$_;
  40                         my($name,$mail,$attr,$iscompany)=map(($data->{$_}),qw(name mail attr iscompany));
  41                         $name=~s/,.*$//s;
  42                         my @nicks=();
  43                         push @nicks,$1 while $name=~s/"([^"]*)"//s;
  44                         $name=~s/\s*$//s;
  45                         $name=~s/^(\w+)\s+(\w+)$/$2 $1/s if !$iscompany;
  46                         push @nicks,$name;
  47                         for (@nicks) {
  48                                 $_.=".$attr" if $attr;
  49                                 s/\s+/./gs;
  50                                 }
  51                         map({
  52                                         "nick"=>$_,
  53                                         "obj"=>Mail::Address->new($name,$mail),
  54                                         },@nicks);
  55                         } @data);
  56         for (@nicked) {
  57                 print "alias ".$_->{"nick"}." ".$_->{"obj"}->format()."\n";
  58                 }
  59         }