PerlMail/Contacts/9210.pm

   1 #! /usr/bin/perl
   2 #
   3 #       $Id$
   4 # Copyright (C) 2002-2004 Jan Kratochvil <project-PerlMail@jankratochvil.net>
   5 #
   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.
  10 #
  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.
  15 #
  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
  19
  20
  21 package PerlMail::Contacts::9210::Text::CSV::Simple;
  22 use vars qw(@ISA);
  23 require Text::CSV::Simple;
  24 @ISA=qw(Text::CSV::Simple);
  25 require Encode::Guess;
  26 use bytes;
  27
  28 sub _contents
  29 {
  30 my($self)=@_;
  31
  32         my $pathname=$self->{"_file"};
  33         my $F;
  34         if (substr($pathname,0,1) eq "\x00") {
  35                 $F=substr($pathname,1);
  36                 }
  37         else {
  38                 local *F;
  39                 open F,$pathname or die "open \"$pathname\": $!";
  40                 $F=do { undef $/; <F>; };
  41                 close F or die "close \"$pathname\": $!";
  42                 }
  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;
  48 }
  49
  50
  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; };
  54 use strict;
  55 use warnings;
  56 use vars qw(@ISA);
  57 require PerlMail::Contacts;
  58 @ISA=qw(PerlMail::Contacts);
  59
  60
  61 sub in
  62 {
  63 my($self,$data)=@_;
  64
  65         $self=$self->new() if !ref $self;
  66         my @F=PerlMail::Contacts::9210::Text::CSV::Simple->new()->read_file("\x00".$data);
  67         my @id=@{shift @F};
  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'";
  72         my %id;
  73         for my $fields (@F) {
  74                 @names==@$fields or die "Fields line fields do not match the header names number";
  75                 my $id=$fields->[0];
  76                 my $mail_name;
  77                 my $mail_data;
  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};
  86                                 push @{$id{$id}{""}},{
  87             "FIELD"=>"Name",
  88             "FIELD-DATA"=>$string,
  89                                                 } if $first;
  90                                 }
  91                         elsif ($name eq "Company") {
  92                                 die "Non-matching field" if $string ne $id{$id}{$name};
  93                                 push @{$id{$id}{""}},{
  94             "FIELD"=>"Company",
  95             "FIELD-DATA"=>$string,
  96                                                 } if $first;
  97                                 }
  98                         elsif ($name eq "Other Mail desc.") {
  99                                 $mail_name=$string;
 100                                 }
 101                         elsif ($name eq "Other Mail") {
 102                                 $mail_data=$string;
 103                                 }
 104                         elsif ($name eq "Mail") {
 105                                 $mail_data=$string;
 106                                 }
 107                         }
 108                 push @{$id{$id}{""}},{
 109                                 "FIELD"=>"Mail",
 110                                 "FIELD-NAME"=>$mail_name,
 111                                 "FIELD-DATA"=>$mail_data,
 112                                 } if $mail_name||$mail_data;
 113                 }
 114         my @r;
 115         for my $id (sort { ($a<=>$b); } keys(%id)) {
 116                 do { push @r,$_ if $_; } for $id{$id}{""};
 117                 }
 118         return @r;
 119 }
 120
 121 1;