The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#! /usr/local/bin/perl -w
#
# $Id$
#
use strict;
my $PP = 0;
eval { require Digest::MD5; };
require Digest::Perl::MD5, $PP = 1 if $@;
my $ctx = $PP ? Digest::Perl::MD5->new() : Digest::MD5->new();

my $TEST_BLOCK_LEN = 10_000;
my $TEST_BLOCK_COUNT = 100_000;

my ($r,$q,$p) = (0)x3;

# reading options:
while (my $input = shift) {
	unless ($input =~ s/^-//) { unshift @ARGV, $input; last; }
	for my $opt (split //, $input) {
		if ($opt eq 'p') {
			$p = 1;
		} elsif ($opt eq 'q') {
			$q = 1;
		} elsif ($opt eq 'r') {
			$r = 1;
		} elsif ($opt eq 't') {
			local $|=1;
			print "MD5 time trial. Digesting $TEST_BLOCK_COUNT $TEST_BLOCK_LEN-byte blocks ... ";
			my $block;
			for (0..$TEST_BLOCK_LEN-1) { $block .= chr($_ & 0xff) }
			my $start = time;
			for (1..$TEST_BLOCK_COUNT) { $ctx->add($block) }
			my $stop = time;
			my $diff = $stop - $start; $diff = 1 if $diff <= 0;
			print "done\n";
			print "Digest = ", $ctx->hexdigest(), "\n";
			print "Time = $diff seconds\n";
			print "Speed = ", int $TEST_BLOCK_LEN*$TEST_BLOCK_COUNT / $diff, " bytes/second\n";
			exit;
		} elsif ($opt eq 'x') {
			print "MD5 test suite:\n";
			for (
				"",
				"a",
				"abc",
				"message digest",
				"abcdefghijklmnopqrstuvwxyz",
				"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789",
				"12345678901234567890123456789012345678901234567890123456789012345678901234567890"
			) {
				md5print(qq'"$_"', $ctx->add($_)->hexdigest());
			}
			exit;
		} elsif ($opt eq 's') {
			unless (@ARGV) {
				die "md5: option requires an argument -- s\n", usage();
			}
			my $text = shift;
			md5print(qq'"$text"', $ctx->add($text)->hexdigest());
		} else {
			die "md5: illegal option -- $opt\n", usage(); 
		}
	}
}



# files
my $file;
@ARGV = '-' unless @ARGV;
foreach $file (@ARGV) {
	my $fh;
	if ($file eq '-') {
		$fh = \*STDIN;
		$q = 1;
	} else {
		open $fh, $file or die "md5: $file: $!\n";
	}
	if ($p) {
		my ($len,$buf) = (0,'');
		while ( $len = read STDIN, $buf, 8192 ) {
			print $buf;
			$ctx->add($buf);
		}
		die "read failed: $!\n" unless defined $buf;
		md5print('',$ctx->hexdigest());
	} else {
		md5print($file, $ctx->addfile($fh)->hexdigest());
	}
}

sub usage { "usage: md5 [-pqrtx] [-s string] [files ...]\n" }
sub md5print {
	my ($file, $md5) = @_;
	if ($q) { print "$md5\n"; return }
	print $r ? "$md5 $file" : "MD5 ($file) = $md5", "\n";
}