+#! /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;