perl/regen_lib.pl
<<
>>
Prefs
   1#!/usr/bin/perl -w
   2use strict;
   3use vars qw($Needs_Write $Verbose @Changed);
   4use File::Compare;
   5use 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
  15END {
  16  print STDOUT "Changed: @Changed\n" if @Changed;
  17}
  18
  19sub 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
  33sub 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
  42sub 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.
  56sub 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
  65sub safer_close {
  66    my $fh = shift;
  67    close $fh or die 'Error closing ' . *{$fh}->{SCALAR} . ": $!";
  68}
  69
  701;
  71
lxr.linux.no kindly hosted by Redpill Linpro AS, provider of Linux consulting and operations services since 1995.