File Coverage

blib/lib/Mail/Addressbook/Convert/Utilities.pm
Criterion Covered Total %
statement 40 43 93.0
branch 10 12 83.3
condition 2 3 66.6
subroutine 8 8 100.0
pod 0 4 0.0
total 60 70 85.7


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Mail::Addressbook::Convert::Utilities
4              
5             =head1 SYNOPSIS
6              
7             This module is not designed to be used by the user.
8              
9             It provides utility methods with for Mail::Addressbook::Convert
10              
11             =head1 REQUIRES
12              
13             Perl, version 5.001 or higher
14              
15             Carp
16              
17             =head1 DESCRIPTION
18              
19              
20             =head1 DEFINITIONS
21            
22            
23              
24             =head1 METHODS
25              
26              
27             =head1 LIMITATIONS
28              
29              
30              
31             =head1 REFERENCES
32              
33            
34              
35             =head1 HISTORY
36              
37             This code is derived from the code used on www.interguru.com/mailconv.htm . The site
38             has been up since 1996 ( but ldif was only included on 1997, when Netscape 3 started
39             using it.) The site gets about 8000 unique visitors a month, many of whom make addressbook
40             conversions. The code has been well tested.
41              
42             =head1 FUTURE DIRECTIONS
43              
44              
45              
46              
47             =head1 BUGS
48              
49             =head1 CHANGES
50              
51             Original Version 2001-Sept-09
52            
53             =head1 COPYRIGHT
54              
55             Copyright (c) 2001 Joe Davidson. All rights reserved.
56             This program is free software; you can redistribute it
57             and/or modify it under the terms of the Perl Artistic License
58             (see http://www.perl.com/perl/misc/Artistic.html). or the
59             GPL copyleft license ( http://www.gnu.org/copyleft/gpl.html)
60              
61              
62             =head1 AUTHOR
63              
64             Mail::Addressbook::Convert was written by Joe Davidson in 2001.
65              
66             =cut
67              
68             package Mail::Addressbook::Convert::Utilities;
69              
70 1     1   4 use Carp;
  1         1  
  1         43  
71              
72 1     1   5 use Exporter ();
  1         1  
  1         41  
73             @ISA = qw(Exporter);
74             @EXPORT = qw( cleanalias commas_outside_quotes getInput isValidInternetAddress );
75              
76 1     1   4 use strict;
  1         8  
  1         25  
77 1     1   4 use vars qw(%usedAlias );
  1         2  
  1         626  
78              
79              
80              
81              
82             ##########################################################################3
83              
84              
85             sub cleanalias
86             {
87 99     99 0 139 my($a2,$allowUnderscores)= @_;
88 99         127 $a2 =~ tr/A-Z0-9/a-z0-9/; #make sure alias is lowercase
89 99 100       160 if ($allowUnderscores)
90             {
91 5         7 $a2 =~ tr/a-z0-9_//cd; # underscores, letters and numbers only
92             }
93             else
94             {
95 94         133 $a2 =~ tr/a-z0-9//cd; # letters and numbers only
96             }
97 99         270 return($a2);
98             }
99             ##########################################################################3
100              
101             sub commas_outside_quotes
102             {
103 47     47 0 72 my($test_string) = $_[0];
104 47         53 my($inside_quote,$num_chars,$s);
105 47         52 $inside_quote = 0; #false;
106 47         50 $num_chars = length($test_string);
107 47         80 foreach $s (0..$num_chars)
108             {
109 1166         1340 my($char) = substr($test_string,$s,1);
110 1166 100       1846 if ($char eq "\"")
  60         86  
111             {$inside_quote =!$inside_quote;}
112 1166 100 66     2483 if ($char eq "\," && !$inside_quote)
113             {
114 14         47 return 1; # we found a comma outside a quote
115             }
116             }
117 33         93 return 0; # no commas outside quotes.
118             }
119              
120             ##########################################################################
121              
122             sub getInput {
123              
124 18     18 0 29 my $parm = shift;
125              
126 18 100       90 if ((ref $parm) =~ /ARRAY/)
    50          
127             {
128 5         14 return $parm;
129             }
130             elsif ( (ref $parm) =~ /SCALAR/)
131             {
132 13         33 local *FH;
133 13         23 my $fileName = $$parm;
134 13 50       471 open (FH, "<$fileName") or confess "Utilities.pm getInput: could not open $fileName: $!\n";
135 13         391 my @ary = ;
136 13         134 close FH;
137 13         93 return \@ary;
138            
139             }
140            
141             else
142             {
143 0         0 croak " Utilities.pm getInput: Input parameter must be a reference to an array or scalar\n";
144             }
145            
146             }
147              
148             ######################## begin sub isValidInternetAddress ######################
149              
150             sub isValidInternetAddress
151             {
152              
153              
154 31     31 0 38 my $member = $_[0];
155 31         169 return $member =~m/\s*^]+@[^@.<>]+(\.[^@.<>]+)+>?\s*$/;
156              
157 0           if (0)
158             {
159             unless ($member =~ /([\w\-\+\.\_]+)@([\w\-\+\.]+)/)
160             {
161             return 0;
162             }
163             my $hst = $2;
164             my @domains = split(/\./,$hst );
165             if ($#domains < 1)
166             {
167             return 0;
168             }
169             my $topLevelDomain = $domains[$#domains];
170             my $lengthTopLevelDomain = length($topLevelDomain );
171             if ($lengthTopLevelDomain > 3 or $lengthTopLevelDomain <2)
172             {
173             return 0;
174             }
175             return 1;
176 0           } end of (0)
177             }
178             ######################## end sub isValidInternetAddress ######################
179              
180              
181             1;