Support 9210 CSV contacts format.
authorshort <>
Fri, 17 Dec 2004 23:07:08 +0000 (23:07 +0000)
committershort <>
Fri, 17 Dec 2004 23:07:08 +0000 (23:07 +0000)
PerlMail/Contacts/9210.pm [new file with mode: 0644]
contacts-n9k2mutt

diff --git a/PerlMail/Contacts/9210.pm b/PerlMail/Contacts/9210.pm
new file mode 100644 (file)
index 0000000..e0c08a9
--- /dev/null
@@ -0,0 +1,121 @@
+#! /usr/bin/perl
+# 
+#      $Id$
+# Copyright (C) 2002-2004 Jan Kratochvil <project-PerlMail@jankratochvil.net>
+# 
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+
+package PerlMail::Contacts::9210::Text::CSV::Simple;
+use vars qw(@ISA);
+require Text::CSV::Simple;
+@ISA=qw(Text::CSV::Simple);
+require Encode::Guess;
+use bytes;
+
+sub _contents
+{
+my($self)=@_;
+
+       my $pathname=$self->{"_file"};
+       my $F;
+       if (substr($pathname,0,1) eq "\x00") {
+               $F=substr($pathname,1);
+               }
+       else {
+               local *F;
+               open F,$pathname or die "open \"$pathname\": $!";
+               $F=do { undef $/; <F>; };
+               close F or die "close \"$pathname\": $!";
+               }
+       my $encoding=Encode::Guess::guess_encoding($F);
+       ref $encoding or die "Cannot guess encoding of: $pathname";
+       my $F_utf8=$encoding->decode($F);
+       $F_utf8=~tr/\r\n/\n\n/s;
+       return split /\n/,$F_utf8;
+}
+
+
+package PerlMail::Contacts::9210;
+use vars qw($VERSION);
+$VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
+use strict;
+use warnings;
+use vars qw(@ISA);
+require PerlMail::Contacts;
+@ISA=qw(PerlMail::Contacts);
+
+
+sub in
+{
+my($self,$data)=@_;
+
+       $self=$self->new() if !ref $self;
+       my @F=PerlMail::Contacts::9210::Text::CSV::Simple->new()->read_file("\x00".$data);
+       my @id=@{shift @F};
+       $id[0] eq "CntMngCsv 3.0.0" or die "Unknown file format";
+       shift @F;       # drop unknown header numbers;
+       my @names=@{shift @F};
+       $names[0] eq "ID" or die "field[0] not 'ID'";
+       my %id;
+       for my $fields (@F) {
+               @names==@$fields or die "Fields line fields do not match the header names number";
+               my $id=$fields->[0];
+               my $mail_name;
+               my $mail_data;
+               for my $fieldi (1..$#names) {
+                       my $string=$fields->[$fieldi];
+                       next if $string eq "";
+                       my $name=$names[$fieldi];
+                       my $first=!exists $id{$id}{$name};
+                       $id{$id}{$name}=$string if $first;
+                       if ($name eq "Last name") {
+                               die "Non-matching field" if $string ne $id{$id}{$name};
+                               push @{$id{$id}{""}},{
+            "FIELD"=>"Name",
+            "FIELD-DATA"=>$string,
+                                               } if $first;
+                               }
+                       elsif ($name eq "Company") {
+                               die "Non-matching field" if $string ne $id{$id}{$name};
+                               push @{$id{$id}{""}},{
+            "FIELD"=>"Company",
+            "FIELD-DATA"=>$string,
+                                               } if $first;
+                               }
+                       elsif ($name eq "Other Mail desc.") {
+                               $mail_name=$string;
+                               }
+                       elsif ($name eq "Other Mail") {
+                               $mail_data=$string;
+                               }
+                       elsif ($name eq "Mail") {
+                               $mail_data=$string;
+                               }
+                       }
+               push @{$id{$id}{""}},{
+                               "FIELD"=>"Mail",
+                               "FIELD-NAME"=>$mail_name,
+                               "FIELD-DATA"=>$mail_data,
+                               } if $mail_name||$mail_data;
+               }
+       my @r;
+       for my $id (sort { ($a<=>$b); } keys(%id)) {
+               do { push @r,$_ if $_; } for $id{$id}{""};
+               }
+       return @r;
+}
+
+1;
index 81aa704..bba3b46 100755 (executable)
@@ -32,9 +32,16 @@ Getopt::Long::Configure(
                "no_ignorecase",
                "bundling",
                );
+my $opt_9000;
 die if !Getopt::Long::GetOptions(
+               "9000"=>\$opt_9000,
                );
 
+my $type="9210";
+$type="9000" if $opt_9000;
+my $class="PerlMail::Contacts::$type";
+eval "require $class;1;" or die "Cannot load loader $class: $!";
+
 undef $/;
 while (<>) {
        my @data=map({
@@ -50,7 +57,7 @@ while (<>) {
                                                        "iscompany"=>($record{"Name"} && $record{"Company"} && $record{"Name"} eq $record{"Company"}),
                                                        }));
                                        } @record);
-                       } PerlMail::Contacts::9000->in($_));
+                       } $class->in($_));
        my @nicked=map({
                        my $data=$_;
                        my($name,$mail,$attr,$iscompany)=map(($data->{$_}),qw(name mail attr iscompany));