4 # Copyright (C) 2002-2004 Jan Kratochvil <project-PerlMail@jankratochvil.net>
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 package PerlMail::Contacts::9210::Text::CSV::Simple;
23 require Text::CSV::Simple;
24 @ISA=qw(Text::CSV::Simple);
25 require Encode::Guess;
32 my $pathname=$self->{"_file"};
34 if (substr($pathname,0,1) eq "\x00") {
35 $F=substr($pathname,1);
39 open F,$pathname or die "open \"$pathname\": $!";
40 $F=do { undef $/; <F>; };
41 close F or die "close \"$pathname\": $!";
43 my $encoding=Encode::Guess::guess_encoding($F);
44 ref $encoding or die "Cannot guess encoding of: $pathname";
45 my $F_utf8=$encoding->decode($F);
46 $F_utf8=~tr/\r\n/\n\n/s;
47 return split /\n/,$F_utf8;
51 package PerlMail::Contacts::9210;
52 use vars qw($VERSION);
53 $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
57 require PerlMail::Contacts;
58 @ISA=qw(PerlMail::Contacts);
65 $self=$self->new() if !ref $self;
66 my @F=PerlMail::Contacts::9210::Text::CSV::Simple->new()->read_file("\x00".$data);
68 $id[0] eq "CntMngCsv 3.0.0" or die "Unknown file format";
69 shift @F; # drop unknown header numbers;
70 my @names=@{shift @F};
71 $names[0] eq "ID" or die "field[0] not 'ID'";
74 @names==@$fields or die "Fields line fields do not match the header names number";
76 my($mail_name,$mail_data);
77 my($name_last,$name_first);
78 for my $fieldi (1..$#names) {
79 my $string=$fields->[$fieldi];
80 next if $string eq "";
81 my $name=$names[$fieldi];
82 my $first=!exists $id{$id}{$name};
83 $id{$id}{$name}=$string if $first;
84 if ($name eq "Last name") {
85 die "Non-matching field" if $string ne $id{$id}{$name};
88 elsif ($name eq "First name") {
89 die "Non-matching field" if $string ne $id{$id}{$name};
92 elsif ($name eq "Company") {
93 die "Non-matching field" if $string ne $id{$id}{$name};
94 push @{$id{$id}{""}},{
96 "FIELD-DATA"=>$string,
99 elsif ($name eq "Other Mail desc.") {
102 elsif ($name eq "Other Mail") {
105 elsif ($name eq "Mail") {
110 $name.=" ".$name_first if defined $name_first;
111 push @{$id{$id}{""}},{
115 push @{$id{$id}{""}},{
117 "FIELD-NAME"=>$mail_name,
118 "FIELD-DATA"=>$mail_data,
119 } if $mail_name||$mail_data;
122 for my $id (sort { ($a<=>$b); } keys(%id)) {
123 do { push @r,$_ if $_; } for $id{$id}{""};