exiftool-vendored.exe 12.82.0 → 12.82.1

package/bin/exiftool_files/lib/TAP/Parser/IteratorFactory.pm

@@ -0,0 +1,339 @@
+package TAP::Parser::IteratorFactory;
+
+use strict;
+use warnings;
+
+use Carp qw( confess );
+use File::Basename qw( fileparse );
+
+use base 'TAP::Object';
+
+use constant handlers => [];
+
+=head1 NAME
+
+TAP::Parser::IteratorFactory - Figures out which SourceHandler objects to use for a given Source
+
+=head1 VERSION
+
+Version 3.42
+
+=cut
+
+our $VERSION = '3.42';
+
+=head1 SYNOPSIS
+
+  use TAP::Parser::IteratorFactory;
+  my $factory = TAP::Parser::IteratorFactory->new({ %config });
+  my $iterator  = $factory->make_iterator( $filename );
+
+=head1 DESCRIPTION
+
+This is a factory class that takes a L<TAP::Parser::Source> and runs it through all the
+registered L<TAP::Parser::SourceHandler>s to see which one should handle the source.
+
+If you're a plugin author, you'll be interested in how to L</register_handler>s,
+how L</detect_source> works.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+Creates a new factory class:
+
+  my $sf = TAP::Parser::IteratorFactory->new( $config );
+
+C<$config> is optional.  If given, sets L</config> and calls L</load_handlers>.
+
+=cut
+
+sub _initialize {
+    my ( $self, $config ) = @_;
+    $self->config( $config || {} )->load_handlers;
+    return $self;
+}
+
+=head3 C<register_handler>
+
+Registers a new L<TAP::Parser::SourceHandler> with this factory.
+
+  __PACKAGE__->register_handler( $handler_class );
+
+=head3 C<handlers>
+
+List of handlers that have been registered.
+
+=cut
+
+sub register_handler {
+    my ( $class, $dclass ) = @_;
+
+    confess("$dclass must implement can_handle & make_iterator methods!")
+      unless UNIVERSAL::can( $dclass, 'can_handle' )
+          && UNIVERSAL::can( $dclass, 'make_iterator' );
+
+    my $handlers = $class->handlers;
+    push @{$handlers}, $dclass
+      unless grep { $_ eq $dclass } @{$handlers};
+
+    return $class;
+}
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<config>
+
+ my $cfg = $sf->config;
+ $sf->config({ Perl => { %config } });
+
+Chaining getter/setter for the configuration of the available source handlers.
+This is a hashref keyed on handler class whose values contain config to be passed
+onto the handlers during detection & creation.  Class names may be fully qualified
+or abbreviated, eg:
+
+  # these are equivalent
+  $sf->config({ 'TAP::Parser::SourceHandler::Perl' => { %config } });
+  $sf->config({ 'Perl' => { %config } });
+
+=cut
+
+sub config {
+    my $self = shift;
+    return $self->{config} unless @_;
+    unless ( 'HASH' eq ref $_[0] ) {
+        $self->_croak('Argument to &config must be a hash reference');
+    }
+    $self->{config} = shift;
+    return $self;
+}
+
+sub _last_handler {
+    my $self = shift;
+    return $self->{last_handler} unless @_;
+    $self->{last_handler} = shift;
+    return $self;
+}
+
+sub _testing {
+    my $self = shift;
+    return $self->{testing} unless @_;
+    $self->{testing} = shift;
+    return $self;
+}
+
+##############################################################################
+
+=head3 C<load_handlers>
+
+ $sf->load_handlers;
+
+Loads the handler classes defined in L</config>.  For example, given a config:
+
+  $sf->config({
+    MySourceHandler => { some => 'config' },
+  });
+
+C<load_handlers> will attempt to load the C<MySourceHandler> class by looking in
+C<@INC> for it in this order:
+
+  TAP::Parser::SourceHandler::MySourceHandler
+  MySourceHandler
+
+C<croak>s on error.
+
+=cut
+
+sub load_handlers {
+    my ($self) = @_;
+    for my $handler ( keys %{ $self->config } ) {
+        my $sclass = $self->_load_handler($handler);
+
+        # TODO: store which class we loaded anywhere?
+    }
+    return $self;
+}
+
+sub _load_handler {
+    my ( $self, $handler ) = @_;
+
+    my @errors;
+    for my $dclass ( "TAP::Parser::SourceHandler::$handler", $handler ) {
+        return $dclass
+          if UNIVERSAL::can( $dclass, 'can_handle' )
+              && UNIVERSAL::can( $dclass, 'make_iterator' );
+
+        eval "use $dclass";
+        if ( my $e = $@ ) {
+            push @errors, $e;
+            next;
+        }
+
+        return $dclass
+          if UNIVERSAL::can( $dclass, 'can_handle' )
+              && UNIVERSAL::can( $dclass, 'make_iterator' );
+        push @errors,
+          "handler '$dclass' does not implement can_handle & make_iterator";
+    }
+
+    $self->_croak(
+        "Cannot load handler '$handler': " . join( "\n", @errors ) );
+}
+
+##############################################################################
+
+=head3 C<make_iterator>
+
+  my $iterator = $src_factory->make_iterator( $source );
+
+Given a L<TAP::Parser::Source>, finds the most suitable L<TAP::Parser::SourceHandler>
+to use to create a L<TAP::Parser::Iterator> (see L</detect_source>).  Dies on error.
+
+=cut
+
+sub make_iterator {
+    my ( $self, $source ) = @_;
+
+    $self->_croak('no raw source defined!') unless defined $source->raw;
+
+    $source->config( $self->config )->assemble_meta;
+
+    # is the raw source already an object?
+    return $source->raw
+      if ( $source->meta->{is_object}
+        && UNIVERSAL::isa( $source->raw, 'TAP::Parser::SourceHandler' ) );
+
+    # figure out what kind of source it is
+    my $sd_class = $self->detect_source($source);
+    $self->_last_handler($sd_class);
+
+    return if $self->_testing;
+
+    # create it
+    my $iterator = $sd_class->make_iterator($source);
+
+    return $iterator;
+}
+
+=head3 C<detect_source>
+
+Given a L<TAP::Parser::Source>, detects what kind of source it is and
+returns I<one> L<TAP::Parser::SourceHandler> (the most confident one).  Dies
+on error.
+
+The detection algorithm works something like this:
+
+  for (@registered_handlers) {
+    # ask them how confident they are about handling this source
+    $confidence{$handler} = $handler->can_handle( $source )
+  }
+  # choose the most confident handler
+
+Ties are handled by choosing the first handler.
+
+=cut
+
+sub detect_source {
+    my ( $self, $source ) = @_;
+
+    confess('no raw source ref defined!') unless defined $source->raw;
+
+    # find a list of handlers that can handle this source:
+    my %confidence_for;
+    for my $handler ( @{ $self->handlers } ) {
+        my $confidence = $handler->can_handle($source);
+        # warn "handler: $handler: $confidence\n";
+        $confidence_for{$handler} = $confidence if $confidence;
+    }
+
+    if ( !%confidence_for ) {
+        # error: can't detect source
+        my $raw_source_short = substr( ${ $source->raw }, 0, 50 );
+        confess("Cannot detect source of '$raw_source_short'!");
+        return;
+    }
+
+    # if multiple handlers can handle it, choose the most confident one
+    my @handlers =
+          sort { $confidence_for{$b} <=> $confidence_for{$a} }
+          keys %confidence_for;
+
+    # Check for a tie.
+    if( @handlers > 1 &&
+        $confidence_for{$handlers[0]} == $confidence_for{$handlers[1]}
+    ) {
+        my $filename = $source->meta->{file}{basename};
+        die("There is a tie between $handlers[0] and $handlers[1].\n".
+            "Both voted $confidence_for{$handlers[0]} on $filename.\n");
+    }
+
+    # this is really useful for debugging handlers:
+    if ( $ENV{TAP_HARNESS_SOURCE_FACTORY_VOTES} ) {
+        warn(
+            "votes: ",
+            join( ', ', map {"$_: $confidence_for{$_}"} @handlers ),
+            "\n"
+        );
+    }
+
+    # return 1st
+    return $handlers[0];
+}
+
+1;
+
+__END__
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head2 Example
+
+If we've done things right, you'll probably want to write a new source,
+rather than sub-classing this (see L<TAP::Parser::SourceHandler> for that).
+
+But in case you find the need to...
+
+  package MyIteratorFactory;
+
+  use strict;
+
+  use base 'TAP::Parser::IteratorFactory';
+
+  # override source detection algorithm
+  sub detect_source {
+    my ($self, $raw_source_ref, $meta) = @_;
+    # do detective work, using $meta and whatever else...
+  }
+
+  1;
+
+=head1 AUTHORS
+
+Steve Purkis
+
+=head1 ATTRIBUTION
+
+Originally ripped off from L<Test::Harness>.
+
+Moved out of L<TAP::Parser> & converted to a factory class to support
+extensible TAP source detective work by Steve Purkis.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::RawTAP>,
+L<TAP::Parser::SourceHandler::Handle>,
+L<TAP::Parser::SourceHandler::Executable>
+
+=cut
+

package/bin/exiftool_files/lib/TAP/Parser/Multiplexer.pm

@@ -0,0 +1,194 @@
+package TAP::Parser::Multiplexer;
+
+use strict;
+use warnings;
+
+use IO::Select;
+
+use base 'TAP::Object';
+
+use constant IS_WIN32 => $^O =~ /^(MS)?Win32$/;
+use constant IS_VMS => $^O eq 'VMS';
+use constant SELECT_OK => !( IS_VMS || IS_WIN32 );
+
+=head1 NAME
+
+TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers
+
+=head1 VERSION
+
+Version 3.42
+
+=cut
+
+our $VERSION = '3.42';
+
+=head1 SYNOPSIS
+
+    use TAP::Parser::Multiplexer;
+
+    my $mux = TAP::Parser::Multiplexer->new;
+    $mux->add( $parser1, $stash1 );
+    $mux->add( $parser2, $stash2 );
+    while ( my ( $parser, $stash, $result ) = $mux->next ) {
+        # do stuff
+    }
+
+=head1 DESCRIPTION
+
+C<TAP::Parser::Multiplexer> gathers input from multiple TAP::Parsers.
+Internally it calls select on the input file handles for those parsers
+to wait for one or more of them to have input available.
+
+See L<TAP::Harness> for an example of its use.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+    my $mux = TAP::Parser::Multiplexer->new;
+
+Returns a new C<TAP::Parser::Multiplexer> object.
+
+=cut
+
+# new() implementation supplied by TAP::Object
+
+sub _initialize {
+    my $self = shift;
+    $self->{select} = IO::Select->new;
+    $self->{avid}   = [];                # Parsers that can't select
+    $self->{count}  = 0;
+    return $self;
+}
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<add>
+
+  $mux->add( $parser, $stash );
+
+Add a TAP::Parser to the multiplexer. C<$stash> is an optional opaque
+reference that will be returned from C<next> along with the parser and
+the next result.
+
+=cut
+
+sub add {
+    my ( $self, $parser, $stash ) = @_;
+
+    if ( SELECT_OK && ( my @handles = $parser->get_select_handles ) ) {
+        my $sel = $self->{select};
+
+        # We have to turn handles into file numbers here because by
+        # the time we want to remove them from our IO::Select they
+        # will already have been closed by the iterator.
+        my @filenos = map { fileno $_ } @handles;
+        for my $h (@handles) {
+            $sel->add( [ $h, $parser, $stash, @filenos ] );
+        }
+
+        $self->{count}++;
+    }
+    else {
+        push @{ $self->{avid} }, [ $parser, $stash ];
+    }
+}
+
+=head3 C<parsers>
+
+  my $count   = $mux->parsers;
+
+Returns the number of parsers. Parsers are removed from the multiplexer
+when their input is exhausted.
+
+=cut
+
+sub parsers {
+    my $self = shift;
+    return $self->{count} + scalar @{ $self->{avid} };
+}
+
+sub _iter {
+    my $self = shift;
+
+    my $sel   = $self->{select};
+    my $avid  = $self->{avid};
+    my @ready = ();
+
+    return sub {
+
+        # Drain all the non-selectable parsers first
+        if (@$avid) {
+            my ( $parser, $stash ) = @{ $avid->[0] };
+            my $result = $parser->next;
+            shift @$avid unless defined $result;
+            return ( $parser, $stash, $result );
+        }
+
+        unless (@ready) {
+            return unless $sel->count;
+            @ready = $sel->can_read;
+        }
+
+        my ( $h, $parser, $stash, @handles ) = @{ shift @ready };
+        my $result = $parser->next;
+
+        unless ( defined $result ) {
+            $sel->remove(@handles);
+            $self->{count}--;
+
+            # Force another can_read - we may now have removed a handle
+            # thought to have been ready.
+            @ready = ();
+        }
+
+        return ( $parser, $stash, $result );
+    };
+}
+
+=head3 C<next>
+
+Return a result from the next available parser. Returns a list
+containing the parser from which the result came, the stash that
+corresponds with that parser and the result.
+
+    my ( $parser, $stash, $result ) = $mux->next;
+
+If C<$result> is undefined the corresponding parser has reached the end
+of its input (and will automatically be removed from the multiplexer).
+
+When all parsers are exhausted an empty list will be returned.
+
+    if ( my ( $parser, $stash, $result ) = $mux->next ) {
+        if ( ! defined $result ) {
+            # End of this parser
+        }
+        else {
+            # Process result
+        }
+    }
+    else {
+        # All parsers finished
+    }
+
+=cut
+
+sub next {
+    my $self = shift;
+    return ( $self->{_iter} ||= $self->_iter )->();
+}
+
+=head1 See Also
+
+L<TAP::Parser>
+
+L<TAP::Harness>
+
+=cut
+
+1;

package/bin/exiftool_files/lib/TAP/Parser/Result/Bailout.pm

@@ -0,0 +1,62 @@
+package TAP::Parser::Result::Bailout;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Result';
+
+=head1 NAME
+
+TAP::Parser::Result::Bailout - Bailout result token.
+
+=head1 VERSION
+
+Version 3.42
+
+=cut
+
+our $VERSION = '3.42';
+
+=head1 DESCRIPTION
+
+This is a subclass of L<TAP::Parser::Result>.  A token of this class will be
+returned if a bail out line is encountered.
+
+ 1..5
+ ok 1 - woo hooo!
+ Bail out! Well, so much for "woo hooo!"
+
+=head1 OVERRIDDEN METHODS
+
+Mainly listed here to shut up the pitiful screams of the pod coverage tests.
+They keep me awake at night.
+
+=over 4
+
+=item * C<as_string>
+
+=back
+
+=cut
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<explanation>
+
+  if ( $result->is_bailout ) {
+      my $explanation = $result->explanation;
+      print "We bailed out because ($explanation)";
+  }
+
+If, and only if, a token is a bailout token, you can get an "explanation" via
+this method.  The explanation is the text after the mystical "Bail out!" words
+which appear in the tap output.
+
+=cut
+
+sub explanation { shift->{bailout} }
+sub as_string   { shift->{bailout} }
+
+1;

package/bin/exiftool_files/lib/TAP/Parser/Result/Comment.pm

@@ -0,0 +1,60 @@
+package TAP::Parser::Result::Comment;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Result';
+
+=head1 NAME
+
+TAP::Parser::Result::Comment - Comment result token.
+
+=head1 VERSION
+
+Version 3.42
+
+=cut
+
+our $VERSION = '3.42';
+
+=head1 DESCRIPTION
+
+This is a subclass of L<TAP::Parser::Result>.  A token of this class will be
+returned if a comment line is encountered.
+
+ 1..1
+ ok 1 - woo hooo!
+ # this is a comment
+
+=head1 OVERRIDDEN METHODS
+
+Mainly listed here to shut up the pitiful screams of the pod coverage tests.
+They keep me awake at night.
+
+=over 4
+
+=item * C<as_string>
+
+Note that this method merely returns the comment preceded by a '# '.
+
+=back
+
+=cut
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<comment> 
+
+  if ( $result->is_comment ) {
+      my $comment = $result->comment;
+      print "I have something to say:  $comment";
+  }
+
+=cut
+
+sub comment   { shift->{comment} }
+sub as_string { shift->{raw} }
+
+1;