view release on metacpan or  search on metacpan

lib/Devel/PatchPerl/Plugin/Darwin.pm  view on Meta::CPAN

+		    keys %want, '2>/dev/null')) or next;
+	    my @rec;
+	    while (<$fh>) {
+		chomp;
+		if ($_ eq '-') {
+		    @rec and $data .= join (':', @rec) . "\n";
+		    @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);
+		}
+	    }
+	    @rec and $data .= join (':', @rec) . "\n";
+	    $where = "dscl . -readall /Users";
+	    undef $reason;
+	    last;
+	}
+    }
+
     if (not defined $where) {	# Try local.
 	my $PW = "/etc/passwd";
 	if (-f $PW && open(PW, $PW) && defined(<PW>)) {
@@ -69,51 +112,90 @@ my %perfect;
 my %seen;

 setpwent();
-while (<PW>) {
-    chomp;
-    # 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);
-    if ($^O eq 'darwin') {
-       ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9];
-    } else {
-       ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
-    }
-    next if /^\+/; # ignore NIS includes
-    if (@s) {
-	push @{ $seen{$name_s} }, $.;
-    } else {
-	warn "# Your $where line $. is empty.\n";
-	next;
-    }
-    if ($n == $max) {
-	local $/;
-	my $junk = <PW>;
-	last;
-    }
-    # 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);
-	# 'nobody' et al.
-	next unless @n;
-	my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
-	# Protect against one-to-many and many-to-one mappings.
-	if ($name_s ne $name) {
-	    @n = getpwnam($name_s);
-	    ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
-	    next if $name_s ne $name;
-	}
-	$perfect{$name_s}++
-	    if $name    eq $name_s    and
-               $uid     eq $uid_s     and
-# Do not compare passwords: think shadow passwords.
-               $gid     eq $gid_s     and
-               $gcos    eq $gcos_s    and
-               $home    eq $home_s    and
-               $shell   eq $shell_s;
+
+if ($^O eq 'darwin') {
+    my @lines = split(/\n/, $data);
+    foreach my $line (@lines) {
+	my @s = split /:/, $line, -1;
+	my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
+	next if /^\+/; # ignore NIS includes
+	if (@s) {
+	    push @{ $seen{$name_s} }, $.;
+	} else {
+	    warn "# Your $where line $. is empty.\n";
+	    next;
+	}
+	if ($n == $max) {
+	    local $/;
+	    my $junk = <PW>;
+	    last;
+	}
+	if (@s == 7 || ($^O eq 'darwin' && @s == 10)) {
+	    @n = getpwuid($uid_s);
+	    next unless @n;
+	    my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
+	    if ($name_s ne $name) {
+		@n = getpwnam($name_s);
+		($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
+		next if $name_s ne $name;
+	    }
+	    $perfect{$name_s}++
+		if $name    eq $name_s    and
+		$uid     eq $uid_s     and
+		$gid     eq $gid_s     and
+		$gcos    eq $gcos_s    and
+		$home    eq $home_s    and
+		$shell   eq $shell_s;
+	}
+	$n++;
+    }
+} else {
+    while (<PW>) {
+	chomp;
+	# 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);
+	if ($^O eq 'darwin') {
+	    ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9];
+	} else {
+	    ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
+	}
+	next if /^\+/; # ignore NIS includes
+	if (@s) {
+	    push @{ $seen{$name_s} }, $.;
+	} else {
+	    warn "# Your $where line $. is empty.\n";
+	    next;
+	}
+	if ($n == $max) {
+	    local $/;
+	    my $junk = <PW>;
+	    last;
+	}
+	# 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);
+	    # 'nobody' et al.
+	    next unless @n;
+	    my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
+	    # Protect against one-to-many and many-to-one mappings.
+	    if ($name_s ne $name) {
+		@n = getpwnam($name_s);
+		($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
+		next if $name_s ne $name;
+	    }
+	    $perfect{$name_s}++
+		if $name    eq $name_s    and
+		$uid     eq $uid_s     and
+		# Do not compare passwords: think shadow passwords.
+		$gid     eq $gid_s     and
+		$gcos    eq $gcos_s    and
+		$home    eq $home_s    and
+		$shell   eq $shell_s;
+	}
+	$n++;
     }
-    $n++;
 }
 endpwent();
END
    Devel::PatchPerl::_patch($patch);
}

sub _patch_h2ph_pht560 {
    my $patch = <<'END';
--- t/lib/h2ph.pht
+++ t/lib/h2ph.pht
@@ -29,7 +29,7 @@ unless(defined(&_H2PH_H_)) {
     if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) {
     }
  elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) {
-	die("Nup\,\ can\'t\ go\ on\ ");
+	die("Nup, can't go on");
     } else {
 	eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK);
     }
@@ -49,7 +49,7 @@ unless(defined(&_H2PH_H_)) {
     require 'sys/ioctl.ph';
     eval {
 	my(%INCD) = map { $INC{$_} => 1 } (grep { $_ eq "sys/fcntl.ph" } keys(%INC));
-	my(@REM) = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"})and -f "$_/sys/fcntl.ph" } @INC);
+	my(@REM) = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"}) and -f "$_/sys/fcntl.ph" } @INC);
 	require "$REM[0]" if @REM;
     };
     warn($@) if $@;
END
    Devel::PatchPerl::_patch($patch);
}

sub _patch_h2ph_h560 {
    my $patch = <<'END';
--- t/lib/h2ph.h
+++ t/lib/h2ph.h
@@ -38,7 +38,7 @@
 #if !(defined __SOMETHING_MORE_IMPORTANT)
 #    warn Be careful...