File Coverage

blib/lib/File/TVShow/Organize.pm
Criterion Covered Total %
statement 181 184 98.3
branch 89 106 83.9
condition 23 35 65.7
subroutine 24 24 100.0
pod 15 15 100.0
total 332 364 91.2


line stmt bran cond sub pod time code
1             package File::TVShow::Organize;
2              
3 5     5   389272 use 5.10.0;
  5         68  
4 5     5   28 use strict;
  5         11  
  5         110  
5 5     5   25 use warnings;
  5         8  
  5         142  
6 5     5   26 use Carp;
  5         10  
  5         341  
7 5     5   38 use File::Path qw(make_path);
  5         10  
  5         405  
8 5     5   3351 use IPC::Cmd qw(can_run);
  5         301491  
  5         329  
9 5     5   2899 use File::Copy;
  5         22688  
  5         328  
10 5     5   2602 use File::TVShow::Info;
  5         27548  
  5         11172  
11              
12             require Exporter;
13              
14             our @ISA = qw(Exporter);
15              
16             our $VERSION = '0.35';
17              
18             # Preloaded methods go here.
19              
20             sub new
21             {
22 7     7 1 5491 my ($class, $args) = @_;
23             my $self = {
24             #default data and states. Other data is created and stored during
25             #program execution
26             countries => "(UK|US)",
27             delete => 0,
28             verbose => 0,
29             recursion => 0,
30             seasonFolder => 1,
31             exceptionListSource => $args->{Exceptions} || undef,
32 7   100     78 };
33              
34 7         20 bless $self, $class;
35              
36             ## Additional constructor code goes here.
37              
38 7 100       57 if (!defined $self->{exceptionListSource}) {
39             ## Do nothing
40             } else {
41             # create an array of pairs seperated by | character
42 3         40 my @list1 = split /\|/, $self->{exceptionListSource};
43             # now split each item in the array with by the : character use the first
44             # value as the key and the second as value
45 3         13 foreach my $item(@list1) {
46 4         23 my ($key, $value) = split(/:/, $item);
47 4         18 $self->{_exceptionList}{$key} = $value;
48             }
49             }
50 7         25 return $self;
51             }
52              
53             sub countries {
54              
55             # Set and get countries in case you want to change or add to the defaults
56             # use | as your separator
57 2     2 1 1492 my ($self, $countries) = @_;
58 2 100       8 $self->{countries} = $countries if defined $countries;
59 2         15 return $self->{countries};
60             }
61              
62             sub show_folder {
63             # Set and get path for where new shows are to be stored in the file system
64 40     40 1 11889 my ($self, $path) = @_;
65 40 100       371 if (defined $path) {
66 6 100 66     206 if ((-e $path) and (-d $path)) {
67 4         23 $self->{showFolder} = $path;
68             # Append / if missing from path
69 4 50       38 if ($self->{showFolder} !~ m/.*\/$/) {
70 4         18 $self->{showFolder} = $self->{showFolder} . '/';
71             }
72             } else {
73 2         33 $self->{showFolder} = undef;
74             }
75             }
76 40         353 return $self->{showFolder};
77             }
78              
79             sub new_show_folder {
80             # Set and get path to find new files to be moved from live
81 46     46 1 5862 my ($self, $path) = @_;
82 46 100       161 if (defined $path) {
83 8 100 66     280 if ((-e $path) and (-d $path)) {
84 6         34 $self->{newShowFolder} = $path;
85             # Append / if missing from path
86 6 100       88 if ($self->{newShowFolder} !~ m/.*\/$/) {
87 1         4 $self->{newShowFolder} = $self->{newShowFolder} . '/';
88             }
89             } else {
90 2         9 $self->{newShowFolder} = undef;
91             }
92             }
93 46         1054 return $self->{newShowFolder};
94             }
95              
96             sub create_show_hash {
97              
98 4     4 1 4150 my ($self) = @_;
99              
100             # exit loudly if the path has not been defined by the time this is called
101 4 50       18 croak unless defined($self->{showFolder});
102              
103             # Get the root path of the TV Show folder
104 4         28 my $directory = $self->show_folder();
105 4         8 my $showNameHolder;
106              
107 4 50       200 opendir(DIR, $directory) or die $!;
108 4         1559 while (my $file = readdir(DIR)) {
109 2380 100       6434 next if ($file =~ m/^\./); # skip hidden files and folders
110 1184         1642 chomp($file); # trim and end of line character
111             # create the inital hash strings are converted to lower case so
112             # "Doctor Who (2005)" becomes
113             # "doctor who (2005)" key="doctor who (2005), path="Doctor Who (2005)
114 1184         3831 $self->{shows}{lc($file)}{path} = $file;
115             # hanle if there is US or UK in the show name
116 1184 100       4113 if ($file =~ m/\s\(?$self->{countries}\)?$/i) {
117 40         88 $showNameHolder = $file;
118             # name minus country in $1 country in $2
119 40         299 $showNameHolder =~ s/(.*) \(?($self->{countries})\)?/$1/gi;
120             #catinate them together again with () around country
121             #This is now another key to the same path
122 40         180 $self->{shows}{lc($showNameHolder . " ($2)")}{path} = $file;
123             # create a key to the same path again with out country unless one has
124             # been already defined by another show
125             # this handles something like "Prey" which has a "Prey US" version
126             # and "Prey UK"
127 40 100       179 $self->{shows}{lc($showNameHolder)}{path} = $file unless (exists $self->{shows}{lc($showNameHolder)});
128             }
129             # Handle shows with Year extensions in the same manner has UK|USA
130 1184 100       4241 if ($file =~ m/\s\(?\d{4}\)?$/i) {
131 80         154 $showNameHolder = $file;
132 80         322 $showNameHolder =~ s/(.*) \(?(\d\d\d\d)\)?/$1/gi;
133 80         290 $self->{shows}{lc($showNameHolder . " ($2)")}{path} = $file;
134 80         241 $self->{shows}{lc($showNameHolder . " $2")}{path} = $file;
135             $self->{shows}{lc($showNameHolder)}{path} = $file unless
136 80 100       416 (exists $self->{shows}{lc($showNameHolder)});
137             }
138             }
139 4         115 closedir(DIR);
140             # Does this need to return anything or can it just return $self
141 4         26 return $self->{shows};
142              
143             }
144              
145             sub clear_show_hash {
146 1     1 1 2865 my ($self) = @_;
147              
148 1         114 $self->{shows} = ();
149 1         3 return $self;
150             }
151              
152             sub show_path {
153              
154             # Access the shows hash and return the correct directory path for the show
155             # name as passed to the funtion
156 85     85 1 1415 my ($self, $show) = @_;
157 85         640 return $self->{shows}{lc($show)}{path};
158             }
159              
160             sub process_new_shows {
161              
162 7     7 1 2381 my ($self, $curr_dir) = @_;
163 7 100       28 $curr_dir = $self->new_show_folder() unless defined($curr_dir);
164              
165 7         14 my $destination;
166              
167 7 50       310 opendir(DIR, $curr_dir) or die $!;
168 7         241 while (my $file = readdir(DIR)) {
169 125         305 $destination = undef;
170             ## Skip hiddenfiles
171 125 100       1050 next if ($file =~ m/^\./);
172             ## Trim the file name incase of end of line marker
173 49         138 chomp($file);
174             ## Skip files that have been processed before. They have had .done appended
175             # to to them.
176 49 100       297 next if ($file =~ m/\.done$/);
177 39 100       213 if (!$self->recursion) {
178 32 100       317 next if -d $self->new_show_folder() . $file; ## Skip non-Files
179             } else {
180 7 100       163 $self->process_new_shows($curr_dir . $file . "/") if -d $curr_dir . $file;
181             };
182             # next if ($file !~ m/s\d\de\d\d/i); # skip if SXXEXX is not present in file name
183 37         166 my $showData;
184             # Extract show name, Season and Episode
185 37         773 $showData = File::TVShow::Info->new($file);
186 37 100       40130 next if !$showData->is_tv_show();
187             # Apply special handling if the show is in the _exceptionList
188 31 100       387 if (exists $self->{_exceptionList}{$showData->{organize_name}}) { ##Handle special cases like "S.W.A.T"
189             # Replace the original name value with the one found in _exceptionList
190 1         18 $showData->{organize_name} = $self->{_exceptionList}{$showData->{organize_name}};
191             } else {
192             # Handle normally using '.' as the space marker name "Somthing.this" becomes "Something this"
193             # Strip periods from name.
194 30         262 $showData->{organize_name} =~ s/\./ /g;
195             }
196              
197             # If we don't have a show_path skip. Probably an unhandled show name
198             # store it in the UnhandledFileNames hash for reporting later.
199 31 100       210 if (!defined $self->show_path($showData->{organize_name})) {
200 2         45 $self->{UnhandledFileNames}{$file} = $showData->{organize_name};
201 2         25 next;
202             }
203             # Create the path string for storing the file in the right place
204 29         140 $destination = $self->show_folder() . $self->show_path($showData->{organize_name});
205             # if this is true. Update the $destination and create the season subfolder if required.
206             # if this is false. Do not append the season folder. files should just be stored in the root of the show folder.
207 29 100       169 if($self->season_folder()) {
208 27         176 $destination = $self->create_season_folder($destination, int($showData->{season}));
209             };
210             # Import the file. This will use rsync to copy the file into place and either rename or delete.
211             # see move_show() for implementation details
212 29         137 $self->move_show($destination, $curr_dir, $file);
213             }
214 7         111 close(DIR);
215 7         119 return;
216             #return $self;
217             }
218              
219             sub were_there_errors {
220              
221 1     1 1 2278 my ($self) = @_;
222              
223             # Check if there has been any files that File::TVShow::Info could not handle
224             # Check that the hash UnHandledFileNames has actually been created before
225             # checking that is is not empty or you will get an error.
226 1 50 33     32 if ((defined $self->{UnhandledFileNames}) && (keys %{$self->{UnhandledFileNames}})) {
  1         20  
227 1         88 print "\nThere were unhandled files in the directory\n";
228 1         14 print "consider adding them to the exceptionList\n###\n";
229 1         5 foreach my $key (keys %{$self->{UnhandledFileNames}}) {
  1         15  
230 1         29 print "### " . $key . " ==> " . $self->{UnhandledFileNames}{$key} . "\n";
231             }
232 1         13 print "###\n";
233             }
234              
235 1         17 return $self;
236             }
237              
238             sub delete {
239              
240 36     36 1 10445 my ($self, $delete) = @_;
241              
242 36 100       711 return $self->{delete} if(@_ == 1);
243              
244 5 100 66     89 if (($delete =~ m/[[:alpha:]]/) || ($delete != 0) && ($delete != 1)) {
      66        
245 1         27 print STDERR "Invalid arguments passed. Value not updated\n";
246 1         7 return undef;
247             } else {
248 4 100       34 if ($delete == 1) {
    50          
249 3         21 $self->{delete} = 1;
250             } elsif ($delete == 0) {
251 1         2 $self->{delete} = 0;
252             }
253              
254             # This return seems like its on a branch of code that is of litle use.
255             # Unless the return is checked on being set.
256              
257 4         25 return $self->{delete};
258             }
259             }
260              
261             sub recursion {
262              
263 45     45 1 2399 my ($self, $recursion) = @_;
264              
265 45 100       256 return $self->{recursion} if(@_ == 1);
266              
267 4 100 66     33 if (($recursion =~ m/[[:alpha:]]/) || ($recursion != 0) && ($recursion != 1)) {
      66        
268 1         12 print STDERR "Invalid arguments passed. Value not updated\n";
269 1         9 return undef;
270             } else {
271 3 100       13 if ($recursion == 1) {
    50          
272 2         6 $self->{recursion} = 1;
273             } elsif ($recursion == 0) {
274 1         2 $self->{recursion} = 0;
275             }
276              
277             # This return seems like its on a branch of code that is of litle use.
278             # Unless the return is checked on being set.
279 3         12 return $self->{recursion};
280             }
281             }
282              
283             sub verbose {
284 61     61 1 2457 my ($self, $verbose) = @_;
285              
286 61 100       442 return $self->{verbose} if(@_ == 1);
287              
288 3 100 66     26 if (($verbose =~ m/[[:alpha:]]/) || ($verbose != 0) && ($verbose != 1)) {
      66        
289 1         12 print STDERR "\n### Invalid arguments passed. Value not updated\n";
290 1         7 return undef;
291             } else {
292 2 100       8 if ($verbose == 1) {
    50          
293 1         3 $self->{verbose} = 1;
294             } elsif ($verbose == 0) {
295 1         2 $self->{verbose} = 0;
296             }
297             # This return seems like its on a branch of code that is of litle use.
298             # Unless the return is checked on being set.
299              
300 2         10 return $self->{verbose};
301             }
302             }
303              
304             sub season_folder {
305 35     35 1 2837 my ($self, $seasonFolder) = @_;
306              
307 35 100       226 return $self->{seasonFolder} if(@_ == 1);
308              
309 4 100 66     102 if (($seasonFolder =~ m/[[:alpha:]]/) || ($seasonFolder != 0) && ($seasonFolder != 1)) {
      66        
310 1         12 print STDERR "\n### Invalid arguments passed. Value not updated\n";
311 1         7 return undef;
312             } else {
313 3 100       59 if ($seasonFolder == 1) {
    50          
314 1         3 $self->{seasonFolder} = 1;
315             } elsif ($seasonFolder == 0) {
316 2         14 $self->{seasonFolder} = 0;
317             }
318             # This return seems like its on a branch of code that is of litle use.
319             # Unless the return is checked on being set.
320 3         26 return $self->{seasonFolder};
321             }
322             }
323              
324             sub create_season_folder {
325              
326 27     27 1 98 my ($self, $_path, $season) = @_;
327              
328 27         73 my $path = $_path . '/';
329              
330 27 100       79 if ($season == 0) {
331 3         11 $path = $path . 'Specials'
332             } else {
333 24         93 $path = $path . 'Season' . $season;
334             }
335             # Show Season folder being created if verbose mode is true.
336 27 50       194 if($self->verbose) {
337 0 0       0 make_path($path, { verbose => 1 }) unless -e $path;
338             } else {
339             # Verbose mode is false so work silently.
340 27 100       5631 make_path($path) unless -e $path;
341             }
342 27         147 return $path;
343             }
344              
345              
346             sub move_show {
347              
348 29     29 1 124 my ($self, $destination, $source, $file) = @_;
349              
350             # If the destination folder or source filder are not defined or no file is
351             # passed exit with errors
352 29 50       95 carp "Destination not passed." unless defined($destination);
353 29 50       184 carp "Source not passed." unless defined($source);
354 29 50       71 carp "File not passed." unless defined($file);
355              
356             # rewrite paths so they are rsync friendly. This means escape spaces and
357             # other special characters.
358 29         105 ($destination, $source) = _rsync_prep ($destination,$source);
359              
360             # create the command string to be used in system() call
361             # Set --progress if verbose is true
362              
363             # Get path to rsync using IPC::Cmd
364 29         434 my $command = can_run('rsync');
365 29         225297 $command .= " -ta ";
366 29 50       276 $command = $command . "--progress " if ($self->verbose);
367 29         171 $command = $command . $source . $file . " " . $destination;
368              
369 29         1446457 system($command);
370              
371 29 50       1565 if($? == 0) {
372             # If delete is true unlink file.
373 29 100       929 if($self->delete) {
374 15         1858 unlink($source . $file);
375             } else {
376             # delete is false so merely rename the file by appending .done
377 14         710 move($source . $file, $source . $file . ".done")
378             }
379             } else {
380             #report failed processing? Error on rsync command return code
381 0         0 print "## Something went very wrong. Rsync failed for some reason.\n";
382 0         0 print "## rsync err $?\n";
383             }
384 29         6747 return $self;
385              
386             }
387              
388             # This interal sub-routine prepares paths for use with external rsynch command
389             # Need to escape special characters
390             sub _rsync_prep {
391              
392 29     29   80 my ($dest, $source) = @_;
393              
394             # escape spaces and () characters to work with the rsync command.
395 29         99 $dest =~ s/\(/\\(/g;
396 29         79 $dest =~ s/\)/\\)/g;
397 29         295 $dest =~ s/ /\\ /g;
398 29         100 $dest = $dest . "/";
399              
400 29         179 $source =~ s/ /\\ /g;
401             #$source = $source . "/";
402              
403 29         127 return $dest, $source;
404             }
405              
406             1;
407              
408              
409             __END__