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