Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

GCExtractFilms.pm - MKV support

By: a guest on Jun 29th, 2012  |  syntax: Perl  |  size: 16.28 KB  |  views: 253  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. package GCExtract::GCExtractFilms;
  2.  
  3. ###################################################
  4. #
  5. #  Copyright 2005-2010 Christian Jodar
  6. #
  7. #  This file is part of GCstar.
  8. #
  9. #  GCstar is free software; you can redistribute it and/or modify
  10. #  it under the terms of the GNU General Public License as published by
  11. #  the Free Software Foundation; either version 2 of the License, or
  12. #  (at your option) any later version.
  13. #
  14. #  GCstar is distributed in the hope that it will be useful,
  15. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. #  GNU General Public License for more details.
  18. #
  19. #  You should have received a copy of the GNU General Public License
  20. #  along with GCstar; if not, write to the Free Software
  21. #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22. #
  23. ###################################################
  24.  
  25. use strict;
  26. use GCExtract;
  27. use Image::ExifTool;
  28.  
  29. {
  30.     package GCExtract::GCfilmsExtracter;
  31.     use base 'GCItemExtracter';
  32.    
  33.     sub new
  34.     {
  35.         my $proto = shift;
  36.         my $class = ref($proto) || $proto;
  37.         my $self  = $class->SUPER::new(@_);
  38.         bless ($self, $class);
  39.  
  40.         return $self;
  41.     }
  42.    
  43.     sub readInt
  44.     {
  45.         my ($self, $size) = @_;
  46.         my $buf;
  47.  
  48.         $size = 4 if !$size;
  49.  
  50.         read $self->{file},$buf,$size;
  51.         return unpack "i",$buf;
  52.     }
  53.    
  54.     sub getAviInfo
  55.     {
  56.         my $self = shift;
  57.        
  58.         my $info = {};
  59.        
  60.         my @audioCodecs;
  61.         $audioCodecs[0x0001] = 'PCM';
  62.         $audioCodecs[0x0002] = 'ADPCM';
  63.         $audioCodecs[0x0030] = 'Dolby AC2';
  64.         $audioCodecs[0x0050] = 'MPEG';
  65.         $audioCodecs[0x0055] = 'MP3';
  66.         $audioCodecs[0x0092] = 'Dolby AC3 SPDIF';
  67.         $audioCodecs[0x2000] = 'Dolby AC3';
  68.         $audioCodecs[0x2001] = 'Dolby DTS';
  69.         $audioCodecs[0x2002] = 'WAVE';
  70.         $audioCodecs[0x2003] = 'WAVE';
  71.         $audioCodecs[0x2004] = 'WAVE';
  72.         $audioCodecs[0x2005] = 'WAVE';
  73.         $audioCodecs[0x674F] = 'Ogg Vorbis',
  74.         $audioCodecs[0x6750] = 'Ogg Vorbis',
  75.         $audioCodecs[0x6751] = 'Ogg Vorbis',
  76.         $audioCodecs[0x676F] = 'Ogg Vorbis',
  77.         $audioCodecs[0x6770] = 'Ogg Vorbis',
  78.         $audioCodecs[0x6771] = 'Ogg Vorbis',
  79.        
  80.         my $chunkName;
  81.         seek $self->{file},8,0;
  82.         read $self->{file},$chunkName,8;
  83.         return $info if ($chunkName ne 'AVI LIST');
  84.         seek $self->{file},4,1;
  85.         read $self->{file},$chunkName,8;
  86.        
  87.         $self->readInt;
  88.         my $dwMicroSecPerFrame = $self->readInt;
  89.         my $dwMaxBytesPerSec = $self->readInt;
  90.         my $dwReserved1 = $self->readInt;
  91.         my $dwFlags = $self->readInt;
  92.         my $dwTotalFrames = $self->readInt;
  93.         my $dwInitialFrames = $self->readInt;
  94.         my $dwStreams = $self->readInt;
  95.         my $dwSuggestedBufferSize = $self->readInt;
  96.         $info->{width} = $self->readInt;
  97.         $info->{height} = $self->readInt;
  98.         my $dwScale = $self->readInt;
  99.         my $dwRate = $self->readInt;
  100.         my $dwStart = $self->readInt;
  101.         my $dwLength = $self->readInt;
  102.  
  103.         $info->{length} = ($dwTotalFrames * $dwMicroSecPerFrame) / 60000000;
  104.         $info->{length} = GCUtils::round($info->{length});
  105.  
  106.         my $buff;
  107.         my ($gotVids, $gotAuds) = (0,0);
  108.         while (! eof($self->{file}))
  109.         {
  110.             read $self->{file},$chunkName,4;
  111.             if ($chunkName eq 'strl')
  112.             {
  113.                 seek $self->{file},8,1;
  114.                 read $self->{file},$buff,4;
  115.                 if ($buff eq 'vids')
  116.                 {
  117.                     read $self->{file},$info->{type},4;
  118.                     $gotVids = 1;
  119.                 }
  120.                 elsif ($buff eq 'auds')
  121.                 {
  122.                     read $self->{file},$info->{audioEncoding},4;
  123.                     $info->{audioEncoding} =~ s/^.*?\w*\W*?$/$1/g;
  124.                     if (!$info->{audioEncoding})
  125.                     {
  126.                         read $self->{file},$chunkName,4 while ($chunkName ne 'strf');
  127.                         seek $self->{file},4,1;
  128.                         my $codec;
  129.                         read $self->{file}, $codec, 2;
  130.                         $codec = unpack "v",$codec;
  131.                         $codec = $audioCodecs[$codec];
  132.                         seek $self->{file}, 2, 1;
  133.                         my $hz = $self->readInt;
  134.                         $info->{audioEncoding} = $codec if $codec;
  135.                         $info->{audioEncoding} .= " ($hz Hz)" if $hz;
  136.                     }
  137.                     $gotAuds = 1;
  138.                 }
  139.                 last if $gotVids && $gotAuds;
  140.             }
  141.             last if ($chunkName eq 'movi');
  142.         }
  143.        
  144.         return {} if ($buff ne 'vids') && ($buff ne 'auds');
  145.  
  146.         return $info;
  147.     }
  148.    
  149.     sub getMovAtom
  150.     {
  151.         my ($self, $wanted, $subAtom) = @_;
  152.    
  153.         my $copy = $subAtom;
  154.    
  155.         my ($header, $type, $length);
  156.         my $atom = 0;
  157.    
  158.         if ($subAtom)
  159.         {  
  160.             while ($copy)
  161.             {
  162.                 $header = substr($copy, 0, 8, '');
  163.                 ($length, $type) = unpack("Na4", $header);
  164.                 last if $type eq $wanted;
  165.                 substr($copy, 0 , $length - 8, '');
  166.             }
  167.             if ($copy)
  168.             {
  169.                 $atom = substr($copy, 0 , $length - 8, '');
  170.             }
  171.         }
  172.         else
  173.         {
  174.             while (!eof ($self->{file}))
  175.             {
  176.                 read $self->{file}, $header, 8;
  177.                 ($length, $type) = unpack("Na4", $header);
  178.                 last if $type eq $wanted;
  179.                 seek $self->{file},$length - 8, 1;
  180.             }
  181.             if ($self->{file})
  182.             {
  183.                 read $self->{file}, $atom, $length - 8;
  184.             }
  185.         }
  186.        
  187.         return $atom;
  188.     }
  189.    
  190.     sub getMovInfo
  191.     {
  192.         #Inspired from Video::Info::Quicktime_PL
  193.    
  194.         my $self = shift;
  195.        
  196.         my $info = {};
  197.        
  198.         seek $self->{file},0,0;
  199.  
  200.         my $header;
  201.  
  202.         my $atom = $self->getMovAtom('moov');
  203.  
  204.  
  205.         if ($atom)
  206.         {
  207.             while (length($atom) > 0)
  208.             {
  209.                 my ($sublen) = unpack("Na4",  substr( $atom, 0, 4, '') );
  210.                 my ($subatom) = substr($atom, 0, $sublen-4, '');
  211.                 my($type)  = substr($subatom, 0, 4, '');
  212.                
  213.                 if ($type eq 'mvhd')
  214.                 {
  215.                     my $timeScale = unpack( "Na4", substr($subatom,12,4));  
  216.                     my $duration = unpack( "Na4", substr($subatom,16,4));  
  217.                     $info->{length} = GCUtils::round($duration / ($timeScale * 60));
  218.                 }
  219.                 elsif ($type eq 'trak')
  220.                 {
  221.                     my $tkhd = $self->getMovAtom('tkhd', $subatom);
  222.                     my $mdia = $self->getMovAtom('mdia', $subatom);
  223.                     next if !$mdia;
  224.                     my $minf = $self->getMovAtom('minf', $mdia);
  225.                     next if !$minf;
  226.                     my $vmhd = $self->getMovAtom('vmhd', $minf);
  227.                     my $smhd = $self->getMovAtom('smhd', $minf);
  228.                     if ($vmhd || $smhd)
  229.                     {
  230.                         my $stbl = $self->getMovAtom('stbl', $minf);
  231.                         my $stsd = $self->getMovAtom('stsd', $stbl);
  232.  
  233.                         if ($vmhd)
  234.                         {
  235.                             my $width = unpack("Na4", substr($tkhd,74,4));
  236.                             my $height = unpack("Na4", substr($tkhd,78,4));
  237.                             ($info->{width}, $info->{height}) = ($width, $height);
  238.                             ($info->{type} = substr($stsd,12,8)) =~ s/\W(.*?)\W/$1/g;
  239.                         }
  240.                         else
  241.                         {
  242.                             ($info->{audioEncoding}= substr($stsd,12,8)) =~ s/\W(.*?)\W/$1/g;
  243.                         }
  244.                     }
  245.                 }
  246.             }
  247.         }        
  248.         return $info;
  249.     }
  250.        
  251.     sub getMpgInfo
  252.     {
  253.         #Inspired from MPEG::Info
  254.    
  255.         my $self = shift;
  256.        
  257.         my @frameRates = (
  258.             0,
  259.             24000/1001,
  260.             24,
  261.             25,
  262.             30000/1001,
  263.             30,
  264.             50,
  265.             60000/1001,
  266.             60,
  267.         );
  268.        
  269.         my $info = {};
  270.         $info->{type} = 'MPEG';
  271.         $info->{audioEncoding} = 'MPEG';
  272.        
  273.         my $magic;
  274.         my $numMagic = unpack("N",$self->{magic});
  275.         while (!eof($self->{file}) && $numMagic != 0x000001b3)
  276.         {
  277.             read $self->{file},$magic,4;
  278.             $numMagic = unpack("N",$magic);
  279.             seek $self->{file},-3, 1;
  280.         }
  281.         seek $self->{file},3, 1;
  282.         my $size;
  283.         read $self->{file},$size,3;
  284.        
  285.         $info->{width} = ((unpack "n",substr($size,0,2)) >> 4);
  286.         $info->{height} = ((unpack "n",substr($size,1,2)) & 0x0fff);
  287.        
  288.         my $fps;
  289.         read $self->{file},$fps,1;
  290.         $fps = $frameRates[ord($fps) & 0x0f];
  291.        
  292.         my ($buff1, $buff2);
  293.         read $self->{file}, $buff1, 2;
  294.         $buff1 = unpack 'n', $buff1;
  295.         $buff1 <<= 2;
  296.         read $self->{file}, $buff2, 1;
  297.         $buff2 = unpack 'C', $buff2;
  298.         $buff2 >>=6;
  299.         my $bitRate = ( ( $buff1 | $buff2 ) * 400);
  300.        
  301.         $info->{length} = GCUtils::round((($self->{fileSize} * 8 ) / $bitRate) / 60) if $bitRate;
  302.        
  303.         return $info;
  304.     }
  305.  
  306.     sub getExifInfo
  307.     {
  308.         my $self = shift;
  309.         my $fln = $self->{fileName};
  310.         my $exifTool = new Image::ExifTool;
  311.         my $exifinfo = $exifTool->ImageInfo($fln);
  312.         my $info = {};
  313.  
  314.         $info->{type} = $exifinfo->{FileType}.':'.$exifinfo->{VideoCodecID};
  315.         #$info->{audioEncoding} = substr $exifinfo->{AudioCodecID}, 2;
  316.        
  317.         my $audCount=0;
  318.         my $subCount=0;
  319.         my $tracki=0;
  320.         my $tc="";
  321.         my $audInfo="";
  322.         my $subInfo="";
  323.         while ($exifinfo->{"TrackType".$tc}){
  324.                 my $trt=$exifinfo->{"TrackType".$tc};
  325.                 my $trl=$exifinfo->{"TrackLanguage".$tc};
  326.                 my $trn=$exifinfo->{"TrackName".$tc};
  327.                 my $succcpc=utf8::decode($trn);
  328.                 if ($trt eq 'Audio'){
  329.                         my $atc=$audCount>0?" (".$audCount.")":"";
  330.                         my $trc=$exifinfo->{"AudioCodecID".$atc};
  331.                         $info->{audioAll}->[$audCount]->[0] = $trl.":".$trn;
  332.                         $info->{audioAll}->[$audCount]->[1] = substr $trc, 2;
  333.                         $audInfo=$audInfo.($audInfo?";":"").$trl.":".$trc;
  334.                         $audCount++;
  335.                 }elsif($trt eq 'Subtitle'){
  336.                         $info->{subtitle}->[$subCount]->[0] = $trl.":".$trn;
  337.                         $subInfo=$subInfo.($subInfo?";":"").$trl;
  338.                         $subCount++;
  339.                 }
  340.                 $tracki++;
  341.                 $tc=" (".$tracki.")";
  342.         }
  343.         $info->{audioEncoding} = $audInfo;
  344.         $info->{subtitleInfo} = $subInfo;
  345.  
  346.        
  347.         $info->{width} =  $exifinfo->{ImageWidth};
  348.         $info->{height} = $exifinfo->{ImageHeight};
  349.        
  350.         $info->{length} = $exifinfo->{Duration};
  351.  
  352.         return $info;
  353.     }
  354.  
  355.    
  356.     sub findOgmPage
  357.     {
  358.         #Inspired from Ogg::Vorbis::Header::PurePerl
  359.  
  360.         my $self = shift;
  361.         my $char;
  362.         my $curStr = '';
  363.  
  364.         my $i = 0;
  365.         while (read($self->{file}, $char, 1))
  366.         {
  367.             $curStr = $char . $curStr;
  368.             $curStr = substr($curStr, 0, 4);
  369.                 if ($curStr eq 'SggO')
  370.                 {
  371.                    seek $self->{file}, 8, 1;
  372.                    my $serial = $self->readInt(4);
  373.                    return $serial;
  374.                 }
  375.         }
  376.         return -1;
  377.     }
  378.  
  379.     sub findLastOgmPage
  380.     {
  381.         my $self = shift;
  382.         my $buff;
  383.         my $curStr = '';
  384.  
  385.         seek $self->{file}, -5, 2;
  386.  
  387.         my $i = 0;
  388.         while (read($self->{file}, $buff, 4))
  389.         {
  390.                 if ($buff eq 'OggS')
  391.                 {
  392.                    seek $self->{file}, 2, 1;
  393.                    my $granulePos = $self->readInt;
  394.                    return $granulePos;
  395.                 }
  396.                 seek $self->{file}, -5, 1;
  397.         }
  398.         return -1;
  399.     }    
  400.    
  401.     sub getOgmInfo
  402.     {
  403.         my $info = {};
  404.         my $self = shift;
  405.  
  406.         my $buff;
  407.         my ($gotAudio, $gotVideo) = (0,0);
  408.         seek $self->{file}, 0, 0;
  409.         my $serial = 0;
  410.         my $videoSerial = -1;
  411.         my $fps;
  412.         my $iteration = 0;
  413.         while ($serial != -1)
  414.         {
  415.             $serial = $self->findOgmPage;
  416.  
  417.             seek $self->{file}, 13, 1;
  418.             read $self->{file}, $buff, 8;
  419.             if ($buff =~ /^video/)
  420.             {
  421.                 read $self->{file}, $info->{type}, 4;
  422.                 my $size = $self->readInt;
  423.                 my $timeUnit = $self->readInt(8);
  424.                 my $spu = $self->readInt(8);
  425.                 $fps = (10000000.0 * $spu) / $timeUnit;
  426.                 my $defaultLen = $self->readInt;
  427.                 my $bufferSize = $self->readInt;
  428.                 my $bbp = $self->readInt;
  429.                 $info->{width} = $self->readInt;
  430.                 $info->{height} = $self->readInt;
  431.                
  432.                 $gotVideo = 1;
  433.                 $videoSerial = $serial;
  434.             }
  435.             elsif ($buff =~ /vorbis/)
  436.             {
  437.                 $info->{audioEncoding} = 'Vorbis';
  438.                 seek $self->{file}, 3, 1;
  439.                 my $hz = $self->readInt;
  440.                 $info->{audioEncoding} .= " ($hz Hz)" if $hz;
  441.                 $gotAudio = 1;
  442.             }
  443.             else
  444.             {
  445.                 last if $iteration > 5;
  446.             }
  447.             last if $gotAudio && $gotVideo;
  448.             $iteration++;
  449.         }
  450.         if ($gotVideo)
  451.         {
  452.             my $biggestGranulePos = $self->findLastOgmPage;
  453.             $info->{length} = GCUtils::round(($biggestGranulePos / $fps) / 60);
  454.         }
  455.        
  456.         return $info;
  457.     }
  458.    
  459.     sub getInfo
  460.     {
  461.         my $self = shift;
  462.    
  463.         open FILE, '<'.$self->{fileName};
  464.         binmode FILE;
  465.  
  466.         my $info = {};
  467.  
  468.         $self->{file} = \*FILE;
  469.         my $magic;
  470.         $self->{magic} = $magic;
  471.         read FILE,$magic,4;
  472.         my $numMagic = unpack("N",$magic);
  473.  
  474.         if ($magic eq 'RIFF')
  475.         {
  476.             $info = $self->getAviInfo;
  477.         }
  478.         elsif ($magic eq 'OggS')
  479.         {
  480.             $info = $self->getOgmInfo;
  481.         }
  482.         elsif (($numMagic == 0x000001ba) || ($numMagic == 0x000001b3))
  483.         {
  484.             $info = $self->getMpgInfo;
  485.         }
  486.         elsif ($numMagic == 0x1a45dfa3)
  487.         {
  488.             close FILE;
  489.             $info = $self->getExifInfo;
  490.         }
  491.         else
  492.         {
  493.             my $magic2;
  494.             read FILE,$magic2,4;
  495.             if ($magic2 =~ /(moov|notp|wide|ftyp)/)
  496.             {
  497.                 $info = $self->getMovInfo;
  498.             }
  499.         }
  500.        
  501.         close FILE;
  502.         my $result;
  503.        
  504.         $result->{time} = {displayed => $info->{length}, value => $info->{length}};
  505.         $result->{video} = {displayed => $info->{type}, value => $info->{type}};
  506.         my $currentAudio = $self->{panel}->audio;
  507.         if ($info->{audioAll})
  508.         {
  509.             $result->{audio}->{value} = $info->{audioAll};
  510.             $result->{audio}->{displayed} = $info->{audioEncoding};
  511.         }
  512.         elsif ($info->{audioEncoding})
  513.         {
  514.             $currentAudio->[0]->[1] = $info->{audioEncoding};
  515.             $result->{audio}->{value} = $currentAudio;
  516.             $result->{audio}->{displayed} = $info->{audioEncoding};
  517.         }
  518.         if ($info->{width} && $info->{height})
  519.         {
  520.             my $comment = $self->{panel}->comment;
  521.             $comment .= "\n" if $comment && ($comment !~ /\n$/m);
  522.             $result->{comment}->{displayed} =
  523.                 $self->{model}->getDisplayedText('ExtractSize').$self->{parent}->{lang}->{Separator}.
  524.                 $info->{width}.'*'.$info->{height};
  525.             $result->{comment}->{value} = $comment . $result->{comment}->{displayed};
  526.         }
  527.         if ($info->{subtitle}){
  528.             $result->{subt}->{value} = $info->{subtitle};
  529.             $result->{subt}->{displayed} = $info->{subtitleInfo};
  530.         }
  531.        
  532.         return $result;
  533.     }
  534.    
  535.     sub getFields
  536.     {
  537.         return ['time', 'video', 'audio', 'comment', 'subt'];
  538.     }
  539. }
  540.  
  541. 1;
clone this paste RAW Paste Data