From: short <>
Date: Fri, 17 Dec 2004 23:07:08 +0000 (+0000)
Subject: Support 9210 CSV contacts format.
X-Git-Tag: bp_lace~15
X-Git-Url: https://git.jankratochvil.net/?p=PerlMail.git;a=commitdiff_plain;h=0c848de6fd9c35f1ec9640b3adbab036ce0a5a91

Support 9210 CSV contacts format.
---

diff --git a/PerlMail/Contacts/9210.pm b/PerlMail/Contacts/9210.pm
new file mode 100644
index 0000000..e0c08a9
--- /dev/null
+++ b/PerlMail/Contacts/9210.pm
@@ -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;
diff --git a/contacts-n9k2mutt b/contacts-n9k2mutt
index 81aa704..bba3b46 100755
--- a/contacts-n9k2mutt
+++ b/contacts-n9k2mutt
@@ -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));