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