Will rename media files consisting of episodes of a television series by using the epguides.com website.

episode_renamer.pl

#!/usr/local/bin/perl

# AUTHORS: Dave Wilkinson and Bradley D. Kuhlman

# PURPOSE: Will rename media files consisting of episodes of a
#   television series by using the epguides.com website from
#   some cryptic, yet commonly found when downloaded on the
#   internet, format to be `## - Title` where ## is the episode
#   number.

# LIMITATIONS:
#   - If it isn't on the website, it doesn't know what to do, so
#        it gives up.
#   - The show title should be the same as expected by the website
#   - Has to follow the file hierarchy discussed in ASSUMPTIONS

# USAGE: Run in the directory of the season you will to rename
# ./episode_renamer.pl
#   Lists the files it will rename
# ./episode_renamer.pl 1
#   Will commit the changes

# ASSUMPTIONS:
# Your file hierarchy is like this:
#   /.../Show Title/Season 1/
# OR
#   /.../Show Title/Series 1/
# OR
#   /.../Show Title/Complete Series/
# and you run the script from that directory

use strict;

use LWP::Simple;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;
use HTML::LinkExtor;
use HTML::Entities;
use Cwd;
use Roman;

# D:/shows/The Office/Season 3"
my $curdir = getcwd();

$curdir =~ /\/([^\/]+)\/(?:Complete|Season|Series)\s([^\/]+$)/;
my $showtitle = $1;
my $season = $2;
if ($season eq "Series")
{
  $season = 1;
}
$showtitle =~ s/\bthe\b//gi;
$showtitle =~ s/\s+//g;
$showtitle =~ s/\(/_/g;
$showtitle =~ s/\)//g;
$showtitle =~ s/\'//g;

my $URL = "http://epguides.com/".$showtitle."/";
my $dirtarget = $curdir . "/";
#mode = 0  print
#mode = 1 rename files
my $mode = 0;

if ($#ARGV + 1 >= 1)
{
  $mode = $ARGV[0];
  
  if ($mode > 1)
  {
    $mode = 0;
  }
}

my $browser = LWP::UserAgent->new();
$browser->timeout(10);

my $request = HTTP::Request->new(GET => $URL);
my $response = $browser->request($request);
if ($response->is_error()) {printf "%s\n", $response->status_line;}

my $contents = $response->content();

my @acontents = split('\n',$contents);

my @episodes = grep(/\b$season-\s*\d+\b/,@acontents);
#my @episodes = grep(/\b5-\s*\d+\b/,@acontents);

my @epnames;
my @filenames;


if (@episodes == 0)
{
  die "This season does not exist on the site\n";
}

foreach (@episodes)
{
  #if ($_ =~ />([^>]+)<\/a>\s*$/)
  if ($_ =~ />([^>]+)<\/a>/)
  {
    my $epname = $1;
    my $idx = $_;
    $idx =~ /\b$season-\s*(\d+)\b/;
    #$idx =~ /\b5-\s*(\d+)\b/;
    $idx = $1;  
    
    $epname = decode_entities($epname);
    $epnames[$idx-1] = $epname;
  }
}

opendir(IMD, $dirtarget) || die("Cannot open directory");

my @thefiles= readdir(IMD);

# Stop correctly renamed files from screwing around
for (my $i=0;$i<@thefiles;$i++)
{
  $thefiles[$i] =~ /^(\d*)(?:,\s(\d*))?\s\-\s(.*)\..*$/;
  my $epNumber = $1;
  my $epNumber2 = $2;
  my $epName = $3;

  if ($epnames[$epNumber-1] eq $epName)
  {
    delete $thefiles[$i];
    $i--;
  }

}

for (my $i=0;$i<@epnames;$i++)
{
  my $t = $i + 1;
  my $d = $i + 2;
  for (my $j=0;$j<@thefiles;$j++)
  {
    #  if ($thefiles[$j] =~ /((?:\b$season|episode\s*|e\s*)0?$t[^\d])\b/i)
    #  
    #  @ - season number
    #  # - episode number
    #
    #  normal:
    #
    #  s@@e##
    #  @##
    #  @x##
    #  @.##
    #  episode ##
    #  season @ episode ##
    #
    #  two part:
    #
    #  -e##
    #  .e##
    
    # if ($thefiles[$j] =~ /((?:[^\de]$season|episode\s*|\bs0?\Q$season\E(e|x)\s*)0?$t\b(?:([^\d]\Q$season\E?(e|x)?\s*0?$d[^\d])|[^\d]))/i)
    my $tzero = "".$t;
    if ($t < 10) {
      $tzero = "0".$t;
    }

    if ($thefiles[$j] =~ /(s0?\Q$season\E_?e0?$t|(?:\we|[^\dex]|^)0?\Q$season\E$tzero|(?:[^\ds]|^)0?\Q$season\E[x.]$tzero|(?:\bseason\s*\Q$season\E\s*)?\bepisode\s*$t)([-.]?e0?$d)?(?:[^\d]|$)/i)
    {
      my $name=$tzero;
      if ($2)
      {
        $name.=",";
        if ($d <10)
        {
          $name.="0";
        }
        $name.= $d." - ".$epnames[$i].", ".$epnames[$i+1];
      }
      else
      {
        $name.=" - ".$epnames[$i];
      }
      
      $name =~ s/[?:]//g;
      $name =~ s/\//-/g;
      $thefiles[$j] =~ /(\.[^.]+)$/;
      my $source = $dirtarget.$thefiles[$j];
      my $dest = $dirtarget.$name.$1;
      if ($mode == 0)
      {
        print $name.$1."\n";
        print $thefiles[$j]."\n";
      }
      elsif (-e $dest)
      {
        print "ERROR! ".$name." already exists!\n";
      }
      else
      {
        rename($source, $dest);
      }
      last;
    }
  }
}

closedir(IMD);