view release on metacpan or  search on metacpan

lib/FLV/VideoTag.pm  view on Meta::CPAN

   # The spec PDF is wrong -- type comes first, then codec
   my $type  = ($flags >> 4) & 0x0f;
   my $codec = $flags & 0x0f;

   if (!exists $VIDEO_CODEC_IDS{$codec})
   {
      die 'Unknown video codec ' . $codec . ' at byte ' . $file->get_pos(-1);
   }
   if (!exists $VIDEO_FRAME_TYPES{$type})
   {
      die 'Unknown video frame type at byte ' . $file->get_pos(-1);
   }

   $self->{codec} = $codec;
   $self->{type}  = $type;

   my $pos = $file->get_pos();

   $self->{data} = $file->get_bytes($datasize - 1);

   my $result
       = 2 == $self->{codec} ? $self->_parse_h263($pos)
       : 3 == $self->{codec} ? $self->_parse_screen_video($pos)
       : 4 == $self->{codec} ? $self->_parse_on2vp6($pos)
       : 5 == $self->{codec} ? $self->_parse_on2vp6_alpha($pos)
       : 6 == $self->{codec} ? $self->_parse_screen_video($pos)
       : 7 == $self->{codec} ? $self->_parse_avc($pos)
       :                       die 'Unknown video type';

   return;
}

sub _parse_h263
{
   my $self = shift;
   my $pos  = shift;

   # Surely there's a better way than this....
   my $bits = unpack 'B67', $self->{data};
   my $sizecode = substr $bits, 30, 3;
   my @d = (
      (ord pack 'B8', substr $bits, 33, 8),
      (ord pack 'B8', substr $bits, 41, 8),
      (ord pack 'B8', substr $bits, 49, 8),
      (ord pack 'B8', substr $bits, 57, 8),
   );
   my ($width, $height, $offset)
       = '000' eq $sizecode ? ($d[0], $d[1], 16)
       : '001' eq $sizecode ? ($d[0] * 256 + $d[1], $d[2] * 256 + $d[3], 32)
       : '010' eq $sizecode ? (352, 288, 0)
       : '011' eq $sizecode ? (176, 144, 0)
       : '100' eq $sizecode ? (128, 96,  0)
       : '101' eq $sizecode ? (320, 240, 0)
       : '110' eq $sizecode ? (160, 120, 0)
       :   die 'Illegal value for H.263 size code at byte ' . $pos;

   $self->{width}  = $width;
   $self->{height} = $height;

   my $typebits = substr $bits, 33 + $offset, 2;
   my @typebits = split m//xms, $typebits;
   my $type     = 1 + $typebits[0] * 2 + $typebits[1];
   if (!defined $self->{type})
   {
      $self->{type} = $type;
   }
   elsif ($type != $self->{type})
   {
      warn "Type mismatch: header says $VIDEO_FRAME_TYPES{$self->{type}}, "
          . "data says $VIDEO_FRAME_TYPES{$type}";
   }

   return;
}

sub _parse_screen_video
{
   my $self = shift;
   my $pos  = shift;

   # Extract 4 bytes, big-endian
   my ($width, $height) = unpack 'nn', $self->{data};

   # Only use the lower 12 bits of each
   $width  &= 0x3fff;
   $height &= 0x3fff;

   $self->{width}  = $width;
   $self->{height} = $height;

   $self->{type} ||= 1;

   return;
}

sub _parse_on2vp6
{
   my $self = shift;
   my $pos  = shift;

   if (!$self->{type})
   {

      # Bit 7 of the header (after 8 bits of offset) distinguishes
      # keyframe from interframe
      # See: http://use.perl.org/~ChrisDolan/journal/30427
      my @bytes = unpack 'CC', $self->{data};
      $self->{type} = 0 == ($bytes[1] & 0x80) ? 1 : 2;
   }

   return;
}

sub _parse_on2vp6_alpha
{
   my $self = shift;
   my $pos  = shift;

   if (!$self->{type})
   {