Alien-Selenium

 view release on metacpan or  search on metacpan

inc/File/Fetch/Item.pm  view on Meta::CPAN

                    return $self->{$method};
                }
}

sub new {
    my $class = shift;
    my %hash  = @_;
    
    my $args = check( $Tmpl, \%hash ) or return;
    
    bless $args, $class;

    if( lc($args->scheme) ne 'file' and not $args->host ) {
        warn "Hostname required when fetching from '".$args->scheme."'\n";
        return;
    }
    
    for (qw[path file]) {
        unless( $args->$_ ) {
            warn "No '$_' specified\n";
            return;

inc/My/Module/Build.pm  view on Meta::CPAN

=cut

package My::Module::Build::PmFilter;

=item I<new()>

Object constructor. Does nothing in the base class.

=cut

sub new { bless {}, shift }

=item I<filter($line)>

Given $line, a line read from a .pm file in lib, returns a piece of
text that L</process_pm_file_if_modified> should replace this line
with.  Note that it is perfectly appropriate for a filter
implementation to buffer stuff, and therefore not always return
something from I<filter>.

The base class does not buffer. Rather, it substitutes standard

inc/My/Module/Build.pm  view on Meta::CPAN

# Module::Build plug-in, a simple cut-n-paste operation will do the
# job.
do {
    # We re-route the process of creating a Module::Build object to
    # a fake package, so as not to make Module::Build itself part
    # of the tests over the dependent graph stuff:
    local @My::Module::Build::ISA=qw(Fake::Module::Build);

    package Fake::Module::Build;

    sub new { bless {}, shift }

    # Various stuff that is being called by My::Module::Build as part
    # of this test, and that we therefore need to stub out:
    no warnings "redefine";
    local *My::Module::Build::maintainer_mode_enabled = sub { 0 };
    local *My::Module::Build::subclass = sub {
        my ($self, %opts) = @_;
        eval <<'HEADER' . $opts{code}; die $@ if $@;

package Fake::Subclass;

inc/My/Tests/Below.pm  view on Meta::CPAN

## Creates an instance of My::Tests::Below from a source file
## that has tests at the bottom.
sub _parse {
    my ($class, $fd, $package, $packfilename, $packline) = @_;

    if (!defined $package) { # Handle self-testing case
        $package="My::Tests::Below";
        $0 =~ m/^(.*)$/; $packfilename = $1;
    }

    my $self = bless {
                      package => $package,
                      packfilename => $packfilename
                     }, $class;

    $self->{testsuite} = do { no warnings; scalar <$fd> };
    return undef if ! defined $self->{testsuite};
    $self->{testsuite} .= join('',<$fd>); # The rest of it

=head2 Comfort features

inc/My/Tests/Below.pm  view on Meta::CPAN

  my $zoinx = new Zoinx;

  =for My::Tests::Below "create-zoinx" end

  =cut

  package Zoinx;

  sub new {
      bless {}, "Zoinx";
  }

  require My::Tests::Below unless caller;

=for My::Tests::Below "reflection is a fun thing" end

=for great "justice"

  __END__

inc/My/Tests/Below.pm  view on Meta::CPAN

$result = run_perl($fakemodule);
is($?, 255 << 8, "Exited with return code 255\n");
like($result, qr/Looks like your test died just after/, "Test died");

######## POD snippets

my $snippet = My::Tests::Below->pod_data_snippet
        ("reflection is a fun thing");
like($snippet, qr/^package Zoinx/m, "pod_data_snippet");
unlike($snippet, qr/reflection/, "Pod delimiters should be cut out");
like($snippet, qr/^    bless/m, "smart ragging");

eval $snippet; die $@ if $@; pass("Created package Zoinx");

my $testsnippet =
    My::Tests::Below->pod_code_snippet("POD testing example");

no warnings "redefine"; local *My::Tests::Below::pod_code_snippet = sub {
    is($_[1], 'create-zoinx',
       "hijacked sub pod_code_snippet() called as expected");
    # Real men would invoke My::Tests::Below recursively here...

inc/Pod/Snippets.pm  view on Meta::CPAN

constructs.  In any case, the parser will soldier on until the end of
the file regardless of the number of errors seen; however, it will
disallow further processing of the snippets if there were any errors
(see L</errors>).

=cut

sub load {
    my ($class, $source, @opts) = @_;

    my $self = bless {}, $class;
    $self->{start_line} = 1;
    $self->{filename} = "$source" unless (ref($source) eq "GLOB" ||
                                          eval { $source->can("getline") });
    undef $@;

    # Grind the syntactic sugar to dust:
    my %opts = (-line => 1, -filename => $self->filename,
                -report_errors => sub {
                    my ($severity, $text, $file, $line) = @_;
                    warn <<"MESSAGE";

inc/Pod/Snippets.pm  view on Meta::CPAN

sub parse {
    my ($class, $string, @args) = @_;
    return $class->load(Pod::Snippets::LineFeeder->new($string), @args);

    package Pod::Snippets::LineFeeder;

    sub new {
        my ($class, $string) = @_;
        my $nl = $/; # Foils smarter-than-thou regex parser
        return bless { lines => [ $string =~ m{(.*(?:$nl|$))}g ] };
    }
    sub getline { shift @{shift->{lines}} }
}

=head1 ACCESSORS

=head2 filename ()

Returns the name of the file to use for C<#line> lines in L</as_code>.
The default behavior is to use the filename passed as the $source

inc/Pod/Snippets.pm  view on Meta::CPAN

=cut

sub named {
    my ($self, $name) = @_;
    $self->_block_access_if_errors();
    my @snippets_with_this_name = grep {
             !defined($_) || $_->names_set->{$name}
         } (@{$self->{unmerged_snippets}});
    return if ! grep { defined } @snippets_with_this_name;
    return bless
        {
         unmerged_snippets => \@snippets_with_this_name,
         map { exists $self->{$_} ? ($_ => $self->{$_}) : () }
         (qw(warnings errors filename start_line) )
         # Purposefully do not transfer other fields such as
         # ->{merged_snippets}
        }, ref($self);
}

=begin internals

inc/Pod/Snippets.pm  view on Meta::CPAN

there may be extraneous whitespace at the beginning and end, and the
ragging is not performed.  $names_set is a reference to a set (that
is, a hash where only the boolean status of the values matter) of all
snippet names that are in scope for this snippet.

=cut

sub new {
    my ($class, $lineno, $rawtext, $names_set) = @_;

    return bless {
                  line => $lineno,
                  text => $rawtext,
                  names => $names_set,
                 }, $class;
}

=head3 stringify ()

Returns the snippet text.  This is also what happens when one
evaluatess the snippet object as a string.

inc/Pod/Snippets.pm  view on Meta::CPAN

Computes and returns a new snippet that has extra $text appended at
the end.  This is also what happens when one uses the L<perlop/.>
operator on a snippet.

=cut

use overload '.' => "append_text";
sub append_text {
    my ($self, $text) = @_;
    return bless {
                  text => "$self->{text}" . "$text",
                  map { ($_ => $self->{$_}) } (qw(line names)),
                 }, ref($self);
}

=head3 names_set ()

Returns the $names_set parameter to L</new>.

=cut