pax_global_header00006660000000000000000000000064142063020350014505gustar00rootroot0000000000000052 comment=5ef6ce46d6a75cf79e88e75e75e6de6bee2c913c arename-4.1/000077500000000000000000000000001420630203500127615ustar00rootroot00000000000000arename-4.1/.gitignore000066400000000000000000000002371420630203500147530ustar00rootroot00000000000000.* !.gitignore *~ *.tmp *.orig *.log *.tar.gz *.pm ataglist arename arename.1 arename.html ataglist.1 ataglist.html optest.pl tests/data/* tags TAGS cover_db/ arename-4.1/ARename.pm.in000066400000000000000000003012031420630203500152330ustar00rootroot00000000000000#!@@perl@@ # Copyright 2007-2017 # Frank Terbeck , All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above # copyright notice, this list of conditions and the following # disclaimer. # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials # provided with the distribution. # # THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED # WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE # DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS OF THE # PROJECT BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, # EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, # PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR # PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY # OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ARename; use warnings; use strict; # modules # These are commonly installed along with Perl: use Readonly; use Carp; use Data::Dumper; use English '-no_match_vars'; use Getopt::Long; use File::Basename; use File::Copy; use Cwd; use Cwd 'abs_path'; use Term::ANSIColor qw(:constants); # This one is not. But it's available via CPAN and - if you're lucky - via your # OS's packaging system. use Audio::Scan; # So, how does all of this work? Well, the main entry point is # `process_file()', which is called from the executable script for every file, # we're about to work on. The `process_file()' function doesn't take an # argument. The name of the current file is provided by calling `set_file()'. # # Then `process_file()' does the following: # # - Check if the file is readable and not a symlink. # - Possibly canonicalise the file name. # - Check if the file appears to be supported. # - Gather tag information (you may want to check the `%infomap' comment # for information on how this works). # - Call the post processing function (which is `arename()' by default). # # When `arename()' takes over, here's its basic functionality: # # - Apply default values to the data hash. # - Choose the right template for the current file. # - Expand the chosen template based on the data in the data hash. # - Make sure the old and new name are not the same (in which case there # would be nothing further to do). # - Make sure there is no file that goes by the generated new name. # - Make sure the destination directory exists. # - Finally (depending on the active mode) rename or copy the old to the # new file name. # # And that's all there is to it really. All that is salted with a number of # options and hooks to ensure flexibility and extensibility. # # The rest of the code is output functions, configuration file handling, # command line options parsing, hook file handling and utility functions. # variables my ( %aliasmap, %cmdline_protect, %conf, %defaults, %hooks, %parsers, %profiles, %opts, %sectconf, %sets, %typemap, %infomap, %defaultmap, %lsets, $__arename_file, $postproc, $sect, @cmdline_profiles, @localizables, @settables, @supported_tags, ); our ( $NAME, $VERSION ) = qw( unset unset ); # a helper for the testsuite sub data_reset { undef %conf; undef %defaults; undef %hooks; undef %parsers; undef %profiles; undef %opts; undef %sectconf; undef %sets; undef @cmdline_profiles; undef @localizables; undef @settables; undef @supported_tags; $conf{verbosity} = 5; return 1; } # Audio::Scan uses a certain set of names for file types. It seems to # be aiming for three letter names. `arename' however uses "flac" for # flac files, not "flc". Therefore we need to map Audio::Scan names to # arename names. And that is what is being done here. # # The wavepack name is mapped from "wvp" to "wv". The latter is the # more common file extension, which makes sense when using the # `usetypeasextension' option - and that is the default behaviour. %typemap = ( 'aac' => 'aac', 'ape' => 'ape', 'asf' => 'asf', 'flc' => 'flac', 'mp3' => 'mp3', 'mp4' => 'mp4', 'mpc' => 'mpc', 'ogg' => 'ogg', 'wav' => 'wav', 'wvp' => 'wv', ); # This maps certain tags to default values. Any tag, that is not # listed here will not get a default value (unless the user defines # such a value in his/her configuration file). %defaultmap = ( bitrate => 0, channels => 1, length_ms => 0, samplerate => 0, ); # Many tags are available via shorter names if the `template_aliases' # option is enabled (which it is *not* by default). This hash maps # alias names to their longer counterparts. %aliasmap = ( al => 'album', ar => 'artist', br => 'bitrate', ch => 'channels', cmp => 'compilation', gn => 'genre', kbr => 'kbitrate', ksr => 'ksamplerate', ln => 'length_ms', ls => 'length_sec', sr => 'samplerate', tn => 'tracknumber', tt => 'tracktitle', yr => 'year', ); # This hash maps infomation from Audio::Scan to our internal data hash. Take # a look at the `flac' and `mp3' entries for specific information. The overall # idea is to have a set of tags that are supported for every file type and a # few which are file type specific. `fill_data()' is responsible for putting # all this together. %infomap = ( aac => { bitrate => [ qw( info bitrate ) ], channels => [ qw( info stereo ) ], length_ms => [ qw( info song_length_ms ) ], samplerate => [ qw( info samplerate ) ], album => [ qw( tags TALB ) ], artist => [ qw( tags TPE1 ) ], compilation => [ qw( tags TPE2 ) ], genre => [ qw( tags TCON ) ], tracknumber => [ qw( tags TRCK ) ], tracktitle => [ qw( tags TIT2 ) ], year => [ qw( tags TDRC ) ], }, ape => { bitrate => [ qw( info bitrate ) ], channels => [ qw( info channels ) ], length_ms => [ qw( info song_length_ms ) ], samplerate => [ qw( info samplerate ) ], album => [ qw( tags ALBUM ) ], artist => [ qw( tags ARTIST ) ], compilation => [ qw( tags ALBUMARTIST ) ], genre => [ qw( tags GENRE ) ], tracknumber => [ qw( tags TRACK ) ], tracktitle => [ qw( tags TITLE ) ], year => [ qw( tags YEAR ) ], }, asf => { # `bitrate', `channels', and `samplerate' are very likely # wrong (or non-existant, in which case the default is used). # I don't care much about `asf' at all, so this will have to # do. Also, I guess this will probably only work properly on # audio-files (wma). I don't know. If you want this to work # better, send patches. bitrate => [ qw( info bitrate ) ], channels => [ qw( info channels ) ], length_ms => [ qw( info play_duration_ms ) ], samplerate => [ qw( info samplerate ) ], album => [ qw( tags WM/AlbumTitle ) ], artist => [ qw( tags Author ) ], compilation => [ qw( tags WM/AlbumArtist ) ], genre => [ qw( tags WM/Genre ) ], tracknumber => [ qw( tags WM/TrackNumber ) ], tracktitle => [ qw( tags Title ) ], year => [ qw( tags WM/Year ) ], }, flac => { # first, file type specific tags; their names always start # in "$type"_; tag_supported relies on it. flac_wordsize => [ qw( info bits_per_sample ) ], # next come all common tags. *Every* file needs to support # these. tag_supported checks the 'flac' entry to check if # a common tag is supported, all other types must follow. bitrate => [ qw( info bitrate ) ], channels => [ qw( info channels ) ], length_ms => [ qw( info song_length_ms ) ], samplerate => [ qw( info samplerate ) ], album => [ qw( tags ALBUM ) ], artist => [ qw( tags ARTIST ) ], compilation => [ qw( tags ALBUMARTIST ) ], genre => [ qw( tags GENRE ) ], tracknumber => [ qw( tags TRACKNUMBER ) ], tracktitle => [ qw( tags TITLE ) ], year => [ qw( tags DATE ) ], }, mp3 => { mp3_id3_version => [ qw( info id3_version ) ], bitrate => [ qw( info bitrate ) ], # there is no channels entity in id3 meta information, but # there is a stereo entity, which is 1 for 2 channels and 0 for # 1 (mono). that information cannot be dealt with in a simple # map, so we're handling it in fill_data_mp3(). channels => [ qw( info stereo ) ], length_ms => [ qw( info song_length_ms ) ], samplerate => [ qw( info samplerate ) ], album => [ qw( tags TALB ) ], artist => [ qw( tags TPE1 ) ], compilation => [ qw( tags TPE2 ) ], genre => [ qw( tags TCON ) ], tracknumber => [ qw( tags TRCK ) ], tracktitle => [ qw( tags TIT2 ) ], year => [ qw( tags TDRC ) ], # a dedicated function called after the data was filled initially. # fill_function is not a valid tag name and tag_supported will return # 0 (false) for it, if asked. fill_function => \&fill_data_mp3, }, mp4 => { bitrate => [ qw( info avg_bitrate ) ], channels => [ qw( info channels ) ], length_ms => [ qw( info song_length_ms ) ], samplerate => [ qw( info samplerate ) ], album => [ qw( tags ALB ) ], artist => [ qw( tags ART ) ], compilation => [ qw( tags AART ) ], genre => [ qw( tags GNRE ) ], tracknumber => [ qw( tags TRKN ) ], tracktitle => [ qw( tags NAM ) ], year => [ qw( tags DAY ) ], }, mpc => { bitrate => [ qw( info bitrate ) ], channels => [ qw( info channels ) ], length_ms => [ qw( info song_length_ms ) ], samplerate => [ qw( info samplerate ) ], album => [ qw( tags ALBUM ) ], artist => [ qw( tags ARTIST ) ], compilation => [ qw( tags ALBUMARTIST ) ], genre => [ qw( tags GENRE ) ], tracknumber => [ qw( tags TRACK ) ], tracktitle => [ qw( tags TITLE ) ], year => [ qw( tags YEAR ) ], }, ogg => { bitrate => [ qw( info bitrate_nominal ) ], channels => [ qw( info channels ) ], length_ms => [ qw( info song_length_ms ) ], samplerate => [ qw( info samplerate ) ], album => [ qw( tags ALBUM ) ], artist => [ qw( tags ARTIST ) ], compilation => [ qw( tags ALBUMARTIST ) ], genre => [ qw( tags GENRE ) ], tracknumber => [ qw( tags TRACKNUMBER ) ], tracktitle => [ qw( tags TITLE ) ], year => [ qw( tags DATE ) ], }, wav => { wav_id3_version => [ qw( info id3_version ) ], bitrate => [ qw( info bitrate ) ], channels => [ qw( info channels ) ], length_ms => [ qw( info song_length_ms ) ], samplerate => [ qw( info samplerate ) ], album => [ qw( tags TALB ) ], artist => [ qw( tags TPE1 ) ], compilation => [ qw( tags TPE2 ) ], genre => [ qw( tags TCON ) ], tracknumber => [ qw( tags TRCK ) ], tracktitle => [ qw( tags TIT2 ) ], year => [ qw( tags TDRC ) ], }, wv => { bitrate => [ qw( info bitrate ) ], channels => [ qw( info channels ) ], length_ms => [ qw( info song_length_ms ) ], samplerate => [ qw( info samplerate ) ], album => [ qw( tags ALBUM ) ], artist => [ qw( tags ARTIST ) ], compilation => [ qw( tags ALBUMARTIST ) ], genre => [ qw( tags GENRE ) ], tracknumber => [ qw( tags TRACK ) ], tracktitle => [ qw( tags TITLE ) ], year => [ qw( tags YEAR ) ], }, ); # settings that may occur in [sections] @localizables = qw( ambiguoususefirst copymode force prefix sepreplace template_aliases tnpad comp_template suppress_skips template ); # This is a helper list, that is used only in `dump_config()'. If a # variable is missing from this list, `dump_config()' will not list # it. @settables = qw( ambiguoususefirst canonicalize checkprofilerc checktemplatesinitially comp_template debug hookerrfatal prefix sepreplace template template_aliases tnpad usehooks uselocalhooks uselocalrc useprofiles warningsautodryrun ); $postproc = \&arename; # high level code sub arename { my ($datref, $ext) = @_; my ($t, $newname, $eq); my $file = get_file(); my $printable = get_file_printable(); run_hook('pre_apply_defaults', $datref, \$ext); apply_defaults($datref); run_hook('pre_template', $datref, \$ext); $t = choose_template($datref); $newname = expand_template($t, $datref); return if not defined $newname; $newname = get_opt("prefix") . "/$newname.$ext"; run_hook('post_template', $datref, \$ext, \$newname); $eq = file_eq($newname, $file); if (!$eq || !get_opt('suppress_skips')) { arename_verbosity($datref); } if ($eq && !get_opt('suppress_skips')) { op('skip-same', $printable) or op('skip', $printable); } return if ($eq); if (-e $newname && !get_opt("force")) { op('target-exists-twoline', $newname) or op('target-exists', $newname); return 0; } ensure_dir(dirname($newname)); run_hook('post_ensure_dir', $datref, \$ext, \$newname); do { my ($mode); if (get_opt("copymode")) { $mode = 'cp'; } else { $mode = 'mv'; } op('rename', $mode, $printable, $newname) or op('quoted-file', sub { my ($ret) = @_; $ret =~ s,','\\'',g; return $ret;}->($newname)); }; if (!get_opt("dryrun")) { if (!get_opt("copymode")) { xrename($file, $newname); } else { xcopy($file, $newname); } } run_hook('post_rename', $datref, \$ext, \$newname); return 1; } sub apply_defaults { my ($datref) = @_; my ($value); foreach my $key (get_default_keys()) { if (!defined $datref->{$key}) { run_hook('apply_defaults', $datref, \$key); $value = get_defaults($key); op('default-set-value', $key, $value); $datref->{$key} = $value; } } return 1; } sub tag_aliased { my ($tag) = @_; return 1 if (defined $aliasmap{$tag}); return 0; } sub tag_supported { my ($tag) = @_; return 0 if ($tag eq 'fill_function'); foreach my $sup (grep { !/^flac_/ } keys %{ $infomap{'flac'} }) { return 1 if ($tag eq $sup); } foreach my $type (keys %infomap) { foreach my $sup (grep { /^$type(_)/ } keys %{ $infomap{$type} }) { return 2 if ($tag eq $sup); } } return 0; } sub arename_verbosity { my ($datref) = @_; return 0 if (get_opt('verbosity') < 10); my $out = sub { my ($thing) = @_; my $name = ucfirst $thing; op('tag-list', $name, getdat($datref, $thing)); }; $out->('artist'); $out->('compilation'); $out->('album'); $out->('tracktitle'); $out->('tracknumber'); $out->('genre'); $out->('year'); return 1; } sub getdat { my ($datref, $tag) = @_; return defined $datref->{$tag} ? q{"} . $datref->{$tag} . q{"} : "(undefined)"; } sub fill_data_mp3 { # $rd is a hash reference my ($rd, $datref) = @_; if ($rd->{'info'}->{'stereo'} eq '1') { $datref->{'channels'} = 2; } else { $datref->{'channels'} = 1; } return 0; } sub fill_default { my ($datref, $key, $default) = @_; if (!defined $datref->{$key} || $datref->{$key} eq q{}) { $datref->{$key} = $default; } return 0; } sub fill_data_sanitize { my ($datref) = @_; foreach my $d (keys %defaultmap) { fill_default($datref, $d, $defaultmap{$d}); } return 0; } sub fill_data_additional { my ($datref) = @_; # others would be length_minsec, length_hourminsec $datref->{'length_sec'} = $datref->{'length_ms'} / 1000; $datref->{'kbitrate'} = $datref->{'bitrate'} / 1000; $datref->{'ksamplerate'} = $datref->{'samplerate'} / 1000; return 0; } sub __fill_data { my ($type, $info, $mapref, $rd, $datref) = @_; my ($value); return 0 if ($info eq 'fill_function'); $value = $rd->{$mapref->[0]}->{$mapref->[1]}; return 0 if (!defined $value); if (ref($value) eq 'ARRAY') { run_hook('ambiguoustag', \$info, \$value, $datref, $rd); } if (ref($value) eq 'ARRAY') { if (get_opt('ambiguoususefirst')) { $value = $value->[0]; } else { op('more-than-one-tag', get_file(), $info); foreach my $val (@{ $value }) { op('more-than-one-tag-value', $val); } return -1; } } if ($info eq 'tracknumber') { my ($max); if ($value =~ m@/@) { $value =~ s@/(.*)$@@; $max = $1; ## no critic (ProhibitCaptureWithoutTest) $datref->{tracknummax} = $max; } } $datref->{$info} = $value; return 1; } sub fill_data { # Like $datref, $rd is a hash reference (for the raw data from # Audio::Scan->scan().. my ($rd, $datref, $type) = @_; my ($errout); $errout = 0; foreach my $info (sort keys %{ $infomap{$type} }) { if (__fill_data($type, $info, $infomap{$type}{$info}, $rd, $datref) < 0) { $errout = 1; } } return 0 if ($errout); fill_data_sanitize($datref); fill_data_additional($datref); if (defined $infomap{$type}{'fill_function'}) { $infomap{$type}{'fill_function'}->($rd, $datref, $type); } return 1; } sub filetype_supported { my ($file) = @_; my ($ext, $type); ($ext) = $file =~ m/[.]([^.]+)$/; return if (!defined $ext); $type = Audio::Scan->type_for($ext); return if (!defined $type); foreach my $t (keys %typemap) { return ($typemap{$t}, $ext) if ($t eq $type); } return; } sub scan_file { my ($datref, $type) = @_; my $file = get_file(); my ($rc, $rd); return 0 if (!defined $file); run_hook('pre_scan', \$type); local $ENV{AUDIO_SCAN_NO_ARTWORK} = 1; $rd = Audio::Scan->scan($file); run_hook('post_scan', \$type, $rd); $rc = fill_data($rd, $datref, $type); run_hook('post_fill', \$rc, \$type, $rd, $datref); return $rc; } sub process_warn { op('no-method', get_file_printable()); return 1; } sub process_file { # process_file() assumes, that set_file() was used to tell # ARename.pm which file to work on currently. my (%data, $file, $printable, $type, $ext); $file = get_file(); $printable = get_file_printable(); run_hook('next_file_early'); op('processing-file', $printable); if (-l $file) { op('skip-symlink', $printable); return 0; } if (! -r $file) { op('file-read-error', $printable, $ERRNO); return 0; } if (get_opt('canonicalize')) { my $f = abs_path($file); run_hook('canonicalize', \$f); set_file($f); } run_hook('next_file_late'); ($type, $ext) = filetype_supported($file); if (!defined $type) { run_hook('filetype_unknown'); process_warn(); return 0; } run_hook('filetype_known', \$ext, \$type); if (get_opt('usetypeasextension')) { $ext = $type; } if (!scan_file(\%data, $type)) { op('warnings-while-scanning-file'); return 0; } run_hook('pre_rename', \$type, \$ext, \%data); $postproc->(\%data, $ext); run_hook('file_done'); return 1; } sub get_profile_list { my @list = (); my $wd = getcwd(); my %seen = (); # make sure $wd ends in *one* slash $wd =~ s/\/+$//; $wd .= q{/}; foreach my $profile (sort keys %profiles) { op('debug',qq{get_profile_list(): Checking "$profile" patterns...\n}); foreach my $pat (@{ $profiles{$profile} }) { op('debug', "get_profile_list(): ($wd) =~ ($pat)...\n"); if ($wd =~ m/^$pat/) { op('debug', "get_profile_list(): MATCHED.\n"); push @list, $profile; last; } } } @list = sort grep { ! $seen{ $_ }++ } (@list, @cmdline_profiles); op('debug', "get_profile_list(): (" . join(q{,}, @list) . ")\n"); return @list; } sub set_default_options { if (defined $ENV{'ARENAME_LOAD_QUIET'} && $ENV{'ARENAME_LOAD_QUIET'} eq '1') { set_opt("load_quiet", 1); } else { set_opt("load_quiet", 0); } set_opt("ambiguoususefirst", 0); set_opt("canonicalize", 0); set_opt("copymode", 0); set_opt("checkprofilerc", 1); set_opt("checktemplatesinitially", 1); set_opt("dryrun", 0); set_opt("force", 0); set_opt("hookerrfatal", 1); set_opt("prefix" , q{.}); set_opt("readstdin", 0); set_opt("sepreplace", q{_}); set_opt("suppress_skips", 0); set_opt("template_aliases", 0); set_opt("tnpad", 2); set_opt("usehooks", 1); set_opt("uselocalhooks", 0); set_opt("uselocalrc", 0); set_opt("usetypeasextension", 1); set_opt("useprofiles", 1); set_opt("warningsautodryrun", 1); set_opt("comp_template", q{va/&album/&tracknumber - &artist - &tracktitle}); set_opt("template", q{&artist[1]/&artist/&album/&tracknumber - &tracktitle}); return 1; } sub set_nameversion { my ($n, $v) = @_; $NAME = $n; ## no critic (RequireConstantVersion) $VERSION = $v; ## use critic return 1; } sub set_postproc { my ($p) = @_; $postproc = $p; return 1; } sub usage { print " Usage:\n $NAME [OPTION(s)] FILE(s)...\n\n"; print " --ambiguous-use-first If a tag has multiple values, use the 1st one.\n"; print " --compare-versions Compare versions of script and module.\n"; print " --copy, -c Copy files, rather than renaming.\n"; print " --debug Enable debugging output.\n"; print " --disable-hooks, -H Disable *all* hooks.\n"; print " --disable-profiles, -N Deactivate all profiles.\n"; print " --dryrun, -d Go into dryrun mode.\n"; print " --enable-hooks Enable hooks, if the configuration disabled\n"; print " them.\n"; print " --force, -f Overwrite files if needed.\n"; print " --help, -h Display this help text.\n"; print " --list-cfg, -L List current configuration.\n"; print " --list-file-types List all supported file types.\n"; print " --list-exts-for-type List extensions recognised as .\n"; print " --list-profiles, -S Show a list of defined profiles\n"; print " --read-local, -l Read local rc, if it exists.\n"; print " --stdin, -s Read file names from stdin.\n"; print " --suppress-skips, -Q Don't display data of skipped files\n"; print " --verbosity Set verbosity of arename's output.\n"; print " --version, -V Display version infomation.\n"; print "\n"; print " --rc Read file instead of ~/.arenamerc.\n"; print " --post-rc Read file after ~/.arenamerc.\n"; print "\n"; print " --prefix, -p Define a prefix for destination files.\n"; print " --profile, -P Comma separated list of profiles to activate\n"; print " forcibly.\n"; print "\n"; print " --compilation-template -T