Skip to content

Instantly share code, notes, and snippets.

@zorchenhimer
Last active August 29, 2015 14:13
Show Gist options
  • Save zorchenhimer/fb2d86dbed478c9942d9 to your computer and use it in GitHub Desktop.
Save zorchenhimer/fb2d86dbed478c9942d9 to your computer and use it in GitHub Desktop.
Add or verify CRC32 checksums in filenames.
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use Digest::CRC;
# Disable output buffer
$|++;
my %opts = (
# Default to the current directory.
'directory' => './',
);
Getopt::Long::Configure("bundling");
GetOptions(\%opts, 'help|h', 'directory|d=s', 'verify|v', 'quiet|q', 'internal-crc|I');
if(defined($opts{'help'})) {
# Print the help documentation and exit.
pod2usage(
-verbose => 3,
-noperldoc => 1,
);
exit(1);
}
# Make sure the directory ends in a slash.
$opts{'directory'} =~ s/([^\/])$/$1\//;
opendir(DIR, $opts{'directory'}) or
die("Unable to open directory: $!");
# Verify files. No renaming.
if (defined($opts{'verify'})) {
# Ignore directory dotfiles.
my @files = sort( grep { $_ ne '.' && $_ ne '..' } readdir(DIR) );
closedir(DIR);
&verify_list(@files);
# Rename files.
} else {
# We only want files that have a place to put the crc.
my @files = sort(grep { $_ =~ /%crc%/ } readdir(DIR));
closedir(DIR);
if ( $#files < 0 ) {
# No files found. Abort.
print "No files found with '%crc%' in the filename. Exiting\n";
exit(2);
} else {
&process_list(@files);
}
}
sub verify_list {
my @file_list = @_;
my %stats = (
'missing' => 0,
'mismatch' => 0,
'ok' => 0,
);
# Quick status report.
my $num = $#file_list + 1;
print "Verifying CRC of $num files.\n\n";
foreach my $file (@file_list) {
print "$file\t";
# Find the CRC and print it.
my $crc = &get_crc($file);
print "$crc\t";
# Grab the expected CRC.
$file =~ /([0-9a-f]{8})/i;
my $found_crc = uc $1;
# Check the CRC.
if(!defined($found_crc) or $found_crc !~ /[0-9a-f]{8}/i) {
print "CRC Missing!\n";
$stats{'missing'}++;
} elsif($found_crc ne $crc) {
print "CRC Mismatch!\n";
$stats{'mismatch'}++;
} else {
print "CRC OK\n";
$stats{'ok'}++;
}
}
# Summary report.
print "\nMissing: $stats{'missing'}\nMismatch: $stats{'mismatch'}\nOK: $stats{'ok'}\n";
}
sub echo {
my $msg = shift;
# Do not print if --quiet was given at the command line.
print $msg unless( $opts{'quiet'} );
}
sub get_crc {
my $filename = shift;
my $crc = '';
if (defined($opts{'internal-crc'})) {
# Digest object
my $ctx = Digest::CRC->new(type=>'crc32');
# Open the file for reading
open INFILE, '<', $opts{'directory'}.$filename
or die("Unable to open file for processing ($opts{'directory'}${filename}): $!");
# If opened in text mode (default), you'll get the wrong CRC.
binmode INFILE;
# Get the checksum.
$ctx->addfile(*INFILE);
$crc = uc $ctx->hexdigest;
# We're done with the file. Close it.
close INFILE;
} else {
my $cksfv = `cksfv "$filename"`;
$cksfv =~ s/;.*\n//g;
$cksfv =~ /([0-F]+)$/i;
$crc = uc $1;
}
# Make sure the CRC is padded correctly.
while( length($crc) < 8 ) {
$crc = "0$crc";
}
return $crc;
}
sub process_list {
my @file_list = @_;
# Quick status report.
my $num = $#file_list + 1;
&echo("Adding CRC32 to $num files.\n");
foreach (@file_list) {
# Double check. Because.
if (/%crc%/) {
# We'll need this later.
my $orig_file = $_;
# Print the file currently being processed.
&echo("$orig_file -> ");
# Find the CRC.
my $crc = &get_crc($orig_file);
# Put the CRC in the filename.
s/%crc%/$crc/;
my $new_file = $_;
# Rename the file.
&echo("$new_file\n");
rename $opts{'directory'}.$orig_file, $opts{'directory'}.$new_file;
}
}
}
__END__
=head1 NAME
add-crc.pl
=head1 SYNOPSIS
=over 4
=item add-crc.pl [options]
Add or verify CRC32 checksums in filenames.
=back
=head1 OPTIONS
=over 4
=item --directory <dir>
=item -d <dir>
Process files in <dir>. Defaults to the current directory.
=item --help
=item -h
Print this help and exit.
=item --verify
=item -v
Verify files. Do not rename anything.
=item --quiet
=item -q
Do not print progress. Ignored if --verify is given.
=cut
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment