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