view release on metacpan or  search on metacpan

FrameGrab.pm  view on Meta::CPAN

    return 0 if $data_points == 0;

    return int(1.0*$intensity/$data_points);
}

###########################################
sub cropdetect_mplayer {
###########################################
    my($self, $time) = @_;

    my($stdout, $stderr, $rc) = 
        tap $self->{mplayer}, qw(-vf cropdetect -ss), $time, 
            "-frames", 10,
            "-vo", "null",
            "-ao", "null",
            $self->{video};

    if(defined $stdout and
       $stdout =~ /-vf crop=(\d+):(\d+):(\d+):(\d+)/) {
        DEBUG "Suggested crop: $1, $2, $3, $4";
        return ($1, $2, $3, $4);
    }

    ERROR "$stderr";

    return undef;
}

###########################################
sub cropdetect_average {
###########################################
    my($self, $nof_probes, $opts) = @_;

    $opts = {} unless defined $opts;

    $self->result_clear();

    my @images = ();

    if(exists $opts->{images}) {
        for my $img (@{ $opts->{images} }) {
            push @images, $img;
        }
    } else {
        for my $probe ( 
            $self->equidistant_snap_times( $nof_probes, 
                $opts ) ) {

            my $data = $self->snap( $probe );
            my $img = Imager->new();
            my $rc = $img->read( data => $data );
            if(! $rc) {
                LOGWARN "Reading snapshop at time $probe failed ($!)";
                next;
            }
            push @images, $img;
        }
    }

    # average all snapshots to obtain a single overlay image
    my $overlay;

    my $i = 1;

    for my $img (@images) {
        $img->filter(type=>"gaussian", stddev=>10)
               or die $overlay->errstr;

        if(! defined $overlay) {
            $overlay = $img;
            next;
        }
        $overlay->compose( src => $img, combine => 'add' );
        $overlay->filter(type=>"postlevels", levels=>3) or
            die $overlay->errstr;

        if(get_logger()->is_trace()) {
            $overlay->write(file => "i-$i.jpg");
        }
        $i++;
    }

    my @params = $self->cropdetect( 0, { image => $overlay } );

    return @params;

#        my @params = $self->cropdetect( $probe, $opts );
#        if(! defined $params[0] ) {
#            ERROR "cropdetect returned an error";
#            next;
#        }
#        DEBUG "Cropdetect at $probe yielded (@params)";
#        $self->result_push( @params );
#    }
#
#    my @result = $self->result_majority_decision();
#    DEBUG "Majority decision: (@result)";
#    return @result;

}

###########################################
sub result_clear  {
###########################################
    my($self) = @_;

    $self->{result} = [];
}

###########################################
sub result_push {
###########################################
    my($self, @result) = @_;

    for(0..$#result) {
        $self->{result}->[$_]->{ $result[$_] }++;
    }
}

###########################################
sub result_majority_decision {
###########################################
    my($self) = @_;

    my @result = ();

    for my $sample (@{ $self->{result} }) {
        my($majority) = sort { $sample->{$b} <=> $sample->{$a} } keys %$sample;
        push @result, $majority;
    }

    return @result;
}

###########################################
sub jpeg_data {
###########################################
    my($self) = @_;
    return $self->{jpeg};
}

###########################################
sub jpeg_save {

FrameGrab.pm  view on Meta::CPAN

Save a grabbed frame as a jpeg image in $file on disk.

=item meta_data()

Runs mplayer's identify() function and returns a reference to a hash
containing something like

    demuxer          => MOV
    video_format     => AVC1
    video_bitrate    => 0
    video_width      => 320
    video_height     => 240
    video_fps        => 29.970
    video_aspect     => 0.0000
    audio_format     => MP4A
    audio_bitrate    => 0
    audio_rate       => 48000
    audio_nch        => 2
    length           => 9515.94

=item equidistant_snap_times( $howmany, [$opts] )

If you want to snap N frames at constant intervals throughout the movie,
use equidistant_snap_times( $n ) to get a list of timestamps you can use
later pass to snap(). For example, on a two hour movie, 
equidistant_snap_times( 5 ) will return

    00:20:00
    00:40:00
    01:00:00
    01:20:00
    01:40:00

as a list of strings. The movie length is determined by a call to meta
data, but some formats don't allow retrieving the movie length that way,
therefore the optional options hash can set the movie_length entry
to the movie length (or the length of the overall interval to perform
the snapshots in) in seconds.

    my @times =
      $fg->equidistant_snap_times( $howmany, { movie_length => 3600 } );

=item cropdetect( $time, [$opts] )

If this is a 16:9 movie converted to 4:3 format, the black bars at the bottom
and the top of the screen should be cropped out. To help with this task,
C<cropdetect> will return a list of ($width, $height, $x, $y) to be passed 
to mplayer/mencoder in the form C<-vf crop=w:h:x:y> to accomplish the 
suggested cropping.

The default algorithm is a homegrown detection mechanism 
C<{algorithm =E<gt> "schilli"}>, which first blurs the 
image with the Gaussian Blur algorithm with a radius of
C<$opts-E<gt>{gaussian_blur_radius}> (which defaults to 3),
and then measures if any of the left, right, upper or lower border
pixel lines of the snapped frame average an intensity of less than 
C<$opts-E<gt>{min_intensity_average}>, which defaults to 20.

Note that this is just a guess and might be incorrect at times. In a
dark scene, black pixels might protrude far into the video, making it
impossible to detect the border reliably. However, if you overlay a number
of frames, obtained at several times during the movie (e.g. by using
the equidistant_snap_times method described above), the result
is fairly predicatblye and accurate. C<cropdetect_average>, 
described below, does exactly that.

The alternative algorithm, C<"mplayer">,
asks mplayer to come up with a recommendation on how to crop the video.
This technique delivers incorrect results if there are sporadic white
spots within the dark bars.

=item cropdetect_average( $number_of_probes, [$opts] )

Takes C<$number_of_probes> from the movie at equidistant intervals,
overlays the frames and performs a border detection on the resulting
images, which is almost white in the viewing area.

See C<equidistant_snap_times> for setting the movie length in
the optional C<$opts> parameter.

=item aspect_ratio_guess( ["16:9", "4:3"] )

This function will take the width and height of the video and 
map it to the best matching aspect ratio given in a reference
to an array.

=item dimensions()

Snaps a frame in the middle of the movie, determines its width and
height and returns them in a list:

    my($width, $height) = $grabber->dimensions();

Dimensions are usually also available via the meta_data() call. 
dimensions() works even in absence of meta data.

=head1 CAVEATS

Note that the mplayer-based frame grabbing mechanism used in 
this module allows you to snap a picture about every 10 seconds into the 
movie, on shorter intervals, you'll get the same frame back.

=back

=head1 LEGALESE

Copyright 2009 by Mike Schilli, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

2009, Mike Schilli <cpan@perlmeister.com>