parser.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

package TAP::Parser;

use strict;
use vars qw($VERSION @ISA);

use TAP::Base                 ();
use TAP::Parser::Grammar      ();
use TAP::Parser::Result       ();
use TAP::Parser::Source       ();
use TAP::Parser::Source::Perl ();
use TAP::Parser::Iterator     ();
use Carp                      ();

@ISA = qw(TAP::Base);

=head1 NAME

TAP::Parser - Parse L<TAP|Test::Harness::TAP> output

=head1 VERSION

Version 3.07

=cut

$VERSION = '3.07';

my $DEFAULT_TAP_VERSION = 12;
my $MAX_TAP_VERSION     = 13;

$ENV{TAP_VERSION} = $MAX_TAP_VERSION;

END {

    # For VMS.
    delete $ENV{TAP_VERSION};
}

BEGIN {    # making accessors
    foreach my $method (
        qw(
        _stream
        _spool
        _grammar
        exec
        exit
        is_good_plan
        plan
        tests_planned
        tests_run
        wait
        version
        in_todo
        start_time
        end_time
        skip_all
        )
      )
    {
        no strict 'refs';

        # another tiny performance hack
        if ( $method =~ /^_/ ) {
            *$method = sub {
                my $self = shift;
                return $self->{$method} unless @_;

                # Trusted methods
                unless ( ( ref $self ) =~ /^TAP::Parser/ ) {
                    Carp::croak("$method() may not be set externally");
                }

                $self->{$method} = shift;
            };
        }
        else {
            *$method = sub {
                my $self = shift;
                return $self->{$method} unless @_;
                $self->{$method} = shift;
            };
        }
    }
}    # done making accessors

=head1 SYNOPSIS

    use TAP::Parser;

    my $parser = TAP::Parser->new( { source => $source } );

    while ( my $result = $parser->next ) {
        print $result->as_string;
    }

=head1 DESCRIPTION

C<TAP::Parser> is designed to produce a proper parse of TAP output. For
an example of how to run tests through this module, see the simple
harnesses C<examples/>.

There's a wiki dedicated to the Test Anything Protocol:

L<http://testanything.org>

It includes the TAP::Parser Cookbook:

L<http://testanything.org/wiki/index.php/TAP::Parser_Cookbook>

=head1 METHODS

=head2 Class Methods

=head3 C<new>

 my $parser = TAP::Parser->new(\%args);

Returns a new C<TAP::Parser> object.

The arguments should be a hashref with I<one> of the following keys:

=over 4

=item * C<source>

This is the preferred method of passing arguments to the constructor.  To
determine how to handle the source, the following steps are taken.

If the source contains a newline, it's assumed to be a string of raw TAP
output.

If the source is a reference, it's assumed to be something to pass to
the L<TAP::Parser::Iterator::Stream> constructor. This is used
internally and you should not use it.

Otherwise, the parser does a C<-e> check to see if the source exists.  If so,
it attempts to execute the source and read the output as a stream.  This is by
far the preferred method of using the parser.

 foreach my $file ( @test_files ) {
     my $parser = TAP::Parser->new( { source => $file } );
     # do stuff with the parser
 }

=item * C<tap>

The value should be the complete TAP output.

=item * C<exec>

If passed an array reference, will attempt to create the iterator by
passing a L<TAP::Parser::Source> object to
L<TAP::Parser::Iterator::Source>, using the array reference strings as
the command arguments to L<IPC::Open3::open3|IPC::Open3>:

 exec => [ '/usr/bin/ruby', 't/my_test.rb' ]

Note that C<source> and C<exec> are mutually exclusive.

=back

The following keys are optional.

=over 4

=item * C<callback>

If present, each callback corresponding to a given result type will be called
with the result as the argument if the C<run> method is used:

 my %callbacks = (
     test    => \&test_callback,
     plan    => \&plan_callback,
     comment => \&comment_callback,
     bailout => \&bailout_callback,
     unknown => \&unknown_callback,
 );

 my $aggregator = TAP::Parser::Aggregator->new;
 foreach my $file ( @test_files ) {
     my $parser = TAP::Parser->new(
         {
             source    => $file,
             callbacks => \%callbacks,
         }
     );
     $parser->run;
     $aggregator->add( $file, $parser );
 }

=item * C<switches>

If using a Perl file as a source, optional switches may be passed which will
be used when invoking the perl executable.

 my $parser = TAP::Parser->new( {
     source   => $test_file,
     switches => '-Ilib',
 } );

=item * C<test_args>

Used in conjunction with the C<source> option to supply a reference to
an C<@ARGV> style array of arguments to pass to the test program.

=item * C<spool>

If passed a filehandle will write a copy of all parsed TAP to that handle.

=item * C<merge>

If false, STDERR is not captured (though it is 'relayed' to keep it
somewhat synchronized with STDOUT.)

If true, STDERR and STDOUT are the same filehandle.  This may cause
breakage if STDERR contains anything resembling TAP format, but does
allow exact synchronization.

Subtleties of this behavior may be platform-dependent and may change in
the future.

=back

=cut

# new implementation supplied by TAP::Base

##############################################################################

=head2 Instance Methods

=head3 C<next>

  my $parser = TAP::Parser->new( { source => $file } );
  while ( my $result = $parser->next ) {
      print $result->as_string, "\n";
  }

This method returns the results of the parsing, one result at a time.  Note
that it is destructive.  You can't rewind and examine previous results.

If callbacks are used, they will be issued before this call returns.

Each result returned is a subclass of L<TAP::Parser::Result>.  See that
module and related classes for more information on how to use them.

=cut

sub next {
    my $self = shift;
    return ( $self->{_iter} ||= $self->_iter )->();
}

##############################################################################

=head3 C<run>

  $parser->run;

This method merely runs the parser and parses all of the TAP.

=cut

sub run {
    my $self = shift;
    while ( defined( my $result = $self->next ) ) {

        # do nothing
    }
}

{

    # of the following, anything beginning with an underscore is strictly
    # internal and should not be exposed.
    my %initialize = (
        version       => $DEFAULT_TAP_VERSION,
        plan          => '',                    # the test plan (e.g., 1..3)
        tap           => '',                    # the TAP
        tests_run     => 0,                     # actual current test numbers
        results       => [],                    # TAP parser results
        skipped       => [],                    #
        todo          => [],                    #
        passed        => [],                    #
        failed        => [],                    #
        actual_failed => [],                    # how many tests really failed
        actual_passed => [],                    # how many tests really passed
        todo_passed  => [],    # tests which unexpectedly succeed
        parse_errors => [],    # perfect TAP should have none
    );

    # We seem to have this list hanging around all over the place. We could
    #聽probably get it from somewhere else to avoid the repetition.
    my @legal_callback = qw(
      test
      version
      plan
      comment
      bailout
      unknown
      yaml
      ALL
      ELSE
      EOF
    );

    sub _initialize {
        my ( $self, $arg_for ) = @_;

        # everything here is basically designed to convert any TAP source to a
        # stream.

        # Shallow copy
        my %args = %{ $arg_for || {} };

        $self->SUPER::_initialize( \%args, \@legal_callback );

        my $stream    = delete $args{stream};
        my $tap       = delete $args{tap};
        my $source    = delete $args{source};
        my $exec      = delete $args{exec};
        my $merge     = delete $args{merge};
        my $spool     = delete $args{spool};
        my $switches  = delete $args{switches};
        my @test_args = @{ delete $args{test_args} || [] };

        if ( 1 < grep {defined} $stream, $tap, $source, $exec ) {
            $self->_croak(
                "You may only choose one of 'exec', 'stream', 'tap' or 'source'"
            );
        }

        if ( my @excess = sort keys %args ) {
            $self->_croak("Unknown options: @excess");
        }

        if ($tap) {
            $stream = TAP::Parser::Iterator->new( [ split "\n" => $tap ] );
        }
        elsif ($exec) {
            my $source = TAP::Parser::Source->new;
            $source->source( [ @$exec, @test_args ] );
            $source->merge($merge);    # XXX should just be arguments?
            $stream = $source->get_stream;
        }
        elsif ($source) {
            if ( my $ref = ref $source ) {
                $stream = TAP::Parser::Iterator->new($source);
            }
            elsif ( -e $source ) {

                my $perl = TAP::Parser::Source::Perl->new;

                $perl->switches($switches)
                  if $switches;

                $perl->merge($merge);    # XXX args to new()?

                $perl->source( [ $source, @test_args ] );

                $stream = $perl->get_stream;
            }
            else {
                $self->_croak("Cannot determine source for $source");
            }
        }

        unless ($stream) {
            $self->_croak('PANIC: could not determine stream');
        }

        while ( my ( $k, $v ) = each %initialize ) {
            $self->{$k} = 'ARRAY' eq ref $v ? [] : $v;
        }

        $self->_stream($stream);
        my $grammar = TAP::Parser::Grammar->new($stream);
        $grammar->set_version( $self->version );
        $self->_grammar($grammar);
        $self->_spool($spool);

        $self->start_time( $self->get_time );

        return $self;
    }
}

=head1 INDIVIDUAL RESULTS

If you've read this far in the docs, you've seen this:

    while ( my $result = $parser->next ) {
        print $result->as_string;
    }

Each result returned is a L<TAP::Parser::Result> subclass, referred to as
I<result types>.

=head2 Result types

Basically, you fetch individual results from the TAP.  The six types, with
examples of each, are as follows:

=over 4

=item * Version

 TAP version 12

=item * Plan

 1..42

=item * Test

 ok 3 - We should start with some foobar!

=item * Comment

 # Hope we don't use up the foobar.

=item * Bailout

 Bail out!  We ran out of foobar!

=item * Unknown

 ... yo, this ain't TAP! ...

=back

Each result fetched is a result object of a different type.  There are common
methods to each result object and different types may have methods unique to
their type.  Sometimes a type method may be overridden in a subclass, but its
use is guaranteed to be identical.

=head2 Common type methods

=head3 C<type>

Returns the type of result, such as C<comment> or C<test>.

=head3 C<as_string>

Prints a string representation of the token.  This might not be the exact
output, however.  Tests will have test numbers added if not present, TODO and
SKIP directives will be capitalized and, in general, things will be cleaned
up.  If you need the original text for the token, see the C<raw> method.

=head3  C<raw>

Returns the original line of text which was parsed.

=head3 C<is_plan>

Indicates whether or not this is the test plan line.

=head3 C<is_test>

Indicates whether or not this is a test line.

=head3 C<is_comment>

Indicates whether or not this is a comment. Comments will generally only
appear in the TAP stream if STDERR is merged to STDOUT. See the
C<merge> option.

=head3 C<is_bailout>

Indicates whether or not this is bailout line.

=head3 C<is_yaml>

Indicates whether or not the current item is a YAML block.

=head3 C<is_unknown>

Indicates whether or not the current line could be parsed.

=head3 C<is_ok>

  if ( $result->is_ok ) { ... }

Reports whether or not a given result has passed.  Anything which is B<not> a
test result returns true.  This is merely provided as a convenient shortcut
which allows you to do this:

 my $parser = TAP::Parser->new( { source => $source } );
 while ( my $result = $parser->next ) {
     # only print failing results
     print $result->as_string unless $result->is_ok;
 }

=head2 C<plan> methods

 if ( $result->is_plan ) { ... }

If the above evaluates as true, the following methods will be available on the
C<$result> object.

=head3 C<plan>

  if ( $result->is_plan ) {
     print $result->plan;
  }

This is merely a synonym for C<as_string>.

=head3 C<tests_planned>

  my $planned = $result->tests_planned;

Returns the number of tests planned.  For example, a plan of C<1..17> will
cause this method to return '17'.

=head3 C<directive>

 my $directive = $result->directive;