File Coverage

blib/lib/CPAN/FTP/netrc.pm
Criterion Covered Total %
statement 3 34 8.8
branch 0 12 0.0
condition 0 2 0.0
subroutine 1 6 16.6
pod 0 5 0.0
total 4 59 6.7


line stmt bran cond sub pod time code
1             package CPAN::FTP::netrc;
2 12     12   49 use strict;
  12         18  
  12         3745  
3              
4             $CPAN::FTP::netrc::VERSION = $CPAN::FTP::netrc::VERSION = "1.01";
5              
6             # package CPAN::FTP::netrc;
7             sub new {
8 0     0 0   my($class) = @_;
9 0           my $file = File::Spec->catfile($ENV{HOME},".netrc");
10              
11 0           my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
12             $atime,$mtime,$ctime,$blksize,$blocks)
13             = stat($file);
14 0   0       $mode ||= 0;
15 0           my $protected = 0;
16              
17 0           my($fh,@machines,$hasdefault);
18 0           $hasdefault = 0;
19 0 0         $fh = FileHandle->new or die "Could not create a filehandle";
20              
21 0 0         if($fh->open($file)) {
22 0           $protected = ($mode & 077) == 0;
23 0           local($/) = "";
24 0           NETRC: while (<$fh>) {
25 0           my(@tokens) = split " ", $_;
26 0           TOKEN: while (@tokens) {
27 0           my($t) = shift @tokens;
28 0 0         if ($t eq "default") {
29 0           $hasdefault++;
30 0           last NETRC;
31             }
32 0 0         last TOKEN if $t eq "macdef";
33 0 0         if ($t eq "machine") {
34 0           push @machines, shift @tokens;
35             }
36             }
37             }
38             } else {
39 0           $file = $hasdefault = $protected = "";
40             }
41              
42 0           bless {
43             'mach' => [@machines],
44             'netrc' => $file,
45             'hasdefault' => $hasdefault,
46             'protected' => $protected,
47             }, $class;
48             }
49              
50             # CPAN::FTP::netrc::hasdefault;
51 0     0 0   sub hasdefault { shift->{'hasdefault'} }
52 0     0 0   sub netrc { shift->{'netrc'} }
53 0     0 0   sub protected { shift->{'protected'} }
54             sub contains {
55 0     0 0   my($self,$mach) = @_;
56 0           for ( @{$self->{'mach'}} ) {
  0            
57 0 0         return 1 if $_ eq $mach;
58             }
59 0           return 0;
60             }
61              
62             1;