This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert t/op/pwent.t to test.pl, strict and warnings.
authorNicholas Clark <nick@ccl4.org>
Sun, 13 Mar 2011 13:19:29 +0000 (13:19 +0000)
committerNicholas Clark <nick@ccl4.org>
Sun, 13 Mar 2011 13:19:29 +0000 (13:19 +0000)
Move most of the logic for "hunt the password data" out of the BEGIN block, as
it has no special reason to be in one.

t/op/pwent.t

index e755cf2..2ebd5dc 100644 (file)
@@ -1,5 +1,19 @@
 #!./perl
 
 #!./perl
 
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use strict;
+use warnings;
+
+eval {my @n = getpwuid 0; setpwent()};
+skip_all($1) if $@ && $@ =~ /(The \w+ function is unimplemented)/;
+
+eval { require Config; };
+
 sub try_prog {
     my ($where, $args, @pathnames) = @_;
     foreach my $prog (@pathnames) {
 sub try_prog {
     my ($where, $args, @pathnames) = @_;
     foreach my $prog (@pathnames) {
@@ -11,121 +25,112 @@ sub try_prog {
     return;
 }
 
     return;
 }
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    eval {my @n = getpwuid 0; setpwent()};
-    if ($@ && $@ =~ /(The \w+ function is unimplemented)/) {
-       print "1..0 # Skip: $1\n";
-       exit 0;
-    }
-    eval { require Config; import Config; };
-
-    # Try NIS.
-    $where = try_prog('NIS passwd', 'passwd',
-                     qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat));
-
-    # Try NetInfo.
-    $where //= try_prog('NetInfo passwd', 'passwd .', '/usr/bin/nidump');
-
-    # Try NIS+.
-    $where //= try_prog('NIS+', 'passwd.org_dir', '/bin/niscat');
-
-    if (!defined $where &&             # Try dscl
-       $Config{useperlio}) {   # need perlio
-
-       # Map dscl items to passwd fields, and provide support for
-       # mucking with the dscl output if we need to (and we do).
-       my %want = do {
-           my $inx = 0;
-           map {$_ => {inx => $inx++, mung => sub {$_[0]}}}
-               qw{RecordName Password UniqueID PrimaryGroupID
-               RealName NFSHomeDirectory UserShell};
-       };
-
-       # The RecordName for a /User record is the username. In some
-       # cases there are synonyms (e.g. _www and www), in which case we
-       # get a blank-delimited list. We prefer the first entry in the
-       # list because getpwnam() does.
-       $want{RecordName}{mung} = sub {(split '\s+', $_[0], 2)[0]};
-
-       # The UniqueID and PrimaryGroupID for a /User record are the
-       # user ID and the primary group ID respectively. In cases where
-       # the high bit is set, 'dscl' returns a negative number, whereas
-       # getpwnam() returns its twos complement. This mungs the dscl
-       # output to agree with what getpwnam() produces. Interestingly
-       # enough, getpwuid(-2) returns the right record ('nobody'), even
-       # though it returns the uid as 4294967294. If you track uid_t
-       # on an i386, you find it is an unsigned int, which makes the
-       # unsigned version the right one; but both /etc/passwd and
-       # /etc/master.passwd contain negative numbers.
-       $want{UniqueID}{mung} = $want{PrimaryGroupID}{mung} = sub {
-           unpack 'L', pack 'l', $_[0]};
-
-       foreach my $dscl (qw(/usr/bin/dscl)) {
-           -x $dscl or next;
-           open (my $fh, '-|', join (' ', $dscl, qw{. -readall /Users},
-                   keys %want, '2>/dev/null')) or next;
-           my $data;
-           my @rec;
-           while (<$fh>) {
-               chomp;
-               if ($_ eq '-') {
-                   @rec and $data .= join (':', @rec) . "\n";
+# Try NIS.
+my $where = try_prog('NIS passwd', 'passwd',
+                    qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat));
+
+# Try NetInfo.
+$where //= try_prog('NetInfo passwd', 'passwd .', '/usr/bin/nidump');
+
+# Try NIS+.
+$where //= try_prog('NIS+', 'passwd.org_dir', '/bin/niscat');
+
+# Try dscl
+if (!defined $where && $Config::Config{useperlio}) {
+    # Map dscl items to passwd fields, and provide support for
+    # mucking with the dscl output if we need to (and we do).
+    my %want = do {
+       my $inx = 0;
+       map {$_ => {inx => $inx++, mung => sub {$_[0]}}}
+           qw{RecordName Password UniqueID PrimaryGroupID
+              RealName NFSHomeDirectory UserShell};
+    };
+
+    # The RecordName for a /User record is the username. In some
+    # cases there are synonyms (e.g. _www and www), in which case we
+    # get a blank-delimited list. We prefer the first entry in the
+    # list because getpwnam() does.
+    $want{RecordName}{mung} = sub {(split '\s+', $_[0], 2)[0]};
+
+    # The UniqueID and PrimaryGroupID for a /User record are the
+    # user ID and the primary group ID respectively. In cases where
+    # the high bit is set, 'dscl' returns a negative number, whereas
+    # getpwnam() returns its twos complement. This mungs the dscl
+    # output to agree with what getpwnam() produces. Interestingly
+    # enough, getpwuid(-2) returns the right record ('nobody'), even
+    # though it returns the uid as 4294967294. If you track uid_t
+    # on an i386, you find it is an unsigned int, which makes the
+    # unsigned version the right one; but both /etc/passwd and
+    # /etc/master.passwd contain negative numbers.
+    $want{UniqueID}{mung} = $want{PrimaryGroupID}{mung} = sub {
+       unpack 'L', pack 'l', $_[0]};
+
+    foreach my $dscl (qw(/usr/bin/dscl)) {
+       next unless -x $dscl;
+       next unless open my $fh, '-|', "$dscl . -readall /Users @{[keys %want]} 2>/dev/null";
+       my @lines;
+       my @rec;
+       while (<$fh>) {
+           chomp;
+           if ($_ eq '-') {
+               if (@rec) {
+                   push @lines, join (':', @rec) . "\n";
                    @rec = ();
                    @rec = ();
-                   next;
-               }
-               my ($name, $value) = split ':\s+', $_, 2;
-               unless (defined $value) {
-                   s/:$//;
-                   $name = $_;
-                   $value = <$fh>;
-                   chomp $value;
-                   $value =~ s/^\s+//;
-               }
-               if (defined (my $info = $want{$name})) {
-                   $rec[$info->{inx}] = $info->{mung}->($value);
                }
                }
+               next;
+           }
+           my ($name, $value) = split ':\s+', $_, 2;
+           unless (defined $value) {
+               s/:$//;
+               $name = $_;
+               $value = <$fh>;
+               chomp $value;
+               $value =~ s/^\s+//;
            }
            }
-           @rec and $data .= join (':', @rec) . "\n";
-           if (open (PW, '<', \$data)) {
-               $where = "dscl . -readall /Users";
-               last;
+           if (defined (my $info = $want{$name})) {
+               $rec[$info->{inx}] = $info->{mung}->($value);
            }
        }
            }
        }
+       if (@rec) {
+           push @lines, join (':', @rec) . "\n";
+       }
+       my $data = join '', @lines;
+       if (open PW, '<', \$data) {
+           $where = "dscl . -readall /Users";
+           last;
+       }
     }
     }
+}
 
 
-    if (not defined $where) {
-       # Try local.
-       my $no_i_pwd = !$Config{i_pwd} && '$Config{i_pwd} undefined';
-
-       my $PW = "/etc/passwd";
-       if (!-f $PW) {
-           skip_all($no_i_pwd) if $no_i_pwd;
-           skip_all("no $PW file");
-       } elsif (open PW, '<', $PW) {
-           if(defined <PW>) {
-               $where = $PW;
-           } else {
-               skip_all($no_i_pwd) if $no_i_pwd;
-               die "\$Config{i_pwd} is defined, $PW exists but has no entries, all other approaches failed, giving up";
-           }
+if (not defined $where) {
+    # Try local.
+    my $no_i_pwd = !$Config::Config{i_pwd} && '$Config{i_pwd} undefined';
+
+    my $PW = "/etc/passwd";
+    if (!-f $PW) {
+       skip_all($no_i_pwd) if $no_i_pwd;
+       skip_all("no $PW file");
+    } elsif (open PW, '<', $PW) {
+       if(defined <PW>) {
+           $where = $PW;
        } else {
        } else {
-           die "Can't open $PW: $!";
+           skip_all($no_i_pwd) if $no_i_pwd;
+           die "\$Config{i_pwd} is defined, $PW exists but has no entries, all other approaches failed, giving up";
        }
        }
+    } else {
+       die "Can't open $PW: $!";
     }
 }
 
 # By now the PW filehandle should be open and full of juicy password entries.
 
     }
 }
 
 # By now the PW filehandle should be open and full of juicy password entries.
 
-print "1..2\n";
+plan(tests => 2);
 
 # Go through at most this many users.
 # (note that the first entry has been read away by now)
 my $max = 25;
 
 my $n = 0;
 
 # Go through at most this many users.
 # (note that the first entry has been read away by now)
 my $max = 25;
 
 my $n = 0;
-my $tst = 1;
 my %perfect;
 my %seen;
 
 my %perfect;
 my %seen;
 
@@ -138,7 +143,7 @@ while (<PW>) {
     # LIMIT -1 so that users with empty shells don't fall off
     my @s = split /:/, $_, -1;
     my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s);
     # LIMIT -1 so that users with empty shells don't fall off
     my @s = split /:/, $_, -1;
     my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s);
-    (my $v) = $Config{osvers} =~ /^(\d+)/;
+    (my $v) = $Config::Config{osvers} =~ /^(\d+)/;
     if ($^O eq 'darwin' && $v < 9) {
        ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9];
     } else {
     if ($^O eq 'darwin' && $v < 9) {
        ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9];
     } else {
@@ -159,7 +164,7 @@ while (<PW>) {
     # In principle we could whine if @s != 7 but do we know enough
     # of passwd file formats everywhere?
     if (@s == 7 || ($^O eq 'darwin' && @s == 10)) {
     # In principle we could whine if @s != 7 but do we know enough
     # of passwd file formats everywhere?
     if (@s == 7 || ($^O eq 'darwin' && @s == 10)) {
-       @n = getpwuid($uid_s);
+       my @n = getpwuid($uid_s);
        # 'nobody' et al.
        next unless @n;
        my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
        # 'nobody' et al.
        next unless @n;
        my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
@@ -185,9 +190,12 @@ endpwent();
 
 print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
 
 
 print "# max = $max, n = $n, perfect = ", scalar keys %perfect, "\n";
 
-if (keys %perfect == 0 && $n) {
-    $max++;
-    print <<EOEX;
+SKIP: {
+    skip("Found no password entries", 1) unless $n;
+
+    if (keys %perfect == 0) {
+       $max++;
+       print <<EOEX;
 #
 # The failure of op/pwent test is not necessarily serious.
 # It may fail due to local password administration conventions.
 #
 # The failure of op/pwent test is not necessarily serious.
 # It may fail due to local password administration conventions.
@@ -201,14 +209,11 @@ if (keys %perfect == 0 && $n) {
 # matches at all, it suspects something is wrong.
 # 
 EOEX
 # matches at all, it suspects something is wrong.
 # 
 EOEX
-    print "not ";
-    $not = 1;
-} else {
-    $not = 0;
+    }
+
+    cmp_ok(keys %perfect, '>', 0)
+       or note("(not necessarily serious: run t/op/pwent.t by itself)");
 }
 }
-print "ok ", $tst++;
-print "\t# (not necessarily serious: run t/op/pwent.t by itself)" if $not;
-print "\n";
 
 # Test both the scalar and list contexts.
 
 
 # Test both the scalar and list contexts.
 
@@ -232,7 +237,6 @@ for (1..$max) {
 }
 endpwent();
 
 }
 endpwent();
 
-print "not " unless "@pw1" eq "@pw2";
-print "ok ", $tst++, "\n";
+is("@pw1", "@pw2");
 
 close(PW);
 
 close(PW);