mirror of
git://git.sv.gnu.org/autoconf
synced 2025-03-19 14:40:24 +08:00
* lib/Autom4te/XFile.pm: New lib file.
* bin/autoupdate.in, bin/autoscan.pl, bin/autom4te.in, * bin/autoheader.in: Use it.
This commit is contained in:
Akim Demaille
parent
32672ba4a6
commit
d134e3aa8d
@ -1,3 +1,9 @@
|
||||
2001-09-05 Akim Demaille <akim@epita.fr>
|
||||
|
||||
* lib/Autom4te/XFile.pm: New lib file.
|
||||
* bin/autoupdate.in, bin/autoscan.pl, bin/autom4te.in,
|
||||
* bin/autoheader.in: Use it.
|
||||
|
||||
2001-09-05 Akim Demaille <akim@epita.fr>
|
||||
|
||||
* bin/autoupdate.in (&handle_m4_macros) <unm4.m4>: Undefine iff
|
||||
|
||||
@ -34,6 +34,7 @@ BEGIN
|
||||
}
|
||||
|
||||
use Autom4te::General;
|
||||
use Autom4te::XFile;
|
||||
use strict;
|
||||
|
||||
# Using `do FILE', we need `local' vars.
|
||||
@ -186,7 +187,7 @@ $config_h_in ||= "$config_h.in";
|
||||
# only the name of the macro.
|
||||
%symbol = map { s/\(.*//; $_ => 1 } keys %symbol;
|
||||
|
||||
my $out = new IO::File (">$tmp/config.hin");
|
||||
my $out = new Autom4te::XFile (">$tmp/config.hin");
|
||||
|
||||
# Don't write "do not edit" -- it will get copied into the
|
||||
# config.h, which it's ok to edit.
|
||||
@ -195,7 +196,7 @@ print $out "/* $config_h_in. Generated from $ARGV[0] by autoheader. */\n";
|
||||
# Dump the top.
|
||||
if ($config_h_top)
|
||||
{
|
||||
my $in = new IO::File ($config_h_top);
|
||||
my $in = new Autom4te::XFile ($config_h_top);
|
||||
while ($_ = $in->getline)
|
||||
{
|
||||
print $out $_;
|
||||
@ -205,7 +206,7 @@ if ($config_h_top)
|
||||
# Dump `acconfig.h' but its bottom.
|
||||
if ($acconfig_h)
|
||||
{
|
||||
my $in = new IO::File ($acconfig_h);
|
||||
my $in = new Autom4te::XFile ($acconfig_h);
|
||||
while ($_ = $in->getline)
|
||||
{
|
||||
last if /\@BOTTOM\@/;
|
||||
@ -223,7 +224,7 @@ foreach (sort keys %verbatim)
|
||||
# Dump `acconfig.h' bottom.
|
||||
if ($acconfig_h)
|
||||
{
|
||||
my $in = new IO::File ($acconfig_h);
|
||||
my $in = new Autom4te::XFile ($acconfig_h);
|
||||
my $dump = 0;
|
||||
while ($_ = $in->getline)
|
||||
{
|
||||
@ -235,7 +236,7 @@ if ($acconfig_h)
|
||||
# Dump the bottom.
|
||||
if ($config_h_bot)
|
||||
{
|
||||
my $in = new IO::File ($config_h_bot);
|
||||
my $in = new Autom4te::XFile ($config_h_bot);
|
||||
while ($_ = $in->getline)
|
||||
{
|
||||
print $out $_;
|
||||
@ -246,7 +247,7 @@ $out->close;
|
||||
|
||||
# Check that all the symbols have a template.
|
||||
{
|
||||
my $in = new IO::File ("$tmp/config.hin");
|
||||
my $in = new Autom4te::XFile ("$tmp/config.hin");
|
||||
while ($_ = $in->getline)
|
||||
{
|
||||
my ($symbol) = /^\#\s*\w+\s+(\w+)/
|
||||
|
||||
@ -41,8 +41,8 @@ package Request;
|
||||
use Data::Dumper;
|
||||
use Autom4te::General;
|
||||
use Autom4te::Struct;
|
||||
use Autom4te::XFile;
|
||||
use Carp;
|
||||
use IO::File;
|
||||
use strict;
|
||||
|
||||
# List of requests.
|
||||
@ -194,8 +194,7 @@ sub save
|
||||
croak "$me: cannot save a single request\n"
|
||||
if ref ($self);
|
||||
|
||||
my $requests = new IO::File ("> $filename")
|
||||
or die "$me: cannot create $filename: $!\n";
|
||||
my $requests = new Autom4te::XFile ("> $filename");
|
||||
print $requests
|
||||
"# This file was created by $me.\n",
|
||||
"# It contains the lists of macros which have been traced.\n",
|
||||
@ -230,7 +229,7 @@ package Autom4te;
|
||||
|
||||
use Autom4te::General;
|
||||
use File::Basename;
|
||||
use IO::File;
|
||||
use Autom4te::XFile;
|
||||
use strict;
|
||||
|
||||
# Configuration file.
|
||||
@ -426,8 +425,7 @@ sub load_configuration ()
|
||||
{
|
||||
use Text::ParseWords;
|
||||
|
||||
my $cfg = new IO::File ($autom4te_cfg)
|
||||
or die "$me: cannot read $autom4te_cfg: $!\n";
|
||||
my $cfg = new Autom4te::XFile ($autom4te_cfg);
|
||||
my $lang;
|
||||
while ($_ = $cfg->getline)
|
||||
{
|
||||
@ -606,7 +604,7 @@ sub handle_output ($$)
|
||||
handle_traces ($req, "$tmp/patterns",
|
||||
('m4_pattern_forbid' => 'forbid:$1',
|
||||
'm4_pattern_allow' => 'allow:$1'));
|
||||
my @patterns = new IO::File ("$tmp/patterns")->getlines;
|
||||
my @patterns = new Autom4te::XFile ("$tmp/patterns")->getlines;
|
||||
chomp @patterns;
|
||||
my $forbidden = join ('|', map { /^forbid:(.*)/ } @patterns) || "^\$";
|
||||
my $allowed = join ('|', map { /^allow:(.*)/ } @patterns) || "^\$";
|
||||
@ -615,10 +613,10 @@ sub handle_output ($$)
|
||||
verbose "allowed tokens: $allowed";
|
||||
|
||||
# Read the (cached) raw M4 output, produce the actual result. We
|
||||
# have to use the 2nd arg to have IO::File honor the third, but then
|
||||
# have to use the 2nd arg to have Autom4te::XFile honor the third, but then
|
||||
# stdout is to be handled by hand :(. Don't use fdopen as it means
|
||||
# we will close STDOUT, which we already do in END.
|
||||
my $out = new IO::File;
|
||||
my $out = new Autom4te::XFile;
|
||||
if ($output eq '-')
|
||||
{
|
||||
$out->open (">$output");
|
||||
@ -629,8 +627,7 @@ sub handle_output ($$)
|
||||
}
|
||||
die "$me: cannot create $output: $!\n"
|
||||
unless $out;
|
||||
my $in = new IO::File ($ocache . $req->id)
|
||||
or die "$me: cannot read $ocache" . $req->id . ": $!\n";
|
||||
my $in = new Autom4te::XFile ($ocache . $req->id);
|
||||
|
||||
my $separate = 0;
|
||||
my $oline = 0;
|
||||
@ -685,8 +682,7 @@ sub handle_output ($$)
|
||||
# Locate the forbidden words in the last input file.
|
||||
# This is unsatisfying but...
|
||||
my $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b';
|
||||
my $file = new IO::File ($ARGV[$#ARGV])
|
||||
or die "$me: cannot open $ARGV[$#ARGV]: $!\n";
|
||||
my $file = new Autom4te::XFile ($ARGV[$#ARGV]);
|
||||
$exit_status = 1;
|
||||
|
||||
while ($_ = $file->getline)
|
||||
@ -803,8 +799,7 @@ sub handle_traces ($$%)
|
||||
verbose "formatting traces for `$output': ", join (', ', sort keys %trace);
|
||||
|
||||
# Processing the traces.
|
||||
my $trace_m4 = new IO::File (">$tmp/traces.m4")
|
||||
or die "$me: cannot create $tmp/traces.m4: $!\n";
|
||||
my $trace_m4 = new Autom4te::XFile (">$tmp/traces.m4");
|
||||
|
||||
$_ = <<'EOF';
|
||||
divert(-1)
|
||||
@ -907,8 +902,7 @@ EOF
|
||||
#
|
||||
# Pay attention that the file name might include colons, if under DOS
|
||||
# for instance, so we don't use `[^:]+'.
|
||||
my $traces = new IO::File ($tcache . $req->id)
|
||||
or die "$me: cannot open $tcache" . $req->id . ": $!\n";
|
||||
my $traces = new Autom4te::XFile ($tcache . $req->id);
|
||||
while ($_ = $traces->getline)
|
||||
{
|
||||
# Trace with arguments, as the example above. We don't try
|
||||
@ -923,10 +917,8 @@ EOF
|
||||
}
|
||||
$trace_m4->close;
|
||||
|
||||
my $in = new IO::File ("$m4 $tmp/traces.m4 |")
|
||||
or die "$me: cannot run $m4: $!\n";
|
||||
my $out = new IO::File (">$output")
|
||||
or die "$me: cannot run open $output: $!\n";
|
||||
my $in = new Autom4te::XFile ("$m4 $tmp/traces.m4 |");
|
||||
my $out = new Autom4te::XFile (">$output");
|
||||
|
||||
# FIXME: Hm... This is dubious: should we really transform the
|
||||
# quadrigraphs in traces? It might break balanced [ ] etc. in the
|
||||
@ -981,7 +973,7 @@ sub up_to_date_p ($)
|
||||
handle_traces ($req, "$tmp/dependencies",
|
||||
('include' => '$1',
|
||||
'm4_include' => '$1'));
|
||||
my $deps = new IO::File ("$tmp/dependencies");
|
||||
my $deps = new Autom4te::XFile ("$tmp/dependencies");
|
||||
push @dep, map { chomp; find_file ($_, @include) } $deps->getlines;
|
||||
|
||||
# If $FILE is younger than one of its dependencies, it is outdated.
|
||||
|
||||
@ -26,10 +26,10 @@ BEGIN
|
||||
unshift @INC, "$perllibdir";
|
||||
}
|
||||
|
||||
use Autom4te::General;
|
||||
use Autom4te::XFile;
|
||||
use File::Basename;
|
||||
use File::Find;
|
||||
use IO::File;
|
||||
use Autom4te::General;
|
||||
use strict;
|
||||
|
||||
use vars qw(@cfiles @makefiles @shfiles %c_keywords %printed);
|
||||
@ -65,8 +65,7 @@ my %kind_comment =
|
||||
);
|
||||
|
||||
my $configure_scan = 'configure.scan';
|
||||
my $log = new IO::File ">$me.log"
|
||||
or die "$me: cannot open $me.log: $!\n";
|
||||
my $log = new Autom4te::XFile ">$me.log";
|
||||
|
||||
# Autoconf and lib files.
|
||||
my $autom4te = $ENV{'AUTOM4TE'} || '@autom4te-name@';
|
||||
@ -150,8 +149,7 @@ sub init_tables ()
|
||||
foreach my $kind (@kinds)
|
||||
{
|
||||
my $file = find_file ("autoscan/$kind", @include);
|
||||
my $table = new IO::File $file
|
||||
or die "$me: cannot open $file: $!\n";
|
||||
my $table = new Autom4te::XFile $file;
|
||||
while ($_ = $table->getline)
|
||||
{
|
||||
# Ignore blank lines and comments.
|
||||
@ -177,8 +175,7 @@ sub init_tables ()
|
||||
push @{$macro{$kind}{$word}}, $macro;
|
||||
}
|
||||
}
|
||||
$table->close
|
||||
or die "$me: cannot close $file: $!\n";
|
||||
$table->close;
|
||||
}
|
||||
|
||||
die "$me: some tables are inconsistent\n"
|
||||
@ -203,8 +200,7 @@ sub scan_c_file ($)
|
||||
# Nonzero if in a multiline comment.
|
||||
my $in_comment = 0;
|
||||
|
||||
my $file = new IO::File "<$filename"
|
||||
or die "$me: cannot open $filename: $!\n";
|
||||
my $file = new Autom4te::XFile "<$filename";
|
||||
|
||||
while ($_ = $file->getline)
|
||||
{
|
||||
@ -251,8 +247,7 @@ sub scan_c_file ($)
|
||||
}
|
||||
}
|
||||
|
||||
$file->close
|
||||
or die "$me: cannot close $filename: $!\n";
|
||||
$file->close;
|
||||
}
|
||||
|
||||
|
||||
@ -263,8 +258,7 @@ sub scan_makefile ($)
|
||||
my ($filename) = @_;
|
||||
push (@makefiles, $File::Find::name);
|
||||
|
||||
my $file = new IO::File "<$filename"
|
||||
or die "$me: cannot open $filename: $!\n";
|
||||
my $file = new Autom4te::XFile "<$filename";
|
||||
|
||||
while ($_ = $file->getline)
|
||||
{
|
||||
@ -291,8 +285,7 @@ sub scan_makefile ($)
|
||||
}
|
||||
}
|
||||
|
||||
$file->close
|
||||
or die "$me: cannot close $filename: $!\n";
|
||||
$file->close;
|
||||
}
|
||||
|
||||
|
||||
@ -303,8 +296,7 @@ sub scan_sh_file ($)
|
||||
my ($filename) = @_;
|
||||
push (@shfiles, $File::Find::name);
|
||||
|
||||
my $file = new IO::File "<$filename"
|
||||
or die "$me: cannot open $filename: $!\n";
|
||||
my $file = new Autom4te::XFile "<$filename";
|
||||
|
||||
while ($_ = $file->getline)
|
||||
{
|
||||
@ -321,8 +313,7 @@ sub scan_sh_file ($)
|
||||
}
|
||||
}
|
||||
|
||||
$file->close
|
||||
or die "$me: cannot close $filename: $!\n";
|
||||
$file->close;
|
||||
}
|
||||
|
||||
|
||||
@ -464,8 +455,7 @@ sub output ($)
|
||||
my $configure_scan = shift;
|
||||
my %unique_makefiles;
|
||||
|
||||
my $file = new IO::File ">$configure_scan"
|
||||
or die "$me: cannot create $configure_scan: $!\n";
|
||||
my $file = new Autom4te::XFile ">$configure_scan";
|
||||
|
||||
print $file "# Process this file with autoconf to produce a configure script.\n";
|
||||
print $file "AC_INIT(FULL-PACKAGE-NAME, VERSION, BUG-REPORT-ADDRESS)\n";
|
||||
@ -492,8 +482,7 @@ sub output ($)
|
||||
join ("\n ", sort keys %unique_makefiles), "])\n";
|
||||
print $file "AC_OUTPUT\n";
|
||||
|
||||
$file->close
|
||||
or die "$me: cannot close $configure_scan: $!\n";
|
||||
$file->close;
|
||||
}
|
||||
|
||||
|
||||
@ -503,8 +492,8 @@ sub output ($)
|
||||
## --------------------------------------- ##
|
||||
|
||||
|
||||
# check_configure_ac ($CONFIGURE_AC)
|
||||
# ----------------------------------
|
||||
# &check_configure_ac ($CONFIGURE_AC)
|
||||
# -----------------------------------
|
||||
# Use autoconf to check if all the suggested macros are included
|
||||
# in CONFIGURE_AC.
|
||||
sub check_configure_ac ($)
|
||||
@ -520,8 +509,7 @@ sub check_configure_ac ($)
|
||||
|
||||
verbose "running: $autoconf $trace_option $configure_ac";
|
||||
my $traces =
|
||||
new IO::File "$autoconf $trace_option $configure_ac|"
|
||||
or die "$me: cannot open traces reading pipe: $!\n";
|
||||
new Autom4te::XFile "$autoconf $trace_option $configure_ac|";
|
||||
|
||||
while ($_ = $traces->getline)
|
||||
{
|
||||
@ -539,17 +527,16 @@ sub check_configure_ac ($)
|
||||
{
|
||||
$word = "struct " . $word;
|
||||
}
|
||||
delete ($needed_macros{"$macro([$word])"});
|
||||
delete $needed_macros{"$macro([$word])"};
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
delete ($needed_macros{$macro});
|
||||
delete $needed_macros{$macro};
|
||||
}
|
||||
}
|
||||
|
||||
$traces->close
|
||||
or die "$me: cannot close traces reading pipe: $!\n";
|
||||
$traces->close;
|
||||
|
||||
# Report the missing macros.
|
||||
foreach my $macro (sort keys %needed_macros)
|
||||
@ -584,7 +571,6 @@ if ($configure_ac)
|
||||
check_configure_ac ($configure_ac);
|
||||
}
|
||||
|
||||
$log->close
|
||||
or die "$me: cannot close $me.log: $!\n";
|
||||
$log->close;
|
||||
|
||||
exit 0;
|
||||
|
||||
@ -29,6 +29,7 @@ BEGIN
|
||||
|
||||
use File::Basename;
|
||||
use Autom4te::General;
|
||||
use Autom4te::XFile;
|
||||
use strict;
|
||||
|
||||
# Lib files.
|
||||
@ -111,28 +112,23 @@ sub handle_m4_macros ()
|
||||
{
|
||||
# Get the list of builtins.
|
||||
xsystem ("echo dumpdef | $m4 2>$tmp/m4.defs >/dev/null");
|
||||
my $m4_defs = new IO::File "$tmp/m4.defs"
|
||||
or die "$me: cannot open $tmp/m4.defs: $!\n";
|
||||
my $m4_defs = new Autom4te::XFile "$tmp/m4.defs";
|
||||
while ($_ = $m4_defs->getline)
|
||||
{
|
||||
push @m4_builtins, $1
|
||||
if /^(\w+):/;
|
||||
}
|
||||
$m4_defs->close
|
||||
or die "$me: cannot close $tmp/m4.defs: $!\n";
|
||||
$m4_defs->close;
|
||||
|
||||
# Output the files.
|
||||
my $m4_m4 = new IO::File ">$tmp/m4.m4"
|
||||
or die "$me: cannot create $tmp/m4.m4: $!\n";
|
||||
my $m4_m4 = new Autom4te::XFile ">$tmp/m4.m4";
|
||||
print $m4_m4 "# m4.m4 -- enable the m4 builtins.\n";
|
||||
my $unm4_m4 = new IO::File ">$tmp/unm4.m4"
|
||||
or die "$me: cannot create $tmp/unm4.m4: $!\n";
|
||||
my $unm4_m4 = new Autom4te::XFile ">$tmp/unm4.m4";
|
||||
print $unm4_m4 "# unm4.m4 -- disable the m4 builtins.\n";
|
||||
print $unm4_m4 "# Because Autoconf, via M4sugar, redefines some of these\n";
|
||||
print $unm4_m4 "# macros, and therefore since unac.m4 disables them,\n";
|
||||
print $unm4_m4 "# disable only if defined.\n";
|
||||
my $m4save_m4 = new IO::File ">$tmp/m4save.m4"
|
||||
or die "$me: cannot create $tmp/unm4.m4: $!\n";
|
||||
my $m4save_m4 = new Autom4te::XFile ">$tmp/m4save.m4";
|
||||
print $m4save_m4 "# savem4.m4 -- save the m4 builtins.\n";
|
||||
foreach (@m4_builtins)
|
||||
{
|
||||
@ -140,12 +136,6 @@ sub handle_m4_macros ()
|
||||
print $unm4_m4 "_au_ifdef([$_], [_au_undefine([$_])])\n";
|
||||
print $m4_m4 "_au_define([$_], _au_defn([_au_$_]))\n";
|
||||
}
|
||||
$m4save_m4->close
|
||||
or die "$me: cannot close $tmp/m4save.m4: $!\n";
|
||||
$unm4_m4->close
|
||||
or die "$me: cannot close $tmp/unm4.m4: $!\n";
|
||||
$m4_m4->close
|
||||
or die "$me: cannot close $tmp/m4.m4: $!\n";
|
||||
}
|
||||
|
||||
|
||||
@ -164,11 +154,10 @@ my (%ac_macros, %au_macros);
|
||||
# @M4_BUILTINS -- M4 builtins and a useful comment.
|
||||
sub handle_autoconf_macros ()
|
||||
{
|
||||
my $macros = new IO::File ("$autoconf"
|
||||
my $macros = new Autom4te::XFile ("$autoconf"
|
||||
. " --trace AU_DEFUN:'AU:\$f:\$1'"
|
||||
. " --trace define:'AC:\$f:\$1'"
|
||||
. " --melt /dev/null |")
|
||||
or die "$me: cannot open definitions reading pipe: $!\n";
|
||||
. " --melt /dev/null |");
|
||||
while ($_ = $macros->getline)
|
||||
{
|
||||
chomp;
|
||||
@ -190,9 +179,8 @@ sub handle_autoconf_macros ()
|
||||
$au_macros{$macro} = $set;
|
||||
}
|
||||
}
|
||||
$macros->close
|
||||
or die ($! ? "$me: cannot close definitions reading pipe: $!\n"
|
||||
: "$me: definitions reading pipe failed with exit status: $?\n");
|
||||
$macros->close;
|
||||
|
||||
# Don't keep AU macros in @AC_MACROS.
|
||||
delete $ac_macros{$_}
|
||||
foreach (keys %au_macros);
|
||||
@ -215,21 +203,15 @@ sub handle_autoconf_macros ()
|
||||
|
||||
# ac.m4 -- autoquoting definitions of the AC macros (M4sugar excluded).
|
||||
# unac.m4 -- undefine the AC macros.
|
||||
my $ac_m4 = new IO::File ">$tmp/ac.m4"
|
||||
or die "$me: cannot create $tmp/ac.m4: $!\n";
|
||||
my $ac_m4 = new Autom4te::XFile ">$tmp/ac.m4";
|
||||
print $ac_m4 "# ac.m4 -- autoquoting definitions of the AC macros.\n";
|
||||
my $unac_m4 = new IO::File ">$tmp/unac.m4"
|
||||
or die "$me: cannot create $tmp/unac.m4: $!\n";
|
||||
my $unac_m4 = new Autom4te::XFile ">$tmp/unac.m4";
|
||||
print $unac_m4 "# unac.m4 -- undefine the AC macros.\n";
|
||||
foreach (sort grep { $ac_macros{$_} ne 'm4sugar' } keys %ac_macros)
|
||||
{
|
||||
print $ac_m4 "_au_define([$_], [[\$0(\$\@)]])\n";
|
||||
print $unac_m4 "_au_undefine([$_])\n";
|
||||
}
|
||||
$unac_m4->close
|
||||
or die "$me: cannot close $tmp/unac.m4: $!\n";
|
||||
$ac_m4->close
|
||||
or die "$me: cannot close $tmp/ac.m4: $!\n";
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
## Process this file with automake to create Makefile.in
|
||||
|
||||
perllibdir = $(pkgdatadir)/Autom4te
|
||||
dist_perllib_DATA = General.pm Struct.pm
|
||||
dist_perllib_DATA = General.pm Struct.pm XFile.pm
|
||||
|
||||
|
||||
## --------------- ##
|
||||
|
||||
@ -65,7 +65,7 @@ PERL = @PERL@
|
||||
VERSION = @VERSION@
|
||||
|
||||
perllibdir = $(pkgdatadir)/Autom4te
|
||||
dist_perllib_DATA = General.pm Struct.pm
|
||||
dist_perllib_DATA = General.pm Struct.pm XFile.pm
|
||||
|
||||
TAGS_FILES = $(dist_perllib_DATA)
|
||||
|
||||
|
||||
156
lib/Autom4te/XFile.pm
Normal file
156
lib/Autom4te/XFile.pm
Normal file
@ -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 <akim@freefriends.org>.
|
||||
|
||||
package Autom4te::XFile;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Autom4te::XFile - supply object methods for filehandles with error handling
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Autom4te::XFile;
|
||||
|
||||
$fh = new Autom4te::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 Autom4te::XFile "> file";
|
||||
# No need to check $FH: we died if new failed.
|
||||
print $fh "bar\n";
|
||||
$fh->close;
|
||||
|
||||
$fh = new Autom4te::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 Autom4te::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<Autom4te::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<akim@freefriends.org>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;
|
||||
|
||||
@ISA = qw(IO::File Exporter DynaLoader);
|
||||
|
||||
$VERSION = "1.0";
|
||||
|
||||
@EXPORT = @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 || "Autom4te::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);
|
||||
my $file = ${*$fh}{'autom4te_xfile_file'};
|
||||
croak "$me: cannot open $file: $!\n";
|
||||
}
|
||||
}
|
||||
|
||||
################################################
|
||||
## 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;
|
||||
Loading…
x
Reference in New Issue
Block a user