xref: /openbsd/gnu/usr.bin/perl/cpan/CPAN/lib/CPAN/FTP/netrc.pm (revision 8932bfb7)
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;
64