automake-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

patches/04-autoconf-2-automake.patch


From: Akim Demaille
Subject: patches/04-autoconf-2-automake.patch
Date: Mon, 01 Oct 2001 09:15:41 +0200

I'm waiting for an approval for this patch for one reason: there are
places where Automake used to proceed when it could not read a file,
and fail at exit.  With this patch, it die immediately.

I did this because it is much simpler, and eases the maintenance.  But
I agree that it is making automake slightly more painful.  The whole
question is the tradeoff between ease of maintainability and features.
I felt the balance was in favor of maintainability, but if people
object, I'm fine with fixing this patch at the appropriate places
(i.e., just removing the corresponding chunks).

The use of General.pm will, imho, considerably ease our tasks, as it
aims at staying sync between Autoconf and Automake.  I only removed
uniq currently, but I'm sure yet other things can be simplified take
more advantage of it.  Conversely, I'm expecting the day Automake will
put into General.pm something that Autoconf will use :)

I suggest that Autoconf remain the original copy, AFAIK, people having
write access to Automake have it for Autoconf too.

Index: ChangeLog
from  Akim Demaille  <address@hidden>

        * lib/Automake/Struct.pm: Update from Autoconf.
        * lib/Automake/General.pm, lib/Automake/XFile.pm: New, from CVS
        Autoconf.
        * automake.in: Use them.
        (&uniq, $me): Remove, as they are provided by Automake::General.

Index: automake.in
--- automake.in Fri, 28 Sep 2001 09:30:37 +0200 akim
+++ automake.in Sun, 30 Sep 2001 19:22:37 +0200 akim
@@ -112,11 +112,9 @@ sub target_hook ($$$$)

 require 5.005;
 use strict 'vars', 'subs';
+use Automake::General;
+use Automake::XFile;
 use File::Basename;
-use IO::File;
-
-my $me = basename ($0);
-

 ## ----------- ##
 ## Constants.  ##
@@ -1040,25 +1038,6 @@ sub prog_error (@)
 }


-# @RES
-# uniq (@LIST)
-# ------------
-# Return LIST with no duplicates.
-sub uniq (@)
-{
-   my @res = ();
-   my %seen = ();
-   foreach my $item (@_)
-     {
-       if (! defined $seen{$item})
-        {
-          $seen{$item} = 1;
-          push (@res, $item);
-        }
-     }
-   return @res;
-}
-
 # subst ($TEXT)
 # -------------
 # Return a configure-style substitution using the indicated text.
@@ -1314,13 +1293,7 @@ sub generate_makefile
        }
     }

-    my $gm_file = new IO::File "> $out_file";
-    if (! $gm_file)
-    {
-       warn "$me: ${am_file}.in: cannot write: $!\n";
-       $exit_status = 1;
-       return;
-    }
+    my $gm_file = new Automake::XFile "> $out_file";
     print "$me: creating ", $makefile, ".in\n" if $verbose;

     # In case we're running under MSWindows, don't write with CRLF
@@ -1334,13 +1307,6 @@ sub generate_makefile
     print $gm_file $output_header;
     print $gm_file $output_rules;
     print $gm_file $output_trailer;
-
-    if (! $gm_file->close)
-      {
-       warn "$me: $am_file.in: cannot close: $!\n";
-       $exit_status = 1;
-       return;
-      }
 }

 ################################################################
@@ -2973,12 +2939,7 @@ sub scan_texinfo_file
     # is not created.
     my @syncodeindexes = ();

-    my $texi = new IO::File ("< $filename");
-    if (! $texi)
-      {
-       &am_error ("couldn't open `$filename': $!");
-       return '';
-    }
+    my $texi = new Automake::XFile ("< $filename");
     print "$me: reading $filename\n" if $verbose;

     my ($outfile, $vfile);
@@ -3597,16 +3558,12 @@ sub scan_aclocal_m4
        &define_variable ("ACLOCAL_M4", '$(top_srcdir)/aclocal.m4');
        &push_dist_common ('aclocal.m4');

-       my $aclocal = new IO::File ("< aclocal.m4");
-       if ($aclocal)
-       {
-           my $line = $aclocal->getline;
-           $aclocal->close;
+       my $aclocal = new Automake::XFile ("< aclocal.m4");
+       my $line = $aclocal->getline;

-           if ($line =~ 'generated automatically by aclocal')
-           {
-               $regen_aclocal = 1;
-           }
+       if ($line =~ 'generated automatically by aclocal')
+       {
+           $regen_aclocal = 1;
        }
     }

@@ -4471,11 +4428,7 @@ sub scan_autoconf_traces
     $traces .= ' -t AC_LIBSOURCE';
     $traces .= ' -t AC_SUBST';

-    my $tracefh = new IO::File ("$traces |");
-    if (! $tracefh)
-    {
-       die "$me: couldn't open `$traces': $!\n";
-    }
+    my $tracefh = new Automake::XFile ("$traces |");
     print "$me: reading $traces\n" if $verbose;

     while ($_ = $tracefh->getline)
@@ -4526,11 +4479,7 @@ sub scan_one_autoconf_file
 {
     my ($filename) = @_;

-    my $configfh = new IO::File ("< $filename");
-    if (! $configfh)
-    {
-       die "$me: couldn't open `$filename': $!\n";
-    }
+    my $configfh = new Automake::XFile ("< $filename");
     print "$me: reading $filename\n" if $verbose;

     my ($in_ac_output, $in_ac_replace) = (0, 0);
@@ -6659,11 +6608,7 @@ sub read_am_file
 {
     my ($amfile) = @_;

-    my $am_file = new IO::File ("< $amfile");
-    if (! $am_file)
-    {
-       die "$me: couldn't open `$amfile': $!\n";
-    }
+    my $am_file = new Automake::XFile ("< $amfile");
     print "$me: reading $amfile\n" if $verbose;

     my $spacing = '';
@@ -7013,11 +6958,7 @@ sub make_paragraphs ($%)
          . 's/\n{3,}/\n\n/g';

     # Swallow the file and apply the COMMAND.
-    my $fc_file = new IO::File ("< $file");
-    if (! $fc_file)
-    {
-       die "$me: installation error: cannot open `$file'\n";
-    }
+    my $fc_file = new Automake::XFile ("< $file");
     # Looks stupid?
     print "$me: reading $file\n"
       if $verbose;
@@ -7962,6 +7903,7 @@ sub set_strictness
 # Ensure a file exists.
 sub create
 {
+    use IO::File;
     my ($file) = @_;

     my $touch = new IO::File (">> $file");
Index: lib/Automake/Makefile.am
--- lib/Automake/Makefile.am Wed, 09 May 2001 19:37:26 +0200 akim
+++ lib/Automake/Makefile.am Sun, 30 Sep 2001 19:05:44 +0200 akim
@@ -1,4 +1,4 @@
 ## Process this file with automake to create Makefile.in

 perllibdir = $(pkgdatadir)/Automake
-dist_perllib_DATA = Struct.pm
+dist_perllib_DATA = Struct.pm General.pm XFile.pm
Index: lib/Automake/Struct.pm
--- lib/Automake/Struct.pm Wed, 09 May 2001 19:37:26 +0200 akim
+++ lib/Automake/Struct.pm Sun, 30 Sep 2001 19:24:48 +0200 akim
@@ -1,6 +1,5 @@
-# automake - create Makefile.in from Makefile.am
-# Copyright 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
-# Free Software Foundation, Inc.
+# autoconf -- create `configure' using m4 macros
+# Copyright 2001 Free Software Foundation, Inc.

 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -17,8 +16,11 @@
 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 # 02111-1307, USA.

-# Originally written by David Mackenzie <address@hidden>.
-# Perl reimplementation by Tom Tromey <address@hidden>.
+# This file is basically Perl 5.6's Class::Struct, but made compatible
+# with Perl 5.5.  If someday this has to be updated, be sure to rename
+# all the occurrences of Class::Struct into Automake::Struct, otherwise
+# if we `use' a Perl module (e.g., File::stat) that uses Class::Struct,
+# we would have two packages defining the same symbols.  Boom.

 package Automake::Struct;

@@ -47,7 +49,7 @@ sub printem {
 }

 {
-    package Class::Struct::Tie_ISA;
+    package Automake::Struct::Tie_ISA;

     sub TIEARRAY {
         my $class = shift;
@@ -56,7 +58,7 @@ sub printem {

     sub STORE {
         my ($self, $index, $value) = @_;
-        Class::Struct::_subclass_error();
+        Automake::Struct::_subclass_error();
     }

     sub FETCH {
@@ -106,7 +108,7 @@ sub struct {
         address@hidden . '::ISA'};
     };
     _subclass_error() if @$isa;
-    tie @$isa, 'Class::Struct::Tie_ISA';
+    tie @$isa, 'Automake::Struct::Tie_ISA';

     # Create constructor.

@@ -248,24 +250,24 @@ sub _subclass_error {

 =head1 NAME

-Class::Struct - declare struct-like datatypes as Perl classes
+Automake::Struct - declare struct-like datatypes as Perl classes

 =head1 SYNOPSIS

-    use Class::Struct;
+    use Automake::Struct;
             # declare struct, based on array:
     struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]);
             # declare struct, based on hash:
     struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... });

     package CLASS_NAME;
-    use Class::Struct;
+    use Automake::Struct;
             # declare struct, based on array, implicit class name:
     struct( ELEMENT_NAME => ELEMENT_TYPE, ... );


     package Myobj;
-    use Class::Struct;
+    use Automake::Struct;
             # declare struct with four types of elements:
     struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' );

@@ -293,7 +295,7 @@ Class::Struct - declare struct-like data

 =head1 DESCRIPTION

-C<Class::Struct> exports a single function, C<struct>.
+C<Automake::Struct> exports a single function, C<struct>.
 Given a list of element names and types, and optionally
 a class name, C<struct> creates a Perl 5 class that implements
 a "struct-like" data structure.
@@ -443,7 +445,7 @@ Class::Struct - declare struct-like data
 microseconds), and C<rusage> has two elements, each of which is of
 type C<timeval>.

-    use Class::Struct;
+    use Automake::Struct;

     struct( rusage => {
         ru_utime => timeval,  # seconds
@@ -474,7 +476,7 @@ Class::Struct - declare struct-like data
 accessor accordingly.

     package MyObj;
-    use Class::Struct;
+    use Automake::Struct;

     # declare the struct
     struct ( 'MyObj', { count => '$', stuff => '%' } );
@@ -514,7 +516,7 @@ Class::Struct - declare struct-like data
 struct's constructor.


-    use Class::Struct;
+    use Automake::Struct;

     struct Breed =>
     {
@@ -545,6 +547,12 @@ Class::Struct - declare struct-like data

 =head1 Author and Modification History

+Modified by Akim Demaille, 2001-08-03
+
+    Rename as Automake::Struct to avoid name clashes with
+    Class::Struct.
+
+    Make it compatible with Perl 5.5.

 Modified by Damian Conway, 1999-03-05, v0.58.

Index: lib/Automake/General.pm
--- lib/Automake/General.pm Sun, 30 Sep 2001 23:08:12 +0200 akim
+++ lib/Automake/General.pm Sun, 30 Sep 2001 19:05:18 +0200 akim
@@ -0,0 +1,334 @@
+# Copyright 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+package Automake::General;
+
+use 5.005;
+use Exporter;
+use File::Basename;
+use File::stat;
+use IO::File;
+use Carp;
+use strict;
+
+use vars qw (@ISA @EXPORT);
+
address@hidden = qw (Exporter);
address@hidden = qw (&debug &find_configure_ac &find_file &getopt &mktmpdir 
&mtime
+              &uniq &update_file &verbose &xsystem
+             $debug $help $me $tmp $verbose $version);
+
+# Variable we share with the main package.  Be sure to have a single
+# copy of them: using `my' together with multiple inclusion of this
+# package would introduce several copies.
+use vars qw ($debug);
+$debug = 0;
+
+use vars qw ($help);
+$help = undef;
+
+use vars qw ($me);
+$me = basename ($0);
+
+# Our tmp dir.
+use vars qw ($tmp);
+$tmp = undef;
+
+use vars qw ($verbose);
+$verbose = 0;
+
+use vars qw ($version);
+$version = undef;
+
+
+# END
+# ---
+# Exit nonzero whenever closing STDOUT fails.
+# Ideally we should `exit ($? >> 8)', unfortunately, for some reason
+# I don't understand, whenever we `exit (1)' somewhere in the code,
+# we arrive here with `$? = 29'.  I suspect some low level END routine
+# might be responsible.  In this case, be sure to exit 1, not 29.
+sub END
+{
+  my $exit_status = $? ? 1 : 0;
+
+  use POSIX qw (_exit);
+
+  if (!$debug && defined $tmp && -d $tmp)
+    {
+      if (<$tmp/*>)
+       {
+         unlink <$tmp/*>
+           or carp ("$me: cannot empty $tmp: $!\n"), _exit (1);
+       }
+      rmdir $tmp
+       or carp ("$me: cannot remove $tmp: $!\n"), _exit (1);
+    }
+
+  # This is required if the code might send any output to stdout
+  # E.g., even --version or --help.  So it's best to do it unconditionally.
+  close STDOUT
+    or (carp "$me: closing standard output: $!\n"), _exit (1);
+
+  _exit ($exit_status);
+}
+
+
+# debug(@MESSAGE)
+# ---------------
+# Messages displayed only if $DEBUG and $VERBOSE.
+sub debug (@)
+{
+  print STDERR "$me: ", @_, "\n"
+    if $verbose && $debug;
+}
+
+
+# $CONFIGURE_AC
+# &find_configure_ac ()
+# ---------------------
+sub find_configure_ac ()
+{
+  if (-f 'configure.ac')
+    {
+      if (-f 'configure.in')
+       {
+         carp "warning: `configure.ac' and `configure.in' both present.\n";
+         carp "warning: proceeding with `configure.ac'.\n";
+       }
+      return 'configure.ac';
+    }
+  elsif (-f 'configure.in')
+    {
+      return 'configure.in';
+    }
+  return;
+}
+
+
+# $FILENAME
+# find_file ($FILENAME, @INCLUDE)
+# -------------------------------
+# We match exactly the behavior of GNU m4: first look in the current
+# directory (which includes the case of absolute file names), and, if
+# the file is not absolute, just fail.  Otherwise, look in the path.
+#
+# If the file is flagged as optional (ends with `?'), then return undef
+# if absent.
+sub find_file ($@)
+{
+  use File::Spec;
+
+  my ($filename, @include) = @_;
+  my $optional = 0;
+
+  $optional = 1
+    if $filename =~ s/\?$//;
+
+  return File::Spec->canonpath ($filename)
+    if -e $filename;
+
+  if (File::Spec->file_name_is_absolute ($filename))
+    {
+      die "$me: no such file or directory: $filename\n"
+       unless $optional;
+      return undef;
+    }
+
+  foreach my $path (reverse @include)
+    {
+      return File::Spec->canonpath (File::Spec->catfile ($path, $filename))
+       if -e File::Spec->catfile ($path, $filename)
+    }
+
+  die "$me: no such file or directory: $filename\n"
+    unless $optional;
+
+  return undef;
+}
+
+
+# getopt (%OPTION)
+# ----------------
+# Handle the %OPTION, plus all the common options.
+# Work around Getopt bugs wrt `-'.
+sub getopt (%)
+{
+  my (%option) = @_;
+  use Getopt::Long;
+
+  # F*k.  Getopt seems bogus and dies when given `-' with `bundling'.
+  # If fixed some day, use this: '' => sub { push @ARGV, "-" }
+  my $stdin = grep /^-$/, @ARGV;
+  @ARGV = grep !/^-$/, @ARGV;
+  %option = (%option,
+            "h|help"     => sub { print $help; exit 0 },
+             "V|version"  => sub { print $version; exit 0 },
+
+             "v|verbose"    => \$verbose,
+             "d|debug"      => \$debug,
+           );
+  Getopt::Long::Configure ("bundling");
+  GetOptions (%option)
+    or exit 1;
+
+    push @ARGV, '-'
+    if $stdin;
+}
+
+
+# mktmpdir ($SIGNATURE)
+# ---------------------
+# Create a temporary directory which name is based on $SIGNATURE.
+sub mktmpdir ($)
+{
+  my ($signature) = @_;
+  my $TMPDIR = $ENV{'TMPDIR'} || '/tmp';
+
+  # If mktemp supports dirs, use it.
+  $tmp = `(umask 077 &&
+           mktemp -d -q "$TMPDIR/${signature}XXXXXX") 2>/dev/null`;
+  chomp $tmp;
+
+  if (!$tmp || ! -d $tmp)
+    {
+      $tmp = "$TMPDIR/$signature" . int (rand 10000) . ".$$";
+      mkdir $tmp, 0700
+       or croak "$me: cannot create $tmp: $!\n";
+    }
+
+  print STDERR "$me:$$: working in $tmp\n"
+    if $debug;
+}
+
+
+# $MTIME
+# MTIME ($FILE)
+# -------------
+# Return the mtime of $FILE.  Missing files, or `-' standing for STDIN
+# or STDOUT are ``obsolete'', i.e., as old as possible.
+sub mtime ($)
+{
+  my ($file) = @_;
+
+  return 0
+    if $file eq '-' || ! -f $file;
+
+  my $stat = stat ($file)
+    or croak "$me: cannot stat $file: $!\n";
+
+  return $stat->mtime;
+}
+
+
+# @RES
+# uniq (@LIST)
+# ------------
+# Return LIST with no duplicates.
+sub uniq (@)
+{
+   my @res = ();
+   my %seen = ();
+   foreach my $item (@_)
+     {
+       if (! exists $seen{$item})
+        {
+          $seen{$item} = 1;
+          push (@res, $item);
+        }
+     }
+   return wantarray ? @res : "@res";
+}
+
+
+# &update_file ($FROM, $TO)
+# -------------------------
+# Rename $FROM as $TO, preserving $TO timestamp if it has not changed.
+# Recognize `$TO = -' standing for stdin.
+sub update_file ($$)
+{
+  my ($from, $to) = @_;
+  my $SIMPLE_BACKUP_SUFFIX = $ENV{'SIMPLE_BACKUP_SUFFIX'} || '~';
+  use File::Compare;
+  use File::Copy;
+
+  if ($to eq '-')
+    {
+      my $in = new IO::File ("$from");
+      my $out = new IO::File (">-");
+      while ($_ = $in->getline)
+       {
+         print $out $_;
+       }
+      $in->close;
+      unlink ($from)
+       or die "$me: cannot not remove $from: $!\n";
+      return;
+    }
+
+  if (-f "$to" && compare ("$from", "$to") == 0)
+    {
+      # File didn't change, so don't update its mod time.
+      print STDERR "$me: `$to' is unchanged\n";
+      return
+    }
+
+  if (-f "$to")
+    {
+      # Back up and install the new one.
+      move ("$to",  "$to$SIMPLE_BACKUP_SUFFIX")
+       or die "$me: cannot not backup $to: $!\n";
+      move ("$from", "$to")
+       or die "$me: cannot not rename $from as $to: $!\n";
+      print STDERR "$me: `$to' is updated\n";
+    }
+  else
+    {
+      move ("$from", "$to")
+       or die "$me: cannot not rename $from as $to: $!\n";
+      print STDERR "$me: `$to' is created\n";
+    }
+}
+
+
+# verbose(@MESSAGE)
+# -----------------
+sub verbose (@)
+{
+  print STDERR "$me: ", @_, "\n"
+    if $verbose;
+}
+
+
+# xsystem ($COMMAND)
+# ------------------
+sub xsystem ($)
+{
+  my ($command) = @_;
+
+  verbose "running: $command";
+
+  (system $command) == 0
+    or croak ("$me: "
+             . (split (' ', $command))[0]
+             . " failed with exit status: "
+             . ($? >> 8)
+             . "\n");
+}
+
+
+1; # for require
Index: lib/Automake/XFile.pm
--- lib/Automake/XFile.pm Sun, 30 Sep 2001 23:08:12 +0200 akim
+++ lib/Automake/XFile.pm Sun, 30 Sep 2001 19:05:28 +0200 akim
@@ -0,0 +1,156 @@
+# Copyright 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# Written by Akim Demaille <address@hidden>.
+
+package Automake::XFile;
+
+=head1 NAME
+
+Automake::XFile - supply object methods for filehandles with error handling
+
+=head1 SYNOPSIS
+
+    use Automake::XFile;
+
+    $fh = new Automake::XFile;
+    $fh->open("< file"))
+    # No need to check $FH: we died if open failed.
+    print <$fh>;
+    $fh->close;
+    # No need to check the return value of close: we died if it failed.
+
+    $fh = new Automake::XFile "> file";
+    # No need to check $FH: we died if new failed.
+    print $fh "bar\n";
+    $fh->close;
+
+    $fh = new Automake::XFile "file", "r";
+    # No need to check $FH: we died if new failed.
+    defined $fh
+    print <$fh>;
+    undef $fh;   # automatically closes the file and checks for errors.
+
+    $fh = new Automake::XFile "file", O_WRONLY|O_APPEND;
+    # No need to check $FH: we died if new failed.
+    print $fh "corge\n";
+
+    $pos = $fh->getpos;
+    $fh->setpos($pos);
+
+    undef $fh;   # automatically closes the file and checks for errors.
+
+    autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+C<Automake::XFile> inherits from C<IO::File>.  It provides dying
+version of the methods C<open>, C<new>, and C<close>.
+
+=head1 SEE ALSO
+
+L<perlfunc>,
+L<perlop/"I/O Operators">,
+L<IO::File>
+L<IO::Handle>
+L<IO::Seekable>
+
+=head1 HISTORY
+
+Derived from IO::File.pm by Akim Demaille E<lt>F<address@hidden>E<gt>.
+
+=cut
+
+require 5.000;
+use strict;
+use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA);
+use Carp;
+use File::Basename;
+
+require Exporter;
+require DynaLoader;
+
address@hidden = qw(IO::File Exporter DynaLoader);
+
+$VERSION = "1.0";
+
address@hidden = @IO::File::EXPORT;
+
+eval {
+    # Make all Fcntl O_XXX constants available for importing
+    require Fcntl;
+    my @O = grep /^O_/, @Fcntl::EXPORT;
+    Fcntl->import(@O);  # first we import what we want to export
+    push(@EXPORT, @O);
+};
+
+
+################################################
+## Constructor
+##
+
+sub new
+{
+  my $type = shift;
+  my $class = ref($type) || $type || "Automake::XFile";
+  my $fh = $class->SUPER::new ();
+  if (@_)
+    {
+      $fh->open (@_);
+    }
+  $fh;
+}
+
+################################################
+## Open
+##
+
+sub open
+{
+  my ($fh) = shift;
+  my ($file) = @_;
+
+  # WARNING: Gross hack: $FH is a typeglob: use its hash slot to store
+  # the `name' of the file we are opening.  See the example with
+  # io_socket_timeout in IO::Socket for more, and read Graham's
+  # comment in IO::Handle.
+  ${*$fh}{'autom4te_xfile_file'} = "$file";
+
+  if (!$fh->SUPER::open (@_))
+    {
+      my $me = basename ($0);
+      croak "$me: cannot open $file: $!\n";
+    }
+  binmode $fh if $file =~ /^\s*>/;
+}
+
+################################################
+## Close
+##
+
+sub close
+{
+  my ($fh) = shift;
+  if (!$fh->SUPER::close (@_))
+    {
+      my $me = basename ($0);
+      my $file = ${*$fh}{'autom4te_xfile_file'};
+      croak "$me: cannot close $file: $!\n";
+    }
+}
+
+1;



reply via email to

[Prev in Thread] Current Thread [Next in Thread]