Add or verify CRC32 checksums in filenames.

add-crc.pl

#!/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