X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=blobdiff_plain;f=PerlMail%2FContacts.pm;h=0767261bcf87d5abf620fd338b3bc1e553ff018d;hp=ecee5696d8fb045acb2fde8aa0859767bcd1aa7b;hb=adc851054ec9cb7f8338eaa8152e14a846c9a9f1;hpb=c0e977a782eefb1cfa81378e1fa947db53e3ac60 diff --git a/PerlMail/Contacts.pm b/PerlMail/Contacts.pm index ecee569..0767261 100644 --- a/PerlMail/Contacts.pm +++ b/PerlMail/Contacts.pm @@ -1,7 +1,7 @@ -#! /usr/bin/perl -w +#! /usr/bin/perl # # $Id$ -# Copyright (C) 2002 Jan Kratochvil +# Copyright (C) 2002-2004 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 @@ -18,11 +18,11 @@ # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -package PrecislovaniLace::Contacts; +package PerlMail::Contacts; use vars qw($VERSION); $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; use strict; -#use warnings; +use warnings; sub new @@ -35,54 +35,10 @@ my $self=bless { 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 in +# my($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)); -} +# sub out +# my($self,$data)=@_; 1;