+syntax '"nickname"!' to force $name to be 'nickname'
[PerlMail.git] / 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                         my $name_force;
44                         while ($name=~s/"([^"]*)"([!])?//s) {
45                                 push @nicks,$1;
46                                 $name_force=$1 if $2;
47                                 }
48                         $name=~s/\s*$//s;
49                         $name=~s/^(\w+)\s+(\w+)$/$2 $1/s if !$iscompany;
50                         push @nicks,$name if !$name_force;
51                         for (@nicks) {
52                                 $_.=".$attr" if $attr;
53                                 s/\s+/./gs;
54                                 }
55                         map({
56                                         "nick"=>$_,
57                                         "obj"=>Mail::Address->new(($name_force || $name),$mail),
58                                         },@nicks);
59                         } @data);
60         for (@nicked) {
61                 print "alias ".$_->{"nick"}." ".$_->{"obj"}->format()."\n";
62                 }
63         }