diff options
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/CPAN/FTP/netrc.pm')
-rwxr-xr-x | Master/tlpkg/tlperl.straw/lib/CPAN/FTP/netrc.pm | 63 |
1 files changed, 63 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/CPAN/FTP/netrc.pm b/Master/tlpkg/tlperl.straw/lib/CPAN/FTP/netrc.pm new file mode 100755 index 00000000000..c05405e7ef6 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/CPAN/FTP/netrc.pm @@ -0,0 +1,63 @@ +package CPAN::FTP::netrc; +use strict; + +$CPAN::FTP::netrc::VERSION = $CPAN::FTP::netrc::VERSION = "1.00"; + +# package CPAN::FTP::netrc; +sub new { + my($class) = @_; + my $home = CPAN::HandleConfig::home(); + my $file = File::Spec->catfile($home,".netrc"); + + my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, + $atime,$mtime,$ctime,$blksize,$blocks) + = stat($file); + $mode ||= 0; + my $protected = 0; + + my($fh,@machines,$hasdefault); + $hasdefault = 0; + $fh = FileHandle->new or die "Could not create a filehandle"; + + if($fh->open($file)) { + $protected = ($mode & 077) == 0; + local($/) = ""; + NETRC: while (<$fh>) { + my(@tokens) = split " ", $_; + TOKEN: while (@tokens) { + my($t) = shift @tokens; + if ($t eq "default") { + $hasdefault++; + last NETRC; + } + last TOKEN if $t eq "macdef"; + if ($t eq "machine") { + push @machines, shift @tokens; + } + } + } + } else { + $file = $hasdefault = $protected = ""; + } + + bless { + 'mach' => [@machines], + 'netrc' => $file, + 'hasdefault' => $hasdefault, + 'protected' => $protected, + }, $class; +} + +# CPAN::FTP::netrc::hasdefault; +sub hasdefault { shift->{'hasdefault'} } +sub netrc { shift->{'netrc'} } +sub protected { shift->{'protected'} } +sub contains { + my($self,$mach) = @_; + for ( @{$self->{'mach'}} ) { + return 1 if $_ eq $mach; + } + return 0; +} + +1; |