[perl #97020] Carp (actually caller) leaking memory
[perl.git] / regen_lib.pl
1 #!/usr/bin/perl -w
2 use strict;
3 use vars qw($Needs_Write $Verbose @Changed);
4 use File::Compare;
5 use Symbol;
6
7 # Common functions needed by the regen scripts
8
9 $Needs_Write = $^O eq 'cygwin' || $^O eq 'os2' || $^O eq 'MSWin32';
10
11 $Verbose = 0;
12 @ARGV = grep { not($_ eq '-q' and $Verbose = -1) }
13   grep { not($_ eq '-v' and $Verbose = 1) } @ARGV;
14
15 END {
16   print STDOUT "Changed: @Changed\n" if @Changed;
17 }
18
19 sub safer_unlink {
20   my @names = @_;
21   my $cnt = 0;
22
23   my $name;
24   foreach $name (@names) {
25     next unless -e $name;
26     chmod 0777, $name if $Needs_Write;
27     ( CORE::unlink($name) and ++$cnt
28       or warn "Couldn't unlink $name: $!\n" );
29   }
30   return $cnt;
31 }
32
33 sub safer_rename_silent {
34   my ($from, $to) = @_;
35
36   # Some dosish systems can't rename over an existing file:
37   safer_unlink $to;
38   chmod 0600, $from if $Needs_Write;
39   rename $from, $to;
40 }
41
42 sub rename_if_different {
43   my ($from, $to) = @_;
44
45   if (compare($from, $to) == 0) {
46       warn "no changes between '$from' & '$to'\n" if $Verbose > 0;
47       safer_unlink($from);
48       return;
49   }
50   warn "changed '$from' to '$to'\n" if $Verbose > 0;
51   push @Changed, $to unless $Verbose < 0;
52   safer_rename_silent($from, $to) or die "renaming $from to $to: $!";
53 }
54
55 # Saf*er*, but not totally safe. And assumes always open for output.
56 sub safer_open {
57     my $name = shift;
58     my $fh = gensym;
59     open $fh, ">$name" or die "Can't create $name: $!";
60     *{$fh}->{SCALAR} = $name;
61     binmode $fh;
62     $fh;
63 }
64
65 sub safer_close {
66     my $fh = shift;
67     close $fh or die 'Error closing ' . *{$fh}->{SCALAR} . ": $!";
68 }
69
70 1;