[libio-all-perl] 14/14: remove old stuff from this branch
Axel Beckert
abe at deuxchevaux.org
Sun Apr 26 22:25:29 UTC 2015
This is an automated email from the git hooks/post-receive script.
abe pushed a commit to tag alt-io-all-new-0.00
in repository libio-all-perl.
commit b9e8cdf14b35c86f727fe01d1b2bc5321d55387a
Author: Ingy döt Net <ingy at ingy.net>
Date: Wed Jul 25 14:12:55 2012 -0700
remove old stuff from this branch
I can checkout master elsewhere...
---
lib/Alt/IO/All/new.pm | 10 +-
old/lib/IO/All.pm | 827 -------------------
old/lib/IO/All.pod | 1694 --------------------------------------
old/lib/IO/All/Base.pm | 196 -----
old/lib/IO/All/DBM.pm | 121 ---
old/lib/IO/All/Dir.pm | 246 ------
old/lib/IO/All/File.pm | 272 ------
old/lib/IO/All/Filesys.pm | 122 ---
old/lib/IO/All/Link.pm | 85 --
old/lib/IO/All/MLDBM.pm | 63 --
old/lib/IO/All/Pipe.pm | 85 --
old/lib/IO/All/STDIO.pm | 83 --
old/lib/IO/All/Socket.pm | 171 ----
old/lib/IO/All/String.pm | 52 --
old/lib/IO/All/Temp.pm | 47 --
old/t/IO_All_Test.pm | 61 --
old/t/IO_Dumper.pm | 20 -
old/t/absolute.t | 16 -
old/t/accept.t | 83 --
old/t/all.t | 52 --
old/t/all2.t | 9 -
old/t/append.t | 67 --
old/t/assert.t | 13 -
old/t/assert2.t | 15 -
old/t/autotie.t | 16 -
old/t/backwards.t | 24 -
old/t/chdir.t | 13 -
old/t/chomp.t | 16 -
old/t/construct.t | 46 --
old/t/dbm.t | 13 -
old/t/devnull.t | 9 -
old/t/empty.t | 17 -
old/t/encoding.t | 43 -
old/t/error1.t | 17 -
old/t/file_spec.t | 45 -
old/t/file_subclass.t | 32 -
old/t/fileno.t | 23 -
old/t/import_flags.t | 73 --
old/t/in-place.t | 37 -
old/t/inline_subclass.t | 49 --
old/t/input.t | 49 --
old/t/link.t | 33 -
old/t/link2.t | 27 -
old/t/lock.t | 29 -
old/t/mldbm.t | 22 -
old/t/morestuff | 3 -
old/t/mydir/dir1/dira/dirx/file1 | 1 -
old/t/mydir/dir1/file1 | 2 -
old/t/mydir/dir2/file1 | 2 -
old/t/mydir/file1 | 2 -
old/t/mydir/file2 | 2 -
old/t/mydir/file3 | 2 -
old/t/mystuff | 3 -
old/t/new.t | 16 -
old/t/overload.t | 77 --
old/t/pipe.t | 13 -
old/t/print.t | 11 -
old/t/println.t | 15 -
old/t/read.t | 22 -
old/t/read_write.t | 13 -
old/t/round_robin.t | 26 -
old/t/rt-41819.t | 11 -
old/t/scalar.t | 11 -
old/t/seek.t | 11 -
old/t/separator.t | 20 -
old/t/stat.t | 27 -
old/t/string_open.t | 14 -
old/t/subtleties.t | 27 -
old/t/synopsis1.t | 17 -
old/t/synopsis2.t | 36 -
old/t/synopsis3.t | 52 --
old/t/synopsis5.t | 15 -
old/t/text.big5 | 2 -
old/t/text.utf8 | 2 -
old/t/tie.t | 10 -
old/t/tie_file.t | 24 -
old/t/xxx.t | 20 -
77 files changed, 8 insertions(+), 5544 deletions(-)
diff --git a/lib/Alt/IO/All/new.pm b/lib/Alt/IO/All/new.pm
index 63736e7..febbd44 100644
--- a/lib/Alt/IO/All/new.pm
+++ b/lib/Alt/IO/All/new.pm
@@ -20,9 +20,15 @@ our $VERSION = '0.01';
=head1 DESCRIPTION
-This is a rewrite of the infamous L<IO::All>. The new design is detailed here:
+This is a rewrite of the infamous L<IO::All>. The new design is detailed
+below.
-=head1 Introduction
+=head1 STATUS
+
+This is a very early release. It's just barely operational. Enough to upload
+to CPAN under the new experimental C<Alt-> namespace.
+
+=head1 IO::All Design
This is a design document for an upcoming version of IO::All.
diff --git a/old/lib/IO/All.pm b/old/lib/IO/All.pm
deleted file mode 100755
index 55a99ee..0000000
--- a/old/lib/IO/All.pm
+++ /dev/null
@@ -1,827 +0,0 @@
-package IO::All;
-use 5.006001;
-use strict;
-use warnings;
-
-require Carp;
-# So one can use Carp::carp "$message" - without the parenthesis.
-sub Carp::carp;
-
-use IO::All::Base -base;
-
-use File::Spec();
-use Symbol();
-use Fcntl;
-
-our $VERSION = '0.44';
-our @EXPORT = qw(io);
-
-#===============================================================================
-# Object creation and setup methods
-#===============================================================================
-my $autoload = {
- qw(
- touch file
-
- dir_handle dir
- All dir
- all_files dir
- All_Files dir
- all_dirs dir
- All_Dirs dir
- all_links dir
- All_Links dir
- mkdir dir
- mkpath dir
- next dir
-
- stdin stdio
- stdout stdio
- stderr stdio
-
- socket_handle socket
- accept socket
- shutdown socket
-
- readlink link
- symlink link
- )
-};
-
-# XXX - These should die if the given argument exists but is not a
-# link, dbm, etc.
-sub link {my $self = shift; require IO::All::Link; IO::All::Link::link($self, @_) }
-sub dbm {my $self = shift; require IO::All::DBM; IO::All::DBM::dbm($self, @_) }
-sub mldbm {my $self = shift; require IO::All::MLDBM; IO::All::MLDBM::mldbm($self, @_) }
-
-sub autoload {my $self = shift; $autoload }
-
-sub AUTOLOAD {
- my $self = shift;
- my $method = $IO::All::AUTOLOAD;
- $method =~ s/.*:://;
- my $pkg = ref($self) || $self;
- $self->throw(qq{Can't locate object method "$method" via package "$pkg"})
- if $pkg ne $self->package;
- my $class = $self->autoload_class($method);
- my $foo = "$self";
- bless $self, $class;
- $self->$method(@_);
-}
-
-sub autoload_class {
- my $self = shift;
- my $method = shift;
- my $class_id = $self->autoload->{$method} || $method;
- my $ucfirst_class_name = 'IO::All::' . ucfirst($class_id);
- my $ucfirst_class_fn = "IO/All/" . ucfirst($class_id) . ".pm";
- return $ucfirst_class_name if $INC{$ucfirst_class_fn};
- return "IO::All::\U$class_id" if $INC{"IO/All/\U$class_id\E.pm"};
- require IO::All::Temp;
- if (eval "require $ucfirst_class_name; 1") {
- my $class = $ucfirst_class_name;
- my $return = $class->can('new')
- ? $class
- : do { # (OS X hack)
- my $value = $INC{$ucfirst_class_fn};
- delete $INC{$ucfirst_class_fn};
- $INC{"IO/All/\U$class_id\E.pm"} = $value;
- "IO::All::\U$class_id";
- };
- return $return;
- }
- elsif (eval "require IO::All::\U$class_id; 1") {
- return "IO::All::\U$class_id";
- }
- $self->throw("Can't find a class for method '$method'");
-}
-
-sub new {
- my $self = shift;
- my $package = ref($self) || $self;
- my $new = bless Symbol::gensym(), $package;
- $new->package($package);
- $new->_copy_from($self) if ref($self);
- my $name = shift;
- return $name if UNIVERSAL::isa($name, 'IO::All');
- return $new->_init unless defined $name;
- return $new->handle($name)
- if UNIVERSAL::isa($name, 'GLOB') or ref(\ $name) eq 'GLOB';
- # WWW - link is first because a link to a dir returns true for
- # both -l and -d.
- return $new->link($name) if -l $name;
- return $new->file($name) if -f $name;
- return $new->dir($name) if -d $name;
- return $new->$1($name) if $name =~ /^([a-z]{3,8}):/;
- return $new->socket($name) if $name =~ /^[\w\-\.]*:\d{1,5}$/;
- return $new->pipe($name)
- if $name =~ s/^\s*\|\s*// or $name =~ s/\s*\|\s*$//;
- return $new->string if $name eq '$';
- return $new->stdio if $name eq '-';
- return $new->stderr if $name eq '=';
- return $new->temp if $name eq '?';
- $new->name($name);
- $new->_init;
-}
-
-sub _copy_from {
- my $self = shift;
- my $other = shift;
- for (keys(%{*$other})) {
- # XXX Need to audit exclusions here
- next if /^(_handle|io_handle|is_open)$/;
- *$self->{$_} = *$other->{$_};
- }
-}
-
-sub handle {
- my $self = shift;
- $self->_handle(shift) if @_;
- return $self->_init;
-}
-
-#===============================================================================
-# Tie Interface
-#===============================================================================
-sub tie {
- my $self = shift;
- tie *$self, $self;
- return $self;
-}
-
-sub TIEHANDLE {
- return $_[0] if ref $_[0];
- my $class = shift;
- my $self = bless Symbol::gensym(), $class;
- $self->init(@_);
-}
-
-sub READLINE {
- goto &getlines if wantarray;
- goto &getline;
-}
-
-sub DESTROY {
- my $self = shift;
- no warnings;
- unless ( $] < 5.008 ) {
- untie *$self if tied *$self;
- }
- $self->close if $self->is_open;
-}
-
-sub BINMODE {
- my $self = shift;
- binmode *$self->io_handle;
-}
-
-{
- no warnings;
- *GETC = \&getc;
- *PRINT = \&print;
- *PRINTF = \&printf;
- *READ = \&read;
- *WRITE = \&write;
- *SEEK = \&seek;
- *TELL = \&getpos;
- *EOF = \&eof;
- *CLOSE = \&close;
- *FILENO = \&fileno;
-}
-
-#===============================================================================
-# Overloading support
-#===============================================================================
-my $old_warn_handler = $SIG{__WARN__};
-$SIG{__WARN__} = sub {
- if ($_[0] !~ /^Useless use of .+ \(.+\) in void context/) {
- goto &$old_warn_handler if $old_warn_handler;
- warn(@_);
- }
-};
-
-use overload '""' => 'overload_stringify';
-use overload '|' => 'overload_bitwise_or';
-use overload '<<' => 'overload_left_bitshift';
-use overload '>>' => 'overload_right_bitshift';
-use overload '<' => 'overload_less_than';
-use overload '>' => 'overload_greater_than';
-use overload '${}' => 'overload_string_deref';
-use overload '@{}' => 'overload_array_deref';
-use overload '%{}' => 'overload_hash_deref';
-use overload '&{}' => 'overload_code_deref';
-
-sub overload_bitwise_or {my $self = shift; $self->overload_handler(@_, '|') }
-sub overload_left_bitshift {my $self = shift; $self->overload_handler(@_, '<<') }
-sub overload_right_bitshift {my $self = shift; $self->overload_handler(@_, '>>') }
-sub overload_less_than {my $self = shift; $self->overload_handler(@_, '<') }
-sub overload_greater_than {my $self = shift; $self->overload_handler(@_, '>') }
-sub overload_string_deref {my $self = shift; $self->overload_handler(@_, '${}') }
-sub overload_array_deref {my $self = shift; $self->overload_handler(@_, '@{}') }
-sub overload_hash_deref {my $self = shift; $self->overload_handler(@_, '%{}') }
-sub overload_code_deref {my $self = shift; $self->overload_handler(@_, '&{}') }
-
-sub overload_handler {
- my ($self) = @_;
- my $method = $self->get_overload_method(@_);
- $self->$method(@_);
-}
-
-my $op_swap = {
- '>' => '<', '>>' => '<<',
- '<' => '>', '<<' => '>>',
-};
-
-sub overload_table {
- my $self = shift;
- (
- '* > *' => 'overload_any_to_any',
- '* < *' => 'overload_any_from_any',
- '* >> *' => 'overload_any_addto_any',
- '* << *' => 'overload_any_addfrom_any',
-
- '* < scalar' => 'overload_scalar_to_any',
- '* > scalar' => 'overload_any_to_scalar',
- '* << scalar' => 'overload_scalar_addto_any',
- '* >> scalar' => 'overload_any_addto_scalar',
- )
-};
-
-sub get_overload_method {
- my ($self, $arg1, $arg2, $swap, $operator) = @_;
- if ($swap) {
- $operator = $op_swap->{$operator} || $operator;
- }
- my $arg1_type = $self->get_argument_type($arg1);
- my $table1 = { $arg1->overload_table };
-
- if ($operator =~ /\{\}$/) {
- my $key = "$operator $arg1_type";
- return $table1->{$key} || $self->overload_undefined($key);
- }
-
- my $arg2_type = $self->get_argument_type($arg2);
- my @table2 = UNIVERSAL::isa($arg2, "IO::All")
- ? ($arg2->overload_table)
- : ();
- my $table = { %$table1, @table2 };
-
- my @keys = (
- "$arg1_type $operator $arg2_type",
- "* $operator $arg2_type",
- );
- push @keys, "$arg1_type $operator *", "* $operator *"
- unless $arg2_type =~ /^(scalar|array|hash|code|ref)$/;
-
- for (@keys) {
- return $table->{$_}
- if defined $table->{$_};
- }
-
- return $self->overload_undefined($keys[0]);
-}
-
-sub get_argument_type {
- my $self = shift;
- my $argument = shift;
- my $ref = ref($argument);
- return 'scalar' unless $ref;
- return 'code' if $ref eq 'CODE';
- return 'array' if $ref eq 'ARRAY';
- return 'hash' if $ref eq 'HASH';
- return 'ref' unless $argument->isa('IO::All');
- $argument->file
- if defined $argument->pathname and not $argument->type;
- return $argument->type || 'unknown';
-}
-
-sub overload_stringify {
- my $self = shift;
- my $name = $self->pathname;
- return defined($name) ? $name : overload::StrVal($self);
-}
-
-sub overload_undefined {
- my $self = shift;
- require Carp;
- my $key = shift;
- Carp::carp "Undefined behavior for overloaded IO::All operation: '$key'"
- if $^W;
- return 'overload_noop';
-}
-
-sub overload_noop {
- my $self = shift;
- return;
-}
-
-sub overload_any_addfrom_any {
- $_[1]->append($_[2]->all);
- $_[1];
-}
-
-sub overload_any_addto_any {
- $_[2]->append($_[1]->all);
- $_[2];
-}
-
-sub overload_any_from_any {
- $_[1]->close if $_[1]->is_file and $_[1]->is_open;
- $_[1]->print($_[2]->all);
- $_[1];
-}
-
-sub overload_any_to_any {
- $_[2]->close if $_[2]->is_file and $_[2]->is_open;
- $_[2]->print($_[1]->all);
- $_[2];
-}
-
-sub overload_any_to_scalar {
- $_[2] = $_[1]->all;
-}
-
-sub overload_any_addto_scalar {
- $_[2] .= $_[1]->all;
- $_[2];
-}
-
-sub overload_scalar_addto_any {
- $_[1]->append($_[2]);
- $_[1];
-}
-
-sub overload_scalar_to_any {
- local $\;
- $_[1]->close if $_[1]->is_file and $_[1]->is_open;
- $_[1]->print($_[2]);
- $_[1];
-}
-
-#===============================================================================
-# Private Accessors
-#===============================================================================
-field 'package';
-field _binary => undef;
-field _binmode => undef;
-field _strict => undef;
-field _encoding => undef;
-field _utf8 => undef;
-field _handle => undef;
-
-#===============================================================================
-# Public Accessors
-#===============================================================================
-field constructor => undef;
-chain block_size => 1024;
-chain errors => undef;
-field io_handle => undef;
-field is_open => 0;
-chain mode => undef;
-chain name => undef;
-chain perms => undef;
-chain separator => $/;
-field type => '';
-sub pathname {my $self = shift; $self->name(@_) }
-
-#===============================================================================
-# Chainable option methods (write only)
-#===============================================================================
-option 'assert';
-option 'autoclose' => 1;
-option 'backwards';
-option 'chomp';
-option 'confess';
-option 'lock';
-option 'rdonly';
-option 'rdwr';
-option 'strict';
-
-#===============================================================================
-# IO::Handle proxy methods
-#===============================================================================
-proxy 'autoflush';
-proxy 'eof';
-proxy 'fileno';
-proxy 'stat';
-proxy 'tell';
-proxy 'truncate';
-
-#===============================================================================
-# IO::Handle proxy methods that open the handle if needed
-#===============================================================================
-proxy_open print => '>';
-proxy_open printf => '>';
-proxy_open sysread => O_RDONLY;
-proxy_open syswrite => O_CREAT | O_WRONLY;
-proxy_open seek => $^O eq 'MSWin32' ? '<' : '+<';
-proxy_open 'getc';
-
-#===============================================================================
-# File::Spec Interface
-#===============================================================================
-sub canonpath {my $self = shift; File::Spec->canonpath($self->pathname) }
-sub catdir {
- my $self = shift;
- my @args = grep defined, $self->name, @_;
- $self->constructor->()->dir(File::Spec->catdir(@args));
-}
-sub catfile {
- my $self = shift;
- my @args = grep defined, $self->name, @_;
- $self->constructor->()->file(File::Spec->catfile(@args));
-}
-sub join {my $self = shift; $self->catfile(@_) }
-sub curdir {
- my $self = shift;
- $self->constructor->()->dir(File::Spec->curdir);
-}
-sub devnull {
- my $self = shift;
- $self->constructor->()->file(File::Spec->devnull);
-}
-sub rootdir {
- my $self = shift;
- $self->constructor->()->dir(File::Spec->rootdir);
-}
-sub tmpdir {
- my $self = shift;
- $self->constructor->()->dir(File::Spec->tmpdir);
-}
-sub updir {
- my $self = shift;
- $self->constructor->()->dir(File::Spec->updir);
-}
-sub case_tolerant {
- my $self = shift;
- File::Spec->case_tolerant;
-}
-sub is_absolute {
- my $self = shift;
- File::Spec->file_name_is_absolute($self->pathname);
-}
-sub path {
- my $self = shift;
- map { $self->constructor->()->dir($_) } File::Spec->path;
-}
-sub splitpath {
- my $self = shift;
- File::Spec->splitpath($self->pathname);
-}
-sub splitdir {
- my $self = shift;
- File::Spec->splitdir($self->pathname);
-}
-sub catpath {
- my $self = shift;
- $self->constructor->(File::Spec->catpath(@_));
-}
-sub abs2rel {
- my $self = shift;
- File::Spec->abs2rel($self->pathname, @_);
-}
-sub rel2abs {
- my $self = shift;
- File::Spec->rel2abs($self->pathname, @_);
-}
-
-#===============================================================================
-# Public IO Action Methods
-#===============================================================================
-sub absolute {
- my $self = shift;
- $self->pathname(File::Spec->rel2abs($self->pathname))
- unless $self->is_absolute;
- $self->is_absolute(1);
- return $self;
-}
-
-sub all {
- my $self = shift;
- $self->assert_open('<');
- local $/;
- my $all = $self->io_handle->getline;
- $self->error_check;
- $self->_autoclose && $self->close;
- return $all;
-}
-
-sub append {
- my $self = shift;
- $self->assert_open('>>');
- $self->print(@_);
-}
-
-sub appendln {
- my $self = shift;
- $self->assert_open('>>');
- $self->println(@_);
-}
-
-sub binary {
- my $self = shift;
- binmode($self->io_handle)
- if $self->is_open;
- $self->_binary(1);
- return $self;
-}
-
-sub binmode {
- my $self = shift;
- my $layer = shift;
- if ($self->is_open) {
- $layer
- ? CORE::binmode($self->io_handle, $layer)
- : CORE::binmode($self->io_handle);
- }
- $self->_binmode($layer);
- return $self;
-}
-
-sub buffer {
- my $self = shift;
- if (not @_) {
- *$self->{buffer} = do {my $x = ''; \ $x}
- unless exists *$self->{buffer};
- return *$self->{buffer};
- }
- my $buffer_ref = ref($_[0]) ? $_[0] : \ $_[0];
- $$buffer_ref = '' unless defined $$buffer_ref;
- *$self->{buffer} = $buffer_ref;
- return $self;
-}
-
-sub clear {
- my $self = shift;
- my $buffer = *$self->{buffer};
- $$buffer = '';
- return $self;
-}
-
-sub close {
- my $self = shift;
- return unless $self->is_open;
- $self->is_open(0);
- my $io_handle = $self->io_handle;
- $self->io_handle(undef);
- $self->mode(undef);
- $io_handle->close(@_)
- if defined $io_handle;
- return $self;
-}
-
-sub empty {
- my $self = shift;
- my $message =
- "Can't call empty on an object that is neither file nor directory";
- $self->throw($message);
-}
-
-sub exists {my $self = shift; -e $self->pathname }
-
-sub getline {
- my $self = shift;
- return $self->getline_backwards
- if $self->_backwards;
- $self->assert_open('<');
- my $line;
- {
- local $/ = @_ ? shift(@_) : $self->separator;
- $line = $self->io_handle->getline;
- chomp($line) if $self->_chomp and defined $line;
- }
- $self->error_check;
- return $line if defined $line;
- $self->close if $self->_autoclose;
- return undef;
-}
-
-sub getlines {
- my $self = shift;
- return $self->getlines_backwards
- if $self->_backwards;
- $self->assert_open('<');
- my @lines;
- {
- local $/ = @_ ? shift(@_) : $self->separator;
- @lines = $self->io_handle->getlines;
- if ($self->_chomp) {
- chomp for @lines;
- }
- }
- $self->error_check;
- return (@lines) or
- $self->_autoclose && $self->close && () or
- ();
-}
-
-sub is_dir {my $self = shift; UNIVERSAL::isa($self, 'IO::All::Dir') }
-sub is_dbm {my $self = shift; UNIVERSAL::isa($self, 'IO::All::DBM') }
-sub is_file {my $self = shift; UNIVERSAL::isa($self, 'IO::All::File') }
-sub is_link {my $self = shift; UNIVERSAL::isa($self, 'IO::All::Link') }
-sub is_mldbm {my $self = shift; UNIVERSAL::isa($self, 'IO::All::MLDBM') }
-sub is_socket {my $self = shift; UNIVERSAL::isa($self, 'IO::All::Socket') }
-sub is_stdio {my $self = shift; UNIVERSAL::isa($self, 'IO::All::STDIO') }
-sub is_string {my $self = shift; UNIVERSAL::isa($self, 'IO::All::String') }
-sub is_temp {my $self = shift; UNIVERSAL::isa($self, 'IO::All::Temp') }
-
-sub length {
- my $self = shift;
- length(${$self->buffer});
-}
-
-sub open {
- my $self = shift;
- return $self if $self->is_open;
- $self->is_open(1);
- my ($mode, $perms) = @_;
- $self->mode($mode) if defined $mode;
- $self->mode('<') unless defined $self->mode;
- $self->perms($perms) if defined $perms;
- my @args;
- unless ($self->is_dir) {
- push @args, $self->mode;
- push @args, $self->perms if defined $self->perms;
- }
- if (defined $self->pathname and not $self->type) {
- $self->file;
- return $self->open(@args);
- }
- elsif (defined $self->_handle and
- not $self->io_handle->opened
- ) {
- # XXX Not tested
- $self->io_handle->fdopen($self->_handle, @args);
- }
- $self->set_binmode;
-}
-
-sub println {
- my $self = shift;
- $self->print(map {/\n\z/ ? ($_) : ($_, "\n")} @_);
-}
-
-sub read {
- my $self = shift;
- $self->assert_open('<');
- my $length = (@_ or $self->type eq 'dir')
- ? $self->io_handle->read(@_)
- : $self->io_handle->read(
- ${$self->buffer},
- $self->block_size,
- $self->length,
- );
- $self->error_check;
- return $length || $self->_autoclose && $self->close && 0;
-}
-
-{
- no warnings;
- *readline = \&getline;
-}
-
-# deprecated
-sub scalar {
- my $self = shift;
- $self->all(@_);
-}
-
-sub slurp {
- my $self = shift;
- my $slurp = $self->all;
- return $slurp unless wantarray;
- my $separator = $self->separator;
- if ($self->_chomp) {
- local $/ = $separator;
- map {chomp; $_} split /(?<=\Q$separator\E)/, $slurp;
- }
- else {
- split /(?<=\Q$separator\E)/, $slurp;
- }
-}
-
-sub utf8 {
- my $self = shift;
- if ($] < 5.008) {
- die "IO::All -utf8 not supported on Perl older than 5.8";
- }
- CORE::binmode($self->io_handle, ':utf8')
- if $self->is_open;
- $self->_utf8(1);
- $self->encoding('utf8');
- return $self;
-}
-
-sub encoding {
- my $self = shift;
- my $encoding = shift
- or die "No encoding value passed to IO::All::encoding";
- if ($] < 5.008) {
- die "IO::All -encoding not supported on Perl older than 5.8";
- }
- CORE::binmode($self->io_handle, ":$encoding")
- if $self->is_open;
- $self->_encoding($encoding);
- return $self;
-}
-
-sub write {
- my $self = shift;
- $self->assert_open('>');
- my $length = @_
- ? $self->io_handle->write(@_)
- : $self->io_handle->write(${$self->buffer}, $self->length);
- $self->error_check;
- $self->clear unless @_;
- return $length;
-}
-
-#===============================================================================
-# Implementation methods. Subclassable.
-#===============================================================================
-sub throw {
- my $self = shift;
- require Carp;
- ;
- return &{$self->errors}(@_)
- if $self->errors;
- return Carp::confess(@_)
- if $self->_confess;
- return Carp::croak(@_);
-}
-
-#===============================================================================
-# Private instance methods
-#===============================================================================
-sub assert_dirpath {
- my $self = shift;
- my $dir_name = shift;
- return $dir_name if -d $dir_name or
- CORE::mkdir($self->pathname, $self->perms || 0755) or
- do {
- require File::Path;
- File::Path::mkpath($dir_name);
- } or
- $self->throw("Can't make $dir_name");
-}
-
-sub assert_open {
- my $self = shift;
- return if $self->is_open;
- $self->file unless $self->type;
- return $self->open(@_);
-}
-
-sub error_check {
- my $self = shift;
- return unless $self->io_handle->can('error');
- return unless $self->io_handle->error;
- $self->throw($!);
-}
-
-sub copy {
- my $self = shift;
- my $copy;
- for (keys %{*$self}) {
- $copy->{$_} = *$self->{$_};
- }
- $copy->{io_handle} = 'defined'
- if defined $copy->{io_handle};
- return $copy;
-}
-
-sub set_binmode {
- my $self = shift;
- if (my $encoding = $self->_encoding) {
- CORE::binmode($self->io_handle, ":encoding($encoding)");
- }
- elsif ($self->_binary) {
- CORE::binmode($self->io_handle);
- }
- elsif ($self->_binmode) {
- CORE::binmode($self->io_handle, $self->_binmode);
- }
- return $self;
-}
-
-#===============================================================================
-# Stat Methods
-#===============================================================================
-BEGIN {
- no strict 'refs';
- my @stat_fields = qw(
- device inode modes nlink uid gid device_id size atime mtime
- ctime blksize blocks
- );
- foreach my $stat_field_idx (0 .. $#stat_fields)
- {
- my $idx = $stat_field_idx;
- my $name = $stat_fields[$idx];
-
- *$name = sub {
- my $self = shift;
- return (stat($self->io_handle || $self->pathname))[$idx];
- };
- }
-}
-
diff --git a/old/lib/IO/All.pod b/old/lib/IO/All.pod
deleted file mode 100644
index a29c7cd..0000000
--- a/old/lib/IO/All.pod
+++ /dev/null
@@ -1,1694 +0,0 @@
-=encoding utf8
-
-=head1 NAME
-
-IO::All - IO::All of it to Graham and Damian!
-
-=head1 SYNOPSIS
-
- use IO::All; # Let the madness begin...
-
- # Some of the many ways to read a whole file into a scalar
- io('file.txt') > $contents; # Overloaded "arrow"
- $contents < io 'file.txt'; # Flipped but same operation
- $io = io 'file.txt'; # Create a new IO::All object
- $contents = $$io; # Overloaded scalar dereference
- $contents = $io->all; # A method to read everything
- $contents = $io->slurp; # Another method for that
- $contents = join '', $io->getlines; # Join the separate lines
- $contents = join '', map "$_\n", @$io; # Same. Overloaded array deref
- $io->tie; # Tie the object as a handle
- $contents = join '', <$io>; # And use it in builtins
- # and the list goes on ...
-
- # Other file operations:
- @lines = io('file.txt')->slurp; # List context slurp
- $content > io('file.txt'); # Print to a file
- io('file.txt')->print($content, $more); # (ditto)
- $content >> io('file.txt'); # Append to a file
- io('file.txt')->append($content); # (ditto)
- $content << $io; # Append to a string
- io('copy.txt') < io('file.txt'); $ Copy a file
- io('file.txt') > io('copy.txt'); # Invokes File::Copy
- io('more.txt') >> io('all.txt'); # Add on to a file
-
- # UTF-8 Support
- $contents = io('file.txt')->utf8->all; # Turn on utf8
- use IO::All -utf8; # Turn on utf8 for all io
- $contents = io('file.txt')->all; # by default in this package.
-
- # General Encoding Support
- $contents = io('file.txt')->encoding('big5')->all;
- use IO::All -encoding => 'big5'; # Turn on big5 for all io
- $contents = io('file.txt')->all; # by default in this package.
-
- # Print the path name of a file:
- print $io->name; # The direct method
- print "$io"; # Object stringifies to name
- print $io; # Quotes not needed here
- print $io->filename; # The file portion only
-
- # Read all the files/directories in a directory:
- $io = io('my/directory/'); # Create new directory object
- @contents = $io->all; # Get all contents of dir
- @contents = @$io; # Directory as an array
- @contents = values %$io; # Directory as a hash
- push @contents, $subdir # One at a time
- while $subdir = $io->next;
-
- # Print the name and file type for all the contents above:
- print "$_ is a " . $_->type . "\n" # Each element of @contents
- for @contents; # is an IO::All object!!
-
- # Print first line of each file:
- print $_->getline # getline gets one line
- for io('dir')->all_files; # Files only
-
- # Print names of all files/dirs three directories deep:
- print "$_\n" for $io->all(3); # Pass in the depth. Default=1
-
- # Print names of all files/dirs recursively:
- print "$_\n" for $io->all(0); # Zero means all the way down
- print "$_\n" for $io->All; # Capitalized shortcut
- print "$_\n" for $io->deep->all; # Another way
-
- # There are some special file names:
- print io('-'); # Print STDIN to STDOUT
- io('-') > io('-'); # Do it again
- io('-') < io('-'); # Same. Context sensitive.
- "Bad puppy" > io('='); # Message to STDERR
- $string_file = io('$'); # Create IO::String Object
- $temp_file = io('?'); # Create a temporary file
-
- # Socket operations:
- $server = io('localhost:5555')->fork; # Create a daemon socket
- $connection = $server->accept; # Get a connection socket
- $input < $connection; # Get some data from it
- "Thank you!" > $connection; # Thank the caller
- $connection->close; # Hang up
- io(':6666')->accept->slurp > io->devnull; # Take a complaint and file it
-
- # DBM database operations:
- $dbm = io 'my/database'; # Create a database object
- print $dbm->{grocery_list}; # Hash context makes it a DBM
- $dbm->{todo} = $new_list; # Write to database
- $dbm->dbm('GDBM_file'); # Demand specific DBM
- io('mydb')->mldbm->{env} = \%ENV; # MLDBM support
-
- # Tie::File support:
- $io = io 'file.txt';
- $io->[42] = 'Line Forty Three'; # Change a line
- print $io->[@$io / 2]; # Print middle line
- @$io = reverse @$io; # Reverse lines in a file
-
- # Stat functions:
- printf "%s %s %s\n", # Print name, uid and size of
- $_->name, $_->uid, $_->size # contents of current directory
- for io('.')->all;
- print "$_\n" for sort # Use mtime method to sort all
- {$b->mtime <=> $a->mtime} # files under current directory
- io('.')->All_Files; # by recent modification time.
-
- # File::Spec support:
- $contents < io->catfile(qw(dir file.txt)); # Portable IO operation
-
- # Miscellaneous:
- @lines = io('file.txt')->chomp->slurp; # Chomp as you slurp
- @chunks =
- io('file.txt')->separator('xxx')->slurp; # Use alternnate record sep
- $binary = io('file.bin')->binary->all; # Read a binary file
- io('a-symlink')->readlink->slurp; # Readlink returns an object
- print io('foo')->absolute->pathname; # Print absolute path of foo
-
- # IO::All External Plugin Methods
- io("myfile") > io->("ftp://store.org"); # Upload a file using ftp
- $html < io->http("www.google.com"); # Grab a web page
- io('mailto:worst at enemy.net')->print($spam); # Email a "friend"
-
- # This is just the beginning, read on...
-
-=head1 DESCRIPTION
-
-"Graham Barr for doing it all. Damian Conway for doing it all different."
-
-IO::All combines all of the best Perl IO modules into a single nifty
-object oriented interface to greatly simplify your everyday Perl IO
-idioms. It exports a single function called C<io>, which returns a new
-IO::All object. And that object can do it all!
-
-The IO::All object is a proxy for IO::File, IO::Dir, IO::Socket,
-IO::String, Tie::File, File::Spec, File::Path and File::ReadBackwards;
-as well as all the DBM and MLDBM modules. You can use most of the
-methods found in these classes and in IO::Handle (which they inherit
-from). IO::All adds dozens of other helpful idiomatic methods
-including file stat and manipulation functions.
-
-IO::All is pluggable, and modules like L<IO::All::LWP> and L<IO::All::Mailto>
-add even more functionality. Optionally, every IO::All object can be
-tied to itself. This means that you can use most perl IO builtins on it:
-readline, <>, getc, print, printf, syswrite, sysread, close.
-
-The distinguishing magic of IO::All is that it will automatically open
-(and close) files, directories, sockets and other IO things for you. You
-never need to specify the mode ('<', '>>', etc), since it is determined
-by the usage context. That means you can replace this:
-
- open STUFF, '<', './mystuff'
- or die "Can't open './mystuff' for input:\n$!";
- local $/;
- my $stuff = <STUFF>;
- close STUFF;
-
-with this:
-
- my $stuff < io './mystuff';
-
-And that is a B<good thing>!
-
-=head1 USAGE
-
-Normally just say:
-
- use IO::All;
-
-and IO::All will export a single function called C<io>, which contructs all IO
-objects.
-
-You can also pass global flags like this:
-
- use IO::All -strict -encoding => 'big5', -foobar;
-
-Which automatically makes those method calls on every new IO object. In other
-words this:
-
- my $io = io('lalala.txt');
-
-becomes this:
-
- my $io = io('lalala.txt')->strict->encoding('big5')->foobar;
-
-=head1 METHOD ROLE CALL
-
-Here is an alphabetical list of all the public methods that you can call
-on an IO::All object.
-
-C<abs2rel>, C<absolute>, C<accept>, C<All>, C<all>, C<All_Dirs>,
-C<all_dirs>, C<All_Files>, C<all_files>, C<All_Links>, C<all_links>,
-C<append>, C<appendf>, C<appendln>, C<assert>, C<atime>, C<autoclose>,
-C<autoflush>, C<backwards>, C<bcc>, C<binary>, C<binmode>, C<blksize>,
-C<blocks>, C<block_size>, C<buffer>, C<canonpath>, C<case_tolerant>,
-C<catdir>, C<catfile>, C<catpath>, C<cc>, C<chdir>, C<chomp>, C<clear>,
-C<close>, C<confess>, C<content>, C<ctime>, C<curdir>, C<dbm>, C<deep>,
-C<device>, C<device_id>, C<devnull>, C<dir>, C<domain>, C<empty>,
-C<encoding>, C<eof>, C<errors>, C<file>, C<filename>, C<fileno>,
-C<filepath>, C<filter>, C<fork>, C<from>, C<ftp>, C<get>, C<getc>,
-C<getline>, C<getlines>, C<gid>, C<handle>, C<head>, C<http>, C<https>,
-C<inode>, C<io_handle>, C<is_absolute>, C<is_dir>, C<is_dbm>,
-C<is_executable>, C<is_file>, C<is_link>, C<is_mldbm>, C<is_open>,
-C<is_pipe>, C<is_readable>, C<is_socket>, C<is_stdio>, C<is_string>,
-C<is_temp>, C<is_writable>, C<join>, C<length>, C<link>, C<lock>,
-C<mailer>, C<mailto>, C<mkdir>, C<mkpath>, C<mldbm>, C<mode>, C<modes>,
-C<mtime>, C<name>, C<new>, C<next>, C<nlink>, C<open>, C<password>,
-C<path>, C<pathname>, C<perms>, C<pipe>, C<port>, C<print>, C<printf>,
-C<println>, C<put>, C<rdonly>, C<rdwr>, C<read>, C<readdir>,
-C<readlink>, C<recv>, C<rel2abs>, C<relative>, C<rename>, C<request>,
-C<response>, C<rmdir>, C<rmtree>, C<rootdir>, C<scalar>, C<seek>,
-C<send>, C<separator>, C<shutdown>, C<size>, C<slurp>, C<socket>,
-C<sort>, C<splitdir>, C<splitpath>, C<stat>, C<stdio>, C<stderr>,
-C<stdin>, C<stdout>, C<strict>, C<string>, C<string_ref>, C<subject>,
-C<sysread>, C<syswrite>, C<tail>, C<tell>, C<temp>, C<tie>, C<tmpdir>,
-C<to>, C<touch>, C<truncate>, C<type>, C<user>, C<uid>, C<unlink>,
-C<unlock>, C<updir>, C<uri>, C<utf8>, C<utime> and C<write>.
-
-Each method is documented further below.
-
-=head1 OPERATOR OVERLOADING
-
-IO::All objects overload a small set of Perl operators to great effect.
-The overloads are limited to <, <<, >, >>, dereferencing operations, and
-stringification.
-
-Even though relatively few operations are overloaded, there is actually
-a huge matrix of possibilities for magic. That's because the overloading
-is sensitive to the types, position and context of the arguments, and an
-IO::All object can be one of many types.
-
-The most important overload to become familiar with is stringification.
-IO::All objects stringify to their file or directory name. Here we print the
-contents of the current directory:
-
- perl -MIO::All -le 'print for io(".")->all'
-
-is the same as:
-
- perl -MIO::All -le 'print $_->name for io(".")->all'
-
-Stringification is important because it allows IO::All operations to return
-objects when they might otherwise return file names. Then the recipient can
-use the result either as an object or a string.
-
-'>' and '<' move data between objects in the direction pointed to by the
-operator.
-
- $content1 < io('file1');
- $content1 > io('file2');
- io('file2') > $content3;
- io('file3') < $content3;
- io('file3') > io('file4');
- io('file5') < io('file4');
-
-'>>' and '<<' do the same thing except the recipent string or file is
-appended to.
-
-An IO::All file used as an array reference becomes tied using Tie::File:
-
- $file = io "file";
- # Print last line of file
- print $file->[-1];
- # Insert new line in middle of file
- $file->[$#$file / 2] = 'New line';
-
-An IO::All file used as a hash reference becomes tied to a DBM class:
-
- io('mydbm')->{ingy} = 'YAML';
-
-An IO::All directory used as an array reference, will expose each file or
-subdirectory as an element of the array.
-
- print "$_\n" for @{io 'dir'};
-
-IO::All directories used as hash references have file names as keys, and
-IO::All objects as values:
-
- print io('dir')->{'foo.txt'}->slurp;
-
-Files used as scalar references get slurped:
-
- print ${io('dir')->{'foo.txt'}};
-
-Not all combinations of operations and object types are supported. Some
-just haven't been added yet, and some just don't make sense. If you use
-an invalid combination, an error will be thrown.
-
-=head1 COOKBOOK
-
-This section describes some various things that you can easily cook up
-with IO::All.
-
-=head2 File Locking
-
-IO::All makes it very easy to lock files. Just use the C<lock> method. Here's a
-standalone program that demonstrates locking for both write and read:
-
- use IO::All;
- my $io1 = io('myfile')->lock;
- $io1->println('line 1');
-
- fork or do {
- my $io2 = io('myfile')->lock;
- print $io2->slurp;
- exit;
- };
-
- sleep 1;
- $io1->println('line 2');
- $io1->println('line 3');
- $io1->unlock;
-
-There are a lot of subtle things going on here. An exclusive lock is
-issued for C<$io1> on the first C<println>. That's because the file
-isn't actually opened until the first IO operation.
-
-When the child process tries to read the file using C<$io2>, there is
-a shared lock put on it. Since C<$io1> has the exclusive lock, the
-slurp blocks.
-
-The parent process sleeps just to make sure the child process gets a
-chance. The parent needs to call C<unlock> or C<close> to release the
-lock. If all goes well the child will print 3 lines.
-
-=head2 Round Robin
-
-This simple example will read lines from a file forever. When the last
-line is read, it will reopen the file and read the first one again.
-
- my $io = io 'file1.txt';
- $io->autoclose(1);
- while (my $line = $io->getline || $io->getline) {
- print $line;
- }
-
-=head2 Reading Backwards
-
-If you call the C<backwards> method on an IO::All object, the
-C<getline> and C<getlines> will work in reverse. They will read the
-lines in the file from the end to the beginning.
-
- my @reversed;
- my $io = io('file1.txt');
- $io->backwards;
- while (my $line = $io->getline) {
- push @reversed, $line;
- }
-
-or more simply:
-
- my @reversed = io('file1.txt')->backwards->getlines;
-
-The C<backwards> method returns the IO::All object so that you can
-chain the calls.
-
-NOTE: This operation requires that you have the L<File::ReadBackwards>
-module installed.
-
-=head2 Client/Server Sockets
-
-IO::All makes it really easy to write a forking socket server and a
-client to talk to it.
-
-In this example, a server will return 3 lines of text, to every client
-that calls it. Here is the server code:
-
- use IO::All;
-
- my $socket = io(':12345')->fork->accept;
- $socket->print($_) while <DATA>;
- $socket->close;
-
- __DATA__
- On your mark,
- Get set,
- Go!
-
-Here is the client code:
-
- use IO::All;
-
- my $io = io('localhost:12345');
- print while $_ = $io->getline;
-
-You can run the server once, and then run the client repeatedly (in
-another terminal window). It should print the 3 data lines each time.
-
-Note that it is important to close the socket if the server is forking,
-or else the socket won't go out of scope and close.
-
-=head2 A Tiny Web Server
-
-Here is how you could write a simplistic web server that works with static and
-dynamic pages:
-
- perl -MIO::All -e 'io(":8080")->fork->accept->(sub { $_[0] < io(-x $1 ? "./$1 |" : $1) if /^GET \/(.*) / })'
-
-There is are a lot of subtle things going on here. First we accept a socket
-and fork the server. Then we overload the new socket as a code ref. This code
-ref takes one argument, another code ref, which is used as a callback.
-
-The callback is called once for every line read on the socket. The line
-is put into C<$_> and the socket itself is passed in to the callback.
-
-Our callback is scanning the line in C<$_> for an HTTP GET request. If one is
-found it parses the file name into C<$1>. Then we use C<$1> to create an new
-IO::All file object... with a twist. If the file is executable (C<-x>), then
-we create a piped command as our IO::All object. This somewhat approximates
-CGI support.
-
-Whatever the resulting object is, we direct the contents back at our socket
-which is in C<$_[0]>. Pretty simple, eh?
-
-=head2 DBM Files
-
-IO::All file objects used as a hash reference, treat the file as a DBM tied to
-a hash. Here I write my DB record to STDERR:
-
- io("names.db")->{ingy} > io('=');
-
-Since their are several DBM formats available in Perl, IO::All picks the first
-one of these that is installed on your system:
-
- DB_File GDBM_File NDBM_File ODBM_File SDBM_File
-
-You can override which DBM you want for each IO::All object:
-
- my @keys = keys %{io('mydbm')->dbm('SDBM_File')};
-
-=head2 File Subclassing
-
-Subclassing is easy with IO::All. Just create a new module and use
-IO::All as the base class, like this:
-
- package NewModule;
- use IO::All -base;
-
-You need to do it this way so that IO::All will export the C<io> function.
-Here is a simple recipe for subclassing:
-
-IO::Dumper inherits everything from IO::All and adds an extra method
-called C<dump>, which will dump a data structure to the file we
-specify in the C<io> function. Since it needs Data::Dumper to do the
-dumping, we override the C<open> method to C<require Data::Dumper> and
-then pass control to the real C<open>.
-
-First the code using the module:
-
- use IO::Dumper;
-
- io('./mydump')->dump($hash);
-
-And next the IO::Dumper module itself:
-
- package IO::Dumper;
- use IO::All -base;
- use Data::Dumper;
-
- sub dump {
- my $self = shift;
- Dumper(@_) > $self;
- }
-
- 1;
-
-=head2 Inline Subclassing
-
-This recipe does the same thing as the previous one, but without needing
-to write a separate module. The only real difference is the first line.
-Since you don't "use" IO::Dumper, you need to still call its C<import>
-method manually.
-
- IO::Dumper->import;
- io('./mydump')->dump($hash);
-
- package IO::Dumper;
- use IO::All -base;
- use Data::Dumper;
-
- sub dump {
- my $self = shift;
- Dumper(@_) > $self;
- }
-
-=head1 THE IO::All METHODS
-
-This section gives a full description of all of the methods that you can
-call on IO::All objects. The methods have been grouped into subsections
-based on object construction, option settings, configuration, action
-methods and support for specific modules.
-
-=head2 Object Construction and Initialization Methods
-
-=over 4
-
-=item * new
-
-There are three ways to create a new IO::All object. The first is with
-the special function C<io> which really just calls C<< IO::All->new >>.
-The second is by calling C<new> as a class method. The third is calling
-C<new> as an object instance method. In this final case, the new objects
-attributes are copied from the instance object.
-
- io(file-descriptor);
- IO::All->new(file-descriptor);
- $io->new(file-descriptor);
-
-All three forms take a single argument, a file descriptor. A file
-descriptor can be any of the following:
-
- - A file name
- - A file handle
- - A directory name
- - A directory handle
- - A typeglob reference
- - A piped shell command. eq '| ls -al'
- - A socket domain/port. eg 'perl.com:5678'
- - '-' means STDIN or STDOUT (depending on usage)
- - '=' means STDERR
- - '$' means an IO::String object
- - '?' means a temporary file
- - A URI including: http, https, ftp and mailto
- - An IO::All object
-
-If you provide an IO::All object, you will simply get that I<same
-object> returned from the constructor.
-
-If no file descriptor is provided, an object will still be created, but
-it must be defined by one of the following methods before it can be used
-for I/O:
-
-=item * file
-
- io->file("path/to/my/file.txt");
-
-Using the C<file> method sets the type of the object to I<file> and sets
-the pathname of the file if provided.
-
-It might be important to use this method if you had a file whose name
-was C<'-'>, or if the name might otherwise be confused with a
-directory or a socket. In this case, either of these statements would
-work the same:
-
- my $file = io('-')->file;
- my $file = io->file('-');
-
-=item * dir
-
- io->file($dir_name);
-
-Make the object be of type I<directory>.
-
-=item * socket
-
- io->socket("${domain}:${port}");
-
-Make the object be of type I<socket>.
-
-=item * link
-
- io->link($link_name);
-
-Make the object be of type I<link>.
-
-=item * pipe
-
- io->pipe($pipe_command);
-
-Make the object be of type I<pipe>. The following two statements are
-equivalent:
-
- my $io = io('ls -l |');
- my $io = io('ls -l')->pipe;
- my $io = io->pipe('ls -l');
-
-=item * dbm
-
-This method takes the names of zero or more DBM modules. The first one
-that is available is used to process the dbm file.
-
- io('mydbm')->dbm('NDBM_File', 'SDBM_File')->{author} = 'ingy';
-
-If no module names are provided, the first available of the
-following is used:
-
- DB_File GDBM_File NDBM_File ODBM_File SDBM_File
-
-=item * mldbm
-
-Similar to the C<dbm> method, except create a Multi Level DBM object
-using the MLDBM module.
-
-This method takes the names of zero or more DBM modules and an optional
-serialization module. The first DBM module that is available is used to
-process the MLDBM file. The serialization module can be Data::Dumper,
-Storable or FreezeThaw.
-
- io('mymldbm')->mldbm('GDBM_File', 'Storable')->{author} =
- {nickname => 'ingy'};
-
-=item * string
-
-Make the object be an IO::String object. These are equivalent:
-
- my $io = io('$');
- my $io = io->string;
-
-=item * temp
-
-Make the object represent a temporary file. It will automatically be
-open for both read and write.
-
-=item * stdio
-
-Make the object represent either STDIN or STDOUT depending on how it is
-used subsequently. These are equivalent:
-
- my $io = io('-');
- my $io = io->stdin;
-
-=item * stdin
-
-Make the object represent STDIN.
-
-=item * stdout
-
-Make the object represent STDOUT.
-
-=item * stderr
-
-Make the object represent STDERR.
-
-=item * handle
-
- io->handle($io_handle);
-
-Forces the object to be created from an pre-existing IO handle. You can
-chain calls together to indicate the type of handle:
-
- my $file_object = io->file->handle($file_handle);
- my $dir_object = io->dir->handle($dir_handle);
-
-=item * http
-
-Make the object represent an HTTP URI. Requires IO-All-LWP.
-
-=item * https
-
-Make the object represent an HTTPS URI. Requires IO-All-LWP.
-
-=item * ftp
-
-Make the object represent an FTP URI. Requires IO-All-LWP.
-
-=item * mailto
-
-Make the object represent a C<mailto:> URI. Requires IO-All-Mailto.
-
-=back
-
-If you need to use the same options to create a lot of objects, and
-don't want to duplicate the code, just create a dummy object with the
-options you want, and use that object to spawn other objects.
-
- my $lt = io->lock->tie;
- ...
- my $io1 = $lt->new('file1');
- my $io2 = $lt->new('file2');
-
-Since the new method copies attributes from the calling object, both
-C<$io1> and C<$io2> will be locked and tied.
-
-=head2 Option Setting Methods
-
-The following methods don't do any actual I/O, but they specify options
-about how the I/O should be done.
-
-Each option can take a single argument of 0 or 1. If no argument is
-given, the value 1 is assumed. Passing 0 turns the option off.
-
-All of these options return the object reference that was used to
-invoke them. This is so that the option methods can be chained
-together. For example:
-
- my $io = io('path/file')->tie->assert->chomp->lock;
-
-=over 4
-
-=item * absolute
-
-Indicates that the C<pathname> for the object should be made absolute.
-
- # Print the full path of the current working directory
- # (like pwd).
-
- use IO::All;
-
- print io->curdir->absolute;
-
-=item * assert
-
-This method ensures that the path for a file or directory actually exists
-before the file is open. If the path does not exist, it is created.
-
-For example, here is a program called "create-cat-to" that outputs to a file
-that it creates.
-
- #!/usr/bin/perl
-
- # create-cat-to.pl
- # cat to a file that can be created.
-
- use strict;
- use warnings;
-
- use IO::All;
-
- my $filename = shift(@ARGV);
-
- # Create a file called $filename, including all leading components.
- io('-') > io->file($filename)->assert;
-
-Here's an example use of it:
-
- $ ls -l
- total 0
- $ echo "Hello World" | create-cat-to one/two/three/four.txt
- $ ls -l
- total 4
- drwxr-xr-x 3 shlomif shlomif 4096 2010-10-14 18:03 one/
- $ cat one/two/three/four.txt
- Hello World
- $
-
-=item * autoclose
-
-By default, IO::All will close an object opened for input when EOF is
-reached. By closing the handle early, one can immediately do other
-operations on the object without first having to close it.
-
-This option is on by default, so if you don't want this behaviour, say
-so like this:
-
- $io->autoclose(0);
-
-The object will then be closed when C<$io> goes out of scope, or you
-manually call C<< $io->close >>.
-
-=item * autoflush
-
-Proxy for IO::Handle::autoflush
-
-=item * backwards
-
-Sets the object to 'backwards' mode. All subsequent C<getline>
-operations will read backwards from the end of the file.
-
-Requires the File::ReadBackwards CPAN module.
-
-=item * binary
-
-Indicates the file has binary content and should be opened with
-C<binmode>.
-
-=item * chdir
-
-chdir() to the pathname of a directory object. When object goes out of
-scope, chdir back to starting directory.
-
-=item * chomp
-
-Indicates that all operations that read lines should chomp the lines. If
-the C<separator> method has been called, chomp will remove that value
-from the end of each record.
-
-=item * confess
-
-Errors should be reported with the very detailed Carp::confess function.
-
-=item * deep
-
-Indicates that calls to the C<all> family of methods should search
-directories as deep as possible.
-
-=item * fork
-
-Indicates that the process should automatically be forked inside the
-C<accept> socket method.
-
-=item * lock
-
-Indicate that operations on an object should be locked using flock.
-
-=item * rdonly
-
-This option indicates that certain operations like DBM and Tie::File
-access should be done in read-only mode.
-
-=item * rdwr
-
-This option indicates that DBM and MLDBM files should be opened in read-
-write mode.
-
-=item * relative
-
-Indicates that the C<pathname> for the object should be made relative.
-
-=item * sort
-
-Indicates whether objects returned from one of the C<all> methods will
-be in sorted order by name. True by default.
-
-=item * strict
-
-Check the return codes of every single system call. To turn this on for all
-calls in your module, use:
-
- use IO::All -strict;
-
-=item * tie
-
-Indicate that the object should be tied to itself, thus allowing it to
-be used as a filehandle in any of Perl's builtin IO operations.
-
- my $io = io('foo')->tie;
- @lines = <$io>;
-
-=item * utf8
-
-Indicates that IO should be done using utf8 encoding. Calls binmode with
-C<:utf8> layer.
-
-=back
-
-=head2 Configuration Methods
-
-The following methods don't do any actual I/O, but they set specific
-values to configure the IO::All object.
-
-If these methods are passed no argument, they will return their
-current value. If arguments are passed they will be used to set the
-current value, and the object reference will be returned for potential
-method chaining.
-
-=over 4
-
-=item * bcc
-
-Set the Bcc field for a mailto object.
-
-=item * binmode
-
-Proxy for binmode. Requires a layer to be passed. Use C<binary> for
-plain binary mode.
-
-=item * block_size
-
-The default length to be used for C<read> and C<sysread> calls.
-Defaults to 1024.
-
-=item * buffer
-
-Returns a reference to the internal buffer, which is a scalar. You can
-use this method to set the buffer to a scalar of your choice. (You can
-just pass in the scalar, rather than a reference to it.)
-
-This is the buffer that C<read> and C<write> will use by default.
-
-You can easily have IO::All objects use the same buffer:
-
- my $input = io('abc');
- my $output = io('xyz');
- my $buffer;
- $output->buffer($input->buffer($buffer));
- $output->write while $input->read;
-
-=item * cc
-
-Set the Cc field for a mailto object.
-
-=item * content
-
-Get or set the content for an LWP operation manually.
-
-=item * domain
-
-Set the domain name or ip address that a socket should use.
-
-=item * encoding
-
-Set the encoding to be used for the PerlIO layer.
-
-=item * errors
-
-Use this to set a subroutine reference that gets called when an internal
-error is thrown.
-
-=item * filter
-
-Use this to set a subroutine reference that will be used to grep
-which objects get returned on a call to one of the C<all> methods.
-For example:
-
- my @odd = io->curdir->filter(sub {$_->size % 2})->All_Files;
-
-C<@odd> will contain all the files under the current directory whose
-size is an odd number of bytes.
-
-=item * from
-
-Indicate the sender for a mailto object.
-
-=item * mailer
-
-Set the mailer program for a mailto transaction. Defaults to 'sendmail'.
-
-=item * mode
-
-Set the mode for which the file should be opened. Examples:
-
- $io->mode('>>')->open;
- $io->mode(O_RDONLY);
-
- my $log_appender = io->file('/var/log/my-application.log')
- ->mode('>>')->open();
-
- $log_appender->print("Stardate 5987.6: Mission accomplished.");
-
-=item * name
-
-Set or get the name of the file or directory represented by the IO::All
-object.
-
-=item * password
-
-Set the password for an LWP transaction.
-
-=item * perms
-
-Sets the permissions to be used if the file/directory needs to be created.
-
-=item * port
-
-Set the port number that a socket should use.
-
-=item * request
-
-Manually specify the request object for an LWP transaction.
-
-=item * response
-
-Returns the resulting reponse object from an LWP transaction.
-
-=item * separator
-
-Sets the record (line) separator to whatever value you pass it. Default
-is \n. Affects the chomp setting too.
-
-=item * string_ref
-
-Proxy for IO::String::string_ref
-
-Returns a reference to the internal string that is acting like a file.
-
-=item * subject
-
-Set the subject for a mailto transaction.
-
-=item * to
-
-Set the recipient address for a mailto request.
-
-=item * uri
-
-Direct access to the URI used in LWP transactions.
-
-=item * user
-
-Set the user name for an LWP transaction.
-
-=back
-
-=head2 IO Action Methods
-
-These are the methods that actually perform I/O operations on an IO::All
-object. The stat methods and the File::Spec methods are documented in
-separate sections below.
-
-=over 4
-
-=item * accept
-
-For sockets. Opens a server socket (LISTEN => 1, REUSE => 1). Returns an
-IO::All socket object that you are listening on.
-
-If the C<fork> method was called on the object, the process will
-automatically be forked for every connection.
-
-=item * all
-
-Read all contents into a single string.
-
- compare(io('file1')->all, io('file2')->all);
-
-=item * all (For directories)
-
-Returns a list of IO::All objects for all files and subdirectories in a
-directory.
-
-'.' and '..' are excluded.
-
-Takes an optional argument telling how many directories deep to search. The
-default is 1. Zero (0) means search as deep as possible.
-
-The filter method can be used to limit the results.
-
-The items returned are sorted by name unless C<< ->sort(0) >> is used.
-
-=item * All
-
-Same as C<all(0)>.
-
-=item * all_dirs
-
-Same as C<all>, but only return directories.
-
-=item * All_Dirs
-
-Same as C<all_dirs(0)>.
-
-=item * all_files
-
-Same as C<all>, but only return files.
-
-=item * All_Files
-
-Same as C<all_files(0)>.
-
-=item * all_links
-
-Same as C<all>, but only return links.
-
-=item * All_Links
-
-Same as C<all_links(0)>.
-
-=item * append
-
-Same as print, but sets the file mode to '>>'.
-
-=item * appendf
-
-Same as printf, but sets the file mode to '>>'.
-
-=item * appendln
-
-Same as println, but sets the file mode to '>>'.
-
-=item * clear
-
-Clear the internal buffer. This method is called by C<write> after it
-writes the buffer. Returns the object reference for chaining.
-
-=item * close
-
-Close will basically unopen the object, which has different meanings for
-different objects. For files and directories it will close and release
-the handle. For sockets it calls shutdown. For tied things it unties
-them, and it unlocks locked things.
-
-=item * empty
-
-Returns true if a file exists but has no size, or if a directory exists but
-has no contents.
-
-=item * eof
-
-Proxy for IO::Handle::eof
-
-=item * exists
-
-Returns whether or not the file or directory exists.
-
-=item * filename
-
-Return the name portion of the file path in the object. For example:
-
- io('my/path/file.txt')->filename;
-
-would return C<file.txt>.
-
-=item * fileno
-
-Proxy for IO::Handle::fileno
-
-=item * filepath
-
-Return the path portion of the file path in the object. For example:
-
- io('my/path/file.txt')->filename;
-
-would return C<my/path>.
-
-=item * get
-
-Perform an LWP GET request manually.
-
-=item * getc
-
-Proxy for IO::Handle::getc
-
-=item * getline
-
-Calls IO::File::getline. You can pass in an optional record separator.
-
-=item * getlines
-
-Calls IO::File::getlines. You can pass in an optional record separator.
-
-=item * head
-
-Return the first 10 lines of a file. Takes an optional argument which is the
-number of lines to return. Works as expected in list and scalar context. Is
-subject to the current line separator.
-
-=item * io_handle
-
-Direct access to the actual IO::Handle object being used on an opened
-IO::All object.
-
-=item * is_dir
-
-Returns boolean telling whether or not the IO::All object represents
-a directory.
-
-=item * is_executable
-
-Returns true if file or directory is executable.
-
-=item * is_dbm
-
-Returns boolean telling whether or not the IO::All object
-represents a dbm file.
-
-=item * is_file
-
-Returns boolean telling whether or not the IO::All object
-represents a file.
-
-=item * is_link
-
-Returns boolean telling whether or not the IO::All object represents
-a symlink.
-
-=item * is_mldbm
-
-Returns boolean telling whether or not the IO::All object
-represents a mldbm file.
-
-=item * is_open
-
-Indicates whether the IO::All is currently open for input/output.
-
-=item * is_pipe
-
-Returns boolean telling whether or not the IO::All object represents
-a pipe operation.
-
-=item * is_readable
-
-Returns true if file or directory is readable.
-
-=item * is_socket
-
-Returns boolean telling whether or not the IO::All object represents
-a socket.
-
-=item * is_stdio
-
-Returns boolean telling whether or not the IO::All object represents
-a STDIO file handle.
-
-=item * is_string
-
-Returns boolean telling whether or not the IO::All object represents
-an IO::String object.
-
-=item * is_temp
-
-Returns boolean telling whether or not the IO::All object represents
-a temporary file.
-
-=item * is_writable
-
-Returns true if file or directory is writable. Can also be spelled as
-C<is_writeable>.
-
-=item * length
-
-Return the length of the internal buffer.
-
-=item * mkdir
-
-Create the directory represented by the object.
-
-=item * mkpath
-
-Create the directory represented by the object, when the path contains
-more than one directory that doesn't exist. Proxy for File::Path::mkpath.
-
-=item * next
-
-For a directory, this will return a new IO::All object for each file
-or subdirectory in the directory. Return undef on EOD.
-
-=item * open
-
-Open the IO::All object. Takes two optional arguments C<mode> and
-C<perms>, which can also be set ahead of time using the C<mode> and
-C<perms> methods.
-
-NOTE: Normally you won't need to call open (or mode/perms), since this
-happens automatically for most operations.
-
-=item * pathname
-
-Return the absolute or relative pathname for a file or directory, depending on
-whether object is in C<absolute> or C<relative> mode.
-
-=item * print
-
-Proxy for IO::Handle::print
-
-=item * printf
-
-Proxy for IO::Handle::printf
-
-=item * println
-
-Same as print, but adds newline to each argument unless it already
-ends with one.
-
-=item * put
-
-Perform an LWP PUT request manually.
-
-=item * read
-
-This method varies depending on its context. Read carefully (no pun
-intended).
-
-For a file, this will proxy IO::File::read. This means you must pass
-it a buffer, a length to read, and optionally a buffer offset for where
-to put the data that is read. The function returns the length actually
-read (which is zero at EOF).
-
-If you don't pass any arguments for a file, IO::All will use its own
-internal buffer, a default length, and the offset will always point at
-the end of the buffer. The buffer can be accessed with the C<buffer>
-method. The length can be set with the C<block_size> method. The default
-length is 1024 bytes. The C<clear> method can be called to clear
-the buffer.
-
-For a directory, this will proxy IO::Dir::read.
-
-=item * readdir
-
-Similar to the Perl C<readdir> builtin. In scalar context, return the next
-directory entry (ie file or directory name), or undef on end of directory. In
-list context, return all directory entries.
-
-Note that C<readdir> does not return the special C<.> and C<..> entries.
-
-=item * readline
-
-Same as C<getline>.
-
-=item * readlink
-
-Calls Perl's readlink function on the link represented by the object.
-Instead of returning the file path, it returns a new IO::All object
-using the file path.
-
-=item * recv
-
-Proxy for IO::Socket::recv
-
-=item * rename
-
- my $new = $io->rename('new-name');
-
-Calls Perl's rename function and returns an IO::All object for the
-renamed file. Returns false if the rename failed.
-
-=item * rewind
-
-Proxy for IO::Dir::rewind
-
-=item * rmdir
-
-Delete the directory represented by the IO::All object.
-
-=item * rmtree
-
-Delete the directory represented by the IO::All object and all the files
-and directories beneath it. Proxy for File::Path::rmtree.
-
-=item * scalar
-
-Deprecated. Same as C<all()>.
-
-=item * seek
-
-Proxy for IO::Handle::seek. If you use seek on an unopened file, it will
-be opened for both read and write.
-
-=item * send
-
-Proxy for IO::Socket::send
-
-=item * shutdown
-
-Proxy for IO::Socket::shutdown
-
-=item * slurp
-
-Read all file content in one operation. Returns the file content
-as a string. In list context returns every line in the file.
-
-=item * stat
-
-Proxy for IO::Handle::stat
-
-=item * sysread
-
-Proxy for IO::Handle::sysread
-
-=item * syswrite
-
-Proxy for IO::Handle::syswrite
-
-=item * tail
-
-Return the last 10 lines of a file. Takes an optional argument which is the
-number of lines to return. Works as expected in list and scalar context. Is
-subject to the current line separator.
-
-=item * tell
-
-Proxy for IO::Handle::tell
-
-=item * throw
-
-This is an internal method that gets called whenever there is an error.
-It could be useful to override it in a subclass, to provide more control
-in error handling.
-
-=item * touch
-
-Update the atime and mtime values for a file or directory. Creates an empty
-file if the file does not exist.
-
-=item * truncate
-
-Proxy for IO::Handle::truncate
-
-=item * type
-
-Returns a string indicated the type of io object. Possible values are:
-
- file
- dir
- link
- socket
- string
- pipe
-
-Returns undef if type is not determinable.
-
-=item * unlink
-
-Unlink (delete) the file represented by the IO::All object.
-
-NOTE: You can unlink a file after it is open, and continue using it
-until it is closed.
-
-=item * unlock
-
-Release a lock from an object that used the C<lock> method.
-
-=item * utime
-
-Proxy for the utime Perl function.
-
-=item * write
-
-Opposite of C<read> for file operations only.
-
-NOTE: When used with the automatic internal buffer, C<write> will
-clear the buffer after writing it.
-
-=back
-
-=head2 Stat Methods
-
-This methods get individual values from a stat call on the file,
-directory or handle represented by th IO::All object.
-
-=over 4
-
-=item * atime
-
-Last access time in seconds since the epoch
-
-=item * blksize
-
-Preferred block size for file system I/O
-
-=item * blocks
-
-Actual number of blocks allocated
-
-=item * ctime
-
-Inode change time in seconds since the epoch
-
-=item * device
-
-Device number of filesystem
-
-=item * device_id
-
-Device identifier for special files only
-
-=item * gid
-
-Numeric group id of file's owner
-
-=item * inode
-
-Inode number
-
-=item * modes
-
-File mode - type and permissions
-
-=item * mtime
-
-Last modify time in seconds since the epoch
-
-=item * nlink
-
-Number of hard links to the file
-
-=item * size
-
-Total size of file in bytes
-
-=item * uid
-
-Numeric user id of file's owner
-
-=back
-
-=head2 File::Spec Methods
-
-These methods are all adaptations from File::Spec. Each method
-actually does call the matching File::Spec method, but the arguments
-and return values differ slightly. Instead of being file and directory
-B<names>, they are IO::All B<objects>. Since IO::All objects stringify
-to their names, you can generally use the methods just like File::Spec.
-
-=over 4
-
-=item * abs2rel
-
-Returns the relative path for the absolute path in the IO::All object.
-Can take an optional argument indicating the base path.
-
-=item * canonpath
-
-Returns the canonical path for the IO::All object.
-
-=item * case_tolerant
-
-Returns 0 or 1 indicating whether the file system is case tolerant.
-Since an active IO::All object is not needed for this function, you can
-code it like:
-
- IO::All->case_tolerant;
-
-or more simply:
-
- io->case_tolerant;
-
-=item * catdir
-
-Concatenate the directory components together, and return a new IO::All
-object representing the resulting directory.
-
-=item * catfile
-
-Concatenate the directory and file components together, and return a new
-IO::All object representing the resulting file.
-
- my $contents = io->catfile(qw(dir subdir file))->slurp;
-
-This is a very portable way to read C<dir/subdir/file>.
-
-=item * catpath
-
-Concatenate the volume, directory and file components together, and
-return a new IO::All object representing the resulting file.
-
-=item * curdir
-
-Returns an IO::All object representing the current directory.
-
-=item * devnull
-
-Returns an IO::All object representing the /dev/null file.
-
-=item * is_absolute
-
-Returns 0 or 1 indicating whether the C<name> field of the IO::All object is
-an absolute path.
-
-=item * join
-
-Same as C<catfile>.
-
-=item * path
-
-Returns a list of IO::All directory objects for each directory in your path.
-
-=item * rel2abs
-
-Returns the absolute path for the relative path in the IO::All object. Can
-take an optional argument indicating the base path.
-
-=item * rootdir
-
-Returns an IO::All object representing the root directory on your
-file system.
-
-=item * splitdir
-
-Returns a list of the directory components of a path in an IO::All object.
-
-=item * splitpath
-
-Returns a volume directory and file component of a path in an IO::All object.
-
-=item * tmpdir
-
-Returns an IO::All object representing a temporary directory on your
-file system.
-
-=item * updir
-
-Returns an IO::All object representing the current parent directory.
-
-=back
-
-=head1 OPERATIONAL NOTES
-
-=over 4
-
-=item *
-
-Each IO::All object gets reblessed into an IO::All::* object as soon as
-IO::All can determine what type of object it should be. Sometimes it gets
-reblessed more than once:
-
- my $io = io('mydbm.db');
- $io->dbm('DB_File');
- $io->{foo} = 'bar';
-
-In the first statement, $io has a reference value of 'IO::All::File', if
-C<mydbm.db> exists. In the second statement, the object is reblessed into
-class 'IO::All::DBM'.
-
-=item *
-
-An IO::All object will automatically be opened as soon as there is
-enough contextual information to know what type of object it is, and
-what mode it should be opened for. This is usually when the first read
-or write operation is invoked but might be sooner.
-
-=item *
-
-The mode for an object to be opened with is determined heuristically
-unless specified explicitly.
-
-=item *
-
-For input, IO::All objects will automatically be closed after EOF (or
-EOD). For output, the object closes when it goes out of scope.
-
-To keep input objects from closing at EOF, do this:
-
- $io->autoclose(0);
-
-=item *
-
-You can always call C<open> and C<close> explicitly, if you need that
-level of control. To test if an object is currently open, use the
-C<is_open> method.
-
-=item *
-
-Overloaded operations return the target object, if one exists.
-
-This would set C<$xxx> to the IO::All object:
-
- my $xxx = $contents > io('file.txt');
-
-While this would set C<$xxx> to the content string:
-
- my $xxx = $contents < io('file.txt');
-
-=back
-
-=head1 STABILITY
-
-The goal of the IO::All project is to continually refine the module
-to be as simple and consistent to use as possible. Therefore, in the
-early stages of the project, I will not hesitate to break backwards
-compatibility with other versions of IO::All if I can find an easier
-and clearer way to do a particular thing.
-
-IO is tricky stuff. There is definitely more work to be done. On the
-other hand, this module relies heavily on very stable existing IO
-modules; so it may work fairly well.
-
-I am sure you will find many unexpected "features". Please send all
-problems, ideas and suggestions to ingy at cpan.org.
-
-=head2 Known Bugs and Deficiencies
-
-Not all possible combinations of objects and methods have been tested.
-There are many many combinations. All of the examples have been tested.
-If you find a bug with a particular combination of calls, let me know.
-
-If you call a method that does not make sense for a particular object,
-the result probably won't make sense. Little attempt is made to check
-for improper usage.
-
-=head1 SEE ALSO
-
-IO::Handle, IO::File, IO::Dir, IO::Socket, IO::String, File::Spec,
-File::Path, File::ReadBackwards, Tie::File
-
-=head1 CREDITS
-
-A lot of people have sent in suggestions, that have become a part of
-IO::All. Thank you.
-
-Special thanks to Ian Langworth for continued testing and patching.
-
-Thank you Simon Cozens for tipping me off to the overloading possibilities.
-
-Finally, thanks to Autrijus Tang, for always having one more good idea.
-
-(It seems IO::All of it to a lot of people!)
-
-=head1 REPOSITORY AND COMMUNITY
-
-The IO::All module can be found on CPAN and on GitHub:
-L<http://github.com/ingydotnet/io-all-pm>.
-
-Please join the IO::All discussion on #io-all on irc.perl.org.
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson.
-
-Copyright (c) 2006, 2008, 2010. Ingy döt Net.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See L<http://www.perl.com/perl/misc/Artistic.html>
-
-=cut
diff --git a/old/lib/IO/All/Base.pm b/old/lib/IO/All/Base.pm
deleted file mode 100644
index cc6ab6a..0000000
--- a/old/lib/IO/All/Base.pm
+++ /dev/null
@@ -1,196 +0,0 @@
-package IO::All::Base;
-use strict;
-use warnings;
-use Fcntl;
-
-sub import {
- my $class = shift;
- my $flag = $_[0] || '';
- my $package = caller;
- no strict 'refs';
- if ($flag eq '-base') {
- push @{$package . "::ISA"}, $class;
- *{$package . "::$_"} = \&$_
- for qw'field const option chain proxy proxy_open';
- }
- elsif ($flag eq -mixin) {
- mixin_import(scalar(caller(0)), $class, @_);
- }
- else {
- my @flags = @_;
- for my $export (@{$class . '::EXPORT'}) {
- *{$package . "::$export"} = $export eq 'io'
- ? $class->generate_constructor(@flags)
- : \&{$class . "::$export"};
- }
- }
-}
-
-sub generate_constructor {
- my $class = shift;
- my (@flags, %flags, $key);
- for (@_) {
- if (s/^-//) {
- push @flags, $_;
- $flags{$_} = 1;
- $key = $_;
- }
- else {
- $flags{$key} = $_ if $key;
- }
- }
- my $constructor;
- $constructor = sub {
- my $self = $class->new(@_);
- for (@flags) {
- $self->$_($flags{$_});
- }
- $self->constructor($constructor);
- return $self;
- }
-}
-
-sub _init {
- my $self = shift;
- $self->io_handle(undef);
- $self->is_open(0);
- return $self;
-}
-
-#===============================================================================
-# Closure generating functions
-#===============================================================================
-sub option {
- my $package = caller;
- my ($field, $default) = @_;
- $default ||= 0;
- field("_$field", $default);
- no strict 'refs';
- *{"${package}::$field"} =
- sub {
- my $self = shift;
- *$self->{"_$field"} = @_ ? shift(@_) : 1;
- return $self;
- };
-}
-
-sub chain {
- my $package = caller;
- my ($field, $default) = @_;
- no strict 'refs';
- *{"${package}::$field"} =
- sub {
- my $self = shift;
- if (@_) {
- *$self->{$field} = shift;
- return $self;
- }
- return $default unless exists *$self->{$field};
- return *$self->{$field};
- };
-}
-
-sub field {
- my $package = caller;
- my ($field, $default) = @_;
- no strict 'refs';
- return if defined &{"${package}::$field"};
- *{"${package}::$field"} =
- sub {
- my $self = shift;
- unless (exists *$self->{$field}) {
- *$self->{$field} =
- ref($default) eq 'ARRAY' ? [] :
- ref($default) eq 'HASH' ? {} :
- $default;
- }
- return *$self->{$field} unless @_;
- *$self->{$field} = shift;
- };
-}
-
-sub const {
- my $package = caller;
- my ($field, $default) = @_;
- no strict 'refs';
- return if defined &{"${package}::$field"};
- *{"${package}::$field"} = sub { $default };
-}
-
-sub proxy {
- my $package = caller;
- my ($proxy) = @_;
- no strict 'refs';
- return if defined &{"${package}::$proxy"};
- *{"${package}::$proxy"} =
- sub {
- my $self = shift;
- my @return = $self->io_handle->$proxy(@_);
- $self->error_check;
- wantarray ? @return : $return[0];
- };
-}
-
-sub proxy_open {
- my $package = caller;
- my ($proxy, @args) = @_;
- no strict 'refs';
- return if defined &{"${package}::$proxy"};
- my $method = sub {
- my $self = shift;
- $self->assert_open(@args);
- my @return = $self->io_handle->$proxy(@_);
- $self->error_check;
- wantarray ? @return : $return[0];
- };
- *{"$package\::$proxy"} =
- (@args and $args[0] eq '>') ?
- sub {
- my $self = shift;
- $self->$method(@_);
- return $self;
- }
- : $method;
-}
-
-sub mixin_import {
- my $target_class = shift;
- $target_class = caller(0)
- if $target_class eq 'mixin';
- my $mixin_class = shift
- or die "Nothing to mixin";
- eval "require $mixin_class";
- my $pseudo_class = CORE::join '-', $target_class, $mixin_class;
- my %methods = mixin_methods($mixin_class);
- no strict 'refs';
- no warnings;
- @{"$pseudo_class\::ISA"} = @{"$target_class\::ISA"};
- @{"$target_class\::ISA"} = ($pseudo_class);
- for (keys %methods) {
- *{"$pseudo_class\::$_"} = $methods{$_};
- }
-}
-
-sub mixin_methods {
- my $mixin_class = shift;
- no strict 'refs';
- my %methods = all_methods($mixin_class);
- map {
- $methods{$_}
- ? ($_, \ &{"$methods{$_}\::$_"})
- : ($_, \ &{"$mixin_class\::$_"})
- } (keys %methods);
-}
-
-sub all_methods {
- no strict 'refs';
- my $class = shift;
- my %methods = map {
- ($_, $class)
- } grep {
- defined &{"$class\::$_"} and not /^_/
- } keys %{"$class\::"};
- return (%methods);
-}
-
-1;
diff --git a/old/lib/IO/All/DBM.pm b/old/lib/IO/All/DBM.pm
deleted file mode 100644
index 5a08340..0000000
--- a/old/lib/IO/All/DBM.pm
+++ /dev/null
@@ -1,121 +0,0 @@
-package IO::All::DBM;
-use strict;
-use warnings;
-use IO::All::File -base;
-use Fcntl;
-
-field _dbm_list => [];
-field '_dbm_class';
-field _dbm_extra => [];
-
-sub dbm {
- my $self = shift;
- bless $self, __PACKAGE__;
- $self->_dbm_list([@_]);
- return $self;
-}
-
-sub assert_open {
- my $self = shift;
- return $self->tied_file
- if $self->tied_file;
- $self->open;
-}
-
-sub assert_filepath {
- my $self = shift;
- $self->SUPER::assert_filepath(@_);
- if ($self->_rdonly and not -e $self->pathname) {
- my $rdwr = $self->_rdwr;
- $self->assert(0)->rdwr(1)->rdonly(0)->open;
- $self->close;
- $self->assert(1)->rdwr($rdwr)->rdonly(1);
- }
-}
-
-sub open {
- my $self = shift;
- $self->is_open(1);
- return $self->tied_file if $self->tied_file;
- $self->assert_filepath if $self->_assert;
- my $dbm_list = $self->_dbm_list;
- my @dbm_list = @$dbm_list ? @$dbm_list :
- (qw(DB_File GDBM_File NDBM_File ODBM_File SDBM_File));
- my $dbm_class;
- for my $module (@dbm_list) {
- (my $file = "$module.pm") =~ s{::}{/}g;
- if (defined $INC{$file} || eval "eval 'use $module; 1'") {
- $self->_dbm_class($module);
- last;
- }
- }
- $self->throw("No module available for IO::All DBM operation")
- unless defined $self->_dbm_class;
- my $mode = $self->_rdonly ? O_RDONLY : O_RDWR;
- if ($self->_dbm_class eq 'DB_File::Lock') {
- $self->_dbm_class->import;
- my $type = eval '$DB_HASH'; die $@ if $@;
- # XXX Not sure about this warning
- warn "Using DB_File::Lock in IO::All without the rdonly or rdwr method\n"
- if not ($self->_rdwr or $self->_rdonly);
- my $flag = $self->_rdwr ? 'write' : 'read';
- $mode = $self->_rdwr ? O_RDWR : O_RDONLY;
- $self->_dbm_extra([$type, $flag]);
- }
- $mode |= O_CREAT if $mode & O_RDWR;
- $self->mode($mode);
- $self->perms(0666) unless defined $self->perms;
- return $self->tie_dbm;
-}
-
-sub tie_dbm {
- my $self = shift;
- my $hash;
- my $filename = $self->name;
- my $db = tie %$hash, $self->_dbm_class, $filename, $self->mode, $self->perms,
- @{$self->_dbm_extra}
- or $self->throw("Can't open '$filename' as DBM file:\n$!");
- $self->add_utf8_dbm_filter($db)
- if $self->_utf8;
- $self->tied_file($hash);
-}
-
-sub add_utf8_dbm_filter {
- my $self = shift;
- my $db = shift;
- $db->filter_store_key(sub { utf8::encode($_) });
- $db->filter_store_value(sub { utf8::encode($_) });
- $db->filter_fetch_key(sub { utf8::decode($_) });
- $db->filter_fetch_value(sub { utf8::decode($_) });
-}
-
-=encoding utf8
-
-=head1 NAME
-
-IO::All::DBM - DBM Support for IO::All
-
-=head1 SYNOPSIS
-
-See L<IO::All>.
-
-=head1 DESCRIPTION
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson.
-
-Copyright (c) 2006, 2008. Ingy döt Net.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=cut
-
-1;
diff --git a/old/lib/IO/All/Dir.pm b/old/lib/IO/All/Dir.pm
deleted file mode 100644
index 1bab14d..0000000
--- a/old/lib/IO/All/Dir.pm
+++ /dev/null
@@ -1,246 +0,0 @@
-package IO::All::Dir;
-use strict;
-use warnings;
-use IO::All::Filesys -base;
-use IO::All -base;
-use IO::Dir;
-
-#===============================================================================
-const type => 'dir';
-option 'sort' => 1;
-chain filter => undef;
-option 'deep';
-field 'chdir_from';
-
-#===============================================================================
-sub dir {
- my $self = shift;
- bless $self, __PACKAGE__;
- $self->name(shift) if @_;
- return $self->_init;
-}
-
-sub dir_handle {
- my $self = shift;
- bless $self, __PACKAGE__;
- $self->_handle(shift) if @_;
- return $self->_init;
-}
-
-#===============================================================================
-sub assert_open {
- my $self = shift;
- return if $self->is_open;
- $self->open;
-}
-
-sub open {
- my $self = shift;
- $self->is_open(1);
- $self->assert_dirpath($self->pathname)
- if $self->pathname and $self->_assert;
- my $handle = IO::Dir->new;
- $self->io_handle($handle);
- $handle->open($self->pathname)
- or $self->throw($self->open_msg);
- return $self;
-}
-
-sub open_msg {
- my $self = shift;
- my $name = defined $self->pathname
- ? " '" . $self->pathname . "'"
- : '';
- return qq{Can't open directory$name:\n$!};
-}
-
-#===============================================================================
-sub All {
- my $self = shift;
- $self->all(0);
-}
-
-sub all {
- my $self = shift;
- my $depth = @_ ? shift(@_) : $self->_deep ? 0 : 1;
- my $first = not @_;
- my @all;
- while (my $io = $self->next) {
- push @all, $io;
- push(@all, $io->all($depth - 1, 1))
- if $depth != 1 and $io->is_dir;
- }
- @all = grep {&{$self->filter}} @all
- if $self->filter;
- return @all unless $first and $self->_sort;
- return sort {$a->pathname cmp $b->pathname} @all;
-}
-
-sub All_Dirs {
- my $self = shift;
- $self->all_dirs(0);
-}
-
-sub all_dirs {
- my $self = shift;
- grep {$_->is_dir} $self->all(@_);
-}
-
-sub All_Files {
- my $self = shift;
- $self->all_files(0);
-}
-
-sub all_files {
- my $self = shift;
- grep {$_->is_file} $self->all(@_);
-}
-
-sub All_Links {
- my $self = shift;
- $self->all_links(0);
-}
-
-sub all_links {
- my $self = shift;
- grep {$_->is_link} $self->all(@_);
-}
-
-sub chdir {
- my $self = shift;
- require Cwd;
- $self->chdir_from(Cwd::cwd());
- CORE::chdir($self->pathname);
- return $self;
-}
-
-sub empty {
- my $self = shift;
- my $dh;
- opendir($dh, $self->pathname) or die;
- while (my $dir = readdir($dh)) {
- return 0 unless $dir =~ /^\.{1,2}$/;
- }
- return 1;
-}
-
-sub mkdir {
- my $self = shift;
- defined($self->perms)
- ? CORE::mkdir($self->pathname, $self->perms)
- : CORE::mkdir($self->pathname);
- return $self;
-}
-
-sub mkpath {
- my $self = shift;
- require File::Path;
- File::Path::mkpath($self->pathname, @_);
- return $self;
-}
-
-sub next {
- my $self = shift;
- $self->assert_open;
- my $name = $self->readdir;
- return unless defined $name;
- my $io = $self->constructor->(File::Spec->catfile($self->pathname, $name));
- $io->absolute if $self->is_absolute;
- return $io;
-}
-
-sub readdir {
- my $self = shift;
- $self->assert_open;
- if (wantarray) {
- my @return = grep {
- not /^\.{1,2}$/
- } $self->io_handle->read;
- $self->close;
- return @return;
- }
- my $name = '.';
- while ($name =~ /^\.{1,2}$/) {
- $name = $self->io_handle->read;
- unless (defined $name) {
- $self->close;
- return;
- }
- }
- return $name;
-}
-
-sub rmdir {
- my $self = shift;
- rmdir $self->pathname;
-}
-
-sub rmtree {
- my $self = shift;
- require File::Path;
- File::Path::rmtree($self->pathname, @_);
-}
-
-sub DESTROY {
- my $self = shift;
- CORE::chdir($self->chdir_from)
- if $self->chdir_from;
- # $self->SUPER::DESTROY(@_);
-}
-
-#===============================================================================
-sub overload_table {
- (
- '${} dir' => 'overload_as_scalar',
- '@{} dir' => 'overload_as_array',
- '%{} dir' => 'overload_as_hash',
- )
-}
-
-sub overload_as_scalar {
- \ $_[1];
-}
-
-sub overload_as_array {
- [ $_[1]->all ];
-}
-
-sub overload_as_hash {
- +{
- map {
- (my $name = $_->pathname) =~ s/.*[\/\\]//;
- ($name, $_);
- } $_[1]->all
- };
-}
-
-=encoding utf8
-
-=head1 NAME
-
-IO::All::Dir - Directory Support for IO::All
-
-=head1 SYNOPSIS
-
-See L<IO::All>.
-
-=head1 DESCRIPTION
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson.
-
-Copyright (c) 2006, 2008. Ingy döt Net.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=cut
-
-1;
diff --git a/old/lib/IO/All/File.pm b/old/lib/IO/All/File.pm
deleted file mode 100644
index 478296e..0000000
--- a/old/lib/IO/All/File.pm
+++ /dev/null
@@ -1,272 +0,0 @@
-package IO::All::File;
-use strict;
-use warnings;
-use IO::All::Filesys -base;
-use IO::All -base;
-use IO::File;
-
-#===============================================================================
-const type => 'file';
-field tied_file => undef;
-
-#===============================================================================
-sub file {
- my $self = shift;
- bless $self, __PACKAGE__;
- $self->name(shift) if @_;
- return $self->_init;
-}
-
-sub file_handle {
- my $self = shift;
- bless $self, __PACKAGE__;
- $self->_handle(shift) if @_;
- return $self->_init;
-}
-
-#===============================================================================
-sub assert_filepath {
- my $self = shift;
- my $name = $self->pathname
- or return;
- my $directory;
- (undef, $directory) = File::Spec->splitpath($self->pathname);
- $self->assert_dirpath($directory);
-}
-
-sub assert_open_backwards {
- my $self = shift;
- return if $self->is_open;
- require File::ReadBackwards;
- my $file_name = $self->pathname;
- my $io_handle = File::ReadBackwards->new($file_name)
- or $self->throw("Can't open $file_name for backwards:\n$!");
- $self->io_handle($io_handle);
- $self->is_open(1);
-}
-
-sub assert_open {
- my $self = shift;
- return if $self->is_open;
- $self->mode(shift) unless $self->mode;
- $self->open;
-}
-
-sub assert_tied_file {
- my $self = shift;
- return $self->tied_file || do {
- eval {require Tie::File};
- $self->throw("Tie::File required for file array operations:\n$@")
- if $@;
- my $array_ref = do { my @array; \@array };
- my $name = $self->pathname;
- my @options = $self->_rdonly ? (mode => O_RDONLY) : ();
- push @options, (recsep => "\n");
- tie @$array_ref, 'Tie::File', $name, @options;
- $self->throw("Can't tie 'Tie::File' to '$name':\n$!")
- unless tied @$array_ref;
- $self->tied_file($array_ref);
- };
-}
-
-sub open {
- my $self = shift;
- $self->is_open(1);
- $self->assert_filepath if $self->_assert;
- my ($mode, $perms) = @_;
- $self->mode($mode) if defined $mode;
- $self->mode('<') unless defined $self->mode;
- $self->perms($perms) if defined $perms;
- my @args = ($self->mode);
- push @args, $self->perms if defined $self->perms;
- if (defined $self->pathname) {
- $self->io_handle(IO::File->new);
- $self->io_handle->open($self->pathname, @args)
- or $self->throw($self->open_msg);
- }
- elsif (defined $self->_handle and
- not $self->io_handle->opened
- ) {
- # XXX Not tested
- $self->io_handle->fdopen($self->_handle, @args);
- }
- $self->set_lock;
- $self->set_binmode;
-}
-
-my %mode_msg = (
- '>' => 'output',
- '<' => 'input',
- '>>' => 'append',
-);
-sub open_msg {
- my $self = shift;
- my $name = defined $self->pathname
- ? " '" . $self->pathname . "'"
- : '';
- my $direction = defined $mode_msg{$self->mode}
- ? ' for ' . $mode_msg{$self->mode}
- : '';
- return qq{Can't open file$name$direction:\n$!};
-}
-
-#===============================================================================
-sub close {
- my $self = shift;
- return unless $self->is_open;
- $self->is_open(0);
- my $io_handle = $self->io_handle;
- $self->unlock;
- $self->io_handle(undef);
- $self->mode(undef);
- if (my $tied_file = $self->tied_file) {
- if (ref($tied_file) eq 'ARRAY') {
- untie @$tied_file;
- }
- else {
- untie %$tied_file;
- }
- $self->tied_file(undef);
- return 1;
- }
- $io_handle->close(@_)
- if defined $io_handle;
- return $self;
-}
-
-sub empty {
- my $self = shift;
- -z $self->pathname;
-}
-
-sub filepath {
- my $self = shift;
- my ($volume, $path) = $self->splitpath;
- return File::Spec->catpath($volume, $path, '');
-}
-
-sub getline_backwards {
- my $self = shift;
- $self->assert_open_backwards;
- return $self->io_handle->readline;
-}
-
-sub getlines_backwards {
- my $self = shift;
- my @lines;
- while (defined (my $line = $self->getline_backwards)) {
- push @lines, $line;
- }
- return @lines;
-}
-
-sub head {
- my $self = shift;
- my $lines = shift || 10;
- my @return;
- $self->close;
- while ($lines--) {
- push @return, ($self->getline or last);
- }
- $self->close;
- return wantarray ? @return : join '', @return;
-}
-
-sub tail {
- my $self = shift;
- my $lines = shift || 10;
- my @return;
- $self->close;
- while ($lines--) {
- unshift @return, ($self->getline_backwards or last);
- }
- $self->close;
- return wantarray ? @return : join '', @return;
-}
-
-sub touch {
- my $self = shift;
- return $self->SUPER::touch(@_)
- if -e $self->pathname;
- return $self if $self->is_open;
- my $mode = $self->mode;
- $self->mode('>>')->open->close;
- $self->mode($mode);
- return $self;
-}
-
-sub unlink {
- my $self = shift;
- unlink $self->pathname;
-}
-
-#===============================================================================
-sub overload_table {
- my $self = shift;
- (
- $self->SUPER::overload_table(@_),
- 'file > file' => 'overload_file_to_file',
- 'file < file' => 'overload_file_from_file',
- '${} file' => 'overload_file_as_scalar',
- '@{} file' => 'overload_file_as_array',
- '%{} file' => 'overload_file_as_dbm',
- )
-}
-
-sub overload_file_to_file {
- require File::Copy;
- File::Copy::copy($_[1]->pathname, $_[2]->pathname);
- $_[2];
-}
-
-sub overload_file_from_file {
- require File::Copy;
- File::Copy::copy($_[2]->pathname, $_[1]->pathname);
- $_[1];
-}
-
-sub overload_file_as_array {
- $_[1]->assert_tied_file;
-}
-
-sub overload_file_as_dbm {
- $_[1]->dbm
- unless $_[1]->isa('IO::All::DBM');
- $_[1]->assert_open;
-}
-
-sub overload_file_as_scalar {
- my $scalar = $_[1]->scalar;
- return \$scalar;
-}
-
-=encoding utf8
-
-=head1 NAME
-
-IO::All::File - File Support for IO::All
-
-=head1 SYNOPSIS
-
-See L<IO::All>.
-
-=head1 DESCRIPTION
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson.
-
-Copyright (c) 2006, 2008. Ingy döt Net.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=cut
-
-1;
diff --git a/old/lib/IO/All/Filesys.pm b/old/lib/IO/All/Filesys.pm
deleted file mode 100644
index ce253df..0000000
--- a/old/lib/IO/All/Filesys.pm
+++ /dev/null
@@ -1,122 +0,0 @@
-package IO::All::Filesys;
-use strict;
-use warnings;
-use IO::All::Base -base;
-use Fcntl qw(:flock);
-
-sub exists { my $self = shift; -e $self->name }
-
-sub filename {
- my $self = shift;
- my $filename;
- (undef, undef, $filename) = $self->splitpath;
- return $filename;
-}
-
-sub is_absolute {
- my $self = shift;
- return *$self->{is_absolute} = shift if @_;
- return *$self->{is_absolute}
- if defined *$self->{is_absolute};
- *$self->{is_absolute} = IO::All::is_absolute($self) ? 1 : 0;
-}
-
-sub is_executable { my $self = shift; -x $self->name }
-sub is_readable { my $self = shift; -r $self->name }
-sub is_writable { my $self = shift; -w $self->name }
-{
- no warnings 'once';
- *is_writeable = \&is_writable;
-}
-
-sub pathname {
- my $self = shift;
- return *$self->{pathname} = shift if @_;
- return *$self->{pathname} if defined *$self->{pathname};
- return $self->name;
-}
-
-sub relative {
- my $self = shift;
- $self->pathname(File::Spec->abs2rel($self->pathname))
- if $self->is_absolute;
- $self->is_absolute(0);
- return $self;
-}
-
-sub rename {
- my $self = shift;
- my $new = shift;
- rename($self->name, "$new")
- ? UNIVERSAL::isa($new, 'IO::All')
- ? $new
- : $self->constructor->($new)
- : undef;
-}
-
-sub set_lock {
- my $self = shift;
- return unless $self->_lock;
- my $io_handle = $self->io_handle;
- my $flag = $self->mode =~ /^>>?$/
- ? LOCK_EX
- : LOCK_SH;
- flock $io_handle, $flag;
-}
-
-sub stat {
- my $self = shift;
- return IO::All::stat($self, @_)
- if $self->is_open;
- CORE::stat($self->pathname);
-}
-
-sub touch {
- my $self = shift;
- $self->utime;
-}
-
-sub unlock {
- my $self = shift;
- flock $self->io_handle, LOCK_UN
- if $self->_lock;
-}
-
-sub utime {
- my $self = shift;
- my $atime = shift;
- my $mtime = shift;
- $atime = time unless defined $atime;
- $mtime = $atime unless defined $mtime;
- utime($atime, $mtime, $self->name);
- return $self;
-}
-
-=encoding utf8
-
-=head1 NAME
-
-IO::All::Filesys - File System Methods Mixin for IO::All
-
-=head1 SYNOPSIS
-
-See L<IO::All>.
-
-=head1 DESCRIPTION
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson.
-
-Copyright (c) 2006, 2008. Ingy döt Net.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=cut
diff --git a/old/lib/IO/All/Link.pm b/old/lib/IO/All/Link.pm
deleted file mode 100644
index 8737b9c..0000000
--- a/old/lib/IO/All/Link.pm
+++ /dev/null
@@ -1,85 +0,0 @@
-package IO::All::Link;
-use strict;
-use warnings;
-use IO::All::File -base;
-
-const type => 'link';
-
-sub link {
- my $self = shift;
- bless $self, __PACKAGE__;
- $self->name(shift) if @_;
- $self->_init;
-}
-
-sub readlink {
- my $self = shift;
- $self->constructor->(CORE::readlink($self->name));
-}
-
-sub symlink {
- my $self = shift;
- my $target = shift;
- $self->assert_filepath if $self->_assert;
- CORE::symlink($target, $self->pathname);
-}
-
-sub AUTOLOAD {
- my $self = shift;
- our $AUTOLOAD;
- (my $method = $AUTOLOAD) =~ s/.*:://;
- my $target = $self->target;
- unless ($target) {
- $self->throw("Can't call $method on symlink");
- return;
- }
- $target->$method(@_);
-}
-
-sub target {
- my $self = shift;
- return *$self->{target} if *$self->{target};
- my %seen;
- my $link = $self;
- my $new;
- while ($new = $link->readlink) {
- my $type = $new->type or return;
- last if $type eq 'file';
- last if $type eq 'dir';
- return unless $type eq 'link';
- return if $seen{$new->name}++;
- $link = $new;
- }
- *$self->{target} = $new;
-}
-
-=encoding utf8
-
-=head1 NAME
-
-IO::All::Link - Symbolic Link Support for IO::All
-
-=head1 SYNOPSIS
-
-See L<IO::All>.
-
-=head1 DESCRIPTION
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson.
-
-Copyright (c) 2006, 2008. Ingy döt Net.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=cut
-
-1;
diff --git a/old/lib/IO/All/MLDBM.pm b/old/lib/IO/All/MLDBM.pm
deleted file mode 100644
index 9878c3c..0000000
--- a/old/lib/IO/All/MLDBM.pm
+++ /dev/null
@@ -1,63 +0,0 @@
-package IO::All::MLDBM;
-use strict;
-use warnings;
-use IO::All::DBM -base;
-
-field _serializer => 'Data::Dumper';
-
-sub mldbm {
- my $self = shift;
- bless $self, __PACKAGE__;
- my ($serializer) = grep { /^(Storable|Data::Dumper|FreezeThaw)$/ } @_;
- $self->_serializer($serializer) if defined $serializer;
- my @dbm_list = grep { not /^(Storable|Data::Dumper|FreezeThaw)$/ } @_;
- $self->_dbm_list([@dbm_list]);
- return $self;
-}
-
-sub tie_dbm {
- my $self = shift;
- my $filename = $self->name;
- my $dbm_class = $self->_dbm_class;
- my $serializer = $self->_serializer;
- eval "use MLDBM qw($dbm_class $serializer)";
- $self->throw("Can't open '$filename' as MLDBM:\n$@") if $@;
- my $hash;
- my $db = tie %$hash, 'MLDBM', $filename, $self->mode, $self->perms,
- @{$self->_dbm_extra}
- or $self->throw("Can't open '$filename' as MLDBM file:\n$!");
- $self->add_utf8_dbm_filter($db)
- if $self->_utf8;
- $self->tied_file($hash);
-}
-
-=encoding utf8
-
-=head1 NAME
-
-IO::All::MLDBM - MLDBM Support for IO::All
-
-=head1 SYNOPSIS
-
-See L<IO::All>.
-
-=head1 DESCRIPTION
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson.
-
-Copyright (c) 2006, 2008. Ingy döt Net.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=cut
-
-1;
diff --git a/old/lib/IO/All/Pipe.pm b/old/lib/IO/All/Pipe.pm
deleted file mode 100644
index e51edd0..0000000
--- a/old/lib/IO/All/Pipe.pm
+++ /dev/null
@@ -1,85 +0,0 @@
-package IO::All::Pipe;
-use strict;
-use warnings;
-use IO::All -base;
-use IO::File;
-
-const type => 'pipe';
-
-sub pipe {
- my $self = shift;
- bless $self, __PACKAGE__;
- $self->name(shift) if @_;
- return $self->_init;
-}
-
-sub assert_open {
- my $self = shift;
- return if $self->is_open;
- $self->mode(shift) unless $self->mode;
- $self->open;
-}
-
-sub open {
- my $self = shift;
- $self->is_open(1);
- require IO::Handle;
- $self->io_handle(IO::Handle->new)
- unless defined $self->io_handle;
- my $command = $self->name;
- $command =~ s/(^\||\|$)//;
- my $mode = shift || $self->mode || '<';
- my $pipe_mode =
- $mode eq '>' ? '|-' :
- $mode eq '<' ? '-|' :
- $self->throw("Invalid usage mode '$mode' for pipe");
- CORE::open($self->io_handle, $pipe_mode, $command);
- $self->set_binmode;
-}
-
-my %mode_msg = (
- '>' => 'output',
- '<' => 'input',
- '>>' => 'append',
-);
-sub open_msg {
- my $self = shift;
- my $name = defined $self->name
- ? " '" . $self->name . "'"
- : '';
- my $direction = defined $mode_msg{$self->mode}
- ? ' for ' . $mode_msg{$self->mode}
- : '';
- return qq{Can't open pipe$name$direction:\n$!};
-}
-
-=encoding utf8
-
-=head1 NAME
-
-IO::All::Pipe - Pipe Support for IO::All
-
-=head1 SYNOPSIS
-
-See L<IO::All>.
-
-=head1 DESCRIPTION
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson.
-
-Copyright (c) 2006, 2008. Ingy döt Net.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=cut
-
-1;
diff --git a/old/lib/IO/All/STDIO.pm b/old/lib/IO/All/STDIO.pm
deleted file mode 100644
index f3fabd6..0000000
--- a/old/lib/IO/All/STDIO.pm
+++ /dev/null
@@ -1,83 +0,0 @@
-package IO::All::STDIO;
-use strict;
-use warnings;
-use IO::All -base;
-use IO::File;
-
-const type => 'stdio';
-
-sub stdio {
- my $self = shift;
- bless $self, __PACKAGE__;
- return $self->_init;
-}
-
-sub stdin {
- my $self = shift;
- $self->open('<');
- return $self;
-}
-
-sub stdout {
- my $self = shift;
- $self->open('>');
- return $self;
-}
-
-sub stderr {
- my $self = shift;
- $self->open_stderr;
- return $self;
-}
-
-sub open {
- my $self = shift;
- $self->is_open(1);
- my $mode = shift || $self->mode || '<';
- my $fileno = $mode eq '>'
- ? fileno(STDOUT)
- : fileno(STDIN);
- $self->io_handle(IO::File->new);
- $self->io_handle->fdopen($fileno, $mode);
- $self->set_binmode;
-}
-
-sub open_stderr {
- my $self = shift;
- $self->is_open(1);
- $self->io_handle(IO::File->new);
- $self->io_handle->fdopen(fileno(STDERR), '>') ? $self : 0;
-}
-
-# XXX Add overload support
-
-=encoding utf8
-
-=head1 NAME
-
-IO::All::STDIO - STDIO Support for IO::All
-
-=head1 SYNOPSIS
-
-See L<IO::All>.
-
-=head1 DESCRIPTION
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson.
-
-Copyright (c) 2006, 2008. Ingy döt Net.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=cut
-
-1;
diff --git a/old/lib/IO/All/Socket.pm b/old/lib/IO/All/Socket.pm
deleted file mode 100644
index 8f8d1d1..0000000
--- a/old/lib/IO/All/Socket.pm
+++ /dev/null
@@ -1,171 +0,0 @@
-package IO::All::Socket;
-use strict;
-use warnings;
-use IO::All -base;
-use IO::Socket;
-
-const type => 'socket';
-field _listen => undef;
-option 'fork';
-const domain_default => 'localhost';
-chain domain => undef;
-chain port => undef;
-proxy_open 'recv';
-proxy_open 'send';
-
-sub socket {
- my $self = shift;
- bless $self, __PACKAGE__;
- $self->name(shift) if @_;
- return $self->_init;
-}
-
-sub socket_handle {
- my $self = shift;
- bless $self, __PACKAGE__;
- $self->_handle(shift) if @_;
- return $self->_init;
-}
-
-sub accept {
- my $self = shift;
- use POSIX ":sys_wait_h";
- sub REAPER {
- while (waitpid(-1, WNOHANG) > 0) {}
- $SIG{CHLD} = \&REAPER;
- }
- local $SIG{CHLD};
- $self->_listen(1);
- $self->assert_open;
- my $server = $self->io_handle;
- my $socket;
- while (1) {
- $socket = $server->accept;
- last unless $self->_fork;
- next unless defined $socket;
- $SIG{CHLD} = \&REAPER;
- my $pid = CORE::fork;
- $self->throw("Unable to fork for IO::All::accept")
- unless defined $pid;
- last unless $pid;
- close $socket;
- undef $socket;
- }
- close $server if $self->_fork;
- my $io = ref($self)->new->socket_handle($socket);
- $io->io_handle($socket);
- $io->is_open(1);
- return $io;
-}
-
-sub shutdown {
- my $self = shift;
- my $how = @_ ? shift : 2;
- my $handle = $self->io_handle;
- $handle->shutdown(2)
- if defined $handle;
-}
-
-sub assert_open {
- my $self = shift;
- return if $self->is_open;
- $self->mode(shift) unless $self->mode;
- $self->open;
-}
-
-sub open {
- my $self = shift;
- return if $self->is_open;
- $self->is_open(1);
- $self->get_socket_domain_port;
- my @args = $self->_listen
- ? (
- LocalAddr => $self->domain,
- LocalPort => $self->port,
- Proto => 'tcp',
- Listen => 1,
- Reuse => 1,
- )
- : (
- PeerAddr => $self->domain,
- PeerPort => $self->port,
- Proto => 'tcp',
- );
- my $socket = IO::Socket::INET->new(@args)
- or $self->throw("Can't open socket");
- $self->io_handle($socket);
- $self->set_binmode;
-}
-
-sub get_socket_domain_port {
- my $self = shift;
- my ($domain, $port);
- ($domain, $port) = split /:/, $self->name
- if defined $self->name;
- $self->domain($domain) unless defined $self->domain;
- $self->domain($self->domain_default) unless $self->domain;
- $self->port($port) unless defined $self->port;
- return $self;
-}
-
-sub overload_table {
- my $self = shift;
- (
- $self->SUPER::overload_table(@_),
- '&{} socket' => 'overload_socket_as_code',
- )
-}
-
-sub overload_socket_as_code {
- my $self = shift;
- sub {
- my $coderef = shift;
- while ($self->is_open) {
- $_ = $self->getline;
- &$coderef($self);
- }
- }
-}
-
-sub overload_any_from_any {
- my $self = shift;
- $self->SUPER::overload_any_from_any(@_);
- $self->close;
-}
-
-sub overload_any_to_any {
- my $self = shift;
- $self->SUPER::overload_any_to_any(@_);
- $self->close;
-}
-
-=encoding utf8
-
-=head1 NAME
-
-IO::All::Socket - Socket Support for IO::All
-
-=head1 SYNOPSIS
-
-See L<IO::All>.
-
-=head1 DESCRIPTION
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson.
-
-Copyright (c) 2006, 2008, 2010. Ingy döt Net.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=cut
-
-1;
diff --git a/old/lib/IO/All/String.pm b/old/lib/IO/All/String.pm
deleted file mode 100644
index 8f10e49..0000000
--- a/old/lib/IO/All/String.pm
+++ /dev/null
@@ -1,52 +0,0 @@
-package IO::All::String;
-use strict;
-use warnings;
-use IO::All -base;
-use IO::String;
-
-const type => 'string';
-proxy 'string_ref';
-
-sub string {
- my $self = shift;
- bless $self, __PACKAGE__;
- $self->_init;
-}
-
-sub open {
- my $self = shift;
- $self->io_handle(IO::String->new);
- $self->set_binmode;
- $self->is_open(1);
-}
-
-=encoding utf8
-
-=head1 NAME
-
-IO::All::String - String IO Support for IO::All
-
-=head1 SYNOPSIS
-
-See L<IO::All>.
-
-=head1 DESCRIPTION
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson. All rights reserved.
-
-Copyright (c) 2006, 2008. Ingy döt Net. All rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=cut
-
-1;
diff --git a/old/lib/IO/All/Temp.pm b/old/lib/IO/All/Temp.pm
deleted file mode 100644
index b425c16..0000000
--- a/old/lib/IO/All/Temp.pm
+++ /dev/null
@@ -1,47 +0,0 @@
-package IO::All::Temp;
-use strict;
-use warnings;
-use IO::All::File -base;
-
-sub temp {
- my $self = shift;
- bless $self, __PACKAGE__;
- my $temp_file = IO::File::new_tmpfile()
- or $self->throw("Can't create temporary file");
- $self->io_handle($temp_file);
- $self->error_check;
- $self->autoclose(0);
- $self->is_open(1);
- return $self;
-}
-
-=encoding utf8
-
-=head1 NAME
-
-IO::All::Temp - Temporary File Support for IO::All
-
-=head1 SYNOPSIS
-
-See L<IO::All>.
-
-=head1 DESCRIPTION
-
-=head1 AUTHOR
-
-Ingy döt Net <ingy at cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004. Brian Ingerson.
-
-Copyright (c) 2006, 2008. Ingy döt Net.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=cut
-
-1;
diff --git a/old/t/IO_All_Test.pm b/old/t/IO_All_Test.pm
deleted file mode 100644
index c2dc662..0000000
--- a/old/t/IO_All_Test.pm
+++ /dev/null
@@ -1,61 +0,0 @@
-package IO_All_Test;
-use File::Path;
- at EXPORT = qw(
- test_file_contents
- test_file_contents2
- test_matching_files
- read_file_lines
- flip_slash f
-);
-use strict;
-use base 'Exporter';
-use Test::More ();
-
-sub test_file_contents {
- my ($data, $file) = @_;
- Test::More::is($data, read_file($file));
-}
-
-sub test_file_contents2 {
- my ($file, $data) = @_;
- Test::More::is(read_file($file), $data);
-}
-
-sub test_matching_files {
- my ($file1, $file2) = @_;
- Test::More::is(read_file($file1), read_file($file2));
-}
-
-sub read_file {
- my ($file) = @_;
- local(*FILE, $/);
- open FILE, $file
- or die "Can't open $file for input:\n$!";
- <FILE>;
-}
-
-sub read_file_lines {
- my ($file) = @_;
- local(*FILE);
- open FILE, $file or die $!;
- (<FILE>);
-}
-
-sub flip_slash {
- my $string = shift;
- if ($^O =~ /^mswin32$/i) {
- $string =~ s/\//\\/g;
- }
- return $string;
-}
-{
- no warnings;
- *f = \&flip_slash;
-}
-
-BEGIN {
- File::Path::rmtree('t/output');
- File::Path::mkpath('t/output');
-}
-
-1;
diff --git a/old/t/IO_Dumper.pm b/old/t/IO_Dumper.pm
deleted file mode 100644
index e92e307..0000000
--- a/old/t/IO_Dumper.pm
+++ /dev/null
@@ -1,20 +0,0 @@
-package IO_Dumper;
-use strict;
-use warnings;
-use IO::All -base;
-
-our @EXPORT = 'io';
-
-sub io { return IO_Dumper->new(@_) };
-
-package IO::All::Filesys;
-use Data::Dumper;
-sub dump {
- my $self = shift;
- local $Data::Dumper::Indent = 1;
- local $Data::Dumper::Sortkeys = 1;
- $self->print(Data::Dumper::Dumper(@_));
- return $self;
-}
-
-1;
diff --git a/old/t/absolute.t b/old/t/absolute.t
deleted file mode 100644
index 70ea0bf..0000000
--- a/old/t/absolute.t
+++ /dev/null
@@ -1,16 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 3;
-use IO::All;
-use IO_All_Test;
-use diagnostics;
-
-my $io = io($0);
-
-$io->absolute;
-is("$io", File::Spec->rel2abs($0));
-$io->relative;
-is($io->pathname, File::Spec->abs2rel($0));
-
-ok(io('t')->absolute->next->is_absolute);
diff --git a/old/t/accept.t b/old/t/accept.t
deleted file mode 100644
index cddea5f..0000000
--- a/old/t/accept.t
+++ /dev/null
@@ -1,83 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 20;
-use IO::All;
-use IO_All_Test;
-use IO::Socket::INET;
-
-# This test tests for the ability of a non-forking socket to handle more
-# than one connection.
-
-my $pid = fork();
-if (! $pid)
-{
- # Let the child process listen on a port
- my $port = 5555;
- my $accepted = 0;
- while (1)
- {
- # Log the port to a file.
- open my $out, ">t/output/server-port.t";
- print {$out} $port;
- close($out);
-
- my $server = io("localhost:$port");
-
- eval {
- for my $count (1 .. 10)
- {
- my $connection = $server->accept();
- $accepted = 1;
- $connection->print(sprintf("Ingy-%.2d", $count));
- $connection->close();
- }
- };
- if ($accepted)
- {
- # We have a listening socket on a port, so we can continue
- last;
- }
- }
- continue
- {
- # Try a different port.
- $port++;
- }
- exit(0);
-}
-# Let the parent process handle the testing.
-
-# Wait a little for the client to find a port.
-sleep(1);
-
-open my $in, "<t/output/server-port.t";
-my $port = <$in>;
-close($in);
-
-# TEST*2*10
-for my $c (1 .. 10)
-{
- my $sock = IO::Socket::INET->new(
- PeerAddr => "localhost",
- PeerPort => $port,
- Proto => "tcp"
- );
-
- ok(defined($sock), "Checking for validity of sock No. $c");
-
- if (!defined($sock))
- {
- last;
- }
-
- my $data;
- $sock->recv($data, 7);
-
- $sock->close();
-
- is ($data, sprintf("Ingy-%.2d", $c), "Checking for connection No. $c.");
-}
-
-waitpid($pid, 0);
-
diff --git a/old/t/all.t b/old/t/all.t
deleted file mode 100644
index 8d29487..0000000
--- a/old/t/all.t
+++ /dev/null
@@ -1,52 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 30;
-use IO::All;
-use IO_All_Test;
-
-my $expected1 = 't/mydir/dir1;t/mydir/dir2;t/mydir/file1;t/mydir/file2;t/mydir/file3';
-my $expected2 = 't/mydir/dir1;t/mydir/dir1/dira;t/mydir/dir1/file1;t/mydir/dir2;t/mydir/dir2/file1;t/mydir/file1;t/mydir/file2;t/mydir/file3';
-my $expected3 = 't/mydir/dir1;t/mydir/dir1/dira;t/mydir/dir1/dira/dirx;t/mydir/dir1/file1;t/mydir/dir2;t/mydir/dir2/file1;t/mydir/file1;t/mydir/file2;t/mydir/file3';
-my $expected4 = 't/mydir/dir1;t/mydir/dir1/dira;t/mydir/dir1/dira/dirx;t/mydir/dir1/dira/dirx/file1;t/mydir/dir1/file1;t/mydir/dir2;t/mydir/dir2/file1;t/mydir/file1;t/mydir/file2;t/mydir/file3';
-my $expected_files1 = 't/mydir/file1;t/mydir/file2;t/mydir/file3';
-my $expected_files2 = 't/mydir/dir1/file1;t/mydir/dir2/file1;t/mydir/file1;t/mydir/file2;t/mydir/file3';
-my $expected_files4 = 't/mydir/dir1/dira/dirx/file1;t/mydir/dir1/file1;t/mydir/dir2/file1;t/mydir/file1;t/mydir/file2;t/mydir/file3';
-my $expected_dirs1 = 't/mydir/dir1;t/mydir/dir2';
-my $expected_dirs2 = 't/mydir/dir1;t/mydir/dir1/dira;t/mydir/dir2';
-my $expected_dirs3 = 't/mydir/dir1;t/mydir/dir1/dira;t/mydir/dir1/dira/dirx;t/mydir/dir2';
-my $expected_filt1 = 't/mydir/dir1/dira;t/mydir/dir1/dira/dirx';
-my $expected_filt2 = 't/mydir/dir1/dira/dirx';
-
-sub prep { join ';', grep { not /CVS|\.svn/ } @_ }
-
-is(prep(io('t/mydir')->all), f$expected1);
-is(prep(io('t/mydir')->all(1)), f$expected1);
-is(prep(io('t/mydir')->all(2)), f$expected2);
-is(prep(io('t/mydir')->all(3)), f$expected3);
-is(prep(io('t/mydir')->all(4)), f$expected4);
-is(prep(io('t/mydir')->all(5)), f$expected4);
-is(prep(io('t/mydir')->all(0)), f$expected4);
-is(prep(io('t/mydir')->All), f$expected4);
-is(prep(io('t/mydir')->deep->all), f$expected4);
-is(prep(io('t/mydir')->all_files), f$expected_files1);
-is(prep(io('t/mydir')->all_files(1)), f$expected_files1);
-is(prep(io('t/mydir')->all_files(2)), f$expected_files2);
-is(prep(io('t/mydir')->all_files(3)), f$expected_files2);
-is(prep(io('t/mydir')->all_files(4)), f$expected_files4);
-is(prep(io('t/mydir')->all_files(5)), f$expected_files4);
-is(prep(io('t/mydir')->all_files(0)), f$expected_files4);
-is(prep(io('t/mydir')->All_Files), f$expected_files4);
-is(prep(io('t/mydir')->deep->all_files), f$expected_files4);
-is(prep(io('t/mydir')->All_Files(2)), f$expected_files4);
-is(prep(io('t/mydir')->all_dirs), f$expected_dirs1);
-is(prep(io('t/mydir')->all_dirs(1)), f$expected_dirs1);
-is(prep(io('t/mydir')->all_dirs(2)), f$expected_dirs2);
-is(prep(io('t/mydir')->all_dirs(3)), f$expected_dirs3);
-is(prep(io('t/mydir')->all_dirs(4)), f$expected_dirs3);
-is(prep(io('t/mydir')->all_dirs(5)), f$expected_dirs3);
-is(prep(io('t/mydir')->all_dirs(0)), f$expected_dirs3);
-is(prep(io('t/mydir')->All_Dirs), f$expected_dirs3);
-is(prep(io('t/mydir')->deep->all_dirs), f$expected_dirs3);
-is(prep(io('t/mydir')->filter(sub {/dira/})->All_Dirs), f$expected_filt1);
-is(prep(io('t/mydir')->filter(sub {/x/})->All_Dirs), f$expected_filt2);
diff --git a/old/t/all2.t b/old/t/all2.t
deleted file mode 100644
index 4385d90..0000000
--- a/old/t/all2.t
+++ /dev/null
@@ -1,9 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 2;
-use IO::All;
-use IO_All_Test;
-
-test_file_contents(io->file('t/all2.t')->all, 't/all2.t');
-test_file_contents(io->file('t/all2.t')->scalar, 't/all2.t');
diff --git a/old/t/append.t b/old/t/append.t
deleted file mode 100644
index ebfc0e2..0000000
--- a/old/t/append.t
+++ /dev/null
@@ -1,67 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More;
-use IO::All;
-use IO_All_Test;
-
-plan((lc($^O) eq 'mswin32' and defined $ENV{PERL5_CPANPLUS_IS_RUNNING})
- ? (skip_all => "CPANPLUS/MSWin32 breaks this")
- : ($] < 5.008003)
- ? (skip_all => 'Broken on older perls')
- : (tests => 4)
-);
-
-{
- my $log = io->file("t/output/myappend.txt")->mode('>>')->open();
-
- $log->print("Hello World!\n");
-
- $log->close();
-}
-
-{
- # TEST
- ok (scalar(-f "t/output/myappend.txt"), "myappend.txt exists.");
-
- my $contents = _slurp("t/output/myappend.txt");
-
- # TEST
- is ($contents, "Hello World!\n", "contents of the file are OK.");
-}
-
-
-{
- my $log = io->file("t/output/myappend.txt")->mode('>>')->open();
-
- $log->print("Message No. 2!\n");
-
- $log->close();
-}
-
-{
- # TEST
- ok (scalar(-f "t/output/myappend.txt"), "myappend.txt exists.");
-
- my $contents = _slurp("t/output/myappend.txt");
-
- # TEST
- is ($contents, "Hello World!\nMessage No. 2!\n",
- "Second append was ok.");
-}
-
-sub _slurp
-{
- my $filename = shift;
-
- open my $in, "<", $filename
- or die "Cannot open '$filename' for slurping - $!";
-
- local $/;
- my $contents = <$in>;
-
- close($in);
-
- return $contents;
-}
-
diff --git a/old/t/assert.t b/old/t/assert.t
deleted file mode 100644
index 0a2a4da..0000000
--- a/old/t/assert.t
+++ /dev/null
@@ -1,13 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 4;
-use IO::All;
-use IO_All_Test;
-
-ok(not -e 't/output/newpath/hello.txt');
-ok(not -e 't/output/newpath');
-my $io = io('t/output/newpath/hello.txt')->assert;
-ok(not -e 't/output/newpath');
-"Hello\n" > $io;
-ok(-f 't/output/newpath/hello.txt');
diff --git a/old/t/assert2.t b/old/t/assert2.t
deleted file mode 100644
index 091212c..0000000
--- a/old/t/assert2.t
+++ /dev/null
@@ -1,15 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 4;
-use IO::All;
-use IO_All_Test;
-
-ok(io('t/output/xxx/yyy/zzz.db')->dbm->assert->{foo} = "bar");
-ok(-f 't/output/xxx/yyy/zzz.db' or -f 't/output/xxx/yyy/zzz.db.dir');
-SKIP: {
- skip "requires MLDBM", 2
- unless eval { require MLDBM; 1};
- ok(io('t/output/xxx/yyy/zzz2.db')->assert->mldbm->{foo} = ["bar"]);
- ok(-f 't/output/xxx/yyy/zzz2.db' or -f 't/output/xxx/yyy/zzz.db.dir');
-}
diff --git a/old/t/autotie.t b/old/t/autotie.t
deleted file mode 100644
index e618ef4..0000000
--- a/old/t/autotie.t
+++ /dev/null
@@ -1,16 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More;
-use IO::All;
-use IO_All_Test;
-
-my @lines = read_file_lines('t/mystuff');
-plan(tests => 1 + @lines + 1);
-
-my $io = io('t/mystuff')->tie;
-is($io->autoclose(0) . '', 't/mystuff');
-while (<$io>) {
- is($_, shift @lines);
-}
-ok(close $io);
diff --git a/old/t/backwards.t b/old/t/backwards.t
deleted file mode 100644
index d77a8b7..0000000
--- a/old/t/backwards.t
+++ /dev/null
@@ -1,24 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More;
-use IO::All;
-use IO_All_Test;
-
-plan((eval {require File::ReadBackwards; 1})
- ? (tests => 2)
- : (skip_all => "requires File::ReadBackwards")
-);
-
-my @reversed;
-my $io = io('t/mystuff');
-$io->backwards;
-while (my $line = $io->getline) {
- push @reversed, $line;
-}
-
-test_file_contents(join('', reverse @reversed), 't/mystuff');
-
- at reversed = io('t/mystuff')->backwards->getlines;
-
-test_file_contents(join('', reverse @reversed), 't/mystuff');
diff --git a/old/t/chdir.t b/old/t/chdir.t
deleted file mode 100644
index 7c2d2d5..0000000
--- a/old/t/chdir.t
+++ /dev/null
@@ -1,13 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 2;
-use IO::All;
-use IO_All_Test;
-use Cwd;
-
-{
- my $dir = io('t')->chdir;
- is((io(io->curdir->absolute->pathname)->splitdir)[-1], 't');
-}
-like((io(io->curdir->absolute->pathname)->splitdir)[-1], qr'(?i:^IO-All)');
diff --git a/old/t/chomp.t b/old/t/chomp.t
deleted file mode 100644
index 4d6158b..0000000
--- a/old/t/chomp.t
+++ /dev/null
@@ -1,16 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More 'no_plan';
-use IO::All;
-use IO_All_Test;
-
-my $io = io('t/chomp.t')->chomp;
-for ($io->slurp) {
- ok(not /\n/);
-}
-$io->close;
-
-for ($io->chomp->separator('io')->getlines) {
- ok(not /io/);
-}
diff --git a/old/t/construct.t b/old/t/construct.t
deleted file mode 100644
index 63c3c9d..0000000
--- a/old/t/construct.t
+++ /dev/null
@@ -1,46 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 18;
-use IO::All;
-use IO_All_Test;
-
-my $io1 = IO::All->new('t/mystuff');
-is(ref($io1), 'IO::All::File');
-test_file_contents($$io1, 't/mystuff');
-
-my $io2 = io('t/mystuff');
-is(ref($io2), 'IO::All::File');
-test_file_contents($$io2, 't/mystuff');
-
-my $io3 = io->file('t/mystuff');
-is(ref($io3), 'IO::All::File');
-test_file_contents($$io3, 't/mystuff');
-
-my $io4 = $io3->file('t/construct.t');
-is(ref($io4), 'IO::All::File');
-test_file_contents($$io4, 't/construct.t');
-
-my $io5 = io->dir('t/mydir');
-is(ref($io5), 'IO::All::Dir');
-is(join('+', map $_->filename, grep {! /CVS|\.svn/} $io5->all), 'dir1+dir2+file1+file2+file3');
-
-my $io6 = io->rdonly->new->file('t/construct.t');
-ok($io6->_rdonly);
-
-SKIP: {
- eval {require Tie::File};
- skip "requires Tie::File", 1 if $@;
-
- test_file_contents(join('', map {"$_\n"} @$io6), 't/construct.t');
-}
-
-my $io7 = io->socket('foo.com:80')->get_socket_domain_port;
-ok($io7->is_socket);
-is($io7->domain, 'foo.com');
-is($io7->port, '80');
-
-my $io8 = io(':8000')->get_socket_domain_port;
-ok($io8->is_socket);
-is($io8->domain, 'localhost');
-is($io8->port, '8000');
diff --git a/old/t/dbm.t b/old/t/dbm.t
deleted file mode 100644
index c35af00..0000000
--- a/old/t/dbm.t
+++ /dev/null
@@ -1,13 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 2;
-use IO::All;
-use IO_All_Test;
-
-my $db = io('t/output/mydbm')->dbm('SDBM_File');
-$db->{fortytwo} = 42;
-$db->{foo} = 'bar';
-
-is(join('', sort keys %$db), 'foofortytwo');
-is(join('', sort values %$db), '42bar');
diff --git a/old/t/devnull.t b/old/t/devnull.t
deleted file mode 100644
index 33bee0b..0000000
--- a/old/t/devnull.t
+++ /dev/null
@@ -1,9 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 2;
-use IO::All;
-use IO_All_Test;
-
-ok("xxx" > io->devnull);
-ok(io->devnull->print("yyy"));
diff --git a/old/t/empty.t b/old/t/empty.t
deleted file mode 100644
index 53f36eb..0000000
--- a/old/t/empty.t
+++ /dev/null
@@ -1,17 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 5;
-use IO::All;
-use IO_All_Test;
-
-my $d = io('t/output/empty');
-ok($d->mkdir);
-ok($d->empty);
-
-my $f = io('t/output/file');
-ok($f->touch->touch);
-ok($f->empty);
-
-eval {io('qwerty')->empty};
-like($@, qr"Can't call empty");
diff --git a/old/t/encoding.t b/old/t/encoding.t
deleted file mode 100644
index 2f81ec8..0000000
--- a/old/t/encoding.t
+++ /dev/null
@@ -1,43 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More;
-use IO_All_Test;
-
-BEGIN {
- plan(($] < 5.008003)
- ? (skip_all => 'Broken on older perls')
- : (tests => 4)
- );
-}
-
-package Normal;
-
-use IO::All;
-
-package UTF8;
-
-use IO::All -utf8;
-
-package Big5;
-
-use IO::All -encoding => 'big5';
-
-package main;
-
-isnt Normal::io('t/text.big5')->all,
- Normal::io('t/text.utf8')->all,
- 'big5 and utf8 tests are different';
-
-isnt Normal::io('t/text.big5')->all,
- Big5::io('t/text.big5')->all,
- 'Read big5 with different io-s does not match';
-
-is UTF8::io('t/text.utf8')->all,
- Big5::io('t/text.big5')->all,
- 'Big5 text matches utf8 text after read';
-
-is Normal::io('t/text.utf8')->utf8->all,
- Normal::io('t/text.big5')->encoding('big5')->all,
- 'Big5 text matches utf8 text after read';
-
diff --git a/old/t/error1.t b/old/t/error1.t
deleted file mode 100644
index b55fb93..0000000
--- a/old/t/error1.t
+++ /dev/null
@@ -1,17 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 2;
-use IO::All;
-
-my $t1 = io('quack');
-eval {
- $t1->slurp;
-};
-like($@, qr{^Can't open file 'quack' for input:});
-
-my $t2 = io('t/xxxxx');
-eval {
- $t2->next;
-};
-like($@, qr{^Can't open directory 't/xxxxx':});
diff --git a/old/t/file_spec.t b/old/t/file_spec.t
deleted file mode 100644
index fde3a67..0000000
--- a/old/t/file_spec.t
+++ /dev/null
@@ -1,45 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 27;
-use IO::All;
-use IO_All_Test;
-
-is(io('././t/file_spec.t')->canonpath, f 't/file_spec.t');
-is(io('././t/bogus')->canonpath, f 't/bogus');
-is(join(';', grep {! /CVS|\.svn/} io->catdir(qw(t mydir))->all), f 't/mydir/dir1;t/mydir/dir2;t/mydir/file1;t/mydir/file2;t/mydir/file3');
-test_file_contents(io->catfile(qw(t mystuff))->scalar, 't/mystuff');
-test_file_contents(io->join(qw(t mystuff))->scalar, 't/mystuff');
-is(ref(io->devnull), 'IO::All::File');
-ok(io->devnull->print('IO::All'));
-# Not supporting class calls anymore. Objects only.
-# ok(IO::All->devnull->print('IO::All'));
-ok(io->rootdir->is_dir);
-ok(io->tmpdir->is_dir);
-ok(io->updir->is_dir);
-like(io->case_tolerant, qr/^[01]$/);
-ok(io('/foo/bar')->is_absolute);
-ok(not io('foo/bar')->is_absolute);
-my @path1 = io->path;
-shift @path1 if $path1[0]->name eq '.';
-my $path2 = $ENV{PATH};
-$path2 =~ s/^\.[;:]//;
-is(scalar(@path1), scalar(
- @{[split((($^O eq 'MSWin32') ? ';' : ':'), $path2)]}));
-my ($v, $d, $f) = io('foo/bar')->splitpath;
-is($d, 'foo/');
-is($f, 'bar');
-my @dirs = io('foo/bar/baz')->splitdir;
-is(scalar(@dirs), 3);
-is(join('+', @dirs), 'foo+bar+baz');
-test_file_contents(io->catpath('', qw(t mystuff))->scalar, 't/mystuff');
-is(io('/foo/bar/baz')->abs2rel('/foo'), f 'bar/baz');
-is(io('foo/bar/baz')->rel2abs('/moo'), f '/moo/foo/bar/baz');
-
-is("".io->dir('doo/foo')->catdir('goo', 'hoo'), f 'doo/foo/goo/hoo');
-is("".io->dir->catdir('goo', 'hoo'), f 'goo/hoo');
-is("".io->catdir('goo', 'hoo'), f 'goo/hoo');
-
-is("".io->file('doo/foo')->catfile('goo', 'hoo'), f 'doo/foo/goo/hoo');
-is("".io->file->catfile('goo', 'hoo'), f 'goo/hoo');
-is("".io->catfile('goo', 'hoo'), f 'goo/hoo');
diff --git a/old/t/file_subclass.t b/old/t/file_subclass.t
deleted file mode 100644
index 8d80551..0000000
--- a/old/t/file_subclass.t
+++ /dev/null
@@ -1,32 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 5;
-use IO_Dumper;
-use IO_All_Test;
-
-my $hash = {
- red => 'square',
- yellow => 'circle',
- pink => 'triangle',
-};
-
-my $io = io->file('t/output/dump2')->dump($hash);
-ok(-f 't/output/dump2');
-ok($io->close);
-ok(-s 't/output/dump2');
-
-my $VAR1;
-my $a = do 't/output/dump2';
-my $b = eval join('',<DATA>);
-is_deeply($a,$b);
-
-ok($io->unlink);
-
-package main;
-__END__
-$VAR1 = {
- 'pink' => 'triangle',
- 'red' => 'square',
- 'yellow' => 'circle'
-};
diff --git a/old/t/fileno.t b/old/t/fileno.t
deleted file mode 100644
index 3f858c9..0000000
--- a/old/t/fileno.t
+++ /dev/null
@@ -1,23 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More;
-use IO::All;
-use IO_All_Test;
-
-plan((lc($^O) eq 'mswin32' and defined $ENV{PERL5_CPANPLUS_IS_RUNNING})
- ? (skip_all => "CPANPLUS/MSWin32 breaks this")
- : ($] < 5.008003)
- ? (skip_all => 'Broken on older perls')
- : (tests => 7)
-);
-
-is(io('-')->mode('<')->open->fileno, 0);
-is(io('-')->mode('>')->open->fileno, 1);
-is(io('=')->fileno, 2);
-
-is(io->stdin->fileno, 0);
-is(io->stdout->fileno, 1);
-is(io->stderr->fileno, 2);
-
-ok(io('t/output/xxx')->open('>')->fileno > 2);
diff --git a/old/t/import_flags.t b/old/t/import_flags.t
deleted file mode 100644
index 1111ec2..0000000
--- a/old/t/import_flags.t
+++ /dev/null
@@ -1,73 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More;
-use IO_All_Test;
-
-BEGIN {
- plan(($] < 5.008003)
- ? (skip_all => 'Broken on older perls')
- : (tests => 16)
- );
-}
-
-package One;
-use IO::All -strict;
-
-
-package Two;
-use IO::All -utf8;
-
-
-package Three;
-use IO::All -strict, -utf8;
-
-
-package Four;
-use IO::All -foo;
-
-
-package main;
-main::ok(defined &One::io, 'io is exported to One');
-main::ok(defined &Two::io, 'io is exported to Two');
-main::ok(defined &Three::io, 'io is exported to Three');
-main::ok(defined &Four::io, 'io is exported to Four');
-
-my $io1 = One::io('xxx');
-ok $io1->_strict,
- 'strict flag set on object 1';
-ok not($io1->_utf8),
- 'utf8 flag not set on object 1';
-
-my $io2 = Two::io('xxx');
-ok not($io2->_strict),
- 'strict flag not set on object 2';
-ok $io2->_utf8,
- 'utf8 flag set on object 2';
-
-my $io3 = Three::io('xxx');
-ok $io3->_strict,
- 'strict flag set on object 3';
-ok $io3->_utf8,
- 'utf8 flag set on object 3';
-
-eval "Four::io('xxx')";
-like $@, qr/Can't find a class for method 'foo'/,
- '-foo flag causes error';
-
-my $io2b = $io2->catfile('yyy');
-is $io2b->name, f('xxx/yyy'),
- 'catfile name is correct';
-ok not($io2b->_strict),
- 'strict flag not set on object 2b (propagated from 2)';
-ok $io2b->_utf8,
- 'utf8 flag set on object 2b (propagated from 2)';
-
-my $io2c = Two::io('aaa')->curdir;
-# use Data::Dumper;
-# die Dumper \%{*$io2c};
-ok not($io2c->_strict),
- 'strict flag not set on object 2c (propagated from 2)';
-ok $io2c->_utf8,
- 'utf8 flag set on object 2c (propagated from 2)';
-
diff --git a/old/t/in-place.t b/old/t/in-place.t
deleted file mode 100644
index 3456c86..0000000
--- a/old/t/in-place.t
+++ /dev/null
@@ -1,37 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 5;
-use IO::All;
-use File::Temp qw/tempdir/;
-
-{
- my $tempdir = tempdir( CLEANUP => 1);
-
- my $f = sub { return io->catfile($tempdir, 'test.txt') };
-
- $f->()->print(<<'EOF');
-#One
-#Two
-#Three
-#Four
-EOF
-
- # Test that the array overloading of IO::All can be modified to
- # produce new contents.
- foreach my $line (@{$f->()})
- {
- # TEST*4
- ok (($line =~ s{\A#}{}), 'Done substitution.');
- }
-
- # TEST
- is (scalar($f->()->slurp()), <<'EOF', 'File contents were modified.');
-One
-Two
-Three
-Four
-EOF
-}
diff --git a/old/t/inline_subclass.t b/old/t/inline_subclass.t
deleted file mode 100644
index 70db838..0000000
--- a/old/t/inline_subclass.t
+++ /dev/null
@@ -1,49 +0,0 @@
-use lib 't', 'lib';
-use strict;
-
-package IO::Dumper;
-use IO::All -base;
-use Data::Dumper;
-
-our @EXPORT = 'io';
-
-sub io { return IO::Dumper->new(@_) };
-
-package IO::All::Filesys;
-sub dump {
- my $self = shift;
- $self->print(Data::Dumper::Dumper(@_));
- return $self;
-}
-
-package main;
-use Test::More tests => 5;
-use IO_All_Test;
-
-IO::Dumper->import;
-
-my $hash = {
- red => 'square',
- yellow => 'circle',
- pink => 'triangle',
-};
-
-die if -f 't/output/dump1';
-my $io = io('t/output/dump1')->file->dump($hash);
-ok(-f 't/output/dump1');
-ok($io->close);
-ok(-s 't/output/dump1');
-
-my $VAR1;
-my $a = do 't/output/dump1';
-my $b = eval join('',<DATA>);
-is_deeply($a,$b);
-
-ok($io->unlink);
-
-__END__
-$VAR1 = {
- 'pink' => 'triangle',
- 'red' => 'square',
- 'yellow' => 'circle'
-};
diff --git a/old/t/input.t b/old/t/input.t
deleted file mode 100644
index e80cedc..0000000
--- a/old/t/input.t
+++ /dev/null
@@ -1,49 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 12;
-use IO::All;
-use IO_All_Test;
-
-io('t/input.t') > my $contents;
-test_file_contents($contents, 't/input.t');
-
-$contents < io 't/input.t';
-test_file_contents($contents, 't/input.t');
-
-my $io = io 't/input.t';
-$contents = $$io;
-test_file_contents($contents, 't/input.t');
-
-$contents = $io->slurp;
-test_file_contents($contents, 't/input.t');
-
-$contents = $io->scalar;
-test_file_contents($contents, 't/input.t');
-
-$contents = join '', $io->getlines;
-test_file_contents($contents, 't/input.t');
-
-SKIP: {
- eval {require Tie::File};
- skip "requires Tie::File", 2 if $@;
-
- $io->rdonly;
- $contents = join '', map "$_\n", @$io;
- test_file_contents($contents, 't/input.t');
- $io->close;
-
- $io->tie;
- $contents = join '', <$io>;
- test_file_contents($contents, 't/input.t');
-}
-
-my @lines = io('t/input.t')->slurp;
-ok(@lines > 36);
-test_file_contents(join('', @lines), 't/input.t');
-
-my $old_contents = $contents;
-$contents << io('t/input.t');
-is($contents, $old_contents . $old_contents);
-
-is(io('t/input.t') >> $contents, ($old_contents x 3));
diff --git a/old/t/link.t b/old/t/link.t
deleted file mode 100644
index cb8b4ee..0000000
--- a/old/t/link.t
+++ /dev/null
@@ -1,33 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More;
-use IO::All;
-use IO_All_Test;
-use Cwd qw(abs_path);
-
-my $cwd = abs_path('.');
-eval { symlink("$cwd/lib/IO/All.pm", 't/output/IO-All-file-link') or die $! };
-
-if ($@ or not (-e 't/output/IO-All-file-link' and -l 't/output/IO-All-file-link')) {
- plan skip_all => 'Cannot call symlink on this platform';
-}
-else {
- plan tests => 7;
-}
-
-my $file_link = io('t/output/IO-All-file-link');
-ok($file_link->is_link, 'Link to file is a link (not a file)');
-my $file_target = $file_link->readlink;
-ok(! $file_target->is_link, 'readlink returns file object, not link' );
-is($file_target->filename, 'All.pm', 'link target is expected file' );
-
-symlink("$cwd/lib/IO", 't/output/IO-All-dir-link');
-
-my $dir_link = io('t/output/IO-All-dir-link');
-ok($dir_link->is_link, 'Link to dir is a link (not a dir)');
-my $dir_target = $dir_link->readlink;
-ok(! $dir_target->is_link, 'readlink returns dir object, not link' );
-ok($dir_target->is_dir, 'readlink returns dir object, not link' );
-is($dir_target->filename, 'IO', 'link target is expected dir' );
-
diff --git a/old/t/link2.t b/old/t/link2.t
deleted file mode 100644
index d20269b..0000000
--- a/old/t/link2.t
+++ /dev/null
@@ -1,27 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More;
-use IO::All;
-use IO_All_Test;
-use Cwd qw(abs_path);
-
-my $linkname = 't/output/mylink';
-
-my $cwd = abs_path('.');
-eval { symlink("t/mydir", $linkname) or die $! };
-
-if ($@ or not -l $linkname) {
- plan skip_all => 'Cannot call symlink on this platform';
-}
-else {
- plan tests => 2;
-}
-
-my $io = io($linkname);
-
-my @files = $io->all_files;
-is(scalar @files, 3);
-
- at files = $io->All_Files;
-is(scalar @files, 6);
diff --git a/old/t/lock.t b/old/t/lock.t
deleted file mode 100755
index a3dd70e..0000000
--- a/old/t/lock.t
+++ /dev/null
@@ -1,29 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use IO::All;
-use IO_All_Test;
-
-# XXX This needs to be fixed!!!
-$^O !~ /^(cygwin|hpux)$/
- ? print "1..3\n"
- : do { print "1..0 # skip - locking problems on $^O\n"; exit(0) };
-
-my $io1 = io('t/output/foo')->lock;
-$io1->println('line 1');
-
-fork or do {
- my $io2 = io('t/output/foo')->lock;
- foreach (1 .. 3) {
- print "not " unless($io2->getline eq "line $_\n");
- print "ok $_\n";
- }
- exit;
-};
-
-sleep 1;
-$io1->println('line 2');
-$io1->println('line 3');
-$io1->unlock;
-
-1;
diff --git a/old/t/mldbm.t b/old/t/mldbm.t
deleted file mode 100644
index ef90153..0000000
--- a/old/t/mldbm.t
+++ /dev/null
@@ -1,22 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More;
-use IO::All;
-use IO_All_Test;
-
-plan((eval {require MLDBM; 1})
- ? (tests => 4)
- : (skip_all => "requires MLDBM")
-);
-
-my $io = io('t/output/mldbm')->mldbm('SDBM_File', 'Data::Dumper');
-$io->{test} = { qw( foo foolsgold bar bargain baz bazzarro ) };
-$io->{test2} = [ 1..4 ];
-$io->close;
-
-my $io2 = io('t/output/mldbm')->mldbm('SDBM_File', 'Data::Dumper');
-is(scalar(@{[%$io2]}), 4);
-is(scalar(@{[%{$io2->{test}}]}), 6);
-is($io2->{test}{bar}, 'bargain');
-is($io2->{test2}[3], 4);
diff --git a/old/t/morestuff b/old/t/morestuff
deleted file mode 100644
index 235d45d..0000000
--- a/old/t/morestuff
+++ /dev/null
@@ -1,3 +0,0 @@
-More stuff
-is pure fluff.
-Off the cuff.
diff --git a/old/t/mydir/dir1/dira/dirx/file1 b/old/t/mydir/dir1/dira/dirx/file1
deleted file mode 100644
index 9daeafb..0000000
--- a/old/t/mydir/dir1/dira/dirx/file1
+++ /dev/null
@@ -1 +0,0 @@
-test
diff --git a/old/t/mydir/dir1/file1 b/old/t/mydir/dir1/file1
deleted file mode 100644
index 408fbee..0000000
--- a/old/t/mydir/dir1/file1
+++ /dev/null
@@ -1,2 +0,0 @@
-file1 is fun
-yo
diff --git a/old/t/mydir/dir2/file1 b/old/t/mydir/dir2/file1
deleted file mode 100644
index 408fbee..0000000
--- a/old/t/mydir/dir2/file1
+++ /dev/null
@@ -1,2 +0,0 @@
-file1 is fun
-yo
diff --git a/old/t/mydir/file1 b/old/t/mydir/file1
deleted file mode 100644
index 408fbee..0000000
--- a/old/t/mydir/file1
+++ /dev/null
@@ -1,2 +0,0 @@
-file1 is fun
-yo
diff --git a/old/t/mydir/file2 b/old/t/mydir/file2
deleted file mode 100644
index 8a42343..0000000
--- a/old/t/mydir/file2
+++ /dev/null
@@ -1,2 +0,0 @@
-file2 is woohoo
-yo
diff --git a/old/t/mydir/file3 b/old/t/mydir/file3
deleted file mode 100644
index f54c7ee..0000000
--- a/old/t/mydir/file3
+++ /dev/null
@@ -1,2 +0,0 @@
-file3 is whee
-yo
diff --git a/old/t/mystuff b/old/t/mystuff
deleted file mode 100644
index 7933db9..0000000
--- a/old/t/mystuff
+++ /dev/null
@@ -1,3 +0,0 @@
-My stuff
-is quite enough.
-No bluff.
diff --git a/old/t/new.t b/old/t/new.t
deleted file mode 100644
index 3fa01d5..0000000
--- a/old/t/new.t
+++ /dev/null
@@ -1,16 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 4;
-use IO::All;
-use IO_All_Test;
-
-my $filename = 't/mydir/file1';
-
-my $file = io($filename);
-ok($file->isa('IO::All::File'), 'string passed to io() is returned as a file');
-is($file->name, $filename, 'name() is the same as the string');
-
-my $file2 = io($file);
-ok($file2->isa('IO::All::File'), 'IO::All::File object passed to io() is returned as a file');
-is($file2->name, $filename, 'name() is the same as the original string');
diff --git a/old/t/overload.t b/old/t/overload.t
deleted file mode 100644
index 734ff5a..0000000
--- a/old/t/overload.t
+++ /dev/null
@@ -1,77 +0,0 @@
-use lib 't'; #, 'lib';
-use strict;
-use warnings;
-use Test::More tests => 24;
-use IO_All_Test;
-use IO::All;
-
-unlink('t/output/overload1');
-unlink('t/output/overload2');
-unlink('t/output/overload3');
-
-my $data < io('t/mystuff');
-test_file_contents($data, 't/mystuff');
-my $data1 = $data;
-my $data2 = $data . $data;
-$data << io('t/mystuff');
-is($data, $data2);
-$data < io('t/mystuff');
-is($data, $data1);
-
-io('t/mystuff') > $data;
-test_file_contents($data, 't/mystuff');
-io('t/mystuff') >> $data;
-is($data, $data2);
-io('t/mystuff') > $data;
-is($data, $data1);
-
-$data > io('t/output/overload1');
-test_file_contents($data, 't/output/overload1');
-$data > io('t/output/overload1');
-test_file_contents($data, 't/output/overload1');
-$data >> io('t/output/overload1');
-test_file_contents($data2, 't/output/overload1');
-
-io('t/output/overload1') < $data;
-test_file_contents($data, 't/output/overload1');
-io('t/output/overload1') < $data;
-test_file_contents($data, 't/output/overload1');
-io('t/output/overload1') << $data;
-test_file_contents($data2, 't/output/overload1');
-
-$data > io('t/output/overload1');
-test_file_contents($data, 't/output/overload1');
-io('t/output/overload1') > io('t/output/overload2');
-test_matching_files('t/output/overload1', 't/output/overload2');
-io('t/output/overload3') < io('t/output/overload2');
-test_matching_files('t/output/overload1', 't/output/overload3');
-io('t/output/overload3') << io('t/output/overload2');
-io('t/output/overload1') >> io('t/output/overload2');
-test_matching_files('t/output/overload2', 't/output/overload3');
-test_file_contents($data2, 't/output/overload3');
-
-is(io('foo') . '', 'foo');
-
-is("@{io 't/mydir'}",
- flip_slash
- 't/mydir/dir1 t/mydir/dir2 t/mydir/file1 t/mydir/file2 t/mydir/file3',
-);
-
-is(join(' ', sort keys %{io 't/mydir'}),
- 'dir1 dir2 file1 file2 file3',
-);
-
-is(join(' ', sort map {"$_"} values %{io 't/mydir'}),
- flip_slash
- 't/mydir/dir1 t/mydir/dir2 t/mydir/file1 t/mydir/file2 t/mydir/file3',
-);
-
-${io('t/mystuff')} . ${io('t/mystuff')} > io('t/output/overload1');
-test_file_contents2('t/output/overload1', $data2);
-
-${io('t/mystuff')} . "xxx\n" . ${io('t/mystuff')} > io('t/output/overload1');
-$data < io('t/mystuff');
-my $cat3 = $data . "xxx\n" . $data;
-test_file_contents2('t/output/overload1', $cat3);
-
-is "" . ${io("t")}, "t", "scalar overload of directory (for mst)";
diff --git a/old/t/pipe.t b/old/t/pipe.t
deleted file mode 100644
index d5b18d8..0000000
--- a/old/t/pipe.t
+++ /dev/null
@@ -1,13 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 4;
-use IO::All;
-
-my $perl_version < io('perl -v|');
-ok($perl_version =~ /Larry Wall/);
-ok($perl_version =~ /This is perl/);
-
-io("$^X -v|") > $perl_version;
-ok($perl_version =~ /Larry Wall/);
-ok($perl_version =~ /This is p(erl|onie)/);
diff --git a/old/t/print.t b/old/t/print.t
deleted file mode 100644
index ce83bd0..0000000
--- a/old/t/print.t
+++ /dev/null
@@ -1,11 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 2;
-use IO::All;
-use IO_All_Test;
-
-my $io1 = io('t/output/print.t');
-is($io1->print("one\n")->print("two\n")->close->scalar, "one\ntwo\n");
-my $io2 = io('t/output/print.t');
-is($io2->println("one")->println("two")->close->scalar, "one\ntwo\n");
diff --git a/old/t/println.t b/old/t/println.t
deleted file mode 100644
index 4946045..0000000
--- a/old/t/println.t
+++ /dev/null
@@ -1,15 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 1;
-use IO::All;
-use IO_All_Test;
-
-my $io = io('t/println.t');
-my @lines = map {chomp; $_} $io->slurp;
-my $temp = io('?');
-$temp->println(@lines);
-$temp->seek(0, 0);
-my $text = $temp->slurp;
-
-test_file_contents($text, 't/println.t');
diff --git a/old/t/read.t b/old/t/read.t
deleted file mode 100644
index f91118b..0000000
--- a/old/t/read.t
+++ /dev/null
@@ -1,22 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 8;
-use IO::All;
-use IO_All_Test;
-
-my $outfile = 't/out.pm';
-ok(not -f $outfile);
-my $input = io('lib/IO/All.pm')->open;
-ok(ref $input);
-my $output = io($outfile)->open('>');
-ok(ref $output);
-my $buffer;
-$input->buffer($buffer);
-$output->buffer($buffer);
-ok(defined $buffer);
-$output->write while $input->read;
-ok(not length($buffer));
-ok($output->close);
-test_matching_files($outfile, 'lib/IO/All.pm');
-ok($output->unlink);
diff --git a/old/t/read_write.t b/old/t/read_write.t
deleted file mode 100644
index 9959de7..0000000
--- a/old/t/read_write.t
+++ /dev/null
@@ -1,13 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 2;
-use IO::All;
-use IO_All_Test;
-
-my $io = io('lib/IO/All.pm');
-my $buffer;
-$io->buffer($buffer);
-1 while $io->read;
-ok(length($buffer));
-test_file_contents($buffer, 'lib/IO/All.pm');
diff --git a/old/t/round_robin.t b/old/t/round_robin.t
deleted file mode 100644
index 76df4cb..0000000
--- a/old/t/round_robin.t
+++ /dev/null
@@ -1,26 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 9;
-use IO::All;
-
-my $io = io('t/mystuff');
-my $x = 0;
-while (my $line = $io->getline || $io->getline) {
- my $expected = <DATA>;
- is($line, $expected);
- last if ++$x >= 8;
-}
-
-is(<DATA>, "last line\n");
-
-__DATA__
-My stuff
-is quite enough.
-No bluff.
-My stuff
-is quite enough.
-No bluff.
-My stuff
-is quite enough.
-last line
diff --git a/old/t/rt-41819.t b/old/t/rt-41819.t
deleted file mode 100644
index 1b214f6..0000000
--- a/old/t/rt-41819.t
+++ /dev/null
@@ -1,11 +0,0 @@
-use Test::More;
-use IO::All;
-
-plan 'skip_all' unless -d '/dev';
-plan tests => 1;
-
-my $io = io('/dev');
-my $path;
-
-my $f = $path->name while ($path = $io->next());
-pass 'It works now';
diff --git a/old/t/scalar.t b/old/t/scalar.t
deleted file mode 100644
index 7d41c52..0000000
--- a/old/t/scalar.t
+++ /dev/null
@@ -1,11 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 2;
-use IO::All;
-use IO_All_Test;
-
-my $io = io('t/scalar.t');
-my @list = $io->scalar;
-ok(@list == 1);
-test_file_contents($list[0], 't/scalar.t');
diff --git a/old/t/seek.t b/old/t/seek.t
deleted file mode 100644
index a0c0af3..0000000
--- a/old/t/seek.t
+++ /dev/null
@@ -1,11 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 1;
-use IO::All;
-use IO_All_Test;
-
-my $string < (io('t/mystuff') > io('t/output/seek'));
-my $io = io('t/output/seek');
-$io->seek(index($string, 'quite'), 0);
-is($io->getline, "quite enough.\n");
diff --git a/old/t/separator.t b/old/t/separator.t
deleted file mode 100644
index 05e10d9..0000000
--- a/old/t/separator.t
+++ /dev/null
@@ -1,20 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 4;
-use IO::All;
-use IO_All_Test;
-
-join('', <DATA>) > io('t/output/separator1');
-my $io = io('t/output/separator1');
-$io->separator('t');
-my @chunks = $io->slurp;
-is(scalar @chunks, 3);
-is($chunks[0], "one\nt");
-is($chunks[1], "wo\nt");
-is($chunks[2], "hree\nfour\n");
-__DATA__
-one
-two
-three
-four
diff --git a/old/t/stat.t b/old/t/stat.t
deleted file mode 100644
index 0776dbb..0000000
--- a/old/t/stat.t
+++ /dev/null
@@ -1,27 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 14;
-use IO::All;
-use IO_All_Test;
-
-my ($dev, $ino, $modes, $nlink, $uid, $gid, $rdev,
- $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat('t/stat.t');
-
-my $io = io('t/stat.t');
-is($io->device, $dev);
-is($io->inode, $ino);
-is($io->modes, $modes);
-is($io->nlink, $nlink);
-is($io->uid, $uid);
-is($io->gid, $gid);
-is($io->device_id, $rdev);
-is($io->size, $size);
-ok(($io->atime == $atime) || ($io->atime == ($atime+1)));
-is($io->mtime, $mtime);
-is($io->ctime, $ctime);
-is($io->blksize, $blksize);
-is($io->blocks, $blocks);
-
-my @stat = $io->stat;
-ok(defined $stat[0]);
diff --git a/old/t/string_open.t b/old/t/string_open.t
deleted file mode 100644
index 797056d..0000000
--- a/old/t/string_open.t
+++ /dev/null
@@ -1,14 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 1;
-use IO::All;
-use IO_All_Test;
-
-my $s = io('$');
-$s->append("write 1\n");
-my $s1 = "IO::String ref: (".$s->string_ref.")";
-$s->append("write 2\n");
-my $s2 = "IO::String ref: (".$s->string_ref.")";
-
-is($s1, $s2, "Don't create new string object with each write");
diff --git a/old/t/subtleties.t b/old/t/subtleties.t
deleted file mode 100644
index a1655f7..0000000
--- a/old/t/subtleties.t
+++ /dev/null
@@ -1,27 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 7;
-use IO::All;
-
-my $data = join '', <DATA>;
-my $io = io('t/output/subtleties1') < $data;
-is("$io", 't/output/subtleties1');
-
-ok($io->close);
-ok(not $io->close);
-
-my $data2 = $io->slurp;
-$data2 .= $$io;
-$data2 << $io;
-is($data2, $data x 3);
-ok(not $io->close);
-
-my $io2 = io(io(io('xxx')));
-ok(ref $io2);
-ok($io2->isa('IO::All'));
-# is("$io2", 'xxx');
-
-__DATA__
-test
-data
diff --git a/old/t/synopsis1.t b/old/t/synopsis1.t
deleted file mode 100644
index 3529348..0000000
--- a/old/t/synopsis1.t
+++ /dev/null
@@ -1,17 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 6;
-use IO::All;
-use IO_All_Test;
-
-# Combine two files into a third
-my $my_stuff = io('t/mystuff')->slurp;
-test_file_contents($my_stuff, 't/mystuff');
-my $more_stuff << io('t/morestuff');
-test_file_contents($more_stuff, 't/morestuff');
-io('t/allstuff')->print($my_stuff, $more_stuff);
-ok(-f 't/allstuff');
-ok(-s 't/allstuff');
-test_file_contents($my_stuff . $more_stuff, 't/allstuff');
-ok(unlink('t/allstuff'));
diff --git a/old/t/synopsis2.t b/old/t/synopsis2.t
deleted file mode 100644
index 0d5112f..0000000
--- a/old/t/synopsis2.t
+++ /dev/null
@@ -1,36 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 10;
-use IO::All;
-use IO_All_Test;
-
-# Print name and first line of all files in a directory
-my $dir = io('t/mydir');
-ok($dir->is_dir);
-my @results;
-while (my $io = $dir->next) {
- if ($io->is_file) {
- push @results, $io->name . ' - ' . $io->getline;
- }
-}
-
-for my $line (sort @results) {
- is($line, flip_slash scalar <DATA>);
-}
-
-# Print name of all files recursively
-is("$_\n", flip_slash scalar <DATA>)
- for sort {$a->name cmp $b->name}
- grep {! /CVS|\.svn/} io('t/mydir')->all_files(0);
-
-__END__
-t/mydir/file1 - file1 is fun
-t/mydir/file2 - file2 is woohoo
-t/mydir/file3 - file3 is whee
-t/mydir/dir1/dira/dirx/file1
-t/mydir/dir1/file1
-t/mydir/dir2/file1
-t/mydir/file1
-t/mydir/file2
-t/mydir/file3
diff --git a/old/t/synopsis3.t b/old/t/synopsis3.t
deleted file mode 100644
index 9a96b14..0000000
--- a/old/t/synopsis3.t
+++ /dev/null
@@ -1,52 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More;
-use IO_All_Test;
-use Config;
-
-plan((eval {require IO::String; 1})
- ? (tests => 3)
- : (skip_all => "requires IO::String")
-);
-
-sub fix {
- local $_ = shift;
- if ($^O eq 'MSWin32') {
- s/"/'/g;
- return qq{"$_"};
- }
- return qq{'$_'};
-}
-
-undef $/;
-# # Copy STDIN to STDOUT
-# io('-')->print(io('-')->slurp);
-my $test1 = fix 'io("-")->print(io("-")->slurp)';
-open TEST, '-|', qq{$^X -Ilib -MIO::All -e $test1 < t/mystuff}
- or die "open failed: $!";
-test_file_contents(<TEST>, 't/mystuff');
-close TEST;
-
-# # Copy STDIN to STDOUT a block at a time
-# my $stdin = io('-');
-# my $stdout = io('-');
-# $stdout->buffer($stdin->buffer);
-# $stdout->write while $stdin->read;
-my $test2 = fix 'my $stdin = io("-");my $stdout = io("-");$stdout->buffer($stdin->buffer);$stdout->write while $stdin->read';
-open TEST, '-|', qq{$^X -Ilib -MIO::All -e $test2 < t/mystuff}
- or die "open failed: $!";
-test_file_contents(<TEST>, 't/mystuff');
-close TEST;
-
-# # Copy STDIN to a String File one line at a time
-# my $stdin = io('-');
-# my $string_out = io('$');
-# while (my $line = $stdin->getline) {
-# $string_out->print($line);
-# }
-my $test3 = fix 'my $stdin = io("-");my $string_out = io(q{$});while (my $line = $stdin->getline("")) {$string_out->print($line)} print ${$string_out->string_ref}';
-open TEST, '-|', qq{$^X -Ilib -MIO::All -e $test3 < t/mystuff}
- or die "open failed: $!";
-test_file_contents(<TEST>, 't/mystuff');
-close TEST;
diff --git a/old/t/synopsis5.t b/old/t/synopsis5.t
deleted file mode 100644
index f1ccf97..0000000
--- a/old/t/synopsis5.t
+++ /dev/null
@@ -1,15 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 3;
-use IO::All;
-
-# Write some data to a temporary file and retrieve all the paragraphs.
-my $data = io('t/synopsis5.t')->slurp;
-
-my $temp = io->temp;
-ok($temp->print($data));
-ok($temp->seek(0, 0));
-
-my @paragraphs = $temp->getlines('');
-is(scalar @paragraphs, 4);
diff --git a/old/t/text.big5 b/old/t/text.big5
deleted file mode 100644
index 6d1b36c..0000000
--- a/old/t/text.big5
+++ /dev/null
@@ -1,2 +0,0 @@
-We are noticing that our Big5 greeting ---
-�A�n, �ڬO��������Ǫ�����y���X���t�� --- is being garbled in
diff --git a/old/t/text.utf8 b/old/t/text.utf8
deleted file mode 100644
index 6d30845..0000000
--- a/old/t/text.utf8
+++ /dev/null
@@ -1,2 +0,0 @@
-We are noticing that our Big5 greeting ---
-你好, 我是貝爾實驗室的中文語音合成系統 --- is being garbled in
diff --git a/old/t/tie.t b/old/t/tie.t
deleted file mode 100644
index 8e99749..0000000
--- a/old/t/tie.t
+++ /dev/null
@@ -1,10 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 1;
-use IO::All;
-use IO_All_Test;
-
-my $io = io('t/tie.t')->tie;
-my $file = join '', <$io>;
-test_file_contents($file, 't/tie.t');
diff --git a/old/t/tie_file.t b/old/t/tie_file.t
deleted file mode 100644
index dbf327c..0000000
--- a/old/t/tie_file.t
+++ /dev/null
@@ -1,24 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More;
-use IO_All_Test;
-use IO::All;
-
-plan((eval {require Tie::File; 1})
- ? (tests => 2)
- : (skip_all => "requires Tie::File")
-);
-
-(io('t/output/tie_file1') < io('t/tie_file.t'))->close;
-my $file = io('t/output/tie_file1')->rdonly;
-is($file->[-1], 'bar');
-is($file->[-2], 'foo');
-
-"foo\n" x 3 > io('t/output/tie_file2');
-io('t/output/tie_file2')->[1] = 'bar';
-
-
-__END__
-foo
-bar
diff --git a/old/t/xxx.t b/old/t/xxx.t
deleted file mode 100644
index 4dbd534..0000000
--- a/old/t/xxx.t
+++ /dev/null
@@ -1,20 +0,0 @@
-use lib 't', 'lib';
-use strict;
-use warnings;
-use Test::More tests => 1;
-
-use IO::All;
-use IO::All::Temp;
-use IO::All::String;
-use IO::All::Socket;
-use IO::All::MLDBM;
-use IO::All::Link;
-use IO::All::Pipe;
-use IO::All::Dir;
-use IO::All::Filesys;
-use IO::All::File;
-use IO::All::DBM;
-use IO::All::STDIO;
-use IO::All::Base;
-
-is($INC{'XXX.pm'}, undef, "Don't ship with XXX");
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libio-all-perl.git
More information about the Pkg-perl-cvs-commits
mailing list