File Coverage

blib/lib/Mail/Addressbook/Convert/Eudora.pm
Criterion Covered Total %
statement 82 95 86.3
branch 20 28 71.4
condition 8 12 66.6
subroutine 8 8 100.0
pod 3 3 100.0
total 121 146 82.8


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Mail::Addressbook::Convert::Eudora - convert to and from Eudora addressbooks
4              
5             =head1 SYNOPSIS
6              
7             use strict;
8              
9             use Eudora;
10              
11             my $Eudora = new Eudora();
12              
13             my $EudoraInFile ="eudoraSample.txt"; # name of the file containing the Eudora data
14              
15             # Convert Eudora to Standard Intermediate format
16              
17             # see documentation for details on format.
18              
19             my $raIntermediate = $Eudora->scan(\$EudoraInFile);
20              
21             # This will also work
22              
23             #my @EudoraInArray = @arrayContainingTheEudoraData;
24              
25             #my $raIntermediate = $Eudora->scan(\@EudoraInArray);
26              
27              
28             # Convert back to Eudora
29              
30             my $raEudorafOut = $Eudora->output($raIntermediate);
31              
32             print join "", @$raIntermediate;
33              
34             print "\n\n\n\n";
35              
36             print join "", @$raEudorafOut
37             ;
38              
39             =head1 REQUIRES
40              
41             Perl, version 5.001 or higher
42              
43             Carp
44             Text::ParseWords
45              
46             =head1 DESCRIPTION
47              
48             This module is meant to be used as part of the Mail::Addressbook::Convert distribution.
49              
50             It can convert a Eudoraaddressbook to a Standard Intermediate format(STF) and a STF to Eudora
51             As part of the larger distribution, it will allow conversion between Eudora and many other
52             formats.
53              
54             To use to convert between Eudora and Ldif as an example, you would do the following
55              
56             use Mail::Addressbook::Convert::Ldif;
57              
58             use Mail::Addressbook::Convert::Eudora;
59              
60             my $Ldif = new Mail::Addressbook::Convert::Ldif();
61              
62             my $Eudora = new Mail::Addressbook::Convert::Eudora();
63              
64             my $EudoraInFile ="eudoraSample.txt"; # name of the file containing the Eudora data
65              
66             my $raIntermediate = $Ldif->scan(\$EudoraInFile);
67              
68             my $raLdif = $Ldif->output($raIntermediate); # reference to an array containing a Ldif addressbook
69              
70              
71             =head1 DEFINITIONS
72            
73             Standard Intermediate Format(STF) :
74              
75             The addressbook format that is used as an intermediate
76             between conversions. It is rfc822 compliant and can
77             be used directly as a Eudora addressbook. Do not use
78             a Eudora addressbook as an STF. Some versions of
79             Eudora use a format, that while RFC822 compliant, will
80             not work as an STF. Run the Eudora addressbook
81             through $Eudora->scan()
82            
83             Eudora addressbook:
84             A Eudora addressbook. The input Eudora address file is
85             "nndbase.txt" in the Eudora directory. for Windows users
86             "Eudora Nicknames" in the System Folder:Eudora Folder for Mac users
87              
88            
89              
90             =head1 METHODS
91              
92             =head2 new
93              
94             no arguments needed.
95              
96             =head2 scan
97              
98             Input : a reference to an array containing a Eudora addressbook
99             or a reference to a scalar containing
100             the file name with the Eudora Addressbook.
101            
102             Returns: a reference to a STF ( see above).
103              
104             =head2 output
105              
106             Input: a reference to a STF ( see above).
107              
108             Returns : a reference to an array containing a Eudora addressbook.
109              
110              
111             =head1 LIMITATIONS
112              
113             This only converts email address, aliases, and mailing lists. Phone numbers,
114             postal addresses and other such data are not converted.
115              
116              
117             =head1 REFERENCES
118              
119              
120              
121             I derived the format by visually inspecting examples, not by reading a document.
122              
123            
124              
125             =head1 HISTORY
126              
127             This code is derived from the code used on www.interguru.com/mailconv.htm . The site
128             has been up since 1996 The site gets about 8000 unique visitors a month,
129             many of whom make addressbook conversions. The code has been well tested.
130              
131             =head1 FUTURE DIRECTIONS
132              
133              
134              
135              
136             =head1 SEE ALSO
137              
138              
139              
140              
141              
142             =head1 BUGS
143              
144              
145              
146             =head1 CHANGES
147              
148             Original Version 2001-Sept-09
149            
150             =head1 COPYRIGHT
151              
152             Copyright (c) 2001 Joe Davidson. All rights reserved.
153             This program is free software; you can redistribute it
154             and/or modify it under the terms of the Perl Artistic License
155             (see http://www.perl.com/perl/misc/Artistic.html). or the
156             GPL copyleft license ( http://www.gnu.org/copyleft/gpl.html)
157              
158              
159             =head1 AUTHOR
160              
161             Mail::Addressbook::Convert was written by Joe Davidson in 2001.
162              
163             =cut
164              
165             #------------------------------------------------------------------------------
166              
167 1     1   1393 use strict;
  1         13  
  1         174  
168              
169              
170             package Mail::Addressbook::Convert::Eudora;
171              
172 1     1   6 use Mail::Addressbook::Convert::Utilities;
  1         2  
  1         85  
173 1     1   6 use Mail::Addressbook::Convert::PersistentUtilities;
  1         2  
  1         22  
174              
175 1     1   30 use 5.001;
  1         4  
  1         159  
176              
177             sub new {
178 5     5 1 1260 bless {},shift;
179             }
180              
181             ######################################################################
182              
183              
184             sub scan {
185              
186 5     5 1 17 my $Eudora = shift;
187 5         9 my $inputParm = shift; # reference to input Eudora data as an array or reference to a scalar
188             # containing the name of a file containing the Eudora Addressbook.
189              
190 5         33 my $perUtil = new Mail::Addressbook::Convert::PersistentUtilities();
191 5         16 my $raEudoraArray= getInput($inputParm);
192              
193 5         9 my (@outputFile, %noteLine, $outLine, %listEntry, %name, $alias);
194 0         0 my ( $type, @rest, $rest, %address, %aliasOf, %newAlias, $nm, @tmp);
195              
196 1     1   969 use Text::ParseWords;
  1         1459  
  1         1457  
197 5         9 my $individualIndex = 0;
198 5         6 my $listIndex = 0;
199 5         12 foreach (@$raEudoraArray)
200             {
201            
202              
203 59         88 s/\'//g;
204 59 50       137 if (tr/"/"/%2 !=0) # to prevent unterminated quotes
205             # (which should not exist, but ocasionaly do)
206            
207             # The garbled line will remain
208             # garbled.
209             {
210 0         0 s/ / "/;
211             }
212 59         170 s/\s+
213 59         251 @tmp = split(" ");
214 59 50 100     326 if (@tmp > 3 and /
      66        
      33        
215             {
216 0         0 /alias\s+(.+)<(.+)>/;
217 0         0 my $firstPart = $1;
218 0         0 my $lastPart = $2;
219 0         0 $firstPart =~ s/^\s+|\s+$//g; # trim leading and trailing spaces.
220 0         0 my @hold22= split(" ", $firstPart);
221 0 0       0 if (@hold22 > 2)
222             {
223 0         0 my $aliasName= shift @hold22;
224 0         0 my $givenName = join (" ", @hold22);
225 0         0 $_ = qq(alias $aliasName "$givenName"<$lastPart>);
226             }
227             else
228             {
229 0         0 $_ = qq(alias "$firstPart"<$lastPart>);
230             }
231             }
232 59 100 66     163 if (/alias "/ and !/<|,/)
233             {
234            
235 3         12 ($type,$alias,@rest) = quotewords(" ",0,$_);
236 3         371 my $userName = $alias;
237 3         8 $alias =~ s/ /_/g;
238 3         9 $_ = qq(alias $alias $userName<$rest[0]>);
239             }
240              
241 59         154 ($type,$alias,@rest) = quotewords(" ",0,$_);
242 59 100       6621 if ($rest[1])
243             {
244 9         23 $rest = join("_",@rest);
245             }
246             else
247             {
248 50         64 $rest = $rest[0];
249             }
250 59         239 $alias =~ s/^\s+|\s+$//g;
251 59         73 $alias =~ s/ //g;
252 59         474 $rest =~ s/^\s+|\s+$//g;
253 59 100       139 if ($type =~ /note/)
254             {
255 11         28 $noteLine{$alias} = $_;
256             }
257             else
258             {
259 48 100       96 if ($rest =~ /\,/)
260             {
261 17         47 $listEntry{$alias} = $rest;
262             }
263             else
264             {
265 31 50       94 if ($rest =~ /\)$/)
    100          
266             {
267             #alias joan joan.olive@utoronto.ca (Joan Olive)
268 0         0 ($address{$alias}, $name{$alias}) =
269             split(/\(/,$rest);
270             }
271             elsif ($rest =~ /
272             {
273            
274             #alias jhd joe
275             #alias jhd
276             #alias jhd Joe Davidson
277 24         94 ($name{$alias},$address{$alias}) = split(/\
278 24         62 $address{$alias} =~ s/>//;
279 24 50       74 $name{$alias} = (split(/@/,$address{$alias}))[0]
280             unless $name{$alias};
281             }
282             else
283             {
284 7         18 $address{$alias} = $rest;
285 7         33 $name{$alias} = (split(/@/,$address{$alias}))[0];
286             }
287             }
288             }
289             }
290              
291             #Examples
292 5         37 foreach my $key (sort { lc($a) cmp lc($b)} ( (keys %name)))
  52         79  
293             {
294              
295 31         94 my $tempAlias = $perUtil->makeAliasUnique($key);
296 31         213 $address{$key} =~ s/\s+|>\(|\)|<|\n|\r//g;
297 31         192 $name{$key} =~ s/\)|\(|\n|\r|\"|^\s+|>|<|\s+$//g;
298 31         71 $aliasOf{$address{$key}} = $tempAlias;
299 31         45 $newAlias{key} = $tempAlias;
300 31         43 $nm = $name{$key};
301 31         53 $nm =~ s/_/ /g;
302             #CONTINUE HERE
303 31         74 $outLine = qq(alias $key \"$nm\"<$address{$key}>\n);
304 31         40 $outLine =~ s/>>/>/;
305 31         44 $outLine =~ s/SPRYCOMMA/,/;
306 31 50       110 push ( @outputFile, $outLine) if ($address{$key}) ;
307              
308 31 100       86 push ( @outputFile, $noteLine{$key}) if $noteLine{$key};
309             }
310 5         12 my @listMembers;
311 5         17 foreach my $key (sort { lc($a) cmp lc($b)} (keys %listEntry))
  18         30  
312             {
313 17         223 $listEntry{$key} =~ s/\)|\(|\n|\r|\"|^\s+|>|<|\s+$//g;
314 17         75 @listMembers = split(/\,/,$listEntry{$key});
315 17         40 foreach my $k (0..$#listMembers)
316             {
317 66 100       147 $listMembers[$k] = $aliasOf{$listMembers[$k]}
318             if $aliasOf{$listMembers[$k]};
319             }
320 17         48 $listEntry{$key} = join(',' , @listMembers );
321 17         38 $outLine = qq(alias $key $listEntry{$key}\n);
322             #$outLine =~ s/>>/>/;
323 17         31 push ( @outputFile, $outLine) ;
324 17 50       42 push ( @outputFile, $noteLine{$key}."\n") if $noteLine{$key};
325             }
326              
327 5         11 push ( @outputFile, "\n");
328 5         66 return \@outputFile;
329             }
330              
331             ########################### sub output #######################
332             sub output
333              
334             {
335              
336 1     1 1 6 my (@outputFile, $alias1,);
337              
338 1         1 my $Eudora = shift;
339 1         3 my $raInputArray = shift; # reference to input data as an array
340              
341              
342             # Return intermediate file, as it is already in Eudora format.
343              
344 1         2 return $raInputArray;
345             }
346              
347              
348              
349             ########################### end sub output #######################
350             1;