base64 (RFC 2045) encode a file

b64_encode.pl

#! perl
# encode a string/file in Base64 in pure Perl
# edit: cleaner (but non-buffered) version @ http://cpansearch.perl.org/src/GAAS/MIME-Base64-Perl-1.00/lib/MIME/Base64/Perl.pm

use strict;
use Getopt::Std;
use File::Temp qw/tempfile/;

# get and process command line options
my %opts;
getopts('f:b:l:s:no:', \%opts);

my ($ifile,
	$ofile, 
	$buff_size,
	$no_lines,
	$max_len,
	$line_sep) = unpack_opts(%opts);

# handle input from file
if ($ifile) {
	# check input file path
	die "bad file/path: $ifile\n" if ! -f $ifile; 
	
	die "nothing to convert!\n" if ! -s $ifile;
	# open file or stdin for reading
	open (FILE, '<', $ifile) or die "could not open input file: $ifile\n";
	binmode FILE;
}
# otherwise get input from STDIN
else {
	binmode STDIN;
}

# open file for writing
my ($out_fh, $tmp_fname);
if ($ofile) {
	open ($out_fh, '>', $ofile) or die "could not open output file: $ofile\n";
}
# otherwise use temp file
else {
	($out_fh, $tmp_fname) = tempfile(UNLINK => 1) or die "could not create tmp file\n";
}

# create lookup table for encoded values
my @lookup = (('A'..'Z'),('a'..'z'),(0..9),('+','/'));

my ($buffer, $prev_buffer, $line_len);
while($ifile ? read FILE, $buffer, $buff_size : read STDIN, $buffer, $buff_size) {
	# convert buffer to a binary string
	# TODO: read buffer without converting, this makes buffer x8 bigger
	$buffer = unpack('B*', $buffer);
	# prepend whatever was left from the last buffer
	$buffer = $prev_buffer . $buffer;
	# calculate how many tokens are in this buffer
	my $num_tokens = int(length ($buffer) / 6);
	
	# parse tokens
	my $encoded = '';
	for (1..$num_tokens) {
		my $token;
		($token, $buffer) = unpack('a6 a*', $buffer);
		$encoded .= $lookup[oct('0b'.$token)];
		# add CRLF if max length has been reached
		if (!$no_lines && !(++$line_len % $max_len)) {
			$encoded .= $line_sep;
			$line_len = 0; 
		}
	}
	
	print $out_fh $encoded;
	
	$prev_buffer = $buffer;
}

# add padding if necessary
my $rest = 6 - length($prev_buffer);
if ($rest && $prev_buffer =~ /\d/) {
	print $out_fh $lookup[oct('0b'.sprintf("%s%0${rest}s", unpack('a*', $prev_buffer)))] . '=' x ($rest / 2);
}

close $out_fh;
close FILE if $ifile;

# if no outfile, write output to STDOUT
if (!$ofile) {
	open (TMP, '<', $tmp_fname) or die "could not read tmp file: $tmp_fname\n";
	while (read TMP, $buffer, $buff_size) {
		print $buffer;
	}
	close TMP;
}

# function for unpacking command line options
sub unpack_opts {
	my (%opts) = @_; 
	
	# get input file, default STDIN
	my $ifile = $opts{f} ? $opts{f} : 0;
	
	# get output file, default STDOUT
	my $ofile = $opts{o} ? $opts{o} : 0;
	
	# get buffer size, default 57
	my $buff_size = $opts{b} =~ /\d+/ ? $opts{b} : 57;
	
	# toggle lines
	my $no_lines = $opts{n} ? 1 : 0;
	
	# get max line length, default 76
	my $max_len = $opts{l} =~ /\d+/ ? $opts{l} : 76;
	
	# get line separator
	my $line_sep = $opts{s} ? $opts{s} : "\r\n";
	
	return ($ifile,
			$ofile,
			$buff_size,
			$no_lines,
			$max_len,
			$line_sep);
}