summaryrefslogtreecommitdiff
path: root/regen/regen_lib.pl
diff options
context:
space:
mode:
authorSteffen Mueller <smueller@cpan.org>2010-10-10 15:43:47 +0200
committerSteffen Mueller <smueller@cpan.org>2010-10-10 15:55:11 +0200
commitaf00134636ffe4172cbffeaed3bbad802e58d8a0 (patch)
treef5ab1e5e8ec6035e6bf8c3e3f497b822e0ff8c1c /regen/regen_lib.pl
parent98f8176da90af0f0d21fac5f61e6d180814b57c9 (diff)
downloadperl-af00134636ffe4172cbffeaed3bbad802e58d8a0.tar.gz
Move regen scripts to regen/
Moves the various scripts that are called by regen.pl to a subdirectory to reduce clutter.
Diffstat (limited to 'regen/regen_lib.pl')
-rw-r--r--regen/regen_lib.pl77
1 files changed, 77 insertions, 0 deletions
diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl
new file mode 100644
index 0000000000..9008629998
--- /dev/null
+++ b/regen/regen_lib.pl
@@ -0,0 +1,77 @@
+#!/usr/bin/perl -w
+use strict;
+use vars qw($Needs_Write $Verbose @Changed $TAP);
+use File::Compare;
+use Symbol;
+
+# Common functions needed by the regen scripts
+
+$Needs_Write = $^O eq 'cygwin' || $^O eq 'os2' || $^O eq 'MSWin32';
+
+$Verbose = 0;
+@ARGV = grep { not($_ eq '-q' and $Verbose = -1) }
+ grep { not($_ eq '--tap' and $TAP = 1) }
+ grep { not($_ eq '-v' and $Verbose = 1) } @ARGV;
+
+END {
+ print STDOUT "Changed: @Changed\n" if @Changed;
+}
+
+sub safer_unlink {
+ my @names = @_;
+ my $cnt = 0;
+
+ my $name;
+ foreach $name (@names) {
+ next unless -e $name;
+ chmod 0777, $name if $Needs_Write;
+ ( CORE::unlink($name) and ++$cnt
+ or warn "Couldn't unlink $name: $!\n" );
+ }
+ return $cnt;
+}
+
+sub safer_rename_silent {
+ my ($from, $to) = @_;
+
+ # Some dosish systems can't rename over an existing file:
+ safer_unlink $to;
+ chmod 0600, $from if $Needs_Write;
+ rename $from, $to;
+}
+
+sub rename_if_different {
+ my ($from, $to) = @_;
+
+ if ($TAP) {
+ my $not = compare($from, $to) ? 'not ' : '';
+ print STDOUT $not . "ok - $0 $to\n";
+ safer_unlink($from);
+ return;
+ }
+ if (compare($from, $to) == 0) {
+ warn "no changes between '$from' & '$to'\n" if $Verbose > 0;
+ safer_unlink($from);
+ return;
+ }
+ warn "changed '$from' to '$to'\n" if $Verbose > 0;
+ push @Changed, $to unless $Verbose < 0;
+ safer_rename_silent($from, $to) or die "renaming $from to $to: $!";
+}
+
+# Saf*er*, but not totally safe. And assumes always open for output.
+sub safer_open {
+ my $name = shift;
+ my $fh = gensym;
+ open $fh, ">$name" or die "Can't create $name: $!";
+ *{$fh}->{SCALAR} = $name;
+ binmode $fh;
+ $fh;
+}
+
+sub safer_close {
+ my $fh = shift;
+ close $fh or die 'Error closing ' . *{$fh}->{SCALAR} . ": $!";
+}
+
+1;