From: Chip Salzenberg Date: Fri, 6 Dec 1996 06:56:00 +0000 (+1200) Subject: [shell changes from patch from perl5.003_10 to perl5.003_11] X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9a62c8669a9d6f57e898f39db6340a5008384639;p=p5sagit%2Fp5-mst-13.2.git [shell changes from patch from perl5.003_10 to perl5.003_11] Change from running these commands: # new directories for new modules test -d lib/Class || mkdir lib/Class test -d lib/User || mkdir lib/User # get rid of old extension rm -rf ext/FileHandle exit 0 --- diff --git a/ext/FileHandle/FileHandle.pm b/ext/FileHandle/FileHandle.pm deleted file mode 100644 index ada75a3..0000000 --- a/ext/FileHandle/FileHandle.pm +++ /dev/null @@ -1,490 +0,0 @@ -package FileHandle; - -=head1 NAME - -FileHandle - supply object methods for filehandles - -=head1 SYNOPSIS - - use FileHandle; - - $fh = new FileHandle; - if ($fh->open "< file") { - print <$fh>; - $fh->close; - } - - $fh = new FileHandle "> FOO"; - if (defined $fh) { - print $fh "bar\n"; - $fh->close; - } - - $fh = new FileHandle "file", "r"; - if (defined $fh) { - print <$fh>; - undef $fh; # automatically closes the file - } - - $fh = new FileHandle "file", O_WRONLY|O_APPEND; - if (defined $fh) { - print $fh "corge\n"; - undef $fh; # automatically closes the file - } - - $pos = $fh->getpos; - $fh->setpos $pos; - - $fh->setvbuf($buffer_var, _IOLBF, 1024); - - ($readfh, $writefh) = FileHandle::pipe; - - autoflush STDOUT 1; - -=head1 DESCRIPTION - -C creates a C, which is a reference to a -newly created symbol (see the C package). If it receives any -parameters, they are passed to C; if the open fails, -the C object is destroyed. Otherwise, it is returned to -the caller. - -C creates a C like C does. -It requires two parameters, which are passed to C; -if the fdopen fails, the C object is destroyed. -Otherwise, it is returned to the caller. - -C accepts one parameter or two. With one parameter, -it is just a front end for the built-in C function. With two -parameters, the first parameter is a filename that may include -whitespace or other special characters, and the second parameter is -the open mode, optionally followed by a file permission value. - -If C receives a Perl mode string ("E", "+E", etc.) -or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic -Perl C operator. - -If C is given a numeric mode, it passes that mode -and the optional permissions value to the Perl C operator. -For convenience, C tries to import the O_XXX -constants from the Fcntl module. If dynamic loading is not available, -this may fail, but the rest of FileHandle will still work. - -C is like C except that its first parameter -is not a filename but rather a file handle name, a FileHandle object, -or a file descriptor number. - -If the C functions fgetpos() and fsetpos() are available, then -C returns an opaque value that represents the -current position of the FileHandle, and C uses -that value to return to a previously visited position. - -If the C function setvbuf() is available, then C -sets the buffering policy for the FileHandle. The calling sequence -for the Perl function is the same as its C counterpart, including the -macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer -parameter specifies a scalar variable to use as a buffer. WARNING: A -variable used as a buffer by C must not be -modified in any way until the FileHandle is closed or until -C is called again, or memory corruption may -result! - -See L for complete descriptions of each of the following -supported C methods, which are just front ends for the -corresponding built-in functions: - - close - fileno - getc - gets - eof - clearerr - seek - tell - -See L for complete descriptions of each of the following -supported C methods: - - autoflush - output_field_separator - output_record_separator - input_record_separator - input_line_number - format_page_number - format_lines_per_page - format_lines_left - format_name - format_top_name - format_line_break_characters - format_formfeed - -Furthermore, for doing normal I/O you might need these: - -=over - -=item $fh-Eprint - -See L. - -=item $fh-Eprintf - -See L. - -=item $fh-Egetline - -This works like E$fhE described in L -except that it's more readable and can be safely called in an -array context but still returns just one line. - -=item $fh-Egetlines - -This works like E$fhE when called in an array context to -read all the remaining lines in a file, except that it's more readable. -It will also croak() if accidentally called in a scalar context. - -=back - -=head1 SEE ALSO - -L, -L. - -=head1 BUGS - -Due to backwards compatibility, all filehandles resemble objects -of class C, or actually classes derived from that class. -They actually aren't. Which means you can't derive your own -class from C and inherit those methods. - -=cut - -require 5.000; -use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD); -use Carp; -use Symbol; -use SelectSaver; - -require Exporter; -require DynaLoader; -@ISA = qw(Exporter DynaLoader); - -require IO::Handle; # Kludge for bareword handles - -$VERSION = "1.00" ; - -@EXPORT = qw(_IOFBF _IOLBF _IONBF); - -@EXPORT_OK = qw( - autoflush - output_field_separator - output_record_separator - input_record_separator - input_line_number - format_page_number - format_lines_per_page - format_lines_left - format_name - format_top_name - format_line_break_characters - format_formfeed - - print - printf - getline - getlines -); - - -################################################ -## If the Fcntl extension is available, -## export its constants. -## - -sub import { - my $pkg = shift; - my $callpkg = caller; - Exporter::export $pkg, $callpkg; - eval { - require Fcntl; - Exporter::export 'Fcntl', $callpkg; - }; -}; - - -################################################ -## Interaction with the XS. -## - -eval { - bootstrap FileHandle; -}; -if ($@) { - *constant = sub { undef }; -} - -sub AUTOLOAD { - if ($AUTOLOAD =~ /::(_?[a-z])/) { - $AutoLoader::AUTOLOAD = $AUTOLOAD; - goto &AutoLoader::AUTOLOAD - } - my $constname = $AUTOLOAD; - $constname =~ s/.*:://; - my $val = constant($constname); - defined $val or croak "$constname is not a valid FileHandle macro"; - *$AUTOLOAD = sub { $val }; - goto &$AUTOLOAD; -} - - -################################################ -## Constructors, destructors. -## - -sub new { - @_ >= 1 && @_ <= 4 - or croak 'usage: new FileHandle [FILENAME [,MODE [,PERMS]]]'; - my $class = shift; - my $fh = gensym; - if (@_) { - FileHandle::open($fh, @_) - or return undef; - } - bless $fh, $class; -} - -sub new_from_fd { - @_ == 3 or croak 'usage: new_from_fd FileHandle FD, MODE'; - my $class = shift; - my $fh = gensym; - FileHandle::fdopen($fh, @_) - or return undef; - bless $fh, $class; -} - -sub DESTROY { - my ($fh) = @_; - - # During global object destruction, this function may be called - # on FILEHANDLEs as well as on the GLOBs that contains them. - # Thus the following trickery. If only the CORE file operators - # could deal with FILEHANDLEs, it wouldn't be necessary... - - if ($fh =~ /=FILEHANDLE\(/) { - local *TMP = $fh; - close(TMP) if defined fileno(TMP); - } - else { - close($fh) if defined fileno($fh); - } -} - -################################################ -## Open and close. -## - -sub pipe { - @_ and croak 'usage: FileHandle::pipe()'; - my $readfh = new FileHandle; - my $writefh = new FileHandle; - pipe($readfh, $writefh) - or return undef; - ($readfh, $writefh); -} - -sub _open_mode_string { - my ($mode) = @_; - $mode =~ /^\+?(<|>>?)$/ - or $mode =~ s/^r(\+?)$/$1/ - or $mode =~ s/^a(\+?)$/$1>>/ - or croak "FileHandle: bad open mode: $mode"; - $mode; -} - -sub open { - @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])'; - my ($fh, $file) = @_; - if (@_ > 2) { - my ($mode, $perms) = @_[2, 3]; - if ($mode =~ /^\d+$/) { - defined $perms or $perms = 0666; - return sysopen($fh, $file, $mode, $perms); - } - $file = "./" . $file unless $file =~ m#^/#; - $file = _open_mode_string($mode) . " $file\0"; - } - open($fh, $file); -} - -sub fdopen { - @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)'; - my ($fh, $fd, $mode) = @_; - if (ref($fd) =~ /GLOB\(/) { - # It's a glob reference; remove the star from its name. - ($fd = "".$$fd) =~ s/^\*//; - } elsif ($fd =~ m#^\d+$#) { - # It's an FD number; prefix with "=". - $fd = "=$fd"; - } - open($fh, _open_mode_string($mode) . '&' . $fd); -} - -sub close { - @_ == 1 or croak 'usage: $fh->close()'; - close($_[0]); -} - -################################################ -## Normal I/O functions. -## - -sub fileno { - @_ == 1 or croak 'usage: $fh->fileno()'; - fileno($_[0]); -} - -sub getc { - @_ == 1 or croak 'usage: $fh->getc()'; - getc($_[0]); -} - -sub gets { - @_ == 1 or croak 'usage: $fh->gets()'; - my ($handle) = @_; - scalar <$handle>; -} - -sub eof { - @_ == 1 or croak 'usage: $fh->eof()'; - eof($_[0]); -} - -sub clearerr { - @_ == 1 or croak 'usage: $fh->clearerr()'; - seek($_[0], 0, 1); -} - -sub seek { - @_ == 3 or croak 'usage: $fh->seek(POS, WHENCE)'; - seek($_[0], $_[1], $_[2]); -} - -sub tell { - @_ == 1 or croak 'usage: $fh->tell()'; - tell($_[0]); -} - -sub print { - @_ or croak 'usage: $fh->print([ARGS])'; - my $this = shift; - print $this @_; -} - -sub printf { - @_ or croak 'usage: $fh->printf([ARGS])'; - my $this = shift; - printf $this @_; -} - -sub getline { - @_ == 1 or croak 'usage: $fh->getline'; - my $this = shift; - return scalar <$this>; -} - -sub getlines { - @_ == 1 or croak 'usage: $fh->getline()'; - my $this = shift; - wantarray or croak "Can't call FileHandle::getlines in a scalar context"; - return <$this>; -} - -################################################ -## State modification functions. -## - -sub autoflush { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $|; - $| = @_ > 1 ? $_[1] : 1; - $prev; -} - -sub output_field_separator { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $,; - $, = $_[1] if @_ > 1; - $prev; -} - -sub output_record_separator { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $\; - $\ = $_[1] if @_ > 1; - $prev; -} - -sub input_record_separator { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $/; - $/ = $_[1] if @_ > 1; - $prev; -} - -sub input_line_number { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $.; - $. = $_[1] if @_ > 1; - $prev; -} - -sub format_page_number { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $%; - $% = $_[1] if @_ > 1; - $prev; -} - -sub format_lines_per_page { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $=; - $= = $_[1] if @_ > 1; - $prev; -} - -sub format_lines_left { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $-; - $- = $_[1] if @_ > 1; - $prev; -} - -sub format_name { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $~; - $~ = qualify($_[1], caller) if @_ > 1; - $prev; -} - -sub format_top_name { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $^; - $^ = qualify($_[1], caller) if @_ > 1; - $prev; -} - -sub format_line_break_characters { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $:; - $: = $_[1] if @_ > 1; - $prev; -} - -sub format_formfeed { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $^L; - $^L = $_[1] if @_ > 1; - $prev; -} - -1; diff --git a/ext/FileHandle/FileHandle.xs b/ext/FileHandle/FileHandle.xs deleted file mode 100644 index 413b312..0000000 --- a/ext/FileHandle/FileHandle.xs +++ /dev/null @@ -1,176 +0,0 @@ -#include "EXTERN.h" -#define PERLIO_NOT_STDIO 1 -#include "perl.h" -#include "XSUB.h" - -typedef int SysRet; -typedef PerlIO * InputStream; -typedef PerlIO * OutputStream; - -static int -not_here(s) -char *s; -{ - croak("FileHandle::%s not implemented on this architecture", s); - return -1; -} - -static bool -constant(name, pval) -char *name; -IV *pval; -{ - switch (*name) { - case '_': - if (strEQ(name, "_IOFBF")) -#ifdef _IOFBF - { *pval = _IOFBF; return TRUE; } -#else - return FALSE; -#endif - if (strEQ(name, "_IOLBF")) -#ifdef _IOLBF - { *pval = _IOLBF; return TRUE; } -#else - return FALSE; -#endif - if (strEQ(name, "_IONBF")) -#ifdef _IONBF - { *pval = _IONBF; return TRUE; } -#else - return FALSE; -#endif - break; - } - - return FALSE; -} - - -MODULE = FileHandle PACKAGE = FileHandle PREFIX = f - -SV * -constant(name) - char * name - CODE: - IV i; - if (constant(name, &i)) - RETVAL = newSViv(i); - else - RETVAL = &sv_undef; - OUTPUT: - RETVAL - -SV * -fgetpos(handle) - InputStream handle - CODE: - if (handle) { - Fpos_t pos; - PerlIO_getpos(handle, &pos); - ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); - } - else { - ST(0) = &sv_undef; - errno = EINVAL; - } - -SysRet -fsetpos(handle, pos) - InputStream handle - SV * pos - CODE: - if (handle) - RETVAL = PerlIO_setpos(handle, (Fpos_t*)SvPVX(pos)); - else { - RETVAL = -1; - errno = EINVAL; - } - OUTPUT: - RETVAL - -int -ungetc(handle, c) - InputStream handle - int c - CODE: - if (handle) - RETVAL = PerlIO_ungetc(handle, c); - else { - RETVAL = -1; - errno = EINVAL; - } - OUTPUT: - RETVAL - -OutputStream -new_tmpfile(packname = "FileHandle") - char * packname - CODE: - RETVAL = PerlIO_tmpfile(); - OUTPUT: - RETVAL - -int -ferror(handle) - InputStream handle - CODE: - if (handle) - RETVAL = PerlIO_error(handle); - else { - RETVAL = -1; - errno = EINVAL; - } - OUTPUT: - RETVAL - -SysRet -fflush(handle) - OutputStream handle - CODE: - if (handle) - RETVAL = PerlIO_flush(handle); - else { - RETVAL = -1; - errno = EINVAL; - } - OUTPUT: - RETVAL - -void -setbuf(handle, buf) - OutputStream handle - char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0; - CODE: -#ifdef PERLIO_IS_STDIO - if (handle) - setbuf(handle, buf); -#else - not_here("setbuf"); -#endif - - -SysRet -setvbuf(handle, buf, type, size) - OutputStream handle - char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; - int type - int size - CODE: -#ifdef PERLIO_IS_STDIO -#ifdef _IOFBF /* Should be HAS_SETVBUF once Configure tests for that */ - if (handle) - RETVAL = setvbuf(handle, buf, type, size); - else { - RETVAL = -1; - errno = EINVAL; - } -#else - RETVAL = (SysRet) not_here("setvbuf"); -#endif /* _IOFBF */ -#else - RETVAL = (SysRet) not_here("setvbuf"); -#endif - OUTPUT: - RETVAL - diff --git a/ext/FileHandle/Makefile.PL b/ext/FileHandle/Makefile.PL deleted file mode 100644 index 7efd382..0000000 --- a/ext/FileHandle/Makefile.PL +++ /dev/null @@ -1,7 +0,0 @@ -use ExtUtils::MakeMaker; -WriteMakefile( - NAME => 'FileHandle', - MAN3PODS => ' ', # Pods will be built by installman. - XSPROTOARG => '-noprototypes', # XXX remove later? - VERSION_FROM => 'FileHandle.pm', -);