/usr/local/CPAN/MPEG-Info/MPEG/Info/Video.pm
##------------------------------------------------------------------------
## Package: MPEG::Info::Video
## Author: Benjamin R. Ginter
## Notice: Copyright (c) 2001 Benjamin R. Ginter
## Purpose: Parse video streams
## Comments: None
## CVS: $Id: Video.pm,v 1.4 2002/02/13 08:27:51 synaptic Exp $
##------------------------------------------------------------------------
package MPEG::Info::Video;
use 5.006;
use strict;
use warnings;
require Exporter;
our @ISA = qw( MPEG::Info Exporter );
use MPEG::Info;
use MPEG::Info::Constants;
##------------------------------------------------------------------------
## Preloaded methods go here.
##------------------------------------------------------------------------
1;
##------------------------------------------------------------------------
## new()
##
## override superclass constructor
##------------------------------------------------------------------------
sub new {
my $proto = shift;
my $class = ref( $proto ) || $proto;
my $self = {};
bless( $self, $class );
return $self;
}
##------------------------------------------------------------------------
## parse()
##
## Parse a video stream
##------------------------------------------------------------------------
sub parse {
my $self = shift;
my $offset = shift;
$offset = 0 if !defined $offset;
$self->{offset} = $self->{last_offset} || $offset;
# print "\n", '-' x 74, "\n", "Parse Video: $offset\n", '-' x 74, "\n";
## Make sure we have video
$self->is_video() or return 0;
#if we made it this far, assume a bona fide MPEG
$self->type('MPEG');
$self->get_size();
$self->get_frame_rate();
$self->get_aspect_ratio();
$self->get_bitrate();
$self->get_duration();
$self->get_extensions();
# $self->get_gop();
# $self->get_header_size();
if ( 0 ) {
print " DIMENSIONS: ", $self->width, 'x', $self->height, "\n";
printf " FRAME RATE: %0.2f fps\n", $self->fps;
printf " ASPECT RATIO: %s ( %d )\n", $self->aspect, $self->aspect_raw;
print " BITRATE: ", $self->vrate, "\n";
print " DURATION: ", $self->duration, "\n";
print " HEADER SIZE: $self->{video_header_size}\n";
}
return 1;
}
##------------------------------------------------------------------------
## get_size()
##
## Get the width and height
##------------------------------------------------------------------------
sub get_size {
my $self = shift;
$self->{offset} += 4;
$self->width( $self->grab( 2, $self->{offset} ) >> 4 );
$self->height( $self->grab( 2, $self->{offset} + 1 ) & 0x0FFF );
if ( !defined $self->width || !defined $self->height ) {
return 0;
}
return 1;
}
##------------------------------------------------------------------------
## is_video()
##
## Verify we're really dealing with a video packet
##
## This method searches up to eof for the start code in case there is
## junk at the beginning of the file. Should we limit this somehow?
##------------------------------------------------------------------------
sub is_video {
my $self = shift;
if ( !$self->next_start_code( SEQ_START_CODE, $self->{offset} ) ) {
print "Not an MPEG Video stream\n";
return 0;
}
# print "\tFound start code at ", $self->{last_offset}, "\n";
$self->{offset} = $self->{last_offset};
return 1;
}
##------------------------------------------------------------------------
## get_frame_rate()
##
## Extract the frame_rate index and do the lookup
##------------------------------------------------------------------------
sub get_frame_rate {
my $self = shift;
$self->{offset} += 3;
my $frame_rate_index = $self->grab( 1, $self->{offset} ) & 0x0f;
if ( $frame_rate_index > 8 ) {
print "Invalid frame rate index: $frame_rate_index\n";
## $self->fps( 0.0 );
return 0;
}
$self->fps( $FRAME_RATE->[ $frame_rate_index ] );
return 1;
}
##------------------------------------------------------------------------
## get_aspect_ratio()
##
## Extract the aspect ratio index and do the lookup.
##
## NOTE: Don't die() on invalid aspect ratios as they are fairly common
## For example, 320x240 is invalid. :)
##------------------------------------------------------------------------
sub get_aspect_ratio {
my $self = shift;
my $aspect = ( $self->grab( 1, $self->{offset} ) & 0xF0 ) >> 4;
if ( !$aspect ) {
# print "Invalid aspect ratio: $aspect\n";
return 0;
}
if ( $aspect > $#{ $ASPECT_RATIO } ) {
# print "Reserved aspect ratio: $aspect\n";
$self->aspect( 'Reserved' );
}
else {
# print "Aspect Ratio: ", $ASPECT_RATIO->[ $aspect ], "\n";
$self->aspect( $ASPECT_RATIO->[ $aspect ] );
}
$self->aspect_raw( $aspect );
return 1;
}
##------------------------------------------------------------------------
## get_bitrate()
##
## From the MPEG-2.2 spec:
##
## bit_rate -- This is a 30-bit integer. The lower 18 bits of the
## integer are in bit_rate_value and the upper 12 bits are in
## bit_rate_extension. The 30-bit integer specifies the bitrate of the
## bitstream measured in units of 400 bits/second, rounded upwards.
## The value zero is forbidden.
##
## So ignoring all the variable bitrate stuff for now, this 30 bit integer
## multiplied times 400 bits/sec should give the rate in bits/sec.
##
## TODO: Variable bitrates? I need one that implements this.
##
## Continued from the MPEG-2.2 spec:
##
## If the bitstream is a constant bitrate stream, the bitrate specified
## is the actual rate of operation of the VBV specified in annex C. If
## the bitstream is a variable bitrate stream, the STD specifications in
## ISO/IEC 13818-1 supersede the VBV, and the bitrate specified here is
## used to dimension the transport stream STD (2.4.2 in ITU-T Rec. xxx |
## ISO/IEC 13818-1), or the program stream STD (2.4.5 in ITU-T Rec. xxx |
## ISO/IEC 13818-1).
##
## If the bitstream is not a constant rate bitstream the vbv_delay
## field shall have the value FFFF in hexadecimal.
##
## Given the value encoded in the bitrate field, the bitstream shall be
## generated so that the video encoding and the worst case multiplex
## jitter do not cause STD buffer overflow or underflow.
##
##
##------------------------------------------------------------------------
sub get_bitrate {
my $self = shift;
$self->{offset}++;
## grab a short
my $bitrate = $self->grab( 2, $self->{offset} ) << 2;
my $lasttwo = $self->get_byte( $self->{offset} + 2 ) >> 6;
$self->vrate( ( $bitrate | $lasttwo ) * 400);
}
##------------------------------------------------------------------------
## get_duration()
##
##
##------------------------------------------------------------------------
sub get_duration {
my $self = shift;
$self->duration ( ( $self->size * 8 ) / ( $self->vrate * 400 ) );
}
##------------------------------------------------------------------------
## get_extensions()
##
## TODO: make the $START_CODE->{$code} description the actual method name
## for the extension handler.
##------------------------------------------------------------------------
sub get_extensions {
my $self = shift;
while (1) {
my $code = $self->next_start_code( undef, $self->{offset}, 1 );
last if $code == 0xB8;
$self->{offset} = $self->{last_offset};
$code = $self->get_byte( $self->{offset} + 3 );
my $descr = $START_CODE->{$code};
if ( defined $descr ) {
## printf "EXTENSION: %s\n", $START_CODE->{$code};
if ( $descr eq 'extension_start_code' ) {
$self->parse_extension( $self->{offset} );
next;
}
elsif ( $descr eq 'user_data_start_code' ) {
$self->parse_user_data( $self->{offset} );
last;
}
else {
print "No methods to handle $descr\n";
last;
}
}
$self->{offset}++;
}
}
##------------------------------------------------------------------------
## get_gop()
##
## Find first GOP header after video sequence header
##------------------------------------------------------------------------
sub get_gop {
my $self = shift;
if ( !$self->next_start_code( 0xb8, $self->{offset} ) ) {
## should we return 0 here?
die "Couldn't find first GOP after Video Sequence start!\n";
}
else {
print "Found GOP Header (0xB8) at $self->{last_offset} $self->{offset}\n";
}
}
##------------------------------------------------------------------------
## get_header_size()
##
## Video header size
##------------------------------------------------------------------------
sub get_header_size {
my $self = shift;
$self->{header_size} = $self->{last_offset} - $self->{offset};
}