local-lib5/lib/perl5/CPAN/FTP/netrc.pm

   1 package CPAN::FTP::netrc;
   2 use strict;
   3
   4 $CPAN::FTP::netrc::VERSION = $CPAN::FTP::netrc::VERSION = "1.00";
   5
   6 # package CPAN::FTP::netrc;
   7 sub 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;
  52 sub hasdefault { shift->{'hasdefault'} }
  53 sub netrc      { shift->{'netrc'}      }
  54 sub protected  { shift->{'protected'}  }
  55 sub contains {
  56     my($self,$mach) = @_;
  57     for ( @{$self->{'mach'}} ) {
  58         return 1 if $_ eq $mach;
  59     }
  60     return 0;
  61 }
  62
  63 1;