oneliner-el 0.3.6-8 / usr / bin / el

#!/usr/bin/perl -w
my $ONELINER_VER="0.3.6";
#!/usr/bin/perl -w
my $ONELINER_VER="0.3.5";
#!/usr/bin/perl -w

use strict 'vars';
use vars qw($ONELINER_VER);
use Getopt::Long;
use File::Temp qw(mktemp);
use File::Spec::Functions qw(catfile);

if( !defined( $ENV{TMPDIR} ) ) {
    print "Error: Please set environment variable TMPDIR (e.g. export TMPDIR=\"/home/youraccount/temp/\")\n";
    exit 1;
}
if( !defined($ONELINER_VER)) {
    $ONELINER_VER = "[testing version]";
}

# global variables
my $id_string = '$Id: el,v 1.1.2.8 2003/11/30 11:51:24 kiyoka Exp $';
my $version_string = 'el ' . $ONELINER_VER . '(revision ' . (split /\s/, $id_string)[2] . ')';
my $oneliner_std_start = $ENV{ONELINER_STD_START};
my $oneliner_std_end   = $ENV{ONELINER_STD_END};
my $oneliner_ex_cmd_prefix = $ENV{ONELINER_EX_CMD_PREFIX};

# option variables
my %opt = (VERSION	=> '',
	   HELP		=> '',
	   ARGS		=> 0,
	   COMMAND	=> '',
	   DEBUG	=> '',
	   FORMAT	=> undef,
	   INPIPE	=> undef,
	   OUTPIPE	=> undef,
	   SERIAL	=> '',
	   EXECUTE	=> '',
	   );

GetOptions ('V|version!'	=> \$opt{VERSION},
	    'h|help!'		=> \$opt{HELP},
	    'a|args=i'		=> \$opt{ARGS},
	    'c|command=s'	=> \$opt{COMMAND},
	    'd|debug!'		=> \$opt{DEBUG},
	    'f|format=s'	=> \$opt{FORMAT},
	    'i|inpipe=s'	=> \$opt{INPIPE},
	    'o|outpipe=s'	=> \$opt{OUTPIPE},
	    's|serial!' 	=> \$opt{SERIAL},
	    'x|execute!' 	=> \$opt{EXECUTE},
	    ) or die;

# debugging info
if ($opt{DEBUG}) {
    debug ("============ Given Options ============\n");
    for my $key (sort keys %opt) {
	debugf ("%-10s = [%s]\n", lc($key), $opt{$key});
    }
    debug ("=======================================\n");
}

# branch for each option
if ($opt{VERSION}) {
    version();
} elsif ($opt{HELP}) {
    help();
} else {
    # normal operation
    my $print = build_print_func ();
    my $use_stdin = (@ARGV==0);		# check count of @ARGV 
    $opt{COMMAND} and unshift @ARGV, $opt{COMMAND}; # @ARGV may change
    $opt{SERIAL}  and undef $/;	# read STDIN as a whole

    $opt{EXECUTE} and print STDERR $oneliner_ex_cmd_prefix, "autoeval\n";
    defined $opt{OUTPIPE}
      and print STDERR $oneliner_ex_cmd_prefix, "outpipe $opt{OUTPIPE}\n";

    if (defined $opt{INPIPE}) {
	my $tmp = mktemp ('el-XXXX') . '.tmp';
	my $tmppath = catfile($ENV{TMPDIR},$tmp);
	my $try = 0;
	$| = 1;
	my $exp = qq((oneliner-write-buffer "$opt{INPIPE}"
		      (concat
		       (file-name-as-directory (getenv "TMPDIR")) "$tmp")));
	$exp =~ s/\s+/ /g;
	print STDERR $oneliner_ex_cmd_prefix,"eval $exp\n";
	while (++$try <= 10) {
	    select(undef, undef, undef, 0.20);	# sleep;
	    last if -f $tmppath;
	}
	$opt{DEBUG} and debug ("inpipe trial: $try\n");
	open INPIPE, $tmppath or die "can't open $tmppath: $!\n";
	$print->($_) while (<INPIPE>);
	close INPIPE;
	unlink $tmppath;
    } elsif ($use_stdin) {
	$print->($_) while (<STDIN>);
    } else {
	$print->();
    }
}
exit;

########## subroutines below ##########

##
## show version
##
sub version {
    print $version_string, "\n";
}

##
## show help
##
sub help {
    print $version_string, "\n", <<'END_OF_USAGE';
usage: el [options] [arg ...]
 -a --args n       number of arguments for given function
 -c --command cmd  use cmd as first argument for each line
 -d --debug        display additional info for debugging
 -f --format fmt   use fmt as format string of printf
 -h --help         give this help
 -i --inpipe  buf  get input from pipe buffer
 -o --outpipe buf  put output to  pipe buffer
 -s --serial       serialize stdin as single stream instead of multi lines
 -V --version      display version number
 -x --execute      put special string for automatic evaluation
END_OF_USAGE
}

##
## build function for output and return its reference
##
sub build_print_func {
    my $format = $opt{FORMAT};	# format string for printf
    my $args   = $opt{ARGS};	# number of arguments
    my $prefix = (($opt{EXECUTE} or defined $opt{OUTPIPE}) ? $oneliner_std_start : '');
    my $suffix = (($opt{EXECUTE} or defined $opt{OUTPIPE}) ? $oneliner_std_end   : '');
    my $print_sub = undef;	# defined later
    # these variables will go into closure defined below

    if (not defined $format) {
	# if no format given, use print()
	$print_sub = sub {
	    my $bareword = shift;
	    my @list = ($bareword, map {qq/"$_"/} @_);
	    print "(@list)";
	};
    } elsif ($format eq '') {
	# if empty, put input as is
	$print_sub = sub { print $_ };
    } else {
	if ($args == 0) {
	    # count single "%" for args
	    # use "%%" for escape instead of "\%"
	    while ($format =~ /[^%]*(%+)/g) {
		++$args if length ($+) % 2 == 1;
	    }
	}
	$print_sub = sub{
	    my $fmt = eval "qq\000$format\000";	# expand \t, @_ etc.
	    chomp $fmt;			# newline will added later
	    if ($opt{DEBUG}) {
		debug ("format(raw)  = [$format]\n");
		debug ("format(used) = [$fmt]\n");
		debug ("params(used) = [@_]\n");
	    }
	    printf $fmt, @_;
	};
    }

    # return subroutine
    return sub {
	do {	# loop at least once even if no input given
	    local $_ = shift || ''; # force string type
	    chomp;
	    my @list = split;
	    my $len = $args || @list;
	    if ($opt{DEBUG}) {
		debug ("input: [$_]\n");
		debug ("splice: [$len]\n");
	    }
	    do {
		print $prefix;
		$print_sub->( @ARGV, splice (@list, 0, $len) );
		print $suffix;
		print "\n";	# force newline
	    } while (@list);
	} while (@_);
    };
}

##
## print debugging info
##
sub debugf {
    my $fmt = shift;
    printf STDERR '[DEBUG] '.$fmt, @_;
}
sub debug {
    print STDERR '[DEBUG] ',@_;
}