share/autoconf/Autom4te/XFile.pm

   1 # Copyright 2001 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2, or (at your option)
   6 # any later version.
   7
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  16 # 02111-1307, USA.
  17
  18 # Written by Akim Demaille <akim@freefriends.org>.
  19
  20 ###############################################################
  21 # The main copy of this file is in Autoconf's CVS repository. #
  22 # Updates should be sent to autoconf-patches@gnu.org.         #
  23 ###############################################################
  24
  25 package Autom4te::XFile;
  26
  27 =head1 NAME
  28
  29 Autom4te::XFile - supply object methods for filehandles with error handling
  30
  31 =head1 SYNOPSIS
  32
  33     use Autom4te::XFile;
  34
  35     $fh = new Autom4te::XFile;
  36     $fh->open("< file"))
  37     # No need to check $FH: we died if open failed.
  38     print <$fh>;
  39     $fh->close;
  40     # No need to check the return value of close: we died if it failed.
  41
  42     $fh = new Autom4te::XFile "> file";
  43     # No need to check $FH: we died if new failed.
  44     print $fh "bar\n";
  45     $fh->close;
  46
  47     $fh = new Autom4te::XFile "file", "r";
  48     # No need to check $FH: we died if new failed.
  49     defined $fh
  50     print <$fh>;
  51     undef $fh;   # automatically closes the file and checks for errors.
  52
  53     $fh = new Autom4te::XFile "file", O_WRONLY|O_APPEND;
  54     # No need to check $FH: we died if new failed.
  55     print $fh "corge\n";
  56
  57     $pos = $fh->getpos;
  58     $fh->setpos($pos);
  59
  60     undef $fh;   # automatically closes the file and checks for errors.
  61
  62     autoflush STDOUT 1;
  63
  64 =head1 DESCRIPTION
  65
  66 C<Autom4te::XFile> inherits from C<IO::File>.  It provides dying
  67 version of the methods C<open>, C<new>, and C<close>.  It also overrides
  68 the C<getline> and C<getlines> methods to translate C<\r\n> to C<\n>.
  69
  70 =head1 SEE ALSO
  71
  72 L<perlfunc>,
  73 L<perlop/"I/O Operators">,
  74 L<IO::File>
  75 L<IO::Handle>
  76 L<IO::Seekable>
  77
  78 =head1 HISTORY
  79
  80 Derived from IO::File.pm by Akim Demaille E<lt>F<akim@freefriends.org>E<gt>.
  81
  82 =cut
  83
  84 require 5.000;
  85 use strict;
  86 use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA);
  87 use Carp;
  88 use File::Basename;
  89
  90 require Exporter;
  91 require DynaLoader;
  92
  93 @ISA = qw(IO::File Exporter DynaLoader);
  94
  95 $VERSION = "1.1";
  96
  97 @EXPORT = @IO::File::EXPORT;
  98
  99 eval {
 100     # Make all Fcntl O_XXX constants available for importing
 101     require Fcntl;
 102     my @O = grep /^O_/, @Fcntl::EXPORT;
 103     Fcntl->import(@O);  # first we import what we want to export
 104     push(@EXPORT, @O);
 105 };
 106
 107
 108 ################################################
 109 ## Constructor
 110 ##
 111
 112 sub new
 113 {
 114   my $type = shift;
 115   my $class = ref($type) || $type || "Autom4te::XFile";
 116   my $fh = $class->SUPER::new ();
 117   if (@_)
 118     {
 119       $fh->open (@_);
 120     }
 121   $fh;
 122 }
 123
 124 ################################################
 125 ## Open
 126 ##
 127
 128 sub open
 129 {
 130   my ($fh) = shift;
 131   my ($file) = @_;
 132
 133   # WARNING: Gross hack: $FH is a typeglob: use its hash slot to store
 134   # the `name' of the file we are opening.  See the example with
 135   # io_socket_timeout in IO::Socket for more, and read Graham's
 136   # comment in IO::Handle.
 137   ${*$fh}{'autom4te_xfile_file'} = "$file";
 138
 139   if (!$fh->SUPER::open (@_))
 140     {
 141       my $me = basename ($0);
 142       croak "$me: cannot open $file: $!\n";
 143     }
 144
 145   # In case we're running under MSWindows, don't write with CRLF.
 146   # (This circumvents a bug in at least Cygwin bash where the shell
 147   # parsing fails on lines ending with the continuation character '\'
 148   # and CRLF).
 149   binmode $fh if $file =~ /^\s*>/;
 150 }
 151
 152 ################################################
 153 ## Close
 154 ##
 155
 156 sub close
 157 {
 158   my ($fh) = shift;
 159   if (!$fh->SUPER::close (@_))
 160     {
 161       my $me = basename ($0);
 162       my $file = ${*$fh}{'autom4te_xfile_file'};
 163       croak "$me: cannot close $file: $!\n";
 164     }
 165 }
 166
 167 ################################################
 168 ## Getline
 169 ##
 170
 171 # Some Win32/perl installations fail to translate \r\n to \n on input
 172 # so we do that here.
 173 sub getline
 174 {
 175     local $_ = $_[0]->SUPER::getline;
 176     # Perform a _global_ replacement: $_ may can contains many lines
 177     # in slurp mode ($/ = undef).
 178     s/\015\012/\n/gs if defined $_;
 179     return $_;
 180 }
 181
 182 ################################################
 183 ## Getlines
 184 ##
 185
 186 sub getlines
 187 {
 188     my @res = ();
 189     my $line;
 190     push @res, $line while $line = $_[0]->getline;
 191     return @res;
 192 }
 193
 194 1;
 195
 196 ### Setup "GNU" style for perl-mode and cperl-mode.
 197 ## Local Variables:
 198 ## perl-indent-level: 2
 199 ## perl-continued-statement-offset: 2
 200 ## perl-continued-brace-offset: 0
 201 ## perl-brace-offset: 0
 202 ## perl-brace-imaginary-offset: 0
 203 ## perl-label-offset: -2
 204 ## cperl-indent-level: 2
 205 ## cperl-brace-offset: 0
 206 ## cperl-continued-brace-offset: 0
 207 ## cperl-label-offset: -2
 208 ## cperl-extra-newline-before-brace: t
 209 ## cperl-merge-trailing-else: nil
 210 ## cperl-continued-statement-offset: 2
 211 ## End: