#!/usr/bin/perl # # mv_suffix [-nf] files|directory... # # Using the file command, try to determine and set the correct filename suffix # of the given files or recursive directories, and fix them. # # OPTIONS: # -f Fix the suffix problems found (default) # -n Dry Run, list command to fix, don't actually run them # # This is typically used after downloading files from the WWW as often the # suffix is not correct, or is a HTML error file rather than the expected # data. This command lets me find and re-download such problem files. # #### # # Anthony Thyssen, 19 March 1995 # 19 Feb 2018 Script renamed from "fix_suffix" to "mv_suffix" # and re-factored to make simplier select((select(STDOUT), $| = 1)[$[]); my $mv='merge'; my $FIX = 1; $FIX = shift if $ARGV[0] eq '-f'; # force fix $FIX = 0,shift if $ARGV[0] eq '-n'; # dry run if ( $FIX ) { print STDERR "Running the following commands...\n"; } else { print STDERR "DRY RUN... Commands to fix suffixes...\n"; } map { s/'/'\\''/; $_ = "\'$_\'"; } @ARGV; open(FILE, "find @ARGV \\( -name .xvpics -prune \\) -o \\( -type f -print0 \\) | xargs -0 file |") or die("open \"file|\" failed: $!\n"); while( ) { chomp; my ($file, $type) = split(/:\s*/, $_, 2); # Non file types next if $type =~ /\bdirectory\b/; next if $type =~ /\bspecial\b/; if ( $type =~ /\btext\b/ ) { fix_it($file, 'html') if $type =~ /\bHTML\b/; # Text files could many different suffixes: # For example: txt, info, data, keys, csv, json # All of which "file" can not properly identify. # It is basically imposible to properly correct text file suffixes. # #next if $file =~ /\bREADME[^\/]*$/i; # skip README files next; } if ( $type =~ /\bimage data\b/ ) { fix_it($file, 'jpg'),next if $type =~ /\bJPEG\b/; fix_it($file, 'png'),next if $type =~ /\bPNG\b/; fix_it($file, 'gif'),next if $type =~ /\bGIF\b/; next; } if ( $type =~ /\bAudio\b/ ) { fix_it($file, 'mp3' ),next if $type =~ /\bMPEG ADTS, layer III\b/; fix_it($file, 'm4a' ),next if $type =~ /\bM4A\b/; fix_it($file, 'flac' ),next if $type =~ /\bFLAC\b/; } # no major catagory for these in 'file' fix_it($file, 'pdf' ),next if $type =~ /\bPDF\b/; fix_it($file, 'avi' ),next if $type =~ /\bAVI\b/; fix_it($file, 'mp4' ),next if $type =~ /\bMP4\b/; fix_it($file, 'mpg' ),next if $type =~ /\bMPEG\b/; fix_it($file, 'mov' ),next if $type =~ /\bMOV\b/; fix_it($file, 'mkv' ),next if $type =~ /\bMatroska\b/; fix_it($file, 'empty'),next if $type =~ /\bempty\b/; } # ------------------------- sub fix_it { my ( $file, $new_suffix) = @_; my ($name, $suffix); if ( $file =~ /\.(\w+)\.(\d+)$/ ) { # suffix with a 'merge' number $name = "$`_$2"; $suffix .= "$1.$2"; # force suffix replacement if file type is known } elsif ( $file =~ /\.(\w+)$/ ) { # just the suffix $name = $`; $suffix = $1; } else { $name=$file; $suffix=''; } #print "$file => \"$name\".\"$suffix\"\n===> \"$new_suffix\"\n"; if ( $suffix ne $new_suffix ) { print "$mv \"$file\" \"$name.$new_suffix\"\n"; return unless $FIX; $mv eq 'mv' ? rename( $file, "$name.$new_suffix") : system( $mv, $file, "$name.$new_suffix" ) ; } }