ext/IO/lib/IO/File.pm

   1 package IO::File;
   2
   3 =head1 NAME
   4
   5 IO::File - supply object methods for filehandles
   6
   7 =head1 SYNOPSIS
   8
   9     use IO::File;
  10
  11     $fh = new IO::File;
  12     if ($fh->open "< file") {
  13         print <$fh>;
  14         $fh->close;
  15     }
  16
  17     $fh = new IO::File "> FOO";
  18     if (defined $fh) {
  19         print $fh "bar\n";
  20         $fh->close;
  21     }
  22
  23     $fh = new IO::File "file", "r";
  24     if (defined $fh) {
  25         print <$fh>;
  26         undef $fh;       # automatically closes the file
  27     }
  28
  29     $fh = new IO::File "file", O_WRONLY|O_APPEND;
  30     if (defined $fh) {
  31         print $fh "corge\n";
  32         undef $fh;       # automatically closes the file
  33     }
  34
  35     $pos = $fh->getpos;
  36     $fh->setpos $pos;
  37
  38     $fh->setvbuf($buffer_var, _IOLBF, 1024);
  39
  40     autoflush STDOUT 1;
  41
  42 =head1 DESCRIPTION
  43
  44 C<IO::File> inherits from C<IO::Handle> and C<IO::Seekable>. It extends
  45 these classes with methods that are specific to file handles.
  46
  47 =head1 CONSTRUCTOR
  48
  49 =over 4
  50
  51 =item new ([ ARGS ] )
  52
  53 Creates a C<IO::File>.  If it receives any parameters, they are passed to
  54 the method C<open>; if the open fails, the object is destroyed.  Otherwise,
  55 it is returned to the caller.
  56
  57 =back
  58
  59 =head1 METHODS
  60
  61 =over 4
  62
  63 =item open( FILENAME [,MODE [,PERMS]] )
  64
  65 C<open> accepts one, two or three parameters.  With one parameter,
  66 it is just a front end for the built-in C<open> function.  With two
  67 parameters, the first parameter is a filename that may include
  68 whitespace or other special characters, and the second parameter is
  69 the open mode, optionally followed by a file permission value.
  70
  71 If C<IO::File::open> receives a Perl mode string ("E<gt>", "+E<lt>", etc.)
  72 or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic
  73 Perl C<open> operator.
  74
  75 If C<IO::File::open> is given a numeric mode, it passes that mode
  76 and the optional permissions value to the Perl C<sysopen> operator.
  77 For convenience, C<IO::File::import> tries to import the O_XXX
  78 constants from the Fcntl module.  If dynamic loading is not available,
  79 this may fail, but the rest of IO::File will still work.
  80
  81 =back
  82
  83 =head1 SEE ALSO
  84
  85 L<perlfunc>,
  86 L<perlop/"I/O Operators">,
  87 L<IO::Handle>
  88 L<IO::Seekable>
  89
  90 =head1 HISTORY
  91
  92 Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>.
  93
  94 =head1 REVISION
  95
  96 $Revision: 1.5 $
  97
  98 =cut
  99
 100 require 5.000;
 101 use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD);
 102 use Carp;
 103 use Symbol;
 104 use SelectSaver;
 105 use IO::Handle qw(_open_mode_string);
 106 use IO::Seekable;
 107
 108 require Exporter;
 109 require DynaLoader;
 110
 111 @ISA = qw(IO::Handle IO::Seekable Exporter DynaLoader);
 112
 113 $VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/);
 114
 115 @EXPORT = @IO::Seekable::EXPORT;
 116
 117 sub import {
 118     my $pkg = shift;
 119     my $callpkg = caller;
 120     Exporter::export $pkg, $callpkg, @_;
 121
 122     #
 123     # If the Fcntl extension is available,
 124     #  export its constants for sysopen().
 125     #
 126     eval {
 127         require Fcntl;
 128         Exporter::export 'Fcntl', $callpkg, '/^O_/';
 129     };
 130 }
 131
 132
 133 ################################################
 134 ## Constructor
 135 ##
 136
 137 sub new {
 138     my $type = shift;
 139     my $class = ref($type) || $type || "IO::File";
 140     @_ >= 0 && @_ <= 3
 141         or croak "usage: new $class [FILENAME [,MODE [,PERMS]]]";
 142     my $fh = $class->SUPER::new();
 143     if (@_) {
 144         $fh->open(@_)
 145             or return undef;
 146     }
 147     $fh;
 148 }
 149
 150 ################################################
 151 ## Open
 152 ##
 153
 154 sub open {
 155     @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])';
 156     my ($fh, $file) = @_;
 157     if (@_ > 2) {
 158         my ($mode, $perms) = @_[2, 3];
 159         if ($mode =~ /^\d+$/) {
 160             defined $perms or $perms = 0666;
 161             return sysopen($fh, $file, $mode, $perms);
 162         }
 163         $file = "./" . $file unless $file =~ m#^/#;
 164         $file = _open_mode_string($mode) . " $file\0";
 165     }
 166     open($fh, $file);
 167 }
 168
 169 1;