#!/usr/bin/perl
=begin metadata
Name: uuencode
Description: encode a binary file
Author: Tom Christiansen, tchrist@perl.com
License: perl
=end metadata
=cut
# uuencode -- by Tom Christiansen
use strict;
use File::Basename qw(basename);
use Getopt::Std qw(getopts);
use constant EX_SUCCESS => 0;
use constant EX_FAILURE => 1;
my $Program = basename($0);
my %opt;
getopts('p', \%opt) or usage();
usage() unless @ARGV;
if ($opt{'p'}) { # write to stdout
for my $input (@ARGV) {
encode($input => $input);
}
exit EX_SUCCESS;
}
if (@ARGV == 2) {
my($in, $out) = @ARGV;
encode($in => $out);
}
elsif (@ARGV == 1) {
my($out) = @ARGV;
encode("-" => $out);
}
else {
usage();
}
exit EX_SUCCESS;
sub usage {
warn "usage: $Program [file] name\n";
warn " $Program -p file ...\n";
exit EX_FAILURE;
}
sub encode {
my($source, $destination) = @_;
my $mode;
my $input;
if ($source eq '-') {
$input = *STDIN;
$mode = 0644;
} else {
if (-d $source) {
warn "$Program: '$source' is a directory\n";
exit EX_FAILURE;
}
unless (open $input, '<', $source) {
warn "$Program: failed to open '$source': $!\n";
exit EX_FAILURE;
}
$mode = (stat($input))[2] & 0666;
}
binmode $input; # winsop
printf "begin %03o $destination\n", $mode;
my $block;
print pack ("u", $block) while read ($input, $block, 45);
print "`\n";
print "end\n";
unless (close $input) {
warn "$Program: can't close '$source': $!\n";
exit EX_FAILURE;
}
}
=encoding utf8
=head1 NAME
uuencode - encode a binary file