view release on metacpan or  search on metacpan

Net/Netrc.pm  view on Meta::CPAN

# Net::Netrc.pm
#
# Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Net::Netrc;

use Carp;
use strict;
use FileHandle;
use vars qw($VERSION);

$VERSION = "2.12"; # $Id: //depot/libnet/Net/Netrc.pm#13 $

my %netrc = ();

sub _readrc
{
 my $host = shift;
 my($home,$file);

 if($^O eq "MacOS") {
   $home = $ENV{HOME} || `pwd`;
   chomp($home);
   $file = ($home =~ /:$/ ? $home . "netrc" : $home . ":netrc");
 } else {
   # Some OS's don't have `getpwuid', so we default to $ENV{HOME}
   $home = eval { (getpwuid($>))[7] } || $ENV{HOME};
   $home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH}||'') if defined $ENV{HOMEDRIVE};
   $file = $home . "/.netrc";
 }

 my($login,$pass,$acct) = (undef,undef,undef);
 my $fh;
 local $_;

 $netrc{default} = undef;

 # OS/2 and Win32 do not handle stat in a way compatable with this check :-(
 unless($^O eq 'os2'
     || $^O eq 'MSWin32'
     || $^O eq 'MacOS'
     || $^O =~ /^cygwin/)
  { 
   my @stat = stat($file);

   if(@stat)
    {
     if($stat[2] & 077)
      {
       carp "Bad permissions: $file";
       return;
      }
     if($stat[4] != $<)
      {
       carp "Not owner: $file";
       return;
      }
    }
  }

 if($fh = FileHandle->new($file,"r"))
  {
   my($mach,$macdef,$tok,@tok) = (0,0);

   while(<$fh>)
    {
     undef $macdef if /\A\n\Z/;

     if($macdef)
      {
       push(@$macdef,$_);
       next;
      }

     s/^\s*//;
     chomp;

     while(length && s/^("((?:[^"]+|\\.)*)"|((?:[^\\\s]+|\\.)*))\s*//) {
       (my $tok = $+) =~ s/\\(.)/$1/g;
       push(@tok, $tok);
     }

TOKEN:
     while(@tok)
      {
       if($tok[0] eq "default")
        {