From c0e977a782eefb1cfa81378e1fa947db53e3ac60 Mon Sep 17 00:00:00 2001 From: short <> Date: Tue, 10 Sep 2002 13:54:19 +0000 Subject: [PATCH 1/1] Initial commit --- PerlMail/Contacts.pm | 88 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) create mode 100644 PerlMail/Contacts.pm diff --git a/PerlMail/Contacts.pm b/PerlMail/Contacts.pm new file mode 100644 index 0000000..ecee569 --- /dev/null +++ b/PerlMail/Contacts.pm @@ -0,0 +1,88 @@ +#! /usr/bin/perl -w +# +# $Id$ +# Copyright (C) 2002 Jan Kratochvil +# +# 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 PrecislovaniLace::Contacts; +use vars qw($VERSION); +$VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; +use strict; +#use warnings; + + +sub new +{ +my($class)=@_; +my $self=bless { + "data"=>[], + },$class; + + return $self; +} + +sub _parse +{ +my($self,$data,@headers)=@_; + + my $re=join("(.*?)(\r\n)?",map("\Q[$_]\E\r\n",@headers)); + $re=qr/^$re/s; + my @r=(); + while (my @items=($data=~/$re/s)) { + my %h=(); + for my $i (0..$#headers) { + $h{$headers[$i]}=(!$items[2*$i+1] ? undef : $items[2*$i+0]) + } + push @r,\%h; + $data=substr($data,length $&); + } + die "Unrecognized data (parsing ".join("/",@headers)."): $data" if $data; + return @r; +} + +sub import +{ +my($self,$data)=@_; + + $self=$self->new() if !ref $self; + push @{$self->{"data"}},map({ + [ $self->_parse($_->{"RECORD"}."\r\n","FIELD","FIELD-NAME","FIELD-DATA","FIELD-END") ]; + } $self->_parse($data,"RECORD","RECORD-END")); + return (wantarray() ? @{$self->{"data"}} : $self->{"data"}); +} + +sub _join +{ +my($self,$href,@headers)=@_; + + my $trailer=pop @headers; + return join("",map(("[$_]\r\n".(!defined $href->{$_} ? "" : $href->{$_}."\r\n")),@headers))."[$trailer]\r\n"; +} + +sub export +{ +my($self,$data)=@_; + + $data=$self->{"data"} if !$data; + return join("",map({ + "[RECORD]\r\n".join("",map({ + $self->_join($_,"FIELD","FIELD-NAME","FIELD-DATA","FIELD-END"); + } @$_))."[RECORD-END]\r\n"; + } @$data)); +} + +1; -- 1.8.3.1