3 # $Id: 9210.pm,v 1.4 2004/12/19 11:47:47 short Exp $
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: 1.4 $=~/\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($omail_name,$omail_data);
77 my($name_last,$name_first);
79 for my $fieldi (1..$#names) {
80 my $string=$fields->[$fieldi];
81 next if $string eq "";
82 my $name=$names[$fieldi];
83 my $first=!exists $id{$id}{$name};
84 $id{$id}{$name}=$string if $first;
85 if ($name eq "Last name") {
86 die "Non-matching field" if $string ne $id{$id}{$name};
89 elsif ($name eq "First name") {
90 die "Non-matching field" if $string ne $id{$id}{$name};
93 elsif ($name eq "Company") {
94 die "Non-matching field" if $string ne $id{$id}{$name};
95 push @{$id{$id}{""}},{
97 "FIELD-DATA"=>$string,
100 elsif ($name eq "Other Mail desc.") {
103 elsif ($name eq "Other Mail") {
106 elsif ($name eq "Mail") {
107 push @mail,undef()=>$string;
109 elsif ($name=~/^Mail [(](.*)[)]$/) {
110 push @mail,$1=>$string;
114 $name.=" ".$name_first if defined $name_first;
115 push @{$id{$id}{""}},{
119 push @mail,$omail_name=>$omail_data if defined $omail_data;
121 my $name=shift @mail;
122 my $data=shift @mail;
123 push @{$id{$id}{""}},{
130 return map(($id{$_}{""}||()),(sort { ($a<=>$b); } keys(%id)));