1 | #!/usr/bin/perl -w |
---|
2 | # |
---|
3 | # $Date: 2006-02-07 04:05:03 +0100 (Di, 07 Feb 2006) $ |
---|
4 | # $Revision: 8888 $ |
---|
5 | # $Author: xris $ |
---|
6 | # |
---|
7 | # license: GPL |
---|
8 | # author: Chris Petersen (based on the ideas in mythlink.sh from Dale Gass) |
---|
9 | # |
---|
10 | # mythrename.pl (formerly mythlink.pl) |
---|
11 | # |
---|
12 | # Renames mythtv recordings to more human-readable filenames. |
---|
13 | # See --help for instructions. |
---|
14 | # |
---|
15 | # Automatically detects database settings from mysql.txt, and loads |
---|
16 | # the mythtv recording directory from the database (code from nuvexport). |
---|
17 | # |
---|
18 | |
---|
19 | # Includes |
---|
20 | use DBI; |
---|
21 | use Getopt::Long; |
---|
22 | use File::Path; |
---|
23 | use File::Basename; |
---|
24 | use File::Find; |
---|
25 | |
---|
26 | # Some variables we'll use here |
---|
27 | our ($dest, $format, $usage, $underscores, $live); |
---|
28 | our ($dformat, $dseparator, $dreplacement, $separator, $replacement); |
---|
29 | our ($db_host, $db_user, $db_name, $db_pass, $video_dir, $verbose); |
---|
30 | our ($hostname, $dbh, $sh, $sh2, $q, $q2, $count); |
---|
31 | |
---|
32 | |
---|
33 | # Default filename format |
---|
34 | # $dformat = '%T %- %Y-%m-%d, %g-%i %A %- %S'; |
---|
35 | $dformat = '%T %- %d.%m.%Y, %G.%i %- %S'; |
---|
36 | # Default separator character |
---|
37 | $dseparator = '-'; |
---|
38 | # Default replacement character |
---|
39 | $dreplacement = '-'; |
---|
40 | |
---|
41 | # Provide default values for GetOptions |
---|
42 | $format = $dformat; |
---|
43 | $separator = $dseparator; |
---|
44 | $replacement = $dreplacement; |
---|
45 | |
---|
46 | # Load the cli options |
---|
47 | GetOptions('link|dest|destination|path:s' => \$dest, |
---|
48 | 'format=s' => \$format, |
---|
49 | 'live' => \$live, |
---|
50 | 'separator=s' => \$separator, |
---|
51 | 'replacement=s' => \$replacement, |
---|
52 | 'usage|help|h' => \$usage, |
---|
53 | 'underscores' => \$underscores, |
---|
54 | 'verbose' => \$verbose |
---|
55 | ); |
---|
56 | |
---|
57 | # Print usage |
---|
58 | if ($usage) { |
---|
59 | print <<EOF; |
---|
60 | $0 usage: |
---|
61 | |
---|
62 | options: |
---|
63 | |
---|
64 | --link [destination directory] |
---|
65 | |
---|
66 | If you would like mythrename.pl to work like the old mythlink.pl, specify |
---|
67 | --link and an optional pathname. If no pathname is given, links will be |
---|
68 | created in the show_names directory inside of the current mythtv data |
---|
69 | directory on this machine. eg: |
---|
70 | |
---|
71 | /var/video/show_names/ |
---|
72 | |
---|
73 | WARNING: ALL symlinks within the destination directory and its |
---|
74 | subdirectories (recursive) will be removed when using the --link option. |
---|
75 | |
---|
76 | --live |
---|
77 | |
---|
78 | Include live tv recordings, affects both linking and renaming. |
---|
79 | |
---|
80 | default: do not link/rename live tv recordings |
---|
81 | |
---|
82 | --format |
---|
83 | |
---|
84 | default: $dformat |
---|
85 | |
---|
86 | \%T = title (aka show name) |
---|
87 | \%S = subtitle (aka episode name) |
---|
88 | \%R = description |
---|
89 | \%C = category (as reported by grabber) |
---|
90 | \%c = chanid |
---|
91 | \%U = recording group |
---|
92 | \%y = year, 2 digits |
---|
93 | \%Y = year, 4 digits |
---|
94 | \%n = month |
---|
95 | \%m = month, leading zero |
---|
96 | \%j = day of month |
---|
97 | \%d = day of month, leading zero |
---|
98 | \%g = 12-hour hour |
---|
99 | \%G = 24-hour hour |
---|
100 | \%h = 12-hour hour, with leading zero |
---|
101 | \%H = 24-hour hour, with leading zero |
---|
102 | \%i = minutes |
---|
103 | \%s = seconds |
---|
104 | \%a = am/pm |
---|
105 | \%A = AM/PM |
---|
106 | \%- = separator character |
---|
107 | / = directory/folder (path separator) |
---|
108 | |
---|
109 | * For end time, prepend an "e" to the appropriate time/date format code |
---|
110 | above; i.e. "\%eG" gives the 24-hour hour for the end time. |
---|
111 | |
---|
112 | * For original airdate, prepend an "o" to the year, month, or day format |
---|
113 | codes above; i.e. "\%oY" gives the year in which the episode was first |
---|
114 | aired. |
---|
115 | |
---|
116 | * A suffix of .mpg or .nuv will be added where appropriate. |
---|
117 | |
---|
118 | * To separate links into subdirectories, include the / format specifier |
---|
119 | between the appropriate fields. For example, "\%T/\%S" would create |
---|
120 | a directory for each title containing links for each recording named |
---|
121 | by subtitle. You may use any number of subdirectories in your format |
---|
122 | specifier. If used without the --link option, "/" will be replaced |
---|
123 | with the "\%-" separator character. |
---|
124 | |
---|
125 | --separator |
---|
126 | |
---|
127 | The string used to separate sections of the link name. Specifying the |
---|
128 | separator allows trailing separators to be removed from the link name and |
---|
129 | multiple separators caused by missing data to be consolidated. Indicate the |
---|
130 | separator character in the format string using either a literal character |
---|
131 | or the \%- specifier. |
---|
132 | |
---|
133 | default: '$dseparator' |
---|
134 | |
---|
135 | --replacement |
---|
136 | |
---|
137 | Characters in the link name which are not legal on some filesystems will |
---|
138 | be replaced with the given character |
---|
139 | |
---|
140 | illegal characters: \\ : * ? < > | " |
---|
141 | |
---|
142 | default: '$dreplacement' |
---|
143 | |
---|
144 | --underscores |
---|
145 | |
---|
146 | Replace whitespace in filenames with underscore characters. |
---|
147 | |
---|
148 | default: No underscores |
---|
149 | |
---|
150 | --verbose |
---|
151 | |
---|
152 | Print debug info. |
---|
153 | |
---|
154 | default: No info printed to console |
---|
155 | |
---|
156 | --help |
---|
157 | |
---|
158 | Show this help text. |
---|
159 | |
---|
160 | EOF |
---|
161 | exit; |
---|
162 | } |
---|
163 | |
---|
164 | # Check the separator and replacement characters for illegal characters |
---|
165 | if ($separator =~ /(?:[\/\\:*?<>|"])/) { |
---|
166 | die "The separator cannot contain any of the following characters: /\\:*?<>|\"\n"; |
---|
167 | } |
---|
168 | elsif ($replacement =~ /(?:[\/\\:*?<>|"])/) { |
---|
169 | die "The replacement cannot contain any of the following characters: /\\:*?<>|\"\n"; |
---|
170 | } |
---|
171 | |
---|
172 | # Escape where necessary |
---|
173 | our $safe_sep = $separator; |
---|
174 | $safe_sep =~ s/([^\w\s])/\\$1/sg; |
---|
175 | our $safe_rep = $replacement; |
---|
176 | $safe_rep =~ s/([^\w\s])/\\$1/sg; |
---|
177 | |
---|
178 | # Get the hostname of this machine |
---|
179 | $hostname = `hostname`; |
---|
180 | chomp($hostname); |
---|
181 | |
---|
182 | # Read the mysql.txt file in use by MythTV. |
---|
183 | # could be in a couple places, so try the usual suspects |
---|
184 | my $found = 0; |
---|
185 | my @mysql = ('/usr/local/share/mythtv/mysql.txt', |
---|
186 | '/usr/share/mythtv/mysql.txt', |
---|
187 | '/etc/mythtv/mysql.txt', |
---|
188 | '/usr/local/etc/mythtv/mysql.txt', |
---|
189 | "$ENV{HOME}/.mythtv/mysql.txt", |
---|
190 | 'mysql.txt' |
---|
191 | ); |
---|
192 | foreach my $file (@mysql) { |
---|
193 | next unless (-e $file); |
---|
194 | $found = 1; |
---|
195 | open(CONF, $file) or die "Unable to open $file: $!\n\n"; |
---|
196 | while (my $line = <CONF>) { |
---|
197 | # Cleanup |
---|
198 | next if ($line =~ /^\s*#/); |
---|
199 | $line =~ s/^str //; |
---|
200 | chomp($line); |
---|
201 | # Split off the var=val pairs |
---|
202 | my ($var, $val) = split(/\=/, $line, 2); |
---|
203 | next unless ($var && $var =~ /\w/); |
---|
204 | if ($var eq 'DBHostName') { |
---|
205 | $db_host = $val; |
---|
206 | } |
---|
207 | elsif ($var eq 'DBUserName') { |
---|
208 | $db_user = $val; |
---|
209 | } |
---|
210 | elsif ($var eq 'DBName') { |
---|
211 | $db_name = $val; |
---|
212 | } |
---|
213 | elsif ($var eq 'DBPassword') { |
---|
214 | $db_pass = $val; |
---|
215 | } |
---|
216 | # Hostname override |
---|
217 | elsif ($var eq 'LocalHostName') { |
---|
218 | $hostname = $val; |
---|
219 | } |
---|
220 | } |
---|
221 | close CONF; |
---|
222 | } |
---|
223 | die "Unable to locate mysql.txt: $!\n\n" unless ($found && $db_host); |
---|
224 | |
---|
225 | # Connect to the database |
---|
226 | $dbh = DBI->connect("dbi:mysql:database=$db_name:host=$db_host", $db_user, $db_pass) |
---|
227 | or die "Cannot connect to database: $!\n\n"; |
---|
228 | END { |
---|
229 | $sh->finish if ($sh); |
---|
230 | $sh2->finish if ($sh2); |
---|
231 | $dbh->disconnect if ($dbh); |
---|
232 | } |
---|
233 | |
---|
234 | |
---|
235 | # Find the directory where the recordings are located |
---|
236 | $q = 'SELECT dirname FROM storagegroup WHERE hostname = ?'; |
---|
237 | $sh = $dbh->prepare($q); |
---|
238 | $sh->execute($hostname) or die "Could not execute ($q): $!\n\n"; |
---|
239 | while (my ($video_dir) = $sh->fetchrow_array()) { |
---|
240 | $video_dir =~ s/\/+$//; |
---|
241 | # Link destination |
---|
242 | $dest = "$video_dir/show_names"; |
---|
243 | # Alert the user |
---|
244 | if (defined($verbose)) { |
---|
245 | print "Link destination directory: $dest\n"; |
---|
246 | } |
---|
247 | # Create nonexistent paths |
---|
248 | unless (-e $dest) { |
---|
249 | mkpath($dest, 0, 0755) or die "Failed to create $dest: $!\n"; |
---|
250 | } |
---|
251 | # Bad path |
---|
252 | die "$dest is not a directory.\n" unless (-d $dest); |
---|
253 | # Delete any old links |
---|
254 | find sub { if (-l $_) { |
---|
255 | unlink $_ or die "Couldn't remove old symlink $_: $!\n"; |
---|
256 | } |
---|
257 | }, $dest; |
---|
258 | |
---|
259 | # Delete empty directories (should this be an option?) |
---|
260 | # Let this fail silently for non-empty directories |
---|
261 | finddepth sub { rmdir $_; }, $dest; |
---|
262 | |
---|
263 | } |
---|
264 | $sh->finish; |
---|
265 | |
---|
266 | # Prepare a database queries |
---|
267 | if (defined($live)) { |
---|
268 | $q = 'SELECT * FROM recorded'; |
---|
269 | } else { |
---|
270 | $q = 'SELECT * FROM recorded where recgroup != "LiveTV"'; |
---|
271 | } |
---|
272 | $sh = $dbh->prepare($q); |
---|
273 | $sh->execute() or die "Couldn't execute $q: $!\n"; |
---|
274 | |
---|
275 | # Only if we're renaming files |
---|
276 | unless ($dest) { |
---|
277 | $q2 = 'UPDATE recorded SET basename=? WHERE chanid=? AND starttime=?'; |
---|
278 | $sh2 = $dbh->prepare($q2); |
---|
279 | } |
---|
280 | |
---|
281 | # Create symlinks for the files on this machine |
---|
282 | while (my $ref = $sh->fetchrow_hashref()) { |
---|
283 | my %info = %{$ref}; |
---|
284 | die "This script requires mythtv >= 0.19\n" unless ($info{'basename'}); |
---|
285 | $video_dir = findFile($dbh,$hostname,$info{'basename'},$info{'storagegroup'}); |
---|
286 | next unless (-e "$video_dir/".$info{'basename'}); |
---|
287 | # set correct link - destination |
---|
288 | $dest = "$video_dir/show_names"; |
---|
289 | |
---|
290 | # Default times |
---|
291 | my ($syear, $smonth, $sday, $shour, $sminute, $ssecond) = $info{'starttime'} =~ /(\d+)-(\d+)-(\d+)\s+(\d+):(\d+):(\d+)/; |
---|
292 | my ($eyear, $emonth, $eday, $ehour, $eminute, $esecond) = $info{'endtime'} =~ /(\d+)-(\d+)-(\d+)\s+(\d+):(\d+):(\d+)/; |
---|
293 | # Format some fields we may be parsing below |
---|
294 | # Start time |
---|
295 | my $meridian = ($shour > 12) ? 'PM' : 'AM'; |
---|
296 | my $hour = ($shour > 12) ? $shour - 12 : $shour; |
---|
297 | if ($hour < 10) { |
---|
298 | $hour = "0$hour"; |
---|
299 | } |
---|
300 | elsif ($hour < 1) { |
---|
301 | $hour = 12; |
---|
302 | } |
---|
303 | # End time |
---|
304 | my $emeridian = ($ehour > 12) ? 'PM' : 'AM'; |
---|
305 | my $ethour = ($ehour > 12) ? $ehour - 12 : $ehour; |
---|
306 | if ($ethour < 10) { |
---|
307 | $ethour = "0$ethour"; |
---|
308 | } |
---|
309 | elsif ($ethour < 1) { |
---|
310 | $ethour = 12; |
---|
311 | } |
---|
312 | # Original airdate |
---|
313 | $info{'originalairdate'} ||= '0000-00-00'; |
---|
314 | my ($oyear, $omonth, $oday) = split(/\-/, $info{'originalairdate'}, 3); |
---|
315 | # Build a list of name format options |
---|
316 | my %fields; |
---|
317 | ($fields{'T'} = ($info{'title'} or '')) =~ s/%/%%/g; |
---|
318 | ($fields{'S'} = ($info{'subtitle'} or '')) =~ s/%/%%/g; |
---|
319 | ($fields{'R'} = ($info{'description'} or '')) =~ s/%/%%/g; |
---|
320 | ($fields{'C'} = ($info{'category'} or '')) =~ s/%/%%/g; |
---|
321 | ($fields{'U'} = ($info{'recgroup'} or '')) =~ s/%/%%/g; |
---|
322 | $fields{'c'} = $info{'chanid'}; |
---|
323 | # Start time |
---|
324 | $fields{'y'} = substr($syear, 2); # year, 2 digits |
---|
325 | $fields{'Y'} = $syear; # year, 4 digits |
---|
326 | $fields{'n'} = int($smonth); # month |
---|
327 | $fields{'m'} = $smonth; # month, leading zero |
---|
328 | $fields{'j'} = int($sday); # day of month |
---|
329 | $fields{'d'} = $sday; # day of month, leading zero |
---|
330 | $fields{'g'} = int($hour); # 12-hour hour |
---|
331 | $fields{'G'} = int($shour); # 24-hour hour |
---|
332 | $fields{'h'} = $hour; # 12-hour hour, with leading zero |
---|
333 | $fields{'H'} = $shour; # 24-hour hour, with leading zero |
---|
334 | $fields{'i'} = $sminute; # minutes |
---|
335 | $fields{'s'} = $ssecond; # seconds |
---|
336 | $fields{'a'} = lc($meridian); # am/pm |
---|
337 | $fields{'A'} = $meridian; # AM/PM |
---|
338 | # End time |
---|
339 | $fields{'ey'} = substr($eyear, 2); # year, 2 digits |
---|
340 | $fields{'eY'} = $eyear; # year, 4 digits |
---|
341 | $fields{'en'} = int($emonth); # month |
---|
342 | $fields{'em'} = $emonth; # month, leading zero |
---|
343 | $fields{'ej'} = int($eday); # day of month |
---|
344 | $fields{'ed'} = $eday; # day of month, leading zero |
---|
345 | $fields{'eg'} = int($ethour); # 12-hour hour |
---|
346 | $fields{'eG'} = int($ehour); # 24-hour hour |
---|
347 | $fields{'eh'} = $ethour; # 12-hour hour, with leading zero |
---|
348 | $fields{'eH'} = $ehour; # 24-hour hour, with leading zero |
---|
349 | $fields{'ei'} = $eminute; # minutes |
---|
350 | $fields{'es'} = $esecond; # seconds |
---|
351 | $fields{'ea'} = lc($emeridian); # am/pm |
---|
352 | $fields{'eA'} = $emeridian; # AM/PM |
---|
353 | # Original Airdate |
---|
354 | $fields{'oy'} = substr($oyear, 2); # year, 2 digits |
---|
355 | $fields{'oY'} = $oyear; # year, 4 digits |
---|
356 | $fields{'on'} = int($omonth); # month |
---|
357 | $fields{'om'} = $omonth; # month, leading zero |
---|
358 | $fields{'oj'} = int($oday); # day of month |
---|
359 | $fields{'od'} = $oday; # day of month, leading zero |
---|
360 | # Literals |
---|
361 | $fields{'%'} = '%'; |
---|
362 | ($fields{'-'} = $separator) =~ s/%/%%/g; |
---|
363 | # Make the substitution |
---|
364 | my $keys = join('|', sort keys %fields); |
---|
365 | my $name = $format; |
---|
366 | $name =~ s#/#$dest ? "\0" : $separator#ge; |
---|
367 | $name =~ s/(?<!%)(?:%($keys))/$fields{$1}/g; |
---|
368 | $name =~ s/%%/%/g; |
---|
369 | # Some basic cleanup for illegal (windows) filename characters, etc. |
---|
370 | $name =~ tr/\ \t\r\n/ /s; |
---|
371 | $name =~ tr/"/'/s; |
---|
372 | $name =~ s/(?:[\/\\:*?<>|]+\s*)+(?=[^\d\s])/$replacement /sg; |
---|
373 | $name =~ s/[\/\\:*?<>|]/$replacement/sg; |
---|
374 | $name =~ s/(?:(?:$safe_sep)+\s*)+(?=[^\d\s])/$separator /sg; |
---|
375 | $name =~ s/^($safe_sep|$safe_rep|\ )+//s; |
---|
376 | $name =~ s/($safe_sep|$safe_rep|\ )+$//s; |
---|
377 | $name =~ s/\0($safe_sep|$safe_rep|\ )+/\0/s; |
---|
378 | $name =~ s/($safe_sep|$safe_rep|\ )+\0/\0/s; |
---|
379 | # repair german Umlauts (by hamsta) |
---|
380 | $name =~ s/À/ae/sg; |
---|
381 | $name =~ s/ö/oe/sg; |
---|
382 | $name =~ s/Ì/ue/sg; |
---|
383 | $name =~ s/Ã/ss/sg; |
---|
384 | $name =~ s/Ã/Ae/sg; |
---|
385 | $name =~ s/Ã/Oe/sg; |
---|
386 | $name =~ s/Ã/Ue/sg; |
---|
387 | $name =~ s/é/e/sg; |
---|
388 | $name =~ s/Ã/E/sg; |
---|
389 | $name =~ s/á/a/sg; |
---|
390 | $name =~ s/Ã/A/sg; |
---|
391 | $name =~ s/Ã /a/sg; |
---|
392 | $name =~ s/Ã/A/sg; |
---|
393 | # Underscores? |
---|
394 | if ($underscores) { |
---|
395 | $name =~ tr/ /_/s; |
---|
396 | } |
---|
397 | # Folders |
---|
398 | $name =~ s#\0#/#sg; |
---|
399 | # Get a shell-safe version of the filename (yes, I know it's not needed in this case, but I'm anal about such things) |
---|
400 | my $safe_file = $info{'basename'}; |
---|
401 | $safe_file =~ s/'/'\\''/sg; |
---|
402 | $safe_file = "'$safe_file'"; |
---|
403 | # Figure out the suffix |
---|
404 | my $out = `file -b $safe_file 2>/dev/null`; |
---|
405 | my $suffix = ($out =~ /mpe?g/i) ? '.mpg' : '.nuv'; |
---|
406 | # Link destination |
---|
407 | if ($dest) { |
---|
408 | # Check for duplicates |
---|
409 | if (-e "$dest/$name$suffix") { |
---|
410 | $count = 2; |
---|
411 | while (-e "$dest/$name.$count$suffix") { |
---|
412 | $count++; |
---|
413 | } |
---|
414 | $name .= ".$count"; |
---|
415 | } |
---|
416 | $name .= $suffix; |
---|
417 | # Create the link |
---|
418 | my $directory = dirname("$dest/$name"); |
---|
419 | unless (-e $directory) { |
---|
420 | mkpath($directory, 0, 0755) |
---|
421 | or die "Failed to create $directory: $!\n"; |
---|
422 | } |
---|
423 | symlink "$video_dir/".$info{'basename'}, "$dest/$name" |
---|
424 | or die "Can't create symlink $dest/$name: $!\n"; |
---|
425 | if (defined($verbose)) { |
---|
426 | print "$dest/$name\n"; |
---|
427 | } |
---|
428 | } |
---|
429 | # Rename the file, but only if it's a real file |
---|
430 | elsif (-f "$video_dir/".$info{'basename'}) { |
---|
431 | if ($info{'basename'} ne $name.$suffix) { |
---|
432 | # Check for duplicates |
---|
433 | if (-e "$video_dir/$name$suffix") { |
---|
434 | $count = 2; |
---|
435 | while (-e "$video_dir/$name.$count$suffix") { |
---|
436 | $count++; |
---|
437 | } |
---|
438 | $name .= ".$count"; |
---|
439 | } |
---|
440 | $name .= $suffix; |
---|
441 | # Update the database |
---|
442 | my $rows = $sh2->execute($name, $info{'chanid'}, $info{'starttime'}); |
---|
443 | die "Couldn't update basename in database for ".$info{'basename'}.": ($q2)\n" unless ($rows == 1); |
---|
444 | my $ret = rename "$video_dir/".$info{'basename'}, "$video_dir/$name"; |
---|
445 | # Rename failed -- Move the database back to how it was (man, do I miss transactions) |
---|
446 | if (!$ret) { |
---|
447 | $rows = $sh2->execute($info{'basename'}, $info{'chanid'}, $info{'starttime'}); |
---|
448 | die "Couldn't restore original basename in database for ".$info{'basename'}.": ($q2)\n" unless ($rows == 1); |
---|
449 | } |
---|
450 | if (defined($verbose)) { |
---|
451 | print $info{'basename'}."\t-> $name\n"; |
---|
452 | } |
---|
453 | } |
---|
454 | } |
---|
455 | } |
---|
456 | |
---|
457 | $sh->finish; |
---|
458 | $sh2->finish if ($sh2); |
---|
459 | |
---|
460 | # Functions |
---|
461 | |
---|
462 | sub findFile { |
---|
463 | my $dbh = shift; |
---|
464 | my $hostname = shift; |
---|
465 | my $basename = shift; |
---|
466 | my $storagegroup = shift; |
---|
467 | |
---|
468 | my $q = 'SELECT dirname FROM storagegroup WHERE hostname = ? AND groupname = ?'; |
---|
469 | my $sh = $dbh->prepare($q); |
---|
470 | |
---|
471 | $sh->execute($hostname,$storagegroup); |
---|
472 | |
---|
473 | while (my ($video_dir) = $sh->fetchrow_array()) { |
---|
474 | next unless (-e "$video_dir/$basename"); |
---|
475 | $path = "$video_dir"; |
---|
476 | last; |
---|
477 | } |
---|
478 | $sh->finish; |
---|
479 | |
---|
480 | return $path; |
---|
481 | } |
---|
482 | |
---|