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 6     6   436375 use 5.10.0;
  6         74  
4 6     6   33 use strict;
  6         13  
  6         133  
5 6     6   29 use warnings;
  6         12  
  6         168  
6 6     6   30 use Carp;
  6         20  
  6         403  
7 6     6   40 use File::Path qw(make_path);
  6         11  
  6         424  
8 6     6   3402 use IPC::Cmd qw(can_run);
  6         303501  
  6         443  
9 6     6   3717 use File::Copy;
  6         24935  
  6         400  
10 6     6   3118 use File::TVShow::Info;
  6         32454  
  6         14172  
11              
12             require Exporter;
13              
14             our @ISA = qw(Exporter);
15              
16             our $VERSION = '0.36';
17              
18             # Preloaded methods go here.
19              
20             sub new
21             {
22 7     7 1 6361 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     87 };
33              
34 7         22 bless $self, $class;
35              
36             ## Additional constructor code goes here.
37              
38 7 100       55 if (!defined $self->{exceptionListSource}) {
39             ## Do nothing
40             } else {
41             # create an array of pairs seperated by | character
42 3         41 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         33 foreach my $item(@list1) {
46 4         18 my ($key, $value) = split(/:/, $item);
47 4         29 $self->{_exceptionList}{$key} = $value;
48             }
49             }
50 7         24 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 1708 my ($self, $countries) = @_;
58 2 100       9 $self->{countries} = $countries if defined $countries;
59 2         16 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 11938 my ($self, $path) = @_;
65 40 100       342 if (defined $path) {
66 6 100 66     204 if ((-e $path) and (-d $path)) {
67 4         20 $self->{showFolder} = $path;
68             # Append / if missing from path
69 4 50       47 if ($self->{showFolder} !~ m/.*\/$/) {
70 4         17 $self->{showFolder} = $self->{showFolder} . '/';
71             }
72             } else {
73 2         33 $self->{showFolder} = undef;
74             }
75             }
76 40         312 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 5706 my ($self, $path) = @_;
82 46 100       205 if (defined $path) {
83 8 100 66     257 if ((-e $path) and (-d $path)) {
84 6         39 $self->{newShowFolder} = $path;
85             # Append / if missing from path
86 6 100       80 if ($self->{newShowFolder} !~ m/.*\/$/) {
87 1         4 $self->{newShowFolder} = $self->{newShowFolder} . '/';
88             }
89             } else {
90 2         7 $self->{newShowFolder} = undef;
91             }
92             }
93 46         891 return $self->{newShowFolder};
94             }
95              
96             sub create_show_hash {
97              
98 4     4 1 4205 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         18 my $directory = $self->show_folder();
105 4         8 my $showNameHolder;
106              
107 4 50       236 opendir(DIR, $directory) or die $!;
108 4         1568 while (my $file = readdir(DIR)) {
109 2380 100       6211 next if ($file =~ m/^\./); # skip hidden files and folders
110 1184         1525 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         3611 $self->{shows}{lc($file)}{path} = $file;
115             # hanle if there is US or UK in the show name
116 1184 100       4106 if ($file =~ m/\s\(?$self->{countries}\)?$/i) {
117 40         80 $showNameHolder = $file;
118             # name minus country in $1 country in $2
119 40         319 $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         194 $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       194 $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       4337 if ($file =~ m/\s\(?\d{4}\)?$/i) {
131 80         147 $showNameHolder = $file;
132 80         341 $showNameHolder =~ s/(.*) \(?(\d\d\d\d)\)?/$1/gi;
133 80         311 $self->{shows}{lc($showNameHolder . " ($2)")}{path} = $file;
134 80         242 $self->{shows}{lc($showNameHolder . " $2")}{path} = $file;
135             $self->{shows}{lc($showNameHolder)}{path} = $file unless
136 80 100       419 (exists $self->{shows}{lc($showNameHolder)});
137             }
138             }
139 4         162 closedir(DIR);
140             # Does this need to return anything or can it just return $self
141 4         30 return $self->{shows};
142              
143             }
144              
145             sub clear_show_hash {
146 1     1 1 3012 my ($self) = @_;
147              
148 1         263 $self->{shows} = ();
149 1         6 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 1618 my ($self, $show) = @_;
157 85         591 return $self->{shows}{lc($show)}{path};
158             }
159              
160             sub process_new_shows {
161              
162 7     7 1 2129 my ($self, $curr_dir) = @_;
163 7 100       27 $curr_dir = $self->new_show_folder() unless defined($curr_dir);
164              
165 7         23 my $destination;
166              
167 7 50       379 opendir(DIR, $curr_dir) or die $!;
168 7         238 while (my $file = readdir(DIR)) {
169 125         306 $destination = undef;
170             ## Skip hiddenfiles
171 125 100       973 next if ($file =~ m/^\./);
172             ## Trim the file name incase of end of line marker
173 49         200 chomp($file);
174             ## Skip files that have been processed before. They have had .done appended
175             # to to them.
176 49 100       299 next if ($file =~ m/\.done$/);
177 39 100       195 if (!$self->recursion) {
178 32 100       281 next if -d $self->new_show_folder() . $file; ## Skip non-Files
179             } else {
180 7 100       154 $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         111 my $showData;
184             # Extract show name, Season and Episode
185 37         763 $showData = File::TVShow::Info->new($file);
186 37 100       38755 next if !$showData->is_tv_show();
187             # Apply special handling if the show is in the _exceptionList
188 31 100       330 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         19 $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         313 $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       131 if (!defined $self->show_path($showData->{organize_name})) {
200 2         39 $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         216 $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       105 if($self->season_folder()) {
208 27         186 $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         109 $self->move_show($destination, $curr_dir, $file);
213             }
214 7         107 close(DIR);
215 7         80 return;
216             #return $self;
217             }
218              
219             sub were_there_errors {
220              
221 1     1 1 2188 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     45 if ((defined $self->{UnhandledFileNames}) && (keys %{$self->{UnhandledFileNames}})) {
  1         21  
227 1         101 print "\nThere were unhandled files in the directory\n";
228 1         27 print "consider adding them to the exceptionList\n###\n";
229 1         7 foreach my $key (keys %{$self->{UnhandledFileNames}}) {
  1         17  
230 1         20 print "### " . $key . " ==> " . $self->{UnhandledFileNames}{$key} . "\n";
231             }
232 1         10 print "###\n";
233             }
234              
235 1         4 return $self;
236             }
237              
238             sub delete {
239              
240 36     36 1 9885 my ($self, $delete) = @_;
241              
242 36 100       820 return $self->{delete} if(@_ == 1);
243              
244 5 100 66     104 if (($delete =~ m/[[:alpha:]]/) || ($delete != 0) && ($delete != 1)) {
      66        
245 1         29 print STDERR "Invalid arguments passed. Value not updated\n";
246 1         142 return undef;
247             } else {
248 4 100       48 if ($delete == 1) {
    50          
249 3         18 $self->{delete} = 1;
250             } elsif ($delete == 0) {
251 1         3 $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         18 return $self->{delete};
258             }
259             }
260              
261             sub recursion {
262              
263 45     45 1 3859 my ($self, $recursion) = @_;
264              
265 45 100       353 return $self->{recursion} if(@_ == 1);
266              
267 4 100 66     36 if (($recursion =~ m/[[:alpha:]]/) || ($recursion != 0) && ($recursion != 1)) {
      66        
268 1         12 print STDERR "Invalid arguments passed. Value not updated\n";
269 1         8 return undef;
270             } else {
271 3 100       12 if ($recursion == 1) {
    50          
272 2         5 $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         14 return $self->{recursion};
280             }
281             }
282              
283             sub verbose {
284 61     61 1 3168 my ($self, $verbose) = @_;
285              
286 61 100       384 return $self->{verbose} if(@_ == 1);
287              
288 3 100 66     23 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       10 if ($verbose == 1) {
    50          
293 1         4 $self->{verbose} = 1;
294             } elsif ($verbose == 0) {
295 1         3 $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         9 return $self->{verbose};
301             }
302             }
303              
304             sub season_folder {
305 35     35 1 3593 my ($self, $seasonFolder) = @_;
306              
307 35 100       163 return $self->{seasonFolder} if(@_ == 1);
308              
309 4 100 66     99 if (($seasonFolder =~ m/[[:alpha:]]/) || ($seasonFolder != 0) && ($seasonFolder != 1)) {
      66        
310 1         38 print STDERR "\n### Invalid arguments passed. Value not updated\n";
311 1         8 return undef;
312             } else {
313 3 100       37 if ($seasonFolder == 1) {
    50          
314 1         3 $self->{seasonFolder} = 1;
315             } elsif ($seasonFolder == 0) {
316 2         11 $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         28 return $self->{seasonFolder};
321             }
322             }
323              
324             sub create_season_folder {
325              
326 27     27 1 96 my ($self, $_path, $season) = @_;
327              
328 27         199 my $path = $_path . '/';
329              
330 27 100       92 if ($season == 0) {
331 3         7 $path = $path . 'Specials'
332             } else {
333 24         81 $path = $path . 'Season' . $season;
334             }
335             # Show Season folder being created if verbose mode is true.
336 27 50       176 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       14607 make_path($path) unless -e $path;
341             }
342 27         133 return $path;
343             }
344              
345              
346             sub move_show {
347              
348 29     29 1 96 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       85 carp "Destination not passed." unless defined($destination);
353 29 50       74 carp "Source not passed." unless defined($source);
354 29 50       80 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         104 ($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         343 my $command = can_run('rsync');
365 29         223097 $command .= " -ta ";
366 29 50       230 $command = $command . "--progress " if ($self->verbose);
367 29         126 $command = $command . $source . $file . " " . $destination;
368              
369 29         1503465 system($command);
370              
371 29 50       1855 if($? == 0) {
372             # If delete is true unlink file.
373 29 100       1023 if($self->delete) {
374 15         2386 unlink($source . $file);
375             } else {
376             # delete is false so merely rename the file by appending .done
377 14         803 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         7620 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   67 my ($dest, $source) = @_;
393              
394             # escape spaces and () characters to work with the rsync command.
395 29         75 $dest =~ s/\(/\\(/g;
396 29         72 $dest =~ s/\)/\\)/g;
397 29         320 $dest =~ s/ /\\ /g;
398 29         74 $dest = $dest . "/";
399              
400 29         74 $source =~ s/ /\\ /g;
401             #$source = $source . "/";
402              
403 29         88 return $dest, $source;
404             }
405              
406             1;
407              
408              
409             __END__