transmission.pl 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965
  1. #!/usr/bin/perl
  2. use warnings;
  3. use strict;
  4. # Includes
  5. use JSON;
  6. use Date::Parse;
  7. use File::Copy;
  8. use File::Touch;
  9. use File::Temp qw/ :mktemp /;
  10. use File::Basename;
  11. use Image::ExifTool qw/ :Public/;
  12. use FindBin qw($Bin);
  13. use lib $Bin;
  14. use Fetch;
  15. # Prototypes
  16. sub session($);
  17. sub fetch($);
  18. sub getSSE($);
  19. sub getDest($$$$);
  20. sub storeNZB($);
  21. sub delNZB($);
  22. sub delTor($);
  23. sub guessExt($);
  24. sub processFile($$);
  25. sub unrar($$);
  26. sub seriesCleanupLocal($);
  27. sub seriesCleanupCore($);
  28. sub seriesCleanup($);
  29. sub readDir($$);
  30. sub findMediaFiles($$);
  31. sub available($);
  32. # Parameters
  33. my $maxAge = 2.5 * 86400;
  34. my $tvDir = `~/bin/video/mediaPath` . '/TV';
  35. my $monitoredExec = $ENV{'HOME'} . '/bin/video/torrentMonitored.pl';
  36. my $content =
  37. '{"method":"torrent-get","arguments":{"fields":["hashString","id","addedDate","comment","creator",'
  38. . '"dateCreated","isPrivate","name","totalSize","pieceCount","pieceSize","downloadedEver","error","errorString",'
  39. . '"eta","haveUnchecked","haveValid","leftUntilDone","metadataPercentComplete","peersConnected","peersGettingFromUs",'
  40. . '"peersSendingToUs","rateDownload","rateUpload","recheckProgress","sizeWhenDone","status","trackerStats",'
  41. . '"uploadedEver","uploadRatio","seedRatioLimit","seedRatioMode","downloadDir","files","fileStats"]}}';
  42. my $delContent = '{"method":"torrent-remove","arguments":{"ids":["#_ID_#"], "delete-local-data":"true"}';
  43. my $history = '{"method":"history","params":[]}';
  44. my $delHistory = '{"method":"editqueue","params":["historyFinalDelete","",[#_ID_#]]}';
  45. my $delSleep = 2;
  46. my $RAR_MIN_FILES = 4;
  47. my $FIND_MAX_DEPTH = 5;
  48. my $CONF_FILE = $ENV{'HOME'} . '/.download.config';
  49. # Debug
  50. my $DEBUG = 0;
  51. if ($ENV{'DEBUG'}) {
  52. $DEBUG = 1;
  53. }
  54. # Command-line parameters
  55. my ($force, $maxDays, $hash) = @ARGV;
  56. # Config file
  57. my %CONFIG = ();
  58. if ($CONF_FILE && -r $CONF_FILE) {
  59. my $fh;
  60. open($fh, '<', $CONF_FILE)
  61. or die('Unable to open config file: ' . $CONF_FILE . ': ' . $! . "\n");
  62. while (<$fh>) {
  63. # Skip blank lines and comments
  64. if (/^\s*#/ || /^\s*$/) {
  65. next;
  66. }
  67. # Assume everything else is bash variables
  68. if (my ($key, undef(), $val) = $_ =~ /^\s*(\S[^\=]+)\=([\'\"])(.*)\g{-2}\s*$/) {
  69. $CONFIG{$key} = $val;
  70. if ($DEBUG) {
  71. print STDERR 'Adding config: ' . $key . ' => ' . $val . "\n";
  72. }
  73. } else {
  74. warn('Ignoring config line: ' . $_ . "\n");
  75. }
  76. }
  77. close($fh);
  78. }
  79. # If a hash is provided, always process matching torrents
  80. if (defined($hash)) {
  81. $force = 1;
  82. }
  83. # Init
  84. my $fetch = undef();
  85. # Tranmission
  86. if (available($CONFIG{'TRANS_URL'})) {
  87. # Fetch the list of paused (i.e. completed) torrents
  88. $fetch->url($CONFIG{'TRANS_URL'});
  89. $fetch->post_content($content);
  90. &fetch($fetch);
  91. my $torrents = decode_json(scalar($fetch->content()));
  92. $torrents = $torrents->{'arguments'}->{'torrents'};
  93. # Process
  94. if ($DEBUG) {
  95. print STDERR "Processing torrents...\n";
  96. }
  97. foreach my $tor (@{$torrents}) {
  98. # Skip torrents that aren't yet done
  99. if ($tor->{'leftUntilDone'} > 0 || $tor->{'metadataPercentComplete'} < 1) {
  100. next;
  101. }
  102. # Only process recent files
  103. # Torrents created with magnet links have no dateCreated, so fake it with addedDate
  104. if ($tor->{'dateCreated'} < 946684800) {
  105. $tor->{'dateCreated'} = $tor->{'addedDate'};
  106. }
  107. if (!$force && $tor->{'dateCreated'} < time() - $maxAge) {
  108. my $age = (time() - $tor->{'dateCreated'}) / 86400;
  109. if ($DEBUG) {
  110. print STDERR 'Skipping old torrent: ' . $tor->{'name'} . ' (' . sprintf('%.0f', $age) . " days)\n";
  111. }
  112. next;
  113. }
  114. # If a hash is provided, process only that file
  115. if (defined($hash) && $tor->{'hashString'} ne $hash) {
  116. if ($DEBUG) {
  117. printf STDERR 'Skipping torrent with non-matching hash: ' . $tor->{'name'} . ' (' . $tor->{'hashString'} . ")\n";
  118. }
  119. next;
  120. }
  121. # We've decided to do something about this torrent
  122. if ($DEBUG) {
  123. print STDERR 'Processing completed torrent: ' . $tor->{'name'} . "\n";
  124. }
  125. # Handle individual files and directories
  126. my @files = ();
  127. my @newFiles = ();
  128. my $path = $tor->{'downloadDir'} . '/' . $tor->{'name'};
  129. if (!-d $path) {
  130. push(@files, $path);
  131. } else {
  132. # State variables
  133. my $IS_RAR = '';
  134. my $IS_FAKE = 0;
  135. # Look for RAR files
  136. foreach my $file (@{ $tor->{'files'} }) {
  137. if ($file->{'name'} =~ /\.rar$/i) {
  138. $IS_RAR = $tor->{'downloadDir'} . '/' . $file->{'name'};
  139. last;
  140. }
  141. }
  142. # Check for password files
  143. foreach my $file (@{ $tor->{'files'} }) {
  144. if ($file->{'name'} =~ /passw(?:or)?d/i) {
  145. print STDERR 'Password file detected in: ' . $tor->{'name'} . "\n";
  146. $IS_FAKE = 1;
  147. last;
  148. }
  149. }
  150. # Check for single-file RARs
  151. if ($IS_RAR && scalar(@{ $tor->{'files'} }) < $RAR_MIN_FILES) {
  152. print STDERR 'Single-file RAR detected in: ' . $tor->{'name'} . "\n";
  153. $IS_FAKE = 1;
  154. }
  155. # Delete fake torrents and bail
  156. if ($IS_FAKE) {
  157. if ($DEBUG) {
  158. print STDERR 'Deleting fake torrent: ' . $tor->{'name'} . "\n";
  159. }
  160. delTor($tor);
  161. next;
  162. }
  163. # Unrar if necessary
  164. if (defined($IS_RAR) && length($IS_RAR) > 0) {
  165. @newFiles = &unrar($IS_RAR, $path);
  166. }
  167. # Find all media files, recursively
  168. @files = findMediaFiles($path, 0);
  169. }
  170. # Bail if we found no files
  171. if (scalar(@files) < 1) {
  172. print STDERR 'No media files found in torrent: ' . $tor->{'name'} . "\n";
  173. next;
  174. }
  175. # Do all the normal file naming/copying/etc. if we found at least one file
  176. my $failure = 0;
  177. foreach my $file (@files) {
  178. my $result = -1;
  179. if (defined($file) && length($file) > 0 && -r $file) {
  180. $result = &processFile($file, $path);
  181. }
  182. if (defined($result) && $result == 1) {
  183. if ($DEBUG) {
  184. print STDERR 'Torrent stored successfully: ' . $tor->{'name'} . "\n";
  185. }
  186. } elsif (defined($result) && $result == -1) {
  187. if ($DEBUG) {
  188. print STDERR 'Deleting bad torrent: ' . $tor->{'name'} . "\n";
  189. }
  190. last;
  191. } else {
  192. print STDERR 'Error storing file "' . basename($file) . '" from torrent: ' . $tor->{'name'} . "\n";
  193. $failure = 1;
  194. last;
  195. }
  196. }
  197. # Delete any files we added
  198. foreach my $file (@newFiles) {
  199. if ($DEBUG) {
  200. print STDERR 'Deleting new file: ' . basename($file) . "\n";
  201. }
  202. unlink($file);
  203. }
  204. # Only delete the torrent on success
  205. if (!$failure) {
  206. delTor($tor);
  207. next;
  208. }
  209. }
  210. # NZB
  211. if (available($CONFIG{'NZB_URL'})) {
  212. # Fetch the list of historical (i.e. completed) NZBs
  213. $fetch->url($CONFIG{'NZB_URL'});
  214. $fetch->post_content($history);
  215. $fetch->fetch();
  216. my $resp = decode_json(scalar($fetch->content()));
  217. if (!defined($resp) || ref($resp) ne 'HASH' || !exists($resp->{'result'}) || ref($resp->{'result'}) ne 'ARRAY') {
  218. print STDERR 'Invalid NZB response: ' . $fetch->content() . "\n";
  219. }
  220. # Process
  221. if ($DEBUG) {
  222. print STDERR "Processing NZBs...\n";
  223. }
  224. foreach my $data (@{ $resp->{'result'} }) {
  225. my %nzb = ('id' => undef(), 'name' => undef(), 'status' => undef(), 'path' => undef());
  226. if (ref($data) ne 'HASH' || !exists($data->{'ID'}) || !int($data->{'ID'})) {
  227. print STDERR 'Invalid NZB item: ' . $data . "\n";
  228. next;
  229. }
  230. $nzb{'id'} = int($data->{'ID'});
  231. # Name
  232. if (exists($data->{'Name'})) {
  233. $nzb{'name'} = $data->{'Name'};
  234. }
  235. if (!$nzb{'name'} && exists($data->{'NZBName'})) {
  236. $nzb{'name'} = $data->{'NZBName'};
  237. }
  238. if (!$nzb{'name'} && exists($data->{'NZBNicename'})) {
  239. $nzb{'name'} = $data->{'NZBNicename'};
  240. }
  241. if (!$nzb{'name'}) {
  242. print STDERR 'Unable to retrieve name for: ' . $nzb{'id'} . "\n";
  243. next;
  244. }
  245. # Status
  246. if (exists($data->{'Status'})) {
  247. $nzb{'status'} = $data->{'Status'};
  248. }
  249. if (!$nzb{'status'}) {
  250. print STDERR 'Unable to retrieve status for: ' . $nzb{'id'} . "\n";
  251. next;
  252. }
  253. # Path
  254. if (exists($data->{'DestDir'})) {
  255. $nzb{'path'} = $data->{'DestDir'};
  256. }
  257. if (!$nzb{'path'}) {
  258. print STDERR 'Unable to retrieve path for: ' . $nzb{'id'} . "\n";
  259. next;
  260. }
  261. # Debug
  262. if ($DEBUG) {
  263. print STDERR "\n\n";
  264. foreach my $key (keys(%nzb)) {
  265. print STDERR $key . ' => ' . $nzb{$key} . "\n";
  266. }
  267. }
  268. # Delete failed NZBs
  269. if ($nzb{'status'} eq 'FAILURE/HEALTH') {
  270. delNZB(\%nzb);
  271. next;
  272. }
  273. # Process sucessful NZBs
  274. if ($nzb{'status'} eq 'SUCCESS') {
  275. if (storeNZB(\%nzb)) {
  276. delNZB(\%nzb);
  277. } else {
  278. print STDERR 'Unable to store NZB: ' . $nzb{'name'} . "\n";
  279. }
  280. next;
  281. }
  282. }
  283. }
  284. }
  285. # Cleanup
  286. exit(0);
  287. # Grab the session ID
  288. sub session($) {
  289. my ($fetch) = @_;
  290. my %headers = ();
  291. ($headers{'X-Transmission-Session-Id'}) = $fetch->content() =~ /X\-Transmission\-Session\-Id\:\s+(\w+)/;
  292. $fetch->headers(\%headers);
  293. }
  294. sub fetch($) {
  295. my ($fetch) = @_;
  296. $fetch->fetch('nocheck' => 1);
  297. if ($fetch->status_code() != 200) {
  298. &session($fetch);
  299. $fetch->fetch();
  300. if ($fetch->status_code() != 200) {
  301. die('Unable to fetch: ' . $fetch->status_code() . "\n");
  302. }
  303. }
  304. }
  305. sub getSSE($) {
  306. my ($name) = @_;
  307. if ($DEBUG) {
  308. print STDERR 'Finding series/season/episode for: ' . $name . "\n";
  309. }
  310. my $season = 0;
  311. my $episode = 0;
  312. my $seasonBlock = '';
  313. if ($name =~ /(?:\b|_)(20\d\d(?:\.|\-)[01]?\d(?:\.|\-)[0-3]?\d)(?:\b|_)/) {
  314. $seasonBlock = $1;
  315. my ($month, $day);
  316. ($season, $month, $day) = $seasonBlock =~ /(20\d\d)(?:\.|\-)([01]?\d)(?:\.|\-)([0-3]?\d)/;
  317. $season = int($season);
  318. $episode = sprintf('%04d-%02d-%02d', $season, $month, $day);
  319. } elsif ($name =~ /(?:\b|_)(S(?:eason)?[_\s\.\-]*\d{1,2}[_\s\.\-]*E(?:pisode)?[_\s\.]*\d{1,3}(?:E\d{1,3})?)(?:\b|_)/i) {
  320. $seasonBlock = $1;
  321. ($season, $episode) = $seasonBlock =~ /S(?:eason)?[_\s\.\-]*(\d{1,2})[_\s\.\-]*E(?:pisode)?[_\s\.\-]*(\d{1,3})/i;
  322. $season = int($season);
  323. $episode = sprintf('%02d', int($episode));
  324. } elsif ($name =~ /\b(\d{1,2}x\d{2,3})\b/i) {
  325. $seasonBlock = $1;
  326. ($season, $episode) = $seasonBlock =~ /(\d+)x(\d+)/i;
  327. $season = int($season);
  328. $episode = sprintf('%02d', int($episode));
  329. } elsif ($name =~ /(?:\b|_)([01]?\d[_\s\.]?[0-3]\d)(?:\b|_)/i) {
  330. $seasonBlock = $1;
  331. ($season, $episode) = $seasonBlock =~ /(?:\b|_)([01]?\d)[_\s\.]?([0-3]\d)/i;
  332. $season = int($season);
  333. $episode = sprintf('%02d', int($episode));
  334. }
  335. if (!defined($seasonBlock) || $season < 1 || length($episode) < 1 || $episode eq '0') {
  336. if ($DEBUG) {
  337. print STDERR 'Could not find seasonBlock in: ' . $name . "\n";
  338. }
  339. return;
  340. }
  341. # Assume the series titles comes before the season/episode block
  342. my $series = '';
  343. my $sIndex = index($name, $seasonBlock);
  344. if ($sIndex > 0) {
  345. $series = substr($name, 0, $sIndex - 1);
  346. $series = seriesCleanupCore($series);
  347. }
  348. if ($DEBUG) {
  349. print STDERR 'Series: ' . $series . ' Season: ' . $season . ' Episode: ' . $episode . "\n";
  350. }
  351. return ($series, $season, $episode);
  352. }
  353. sub getDest($$$$) {
  354. my ($series, $season, $episode, $ext) = @_;
  355. if ($DEBUG) {
  356. print STDERR 'Finding destintion for: ' . $series . ' S' . $season . 'E' . $episode . "\n";
  357. }
  358. # Input cleanup
  359. $episode =~ s/^0+//;
  360. # Find all our existing TV series
  361. my @shows = ();
  362. my %showsCan = ();
  363. open(SHOWS, '-|', $monitoredExec, 'STORE')
  364. or die("Unable to fork: ${!}\n");
  365. while (<SHOWS>) {
  366. chomp;
  367. my $orig = $_;
  368. my $clean = seriesCleanupLocal($_);
  369. push(@shows, $clean);
  370. $showsCan{$clean} = $orig;
  371. }
  372. close SHOWS or die("Unable to read monitored series list: ${!} ${?}\n");
  373. # See if we can find a unique series name match
  374. my $sClean = seriesCleanup($series);
  375. my $sCleanCore = seriesCleanupCore($series);
  376. my $sMatch = '\b' . $sClean . '\b';
  377. $series = '';
  378. foreach my $show (@shows) {
  379. # Match the folder name or the search_name
  380. my $coarse_match = 0;
  381. if ($show =~ /${sMatch}/i) {
  382. $coarse_match = 1;
  383. } else {
  384. my $search_name = '';
  385. my $file = $tvDir . '/' . $showsCan{$show} . '/search_name';
  386. if (-e $file) {
  387. open(FH, $file)
  388. or die('Unable to read search_name file: ' . $file . "\n");
  389. $search_name = <FH>;
  390. close(FH);
  391. }
  392. if ($search_name) {
  393. $search_name = seriesCleanup($search_name);
  394. if ($search_name =~ /${sMatch}/i) {
  395. $coarse_match = 1;
  396. }
  397. }
  398. }
  399. # If we got a course match, continue checking
  400. if ($coarse_match) {
  401. # Enforce any secondary matching rules (for ambiguous titles)
  402. my $detail_match = 1;
  403. {
  404. my @lines;
  405. my $file = $tvDir . '/' . $showsCan{$show} . '/must_match';
  406. if (-e $file) {
  407. local ($/, *FH);
  408. open(FH, $file)
  409. or die('Unable to read must_match file: ' . $file . "\n");
  410. my @tmp = <FH>;
  411. close(FH);
  412. push(@lines, @tmp);
  413. }
  414. foreach my $line (@lines) {
  415. chomp($line);
  416. if (!eval('$sCleanCore =~ m' . $line)) {
  417. if ($DEBUG) {
  418. print STDERR 'Skipping ' . $show . ' due to must_match failure for: ' . $line . "\n";
  419. }
  420. $detail_match = 0;
  421. last;
  422. }
  423. }
  424. }
  425. if (!$detail_match) {
  426. next;
  427. }
  428. # If we find more than one matching series
  429. if (length($series) > 0) {
  430. # If the old match is a subset of the new match, prefer the new match
  431. # If the new match is a subet of the old match, prefer the old match
  432. # Bail if the matches do not overlap
  433. if ($show =~ m/^${series}\b/) {
  434. if ($DEBUG) {
  435. print STDERR 'Using longer match ('
  436. . $showsCan{$show}
  437. . ') in place of shorter match ('
  438. . $showsCan{$series} . ")\n";
  439. }
  440. $series = $show;
  441. } elsif ($series =~ m/^${show}\b/) {
  442. if ($DEBUG) {
  443. print STDERR 'Using longer match ('
  444. . $showsCan{$series}
  445. . ') in place of shorter match ('
  446. . $showsCan{$show} . ")\n";
  447. }
  448. $series = $series;
  449. } else {
  450. print STDERR 'Matched both ' . $showsCan{$series} . ' and ' . $showsCan{$show} . "\n";
  451. return;
  452. }
  453. } else {
  454. # If we're still around this is the first series title match
  455. $series = $show;
  456. }
  457. }
  458. }
  459. if (length($series) < 1) {
  460. if ($DEBUG) {
  461. print STDERR 'No series match for: ' . $sMatch . "\n";
  462. }
  463. return;
  464. }
  465. # Lookup the canonical name from the matched name
  466. $series = $showsCan{$series};
  467. # Make sure we have the right season folder
  468. my $seriesDir = $tvDir . '/' . $series;
  469. my $seasonDir = $seriesDir . '/' . 'Season ' . $season;
  470. if (!-d $seasonDir) {
  471. print STDERR 'No season folder for: ' . $series . ' S' . $season . "\n";
  472. return;
  473. }
  474. # Bail if we already have this episode
  475. my @episodes = readDir($seasonDir, 0);
  476. foreach my $ep (@episodes) {
  477. my ($epNum) = $ep =~ /^\s*([\d\-]+)\s*\-\s*/;
  478. if (!defined($epNum)) {
  479. next;
  480. }
  481. $epNum =~ s/^0+//;
  482. if ($epNum eq $episode) {
  483. print STDERR 'Existing episode for: ' . $series . ' S' . $season . 'E' . $episode . "\n";
  484. return;
  485. }
  486. }
  487. # Construct the final path
  488. if (!defined($ext) || length($ext) < 1) {
  489. $ext = 'avi';
  490. }
  491. if ($episode =~ /^\d+$/) {
  492. $episode = sprintf('%02d', $episode);
  493. }
  494. my $dest = sprintf('%s/%s - NoName.%s', $seasonDir, $episode, $ext);
  495. if ($DEBUG) {
  496. print STDERR 'Destination: ' . $dest . "\n";
  497. }
  498. return $dest;
  499. }
  500. sub storeNZB($) {
  501. my ($nzb) = @_;
  502. if ($DEBUG) {
  503. print STDERR 'Storing NZB: ' . $nzb->{'name'} . "\n";
  504. }
  505. # Find all media files, recursively
  506. my @files = findMediaFiles($nzb->{'path'}, 0);
  507. # Bail if we found no files
  508. if (scalar(@files) < 1) {
  509. print STDERR 'No media files found in NZB: ' . $nzb->{'name'} . "\n";
  510. next;
  511. }
  512. return 0;
  513. }
  514. sub delNZB($) {
  515. my ($nzb) = @_;
  516. if ($DEBUG) {
  517. print STDERR 'Deleting NZB: ' . $nzb->{'name'} . "\n";
  518. }
  519. # Remove the files, if any
  520. if (-e $nzb->{'path'} && -d $nzb->{'path'}) {
  521. if ($DEBUG) {
  522. print STDERR 'Removing NZB folder: ' . $nzb->{'path'} . "\n";
  523. }
  524. #system('rm -rf ' . $nzb->{'path'});
  525. # Check for deletion
  526. if (-e $nzb->{'path'}) {
  527. print STDERR 'Unable to remove NZB folder: ' . $nzb->{'path'} . "\n";
  528. return 0;
  529. }
  530. }
  531. # Send the command
  532. my $id = $nzb->{'id'};
  533. my $content = $delHistory;
  534. $content =~ s/\#_ID_\#/${id}/;
  535. $fetch->post_content($content);
  536. print STDERR 'Delete: ' . $content . "\n";
  537. #$fetch->fetch();
  538. # Check the result
  539. return 0;
  540. }
  541. sub delTor($) {
  542. my ($tor) = @_;
  543. if ($DEBUG) {
  544. print STDERR 'Deleting torrent: ' . $tor->{'name'} . "\n";
  545. }
  546. # Sleep to avoid bugs in Transmission (i.e. multiple deletes fail)
  547. sleep($delSleep);
  548. # Construct the content
  549. my $id = $tor->{'hashString'};
  550. my $content = $delContent;
  551. $content =~ s/\#_ID_\#/${id}/;
  552. # Send the command
  553. &session($fetch);
  554. $fetch->post_content($content);
  555. &fetch($fetch);
  556. }
  557. sub guessExt($) {
  558. my ($file) = @_;
  559. my $ext = '';
  560. # Believe most non-avi file extensions without checking
  561. # It's mostly "avi" that lies, and the checks are expensive
  562. {
  563. my $orig_ext = basename($file);
  564. $orig_ext =~ s/^.*\.(\w{2,3})$/$1/;
  565. $orig_ext = lc($orig_ext);
  566. if ($orig_ext eq 'mkv' || $orig_ext eq 'ts') {
  567. $ext = $orig_ext;
  568. }
  569. }
  570. # Deal with the weird case of text files labeled as .txt.mp4
  571. if ($file =~ /\.txt\.mp4$/i) {
  572. $ext = 'txt';
  573. }
  574. # Guess the file type if we don't have one yet
  575. if (!$ext) {
  576. my $mime = '';
  577. my $demux = '';
  578. # Try ExifTool for MIME and demuxer types
  579. if (!$mime || !$demux) {
  580. my $exif = ImageInfo($file);
  581. if (defined($exif) && ref($exif) eq 'HASH') {
  582. if ($exif->{'MIMEType'}) {
  583. $mime = $exif->{'MIMEType'};
  584. }
  585. if ($exif->{'FileType'}) {
  586. $demux = $exif->{'FileType'};
  587. }
  588. }
  589. }
  590. # Try file(1) for MIME types
  591. if (!$mime) {
  592. open(FILE, '-|', 'file', '-b', $file);
  593. while (<FILE>) {
  594. $mime .= $_;
  595. }
  596. close(FILE);
  597. }
  598. # Cleanup the demuxer and MIME types
  599. $demux =~ s/^\s+//;
  600. $demux =~ s/\s+$//;
  601. $mime =~ s/^\s+//;
  602. $mime =~ s/\s+$//;
  603. $mime =~ s/\;.*$//;
  604. $mime =~ s/^video\///i;
  605. # Try to pick an extension we understand
  606. if ($demux =~ /MKV/i || $mime =~ /Matroska/i) {
  607. $ext = 'mkv';
  608. } elsif ($demux =~ /ASF/i || $mime =~ /\bASF\b/i) {
  609. $ext = 'wmv';
  610. } elsif ($demux =~ /MP4/i || $mime =~ /\bMP4\b/i) {
  611. $ext = 'mp4';
  612. } elsif ($mime =~ /\bZIP/i) {
  613. $ext = 'zip';
  614. } elsif ($demux =~ /MPEGTS/i) {
  615. $ext = 'ts';
  616. } else {
  617. $ext = 'avi';
  618. }
  619. }
  620. return $ext;
  621. }
  622. sub processFile($$) {
  623. my ($file, $path) = @_;
  624. if ($DEBUG) {
  625. print STDERR 'Attempting to process file: ' . basename($file) . "\n";
  626. }
  627. # Skip known packaging files files with success code
  628. if ($file =~ /\/RARBG\.com\.(?:mp4|avi|mkv|txt)$/i || $file =~ /\.txt\.(?:mp4|avi|mkv)$/) {
  629. if ($DEBUG) {
  630. print STDERR 'Declining to save packaging file: ' . $file . "\n";
  631. }
  632. return 1;
  633. }
  634. # Guess a file extension and basename
  635. my $ext = &guessExt($file);
  636. my $filename = basename($file);
  637. # Delete WMV files -- mostly viruses/fake
  638. if ($ext =~ /wmv/i) {
  639. if ($DEBUG) {
  640. print STDERR 'Declining to save WMV file: ' . $filename . "\n";
  641. }
  642. return -1;
  643. }
  644. # Delete ZIP files -- mostly fake
  645. if ($ext =~ /zip/i) {
  646. if ($DEBUG) {
  647. print STDERR 'Declining to save ZIP file: ' . $filename . "\n";
  648. }
  649. return -1;
  650. }
  651. # Allow multiple guesses at the series/season/episode
  652. my $dest = '';
  653. LOOP: {
  654. # Determine the series, season, and episode number
  655. my ($series, $season, $episode) = &getSSE($filename);
  656. if ( defined($series)
  657. && length($series) > 0
  658. && defined($season)
  659. && $season > 0
  660. && defined($episode)
  661. && length($episode) > 0
  662. && $episode ne '0')
  663. {
  664. # Find the proper destination for this torrent, if any
  665. $dest = &getDest($series, $season, $episode, $ext);
  666. }
  667. # Sanity/loop check
  668. if (!defined($dest) || length($dest) < 1) {
  669. # If there is no match but the torrent is a folder
  670. # retry the guess using the torrent path
  671. if ($file ne $path) {
  672. my $newName = basename($path);
  673. if ($newName ne $filename) {
  674. $filename = basename($path);
  675. redo LOOP;
  676. }
  677. }
  678. # Otherwise we just fail
  679. print STDERR 'No destination for: ' . basename($file) . "\n";
  680. return;
  681. }
  682. }
  683. # Copy (to let Transmission deal with local cleanup) and rename into place
  684. my $tmp = mktemp($dest . '.XXXXXXXX');
  685. copy($file, $tmp);
  686. rename($tmp, $dest);
  687. # Touch to avoid carrying dates set in the download process
  688. touch($dest);
  689. # Return success
  690. return 1;
  691. }
  692. sub unrar($$) {
  693. my ($file, $path) = @_;
  694. if ($DEBUG) {
  695. print STDERR 'UnRARing: ' . basename($file) . "\n";
  696. }
  697. # Keep a list of old files, so we can find/delete the output
  698. my @beforeFiles = readDir($path, 1);
  699. # Run the unrar utility
  700. my $pid = fork();
  701. if (!defined($pid)) {
  702. print STDERR "Unable to fork for RAR\n";
  703. return;
  704. } elsif ($pid == 0) {
  705. # Child
  706. close(STDOUT);
  707. close(STDERR);
  708. chdir($path);
  709. my @args = ('unrar', 'e', '-p-', '-y', $file);
  710. exec { $args[0] } @args;
  711. }
  712. # Wait for the child
  713. waitpid($pid, 0);
  714. # Compare the old file list to the new one
  715. my @newFiles = ();
  716. my @afterFiles = readDir($path, 1);
  717. foreach my $file (@afterFiles) {
  718. my $found = 0;
  719. foreach my $file2 (@beforeFiles) {
  720. if ($file eq $file2) {
  721. $found = 1;
  722. last;
  723. }
  724. }
  725. if (!$found) {
  726. push(@newFiles, $file);
  727. }
  728. }
  729. # Return the list of added files
  730. return @newFiles;
  731. }
  732. sub seriesCleanupLocal($) {
  733. my ($name) = @_;
  734. $name =~ s/\.//g;
  735. return seriesCleanupCore($name);
  736. }
  737. sub seriesCleanupCore($) {
  738. my ($name) = @_;
  739. $name =~ s/^.*\[[^\]]*\]\s+//;
  740. $name =~ s/\b(?:and|\&)\b/ /ig;
  741. $name =~ s/^\s*The\b//ig;
  742. $name =~ s/\[[^\]]*\]//g;
  743. $name =~ s/\{[^\}]*\}//g;
  744. $name =~ s/[\(\)]//g;
  745. $name =~ s/[\'\"]//g;
  746. $name =~ s/[^\w\s]+/ /g;
  747. $name =~ s/_+/ /g;
  748. $name =~ s/\s+/ /g;
  749. $name =~ s/^\s*//;
  750. $name =~ s/\s*$//;
  751. return $name;
  752. }
  753. sub seriesCleanup($) {
  754. my ($name) = @_;
  755. $name =~ s/\s*\(?US\)?\s*$//;
  756. $name =~ s/\s*\(?20[01][0-9]\)?\s*$//;
  757. return seriesCleanupCore($name);
  758. }
  759. sub readDir($$) {
  760. my ($indir, $long) = @_;
  761. # Clean up the input directory
  762. $indir =~ s/\/+$//;
  763. my @files = ();
  764. if (!opendir(DIR, $indir)) {
  765. warn('readDir: Unable to read directory: ' . $indir . ': ' . $! . "\n");
  766. return;
  767. }
  768. foreach my $file (readdir(DIR)) {
  769. my $keep = 0;
  770. # Skip junk
  771. if ( $file eq '.'
  772. || $file eq '..'
  773. || $file =~ /\._/)
  774. {
  775. next;
  776. }
  777. # Save the full path
  778. if ($long) {
  779. push(@files, $indir . '/' . $file);
  780. } else {
  781. push(@files, $file);
  782. }
  783. }
  784. closedir(DIR);
  785. # Sorts the files before returning to the caller
  786. my @orderedFiles = ();
  787. @orderedFiles = sort(@files);
  788. # Return the file list
  789. return (@orderedFiles);
  790. }
  791. sub findMediaFiles($$) {
  792. my ($path, $depth) = @_;
  793. my @files = ();
  794. # Recursion limit
  795. if ($depth > $FIND_MAX_DEPTH) {
  796. return ();
  797. }
  798. my @tmpFiles = readDir($path, 1);
  799. foreach my $file (@tmpFiles) {
  800. # Skip sample files
  801. if ($file =~ /sample/i) {
  802. next;
  803. }
  804. # Recurse on directories
  805. if (-d $file) {
  806. push(@files, findMediaFiles($file, $depth + 1));
  807. next;
  808. }
  809. # Save matching files
  810. if ($file =~ /\.(?:avi|mkv|m4v|mov|mp4|ts|wmv)$/i) {
  811. push(@files, $file);
  812. next;
  813. }
  814. }
  815. return @files;
  816. }
  817. # Check availability of web interface
  818. sub available($) {
  819. my ($url) = @_;
  820. if ($DEBUG) {
  821. print STDERR "Checking for interface\n";
  822. }
  823. # Reset from the last host
  824. $fetch = Fetch->new();
  825. my ($host) = $url =~ /^(\w+\:\/\/[^\/]+\/?)/;
  826. $fetch->url($host);
  827. if ($fetch->fetch('nocheck' => 1) != 200) {
  828. if ($DEBUG) {
  829. print STDERR 'Code: ' . $fetch->status_code() . "\n";
  830. print STDERR 'Content: ' . $fetch->content() . "\n";
  831. warn('Interface not available: ' . $host . "\n");
  832. }
  833. return 0;
  834. }
  835. return 1;
  836. }