# Perl & CGI: FLV audio/video tag extractor

By Mateusz Kaczanowski in Perl 0 Comment

Requirements

What does the script do?

The script processes FLV stream by deleting audio/video tags. It is also possible to obtain a raw content of the tags (eg. mp3). Data is processed on fly, so there is no necessity to download whole file to listen favorite music from eg. YouTube.

3. Legal notice

The script uses direct YouTube FLV stream which is inconsistent with YouTube terms. This feature was included only for education purposes. To avoid undesired usage I didn’t publish the CGI version of the script.

4. Usage

# Returns whole FLV stream (audio: MP3, video: Sorensen H.263)
perl extract.pl -u http://www.youtube.com/watch?v=s0NlNOI5LG0 -f 5 -g AV 2> /dev/null | mplayer -

# Returns "audio only" FLV stream (audio: MP3)
perl extract.pl -u http://www.youtube.com/watch?v=8UVNT4wvIGY -f 5 -g Audio 2> /dev/null | mplayer -

# Returns raw mp3 stream
perl extract.pl -u http://www.youtube.com/watch?v=8UVNT4wvIGY -f 5 -g Audio -r 2> /dev/null | mpg123 -

# Returns "video only" FLV stream (video: Sorensen H.263)
perl extract.pl -u http://mkaczanowski.com/demos/test.flv -g Video 2> /dev/null | mplayer -

# Returns "audio only" FLV stream starting from 01:20 (audio: AAC)
perl extract.pl -u http://www.youtube.com/watch?v=8UVNT4wvIGY -g Audio -t 01m20s 2> /dev/null | mplayer -

# See debug messages. "1> /dev/null" redirects sdtout to /dev/null, so only stderr is visible
perl extract.pl -u http://mkaczanowski.com/demos/test.flv -g Audio 1> /dev/null

# See debug messages. "1> /dev/null" redirects sdtout to /dev/null, so only stderr is visible
perl extract.pl -u http://www.youtube.com/watch?v=8UVNT4wvIGY -f 34 -g Audio -t 01m20s 1> /dev/null

# Returns raw mp3 stream (local url)
perl extract.pl -u http://mkaczanowski.com/demos/test.flv -g Audio -r 2> /dev/null | mpg123 -

FLV format specification

Before we start programming let’s cover some theory. After reading specification (links below) you will have to know answers to the following questions:

  1. What is the FLV header?
  2. What is „tag” and what are the its types?
  3. How are the tags placed? What is the order?
  4. What are the flags?
  5. What are the specific data types (such as uint8, uint32_be etc)?
  6. What is the big endian notation?

References:

Get YouTube video URI using wireshark

Extract.pl – main file

Extract.pl is responsible for handling command line arguments and for creating an appropriate object ( depending on given URL ).

#!/usr/bin/perl

use warnings;
use strict;

use Getopt::Long;
use YouTube;
use Print;
use Local;
use Switch;

# Local Variables
my $params = {};
my $obj; # holds 'Youtube' or 'Local' object

# Collect parameters
GetOptions ('help|?' => sub{ showHelp(); },
        'url=s' => \$params->{_url},
        'time:s'=>sub{ $params->{_startFromTime} = timeToMsecs($_[1]); },
        'fmt:i'=>\$params->{_selectedFmt},
        'raw' => \$params->{_raw},
        'get=s' => \$params->{_get} # Audio, Video, AV
        );

# Mandatory params
if(!defined($params->{_url}) || !defined($params->{_get})){ showHelp(); }

# Check if url contains youtube.com address
if($params->{_url} =~ m/(youtube.com)/){
    $obj = new YouTube();
    $obj->{_url} = $params->{_url};
    $obj->{_startFromTime} = $params->{_startFromTime}; # Time in milliseconds
    $obj->{_selectedFmt} = $params->{_selectedFmt}; # YT fmt -> http://en.wikipedia.org/wiki/YouTube
}else{
    $obj = new Local();
    $obj->{_url} = $params->{_url};
}

switch($params->{_get}){
    case "Audio" {
        if(!defined($params->{_raw})){
            $obj->getAudio();
        }else{
            $obj->getRawAudio();
        }
    }
    case "Video" {
        if(!defined($params->{_raw})){
            $obj->getVideo();
        }else{
            $obj->getRawVideo();
        }
    }
    case "AV" {
        $obj->getAV();
    }

    default {
        Print::err("Get: Audio, Video, AV options are avalible");
    }
}

sub showHelp{
    print "Options: \n";
    print "\t --url http://www.youtube.com/watch?v=VIDEO_ID\t #YouTube video url address\n";
    print "\t --time ##m##s\t\t\t\t\t #Start playing from given time\n";
    print "\t --fmt FMT_VAL\t\t\t\t\t #Choose fmt manually\n";
    print "\t --raw\t\t\t\t\t\t #Raw output\n";
    print "\t --help\t\t\t\t\t\t #Show this menu\n";
    exit;
}

sub timeToMsecs{
    my $str = shift;
    if(!($str =~ m/([0-9]+)m([0-5][0-9])s/)){ return 0; }
    $str =~ s//([0-9]+)m([0-5][0-9])s/;
    return($1*60+$2)*1000;
}

YouTube.pm

YouTube.pm downloads site, parse it and finds the video URI which is passed to Download.pm.

#!/usr/bin/perl

package YouTube;

use WWW::Curl::Easy;
use URI::Escape;
use Mojo::DOM;

use Download;
use FLV;

sub new{
    my $class = shift;
    my $self = {
        _url => undef, # contains stream url
        _startFromTime => shift || 0,
        _fmt => {}, # Fmt list
        _html => [], # HTML code of YouTube site
        _cookies => [], # Part of HTTP Header
        _selectedFmt => undef,
        _httpReferer => undef, # Part of HTTP Header
        _download => undef # contains 'download' object
    };

    bless $self, $class;
    return $self;
}

sub init {
    my $self = shift;

    if(!defined($self->{_url})){
        Print::err("URL is missing");
    }

    $self->getHtml();
    $self->parseHtml();
    $self->{_url} = $self->{_fmt}{$self->{_selectedFmt}}{url};
}

# Prints FLV stream whith only audio tags
sub getAudio{
    my $self = shift;
    $self->run(0,1,0);
}

# Prints codec part from audio tags
sub getRawAudio{
    my $self = shift;
    $self->run(0,1,1);
}

# Prints FLV stream with only video tags
sub getVideo{
    my $self = shift;
    $self->run(1,0,0);
}

# Prints codec part from video tags
sub getRawVideo{
    my $self = shift;
    $self->run(1,0,1);
}

# Prints both: audio and video as FLV stream
sub getAV{
    my $self = shift;
    $self->run(1,1,0);
}

# Start downloading
sub run{
    my $self = shift;

    $self->init();
    $self->{_download} = new Download($self);
    $self->{_download}->start();
    $self->summary();

    my $flv = new FLV(shift, shift, shift);
    $flv->getTags();
}

# Download YouTube website
sub getHtml{
        my $self = shift;
    my $curl = WWW::Curl::Easy->new;

        my $response;
        my $headers;

    $curl->setopt(CURLOPT_HEADER,0);
    $curl->setopt(CURLOPT_COOKIESESSION, 1);
    $curl->setopt(CURLOPT_USERAGENT, Download::getUserAgent());
    $curl->setopt(CURLOPT_URL, $self->{_url});

    $curl->setopt(CURLOPT_WRITEDATA,\$response);
    $curl->setopt(CURLOPT_WRITEHEADER, \$headers);

    $curl->perform();

    if ($curl->getinfo(CURLINFO_HTTP_CODE) == 200) {
            my @headers = split /\n/, $headers;
            @{$self->{_html}} = split /\n/, $response;
            @{$self->{_cookies}} = grep {/Set\-Cookie/} @headers; # extract cookies

        # Parse cookies
            for(my $i = 0; $i {_cookies}}; $i++){
                    $self->{_cookies}[$i] =~ s/(\\n|\s+)//g;
                    my @temp = split(/\;/, $self->{_cookies}[$i], 2);
                    $self->{_cookies}[$i] = substr($temp[0],11);
            }
    } else {
            Print::err("Download Error");
    }
}

sub parseHtml{
        my $self = shift;
        my @explode = grep {/flashvars/} @{$self->{_html}}; # extract embed tag which is contained inside of flashvars parameter
        if($#explode == -1){ Print::err("flashvars NOT FOUND"); }

    $explode[0] =~ s/\\u([[:xdigit:]]{1,4})/chr(eval("0x$1"))/egis; # convert unicode to asci characters
    $explode[0] =~ s/(\;|\n|\\")//g; # remove ";", "\n", " ", \" (|\s+|) from string
        $explode[0] =~ s/\\\//\//g; # change \/ to /

    my $dom = Mojo::DOM->new($explode[0]);
    $self->{_httpReferer} = $dom->embed->{src};

    my %embed_params;
    foreach(split(/\&/,$dom->embed->{flashvars})){ # get List of embed params
        (my $param, my $val) = split(/\=/, $_);
        $embed_params{$param} = $val;
    }

    foreach(split(/\,/,uri_unescape($embed_params{fmt_list}))){ # get List of avalible FMT
        (my $id, my $resolution) = split(/\//, $_, 3);
        $self->{_fmt}{$id} = {'resolution' => $resolution};
    }

    foreach(split(/\,/,uri_unescape($embed_params{url_encoded_fmt_stream_map}))){ # get Url List
        my @spli = split(/itag\=/,$_);
        $self->{_fmt}{$spli[1]}{'url'} = substr uri_unescape($_), 4;
    }

    # Check if _selectedFmt is defined or sort and select lowest fmt
    if(!defined($self->{'_selectedFmt'}) || (defined($self->{'_selectedFmt'}) && !defined($self->{'_fmt'}{$self->{'_selectedFmt'}}))){
        $self->{'_selectedFmt'} = (sort {$a  $b} keys %{$self->{'_fmt'}})[0];
    }
}

# Prepare HTTP header
sub getHeader{
        my $self = shift;
    my $url = shift || exit;
    my $return = "";

    $url =~ m|(\w+)://([^/:]+)(:\d+)?/(.*)|;
    $return .= "Host: $2\r\n";
    $return .= "Connection: keep-alive\r\n";
    $return .= "Referer: ".$self->{_httpReferer}."\r\n";
    $return .= "Accept: */*\r\n";
    $return .= "Accept-Encoding: gzip,deflate,sdch\r\n";
    $return .= "Accept-Language: en-US,pl;q=0.8,en-US;q=0.6,en;q=0.4\r\n";
    $return .= "Accept-Charset: Accept-Charset: UTF-8,utf-8;q=0.7,*;q=0.3\r\n";
    $return .= "Cookie: ".$self->{_cookies}[0].";".$self->{_cookies}[1].";".$self->{_cookies}[2].";".$self->{_cookies}[3]."&fv=10.1.103\r\n";

    return $return;
}

sub summary{
    my $self = shift;
    Print::info("FMT: ".$self->{_selectedFmt});
    Print::info("Time: ".$self->{_startFromTime}."ms");
    Print::info("Resolution: ".$self->{_fmt}{$self->{_selectedFmt}}{resolution});
    Print::info("Http Referer: ".$self->{_httpReferer});
    Print::info("URI: ".$self->{_download}->{_uri});
    Print::info("Host: ".$self->{_download}->{_host});
}

Local.pm

Local.pm handles "direct" URL (different from YouTube address) and pass it to Download.pm.

#!/usr/bin/perl

package Local;

use Download;
use FLV;

sub new{
    my $class = shift;
    my $self = {
        _url => undef,
        _download => undef # Holds 'download' object
    };

    bless $self, $class;
    return $self;
}

# Prints FLV stream whith only audio tags
sub getAudio{
    my $self = shift;
    $self->run(0,1,0);
}

# Prints codec part from audio tags
sub getRawAudio{
    my $self = shift;
    $self->run(0,1,1);
}

# Prints FLV stream with only video tags
sub getVideo{
    my $self = shift;
    $self->run(1,0,0);
}

# Prints codec part from video tags
sub getRawVideo{
    my $self = shift;
    $self->run(1,0,1);
}

# Prints both: audio and video as FLV stream
sub getAV{
    my $self = shift;
    $self->run(1,1,0);
}

# Starts downloading
sub run{
    my $self = shift;

    $self->{_download} = new Download($self);
    $self->{_download}->start();
    $self->summary(); # Print summary of connection such as Host, URI

    my $flv = new FLV(shift, shift, shift);
    $flv->getTags(); # Print out tags
}

# Prepares HTTP header
sub getHeader{
        my $self = shift;
    my $url = shift || exit;
    my $return = "";

    $url =~ m|(\w+)://([^/:]+)(:\d+)?/(.*)|; # split url
    $return .= "Host: $2\r\n";
    $return .= "Connection: keep-alive\r\n";
    $return .= "Accept: */*\r\n";

    return $return;
}

# Prints URI and HOST to stderr
sub summary{
    my $self = shift;
    Print::info("URI: ".$self->{_download}->{_uri});
    Print::info("Host: ".$self->{_download}->{_host});
}

Download.pm

In general Download.pm handles the Sock.pm operations (such as write, read). Also perpares headers and requests.

#!/usr/bin/perl

package Download;

use IO::Lambda qw(:all);
use IO::Socket;
use HTTP::Request;
use HTTP::Response;
use URI::Escape;
use Sock;

sub new{
    my $class = shift;
    my $self = {
        _obj => shift || die("YT object is missing"),
        _contentLength => undef,
        _uri => undef,
        _host => undef
    };

    bless $self, $class;
    return $self;
}

# Prepares request and starts downloading!
sub start{
    my $self = shift;
    my $request = HTTP::Request-> new( GET => $self->{_obj}->{_url});
    my $q = $self->talkRedirect($request);
    $q->wait;
}

sub talkRedirect{
    my $self = shift;
    my $req = shift;

    lambda{
            context $self->talk($req);
            tail{
                    my @tempHeader;
                    my $newUrl;

                    while (defined($_ = Sock->instance()->get()->getline)){ # read line from socket
                            last if($_ =~ /^[\r\n]+$/);

                            if($_ =~ /Location/){ (my $first, $newUrl) = split /\ /,$_; }
                            if($_ =~ /Content\-Length/){ $_ =~ s/.Length\: /\r/; $self->{_contentLength} = $_;} # save ContentLength
                            $tempHeader[$#tempHeader+1] = $_;
                    }

                    my $res = HTTP::Response->parse(@tempHeader);
                    return $res unless $res->code == 302; # if response code == 302 prepare and send another request

                    $req->uri($newUrl);
                    context $self->talk($req);
                    again;
            }
    }
}

sub talk{
        my $self = shift;
    my $req = shift;

    my $url = $req->uri;
    my($uri, $host) = $self->getUriHost($url);
    my @spl = split(/\&quality/, $uri, 0);
    $uri = $spl[0];

    # GVS adds redirect_counter parameter automatically
    if(!($uri =~ m/redirect_counter/) && defined($self->{_obj}->{_startFromTime}) && $self->{_obj}->{_startFromTime} > 0){
        $uri .= "&begin=".$self->{_obj}->{_startFromTime};
    }

        $self->{_uri} = $uri;
        $self->{_host} = $host;

    my $sock = Sock->instance($host)->get();

        lambda {
        context $sock;
        writable {
                        $sock->write("GET ".$uri." HTTP/1.1\r\n");
                        $sock->write("User-Agent: ".$self->getUserAgent()."\r\n");
                        $sock->write($self->{_obj}->getHeader($url)."\r\n");
        }
    }
}

# Gets Uri and Host address
sub getUriHost{
        my $self = shift;
    my $url = shift || exit;
    my $uri = URI->new($url);
    my $path = $uri->path;

    if($uri->query){
        $path .= "?".$uri->query;
    }

    return ($path,$uri->host);
}

# Gets UserAgent string. For IE YouTube generates diffrent HTML code, so IE is not included in the list
sub getUserAgent{
    my @agents = [];
    $agents[0] = "Mozilla/5.0 (X11; U; Linux i686; en-US) AppleWebKit/534.10 (KHTML, like Gecko) Chrome/8.0.552.224 Safari/534.10";
    $agents[1] = "Mozilla/5.0 (X11; Linux i686; rv:2.0) Gecko/20110321 Firefox/4.0";
    $agents[2] = "Opera/9.80 (X11; Linux i686; U; en-US) Presto/2.7.62 Version/11.01";
    $agents[3] = "Mozilla/5.0 (Windows; U; Windows NT 6.0; en-US; rv:1.9.0.5) Gecko/2008120122 Firefox/3.0.5";
    $agents[4] = "Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10_5_6; en-us) AppleWebKit/525.27.1 (KHTML, like Gecko) Version/3.2.1 Safari/525.27.1";

    return $agents[rand($#agents)];
}

Sock.pm

Sock.pm holds IO::Socket::INET singleton object instance.

#!/usr/bin/perl

package Sock;
use IO::Socket;
use Time::HiRes;

# Create singleton instance
my $singleton;

# Returns Sock instance
sub instance {
    my $class = shift;

    unless($singleton){
        my $self = {
            _socket => IO::Socket::INET-> new( PeerAddr => shift || die("Host is missing"), PeerPort => 80), # Create new IO::Socket::Inet object
            _readBytes => 0
        };

        bless ($self, $class);
        $singleton = $self;
    }

    return $singleton;
}

# Reads bytes from IO::Socket::INET if can't wait 10 secs
sub readBytes{
        my $self = shift;
    my $n = shift;
    my $wait = shift;
    my $counter = shift || 10;
    my $buffer;
    my $bytes;

    if($wait){
        if($counter > 0){
            Print::warn("Waiting ".$counter);
            Time::HiRes::sleep(.5);
            $counter--;
        }else{
            Print::err("Problem during download");
        }
    }

    $bytes = read $self->{_socket}, $buffer, $n or $self->readBytes($n,1,$counter);
    $self->{_readBytes} += $bytes;
    return $buffer;
}

# Gets socket instance
sub get{
    my $self = shift;
    return $self->{_socket};
}

# How many bytes have been read?
sub bytesCount{
    my $self = shift;
    return $self->{_readBytes};
}

FLV.pm

FLV.pm is the core of the script. It’s resposible for stream processing (reading/creating tags, reading/sending headers etc.)

#!/usr/bin/perl

package FLV;
use Tag;
use Sock;

sub new{
    my $class = shift;
    my $self = {
        _hasVideo => shift, # Enable/Disable video output
        _hasAudio => shift, # Enable/Disable audio output
    _isRawOutput => shift
    };

    if($self->{_hasVideo} == 0 && $self->{_hasAudio} == 0){
        Print::err("There's nothing to be done");
    }

    bless $self, $class;
    return $self;
}

sub getNewFlvHeader{
        my $self = shift;

    my $flags = (($self->{_hasAudio}) ? 0x04 : 0) | (($self->{_hasVideo}) ? 0x01 : 0);
    return pack 'A3CCN', 'FLV', 1, $flags, 9;
}

sub getTags{
        my $self = shift;
    my $sock = Sock->instance(); # Get socket instance
    my ($signature, $version, $flags, $offset) = unpack 'A3CCN', $sock->readBytes(9); # Unpack header
    my $lastTagSize = 0;

    if ($signature ne 'FLV'){ Print::err("FLV signature: $signature"); }
    if ($version != 1){ Print::err('Internal error: I only understand FLV version 1'); }
    if (0 != ($flags & 0xf0)){ Print::err('Reserved header flags are non-zero at byte'); }
    if ($offset < 9){ Print::err('Illegal value for body offset at byte'); }    if(!$self->{_isRawOutput}){
        Print::out($self->getNewFlvHeader()); # Prints new FLV Header
        Print::out(pack 'N', 0); # First previous tag is alwas equal to 0
    }

    while(1) {
        $sock->readBytes(4); # Read last tag size
        if(eof($sock->get())){ last; }

        my $tag = new Tag($self); # Create new Tag

        if(!$self->{_isRawOutput}){
            if(($self->{_hasAudio} && !$tag->isVideo()) || ($self->{_hasVideo} && !$tag->isAudio() || ($self->{_hasVideo} && $self->{_hasAudio}))){
            $tag->printTag();
            $lastTagSize = $tag->getSize();
            Print::out(pack 'N', $lastTagSize); # Each tag is followed by "Last Tag Size" Tag
            }
        }else{
            if($self->{_hasAudio} && $tag->isAudio() || $self->{_hasVideo} && $tag->isVideo()){
            $tag->{_obj}->printCodec(); # Raw output
            }
        }
    }
}

# Converts timestamp to seconds
sub timestampToSeconds{
        my $self = shift;
    my $msec = shift;
    return $self->round($msec/1000,2);
}

# Rounds up the number
sub round {
        my $self = shift;
    my $number = shift || 0;
    my $dec = 10 ** (shift || 0);
    return int( $dec * $number + .5 * ($number  0)) / $dec;
}

Tag.pm

Tag.pm parse raw Tag header and then creates appropriate tag object (see AudioTag.pm, VideoTag.pm)

#!/usr/bin/perl

package Tag;
use AudioTag;
use VideoTag;
use Sock;

sub new{
    my $class = shift;
    my $self = {
        _flv => shift || die("FLV object is missing"), # holds FLV object
        _rawHeader => undef, # contains raw Tag header
        _type => undef, # Tag type, 8:Audio, 9:Video, 18: Meta
        _dataSize => undef, # Tag size
        _timestamp => undef,
        _obj => undef, # Tag object
        _script => undef
    };

    bless $self, $class;

    $self->{_rawHeader} = Sock->instance()->readBytes(11); # Read raw tag header from stream
    ($self->{_type}, $self->{_dataSize}, $self->{_timestamp}) = $self->getTagInfo($self->{_rawHeader});

    $self->isValid(); # Check if tag is valid

    if($self->{_type} == 8){
        $self->{_obj} = new AudioTag($self->{_dataSize}); # Create AudioTag obj
    }elsif($self->{_type} == 9){
        $self->{_obj} = new VideoTag($self->{_dataSize}); # Create VideoTag obj
    }elsif($self->{_type} == 12 || $self->{_type} == 18){
        $self->{_script} = Sock->instance()->readBytes($self->{_dataSize}); # Just save raw data, we don't need to parse script or meta tag
    }

    return $self;
}

# Checks if current tag is an AudioTag
sub isAudio{
    return shift->{_type} == 8;
}

# Checks if current tag is an VideoTag
sub isVideo{
    return shift->{_type} == 9;
}

# Prints out the tag
sub printTag{
    my $self = shift;
    Print::out($self->{_rawHeader});

    if(defined($self->{_obj})){
        $self->{_obj}->printTag();
    }else{
        Print::tag("Meta Tag at ".Sock->instance()->bytesCount());
        Print::out($self->{_script});
    }
}

# Returns size of whole tag (header+content)
sub getSize{
    return shift->{_dataSize} + 11;
}

# Reads raw tag and returns TimeStamp, DataSize, Type
sub getTagInfo{
    my $self = shift;
    my $bytes = shift || exit;

    my ($type, @datasize, @timestamp);
    ($type, $dataSize[0],  $dataSize[1],  $dataSize[2], $timestamp[1], $timestamp[2], $timestamp[3], $timestamp[0]) = unpack 'CCCCCCCC', $bytes;

    my $dataSize = ($dataSize[0] * 256 + $dataSize[1]) * 256 + $dataSize[2];
    my $timestamp = (($timestamp[0] * 256 + $timestamp[1]) * 256 + $timestamp[2]) * 256 +$timestamp[3];

    return $type, $dataSize, $timestamp;
}

# Validates tag
sub isValid{
    my $self = shift;

    if ($self->{_timestamp} > 4_000_000_000 || $self->{_timestamp} < 0){         Print::warn("Strange timestamp: $self->{_timestamp}");
    }

    if($self->{_dataSize} < 4){         Print::err("Tag size is too small ($self->{_dataSize})");
    }
}

AudioTag.pm

AudioTag.pm holds information about audio (format, codec etc.)

#!/usr/bin/perl

package AudioTag;
use Sock;

my $formats = {
    0 => "Uncompressed",
    1 => "DPCM",
    2 => "MP3",
    10 => "AAC"
};

sub new{
    my $class = shift;
    my $self = {
        _tagSize => shift || die("TagSize is missing"),
        _flags => shift,
        _rawFlags => shift,
        _format => undef,
        _rate => undef,
        _size => undef,
        _type => undef,
        _codecData => undef
    };

    bless $self, $class;

    my $sock = Sock->instance();
    $self->{_rawFlags} = $sock->readBytes(1); # Read flags
    $self->{_codecData} = $sock->readBytes($self->{_tagSize}-1);
    $self->{_flags} = unpack 'C', $self->{_rawFlags}; # Unpack. "C" - An unsigned char (octet) value.

    $self->{_format} = (($self->{_flags} >> 4) & 0x0f);
    $self->{_rate} = (($self->{_flags} >> 2) & 0x0C);
    $self->{_size} = (($self->{_flags} >> 1) & 0x02);
    $self->{_type} = (($self->{_flags} >> 0) & 0x01);

    return $self;
}

sub printCodec{
    Print::out(shift->{_codecData});
}

sub printTag{
    my $self = shift;
    Print::tag("Audio Tag at ".Sock->instance()->bytesCount()." format: ".$formats->{$self->{_format}});
    Print::out($self->{_rawFlags});
    Print::out($self->{_codecData});
}
1;

VideoTag.pm

VideoTag.pm holds information about video (format, codec etc.)

#!/usr/bin/perl

package VideoTag;
use Sock;

my $codecs = {
    2 => "Sorensen H.263",
    3 => "Screen video",
    4 => "On2 VP6",
    5 => "On2 VP6 Alpha",
    6 => "ScreenVideo 2",
    7 => "MPEG-4 AVC (H.264)"
};

sub new{
    my $class = shift;
    my $self = {
        _tagSize => shift || die("TagSize is missing"),
        _flags => shift,
        _rawFlags => shift,
        _codecData => undef,

        _codecId => undef,
        _frameType => undef
    };

    bless $self, $class;
    my $sock = Sock->instance();

    $self->{_rawFlags} = $sock->readBytes(1);
    $self->{_codecData} = $sock->readBytes($self->{_tagSize}-1);
    $self->{_flags} = unpack 'C', $self->{_rawFlags};

    $self->{_codecId} = (($self->{_flags} >> 0) & 0x0f);
    $self->{_frameType} = (($self->{_flags} >> 4) & 0xf0);

    return $self;
}

sub printCodec{
    my $self = shift;
    Print::out($self->{_codecData});
}

sub printTag{
    my $self = shift;

    Print::tag("Video Tag at ".Sock->instance()->bytesCount()." codec: ".$codecs->{$self->{_codecId}});
    Print::out($self->{_rawFlags});
    Print::out($self->{_codecData});
}

Print.pm

Print.pm is responsible for printing out debug information/raw data.

#!/usr/bin/perl

package Print;
use Term::ANSIColor qw(:constants);

sub err{
    print STDERR BOLD, RED, "[Error]", RESET, " @_\n"; exit;
}

sub warn{
    print STDERR BOLD, YELLOW, "[Warning]", RESET, " @_\n";
}

sub tag{
    print STDERR BOLD, GREEN, "\r[Tag]", RESET, " @_";
}

sub info{
    print STDERR BOLD, GREEN, "[Info]", RESET, " @_\n";
}

sub out{
    print STDOUT @_;
}
1;

Demo

Sources: