Alt-IO-All-new

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

        *   Often they return themselves ($self) for chaining

    *   IO::All needs to be completely and consistently extensible

        *   The extensions that ship with IO-All should be the same as third
            party extensions

        *   Plugins register capabilities with IO::All (tied to a scope)

    *   IO::All operations can be strict or loose. Strict always throws
        errors on any possible error condition. Strict or loose should be
        determined by the presence of "use strict" in the scope (possibly).

    *   IO::All currently uses a big set of overloaded operations by
        default. This is loved by some and hated by others. It should
        probably be off by default for 2.0.

"IO::ALL" PLUGINS
    Currently the extension API is fairly muddy. I would like the new API to
    require something like this:

inc/Pegex/Parser.pm  view on Meta::CPAN

has grammar => (required => 1);
has receiver => ();
has input => ();
has debug => (
    exists($ENV{PERL_PEGEX_DEBUG}) ? $ENV{PERL_PEGEX_DEBUG} :
    defined($Pegex::Parser::Debug) ? $Pegex::Parser::Debug :
    0
);
sub BUILD {
    my ($self) = @_;
    $self->{throw_on_error} ||= 1;
    # $self->{rule} = undef;
    # $self->{parent} = undef;
    # $self->{error} = undef;
    # $self->{position} = undef;
    # $self->{farthest} = undef;
}

# XXX Add an optional $position argument. Default to 0. This is the position
# to start parsing. Set position and farthest below to this value. Allows for
# sub-parsing. Need to somehow return the finishing position of a subparse.

inc/Pegex/Parser.pm  view on Meta::CPAN

    }

    my $match = $self->debug ? do {
        my $method = $optimizer->make_trace_wrapper(\&match_ref);
        $self->$method($start_rule_ref, {'+asr' => 0});
    } : $self->match_ref($start_rule_ref, {});

    $self->{input}->close;

    if (not $match or $self->{position} < length ${$self->{buffer}}) {
        $self->throw_error("Parse document failed for some reason");
        return;  # In case $self->throw_on_error is off
    }

    if ($self->{receiver}->can("final")) {
        $self->{rule} = $start_rule_ref;
        $self->{parent} = {};
        $match = [ $self->{receiver}->final(@$match) ];
    }

    $match->[0];
}

inc/Pegex/Parser.pm  view on Meta::CPAN

    for my $elem (@$list) {
        if (my $match = $self->match_next($elem)) {
            return $match;
        }
    }
    return;
}

sub match_err {
    my ($self, $error) = @_;
    $self->throw_error($error);
}

sub trace {
    my ($self, $action) = @_;
    my $indent = ($action =~ /^try_/) ? 1 : 0;
    $self->{indent} ||= 0;
    $self->{indent}-- unless $indent;
    print STDERR ' ' x $self->{indent};
    $self->{indent}++ if $indent;
    my $snippet = substr(${$self->{buffer}}, $self->{position});
    $snippet = substr($snippet, 0, 30) . "..."
        if length $snippet > 30;
    $snippet =~ s/\n/\\n/g;
    print STDERR sprintf("%-30s", $action) .
        ($indent ? " >$snippet<\n" : "\n");
}

sub throw_error {
    my ($self, $msg) = @_;
    $@ = $self->{error} = $self->format_error($msg);
    return undef unless $self->{throw_on_error};
    require Carp;
    Carp::croak($self->{error});
}

sub format_error {
    my ($self, $msg) = @_;
    my $buffer = $self->{buffer};
    my $position = $self->{farthest};
    my $real_pos = $self->{position};

lib/Alt/IO/All/new.pod  view on Meta::CPAN

=item * IO::All needs to be completely and consistently extensible

=over

=item * The extensions that ship with IO-All should be the same as third party extensions

=item * Plugins register capabilities with IO::All (tied to a scope)

=back

=item * IO::All operations can be strict or loose. Strict always throws errors on any possible error condition. Strict or loose should be determined by the presence of C<use strict> in the scope (possibly).

=item * IO::All currently uses a big set of overloaded operations by default. This is loved by some and hated by others. It should probably be off by default for 2.0.

=back

=head1 C<IO::ALL> PLUGINS

Currently the extension API is fairly muddy. I would like the new API to
require something like this:

lib/IO/All.pm  view on Meta::CPAN

    my $class = shift;
    my $caller = caller;
    no strict 'refs';
    *{"${caller}::io"} = $class->make_constructor(@_);
}

sub make_constructor {
    my $class = shift;
    my $scope_args = $class->parse_args(@_);
    return sub {
        $class->throw("'io' constructor takes zero or one arguments")
            if @_ > 1;
        my $location = @_ ? shift(@_) : undef;
        $class->new([-location => $location], @$scope_args);
    };
}

{
    no warnings 'redefine';
    sub new {
        my $class = shift;
        my $self = bless {}, $class;
        for (@_) {
            my $property = shift(@$_);
            $property =~ s/^-//;
            $self->$property(@$_);
        }
        for my $plugin_class (@{$self->plugin_classes}) {
            eval "require $plugin_class; 1"
                or $self->throw("Can't require $plugin_class: $@");
            $self->register_methods($plugin_class);
            $self->register_overloads($plugin_class);
            if ($plugin_class->can_upgrade($self)) {
                $self->rebless($plugin_class);
                last;
            }
        }
        return $self;
    }
}

lib/IO/All.pm  view on Meta::CPAN

}

sub register_overloads {
    my ($self, $plugin_class) = @_;
}

sub AUTOLOAD {
    my $self = shift;
    (my $method = $IO::All::AUTOLOAD) =~ s/.*:://;
    my $plugin_class = $self->methods->{$method}
        or $self->throw(
            "Can't locate object method '$method' for '$self' object"
        );
    $self->rebless($plugin_class);
    $self->$method(@_);
}

sub rebless {
    my ($self, $plugin_class) = @_;
    delete $self->{plugin_classes};
    bless $self, $plugin_class;

lib/IO/All/Base.pm  view on Meta::CPAN

                ref($default) eq 'HASH' ? {} :
                $default;
          }
          return $self->{$field} unless @_;
          $self->{$field} = shift;
      };
}

package IO::All::OO::Object;

sub throw {
    my $self = shift;
    require Carp;
    Carp::croak(@_);
}

1;

lib/IO/All/Dir.pm  view on Meta::CPAN

    $self->name(shift) if @_;
    return $self;
}

sub mkdir {
    my ($self) = @_;
    my $name = $self->name;
    my $strict = $self->{_strict};
    if (-d $name) {
        return unless $strict;
        $self->throw("Can't mkdir $name. Directory already exists.");
    }
    CORE::mkdir($name) or $self->throw("mkdir $name failed: $!");
}

1;

t/expectations.t  view on Meta::CPAN

Plan = 4;

setup(*setup).eval_perl(*perl, *expect).Catch == *expect;

setup('rm -f foo');

=== foo doesn't exist
--- setup: rm -f foo
--- perl: io('foo')->appends
--- expect: throws exception

=== foo does exist
--- setup: touch foo
--- perl: io('foo')->create
--- expect: throws exception

# maybe require ->strict for those two:

=== foo doesn't exist
--- setup: rm foo
--- perl: io('foo')->strict->append
--- expect: definitely dies

=== foo does exist
--- setup: touch foo