release/src-rt-6.x.4708/toolchains/hndtools-arm-linux-2.6.36-uclibc-4.5.3/share/autoconf/Autom4te/XFile.pm

   1 # Copyright (C) 2001, 2003, 2004, 2006, 2008, 2009 Free Software Foundation,
   2 # Inc.
   3
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2, or (at your option)
   7 # any later version.
   8
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17 # Written by Akim Demaille <akim@freefriends.org>.
  18
  19 ###############################################################
  20 # The main copy of this file is in Automake's CVS repository. #
  21 # Updates should be sent to automake-patches@gnu.org.         #
  22 ###############################################################
  23
  24 package Autom4te::XFile;
  25
  26 =head1 NAME
  27
  28 Autom4te::XFile - supply object methods for filehandles with error handling
  29
  30 =head1 SYNOPSIS
  31
  32     use Autom4te::XFile;
  33
  34     $fh = new Autom4te::XFile;
  35     $fh->open ("< file");
  36     # No need to check $FH: we died if open failed.
  37     print <$fh>;
  38     $fh->close;
  39     # No need to check the return value of close: we died if it failed.
  40
  41     $fh = new Autom4te::XFile "> file";
  42     # No need to check $FH: we died if new failed.
  43     print $fh "bar\n";
  44     $fh->close;
  45
  46     $fh = new Autom4te::XFile "file", "r";
  47     # No need to check $FH: we died if new failed.
  48     defined $fh
  49     print <$fh>;
  50     undef $fh;   # automatically closes the file and checks for errors.
  51
  52     $fh = new Autom4te::XFile "file", O_WRONLY | O_APPEND;
  53     # No need to check $FH: we died if new failed.
  54     print $fh "corge\n";
  55
  56     $pos = $fh->getpos;
  57     $fh->setpos ($pos);
  58
  59     undef $fh;   # automatically closes the file and checks for errors.
  60
  61     autoflush STDOUT 1;
  62
  63 =head1 DESCRIPTION
  64
  65 C<Autom4te::XFile> inherits from C<IO::File>.  It provides the method
  66 C<name> returning the file name.  It provides dying versions of the
  67 methods C<close>, C<lock> (corresponding to C<flock>), C<new>,
  68 C<open>, C<seek>, and C<truncate>.  It also overrides the C<getline>
  69 and C<getlines> methods to translate C<\r\n> to C<\n>.
  70
  71 =cut
  72
  73 require 5.000;
  74 use strict;
  75 use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA);
  76 use Carp;
  77 use Errno;
  78 use IO::File;
  79 use File::Basename;
  80 use Autom4te::ChannelDefs;
  81 use Autom4te::Channels qw(msg);
  82 use Autom4te::FileUtils;
  83
  84 require Exporter;
  85 require DynaLoader;
  86
  87 @ISA = qw(IO::File Exporter DynaLoader);
  88
  89 $VERSION = "1.2";
  90
  91 @EXPORT = @IO::File::EXPORT;
  92
  93 eval {
  94   # Make all Fcntl O_XXX and LOCK_XXX constants available for importing
  95   require Fcntl;
  96   my @O = grep /^(LOCK|O)_/, @Fcntl::EXPORT, @Fcntl::EXPORT_OK;
  97   Fcntl->import (@O);  # first we import what we want to export
  98   push (@EXPORT, @O);
  99 };
 100
 101 # Used in croak error messages.
 102 my $me = basename ($0);
 103
 104 =head2 Methods
 105
 106 =over
 107
 108 =item C<$fh = new Autom4te::XFile ([$expr, ...]>
 109
 110 Constructor a new XFile object.  Additional arguments
 111 are passed to C<open>, if any.
 112
 113 =cut
 114
 115 sub new
 116 {
 117   my $type = shift;
 118   my $class = ref $type || $type || "Autom4te::XFile";
 119   my $fh = $class->SUPER::new ();
 120   if (@_)
 121     {
 122       $fh->open (@_);
 123     }
 124   $fh;
 125 }
 126
 127 =item C<$fh-E<gt>open ([$file, ...])>
 128
 129 Open a file, passing C<$file> and further arguments to C<IO::File::open>.
 130 Die if opening fails.  Store the name of the file.  Use binmode for writing.
 131
 132 =cut
 133
 134 sub open
 135 {
 136   my $fh = shift;
 137   my ($file) = @_;
 138
 139   # WARNING: Gross hack: $FH is a typeglob: use its hash slot to store
 140   # the `name' of the file we are opening.  See the example with
 141   # io_socket_timeout in IO::Socket for more, and read Graham's
 142   # comment in IO::Handle.
 143   ${*$fh}{'autom4te_xfile_file'} = "$file";
 144
 145   if (!$fh->SUPER::open (@_))
 146     {
 147       fatal "cannot open $file: $!";
 148     }
 149
 150   # In case we're running under MSWindows, don't write with CRLF.
 151   # (This circumvents a bug in at least Cygwin bash where the shell
 152   # parsing fails on lines ending with the continuation character '\'
 153   # and CRLF).
 154   binmode $fh if $file =~ /^\s*>/;
 155 }
 156
 157 =item C<$fh-E<gt>close>
 158
 159 Close the file, handling errors.
 160
 161 =cut
 162
 163 sub close
 164 {
 165   my $fh = shift;
 166   if (!$fh->SUPER::close (@_))
 167     {
 168       my $file = $fh->name;
 169       Autom4te::FileUtils::handle_exec_errors $file
 170         unless $!;
 171       fatal "cannot close $file: $!";
 172     }
 173 }
 174
 175 =item C<$line = $fh-E<gt>getline>
 176
 177 Read and return a line from the file.  Ensure C<\r\n> is translated to
 178 C<\n> on input files.
 179
 180 =cut
 181
 182 # Some Win32/perl installations fail to translate \r\n to \n on input
 183 # so we do that here.
 184 sub getline
 185 {
 186   local $_ = $_[0]->SUPER::getline;
 187   # Perform a _global_ replacement: $_ may can contains many lines
 188   # in slurp mode ($/ = undef).
 189   s/\015\012/\n/gs if defined $_;
 190   return $_;
 191 }
 192
 193 =item C<@lines = $fh-E<gt>getlines>
 194
 195 Slurp lines from the files.
 196
 197 =cut
 198
 199 sub getlines
 200 {
 201   my @res = ();
 202   my $line;
 203   push @res, $line while $line = $_[0]->getline;
 204   return @res;
 205 }
 206
 207 =item C<$name = $fh-E<gt>name>
 208
 209 Return the name of the file.
 210
 211 =cut
 212
 213 sub name
 214 {
 215   my $fh = shift;
 216   return ${*$fh}{'autom4te_xfile_file'};
 217 }
 218
 219 =item C<$fh-E<gt>lock>
 220
 221 Lock the file using C<flock>.  If locking fails for reasons other than
 222 C<flock> being unsupported, then error out if C<$ENV{'MAKEFLAGS'}> indicates
 223 that we are spawned from a parallel C<make>.
 224
 225 =cut
 226
 227 sub lock
 228 {
 229   my ($fh, $mode) = @_;
 230   # Cannot use @_ here.
 231
 232   # Unless explicitly configured otherwise, Perl implements its `flock' with the
 233   # first of flock(2), fcntl(2), or lockf(3) that works.  These can fail on
 234   # NFS-backed files, with ENOLCK (GNU/Linux) or EOPNOTSUPP (FreeBSD); we
 235   # usually ignore these errors.  If $ENV{MAKEFLAGS} suggests that a parallel
 236   # invocation of `make' has invoked the tool we serve, report all locking
 237   # failures and abort.
 238   #
 239   # On Unicos, flock(2) and fcntl(2) over NFS hang indefinitely when `lockd' is
 240   # not running.  NetBSD NFS clients silently grant all locks.  We do not
 241   # attempt to defend against these dangers.
 242   #
 243   # -j is for parallel BSD make, -P is for parallel HP-UX make.
 244   if (!flock ($fh, $mode))
 245     {
 246       my $make_j = (exists $ENV{'MAKEFLAGS'}
 247                     && " -$ENV{'MAKEFLAGS'}" =~ / (-[BdeikrRsSw]*[jP]|--[jP]|---?jobs)/);
 248       my $note = "\nforgo `make -j' or use a file system that supports locks";
 249       my $file = $fh->name;
 250
 251       msg ($make_j ? 'fatal' : 'unsupported',
 252            "cannot lock $file with mode $mode: $!" . ($make_j ? $note : ""))
 253         if $make_j || !($!{ENOLCK} || $!{EOPNOTSUPP});
 254     }
 255 }
 256
 257 =item C<$fh-E<gt>seek ($position, [$whence])>
 258
 259 Seek file to C<$position>.  Die if seeking fails.
 260
 261 =cut
 262
 263 sub seek
 264 {
 265   my $fh = shift;
 266   # Cannot use @_ here.
 267   if (!seek ($fh, $_[0], $_[1]))
 268     {
 269       my $file = $fh->name;
 270       fatal "$me: cannot rewind $file with @_: $!";
 271     }
 272 }
 273
 274 =item C<$fh-E<gt>truncate ($len)>
 275
 276 Truncate the file to length C<$len>.  Die on failure.
 277
 278 =cut
 279
 280 sub truncate
 281 {
 282   my ($fh, $len) = @_;
 283   if (!truncate ($fh, $len))
 284     {
 285       my $file = $fh->name;
 286       fatal "cannot truncate $file at $len: $!";
 287     }
 288 }
 289
 290 =back
 291
 292 =head1 SEE ALSO
 293
 294 L<perlfunc>,
 295 L<perlop/"I/O Operators">,
 296 L<IO::File>
 297 L<IO::Handle>
 298 L<IO::Seekable>
 299
 300 =head1 HISTORY
 301
 302 Derived from IO::File.pm by Akim Demaille E<lt>F<akim@freefriends.org>E<gt>.
 303
 304 =cut
 305
 306 1;
 307
 308 ### Setup "GNU" style for perl-mode and cperl-mode.
 309 ## Local Variables:
 310 ## perl-indent-level: 2
 311 ## perl-continued-statement-offset: 2
 312 ## perl-continued-brace-offset: 0
 313 ## perl-brace-offset: 0
 314 ## perl-brace-imaginary-offset: 0
 315 ## perl-label-offset: -2
 316 ## cperl-indent-level: 2
 317 ## cperl-brace-offset: 0
 318 ## cperl-continued-brace-offset: 0
 319 ## cperl-label-offset: -2
 320 ## cperl-extra-newline-before-brace: t
 321 ## cperl-merge-trailing-else: nil
 322 ## cperl-continued-statement-offset: 2
 323 ## End: