API tools faq
paste
Advertisement
Guest User

GCExtractFilms.pm - MKV support

a guest
Jun 29th, 2012
472
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 16.28 KB | None | 0 0
raw download clone embed print report
  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;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!