This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test::More::is_deeply may do overloading (at least for TODOs), and
[perl5.git] / regen_lib.pl
CommitLineData
9ad884cb
JH
1#!/usr/bin/perl -w
2use strict;
95aa0565 3use vars qw($Is_W32 $Is_OS2 $Is_Cygwin $Is_NetWare $Needs_Write $Verbose);
9ad884cb 4use Config; # Remember, this is running using an existing perl
424a4936
NC
5use File::Compare;
6use Symbol;
9ad884cb
JH
7
8# Common functions needed by the regen scripts
9
10$Is_W32 = $^O eq 'MSWin32';
11$Is_OS2 = $^O eq 'os2';
12$Is_Cygwin = $^O eq 'cygwin';
13$Is_NetWare = $Config{osname} eq 'NetWare';
14if ($Is_NetWare) {
15 $Is_W32 = 0;
16}
17
18$Needs_Write = $Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare;
19
95aa0565
RB
20@ARGV = grep { not($_ eq '-v' and $Verbose = 1) } @ARGV;
21
9ad884cb
JH
22sub safer_unlink {
23 my @names = @_;
24 my $cnt = 0;
25
26 my $name;
27 foreach $name (@names) {
28 next unless -e $name;
29 chmod 0777, $name if $Needs_Write;
30 ( CORE::unlink($name) and ++$cnt
31 or warn "Couldn't unlink $name: $!\n" );
32 }
33 return $cnt;
34}
35
36sub safer_rename_silent {
37 my ($from, $to) = @_;
38
39 # Some dosish systems can't rename over an existing file:
40 safer_unlink $to;
41 chmod 0600, $from if $Needs_Write;
42 rename $from, $to;
43}
44
424a4936 45sub rename_if_different {
9ad884cb 46 my ($from, $to) = @_;
b6b9a099 47
424a4936 48 if (compare($from, $to) == 0) {
95aa0565 49 warn "no changes between '$from' & '$to'\n" if $Verbose;
b6b9a099
JC
50 safer_unlink($from);
51 return;
52 }
53 warn "changed '$from' to '$to'\n";
9ad884cb
JH
54 safer_rename_silent($from, $to) or die "renaming $from to $to: $!";
55}
424a4936
NC
56
57# Saf*er*, but not totally safe. And assumes always open for output.
58sub safer_open {
59 my $name = shift;
60 my $fh = gensym;
61 open $fh, ">$name" or die "Can't create $name: $!";
08858ed2 62 *{$fh}->{SCALAR} = $name;
424a4936
NC
63 binmode $fh;
64 $fh;
65}
66
08858ed2
NC
67sub safer_close {
68 my $fh = shift;
69 close $fh or die 'Error closing ' . *{$fh}->{SCALAR} . ": $!";
70}
71
9ad884cb 721;