[alt.sources] edbh.pl perl program

think@ut-emx.UUCP (s j moon) (10/26/89)

It is a little but useful perl program.
You can delete useless head/tail of shar/binhex files with this.
You have to modify first line.(maybe #!/bin/perl)

ps: you can get perl source code from anonymous FTP

       jpl-devvax.jpl.nasa.gov (128.149.1.143)


---------- cut here  ------
#!/usr/uns/perl      
# It is not in /bin  of my emx computer

# 
# Name:  edbh.pl
#        by   Sungjin Moon     think@emx.utexas.edu

# format:        perl edbh oldfile newfile 
#           or   edbh oldfile newfile  if edbh is executable
# description:   edit head and tail of binhex file

$oldfile = shift;
die "Usage: edbh old new" unless $oldfile;
open(binhex,$oldfile) || die "Can't find $oldfile";

$newfile = shift;
die "Usage: edbh old new" unless $newfile;
open(ofile, ">$newfile") || die "Can't open $newfile";

$len = 20; # default length of display lines
$first = 1;  # pointer to first real text
$last = 0;   # pointer to last real text
while (<binhex>) {
    s/ *$//;   			# remove trailing space
    $binhex[++$last] = $_;	# save text
}
close binhex;
print "$last Lines Read In.\n";
print "Type h for help.\n";
do ED();

#
#
sub ED {
	for (;;) {
	    print "edbh-- ";
	    $cmd = <stdin>;
	    $cnt = $last - $first + 1; # current # of lines
	    if($cnt <=0) {print "No more text\.\n";last;} # no text

	    if ($cmd =~ /^q$/) {
		for($i=$first;$i<=$last;$i++) {
		  printf ofile $binhex[$i];
		}
	    close ofile;
	    print "New file $newfile is created: $cnt Lines.\n";
	    exit 0;
	    }

	    if ($cmd =~ /^h$/) {
		print "
q		Save and quit.
c N		Change default no. of lines(20)

<cr>		List first 20 head lines.
l		List first 20 head lines.
l N		List first N head lines.

lt		List last 20 tail lines.
lt N		List last N tail lines.

d		Delete first 20 head lines.
dh N		Delete first N head lines.

dt N		Delete last N tail lines.

";
		next;
	    }
	    if ($cmd =~ /^c (.*)/) {
		$len = $1;
		next;
	    }
	    if ($cmd =~ /^$/) {
		$j = 1;
		$k = $cnt<$len ? $cnt : $len;
		for($i=$first;$i < $first+$k;$i++) {
		  print "$j:\t", $binhex[$i];
		  $j++;
		}
		next;
	    }
	    if ($cmd =~ /^l$/) {
		$j = 1;
		$k = $cnt<$len ? $cnt : $len;
		for($i=$first;$i < $first+$k;$i++) {
		  print "$j:\t", $binhex[$i];
		  $j++;
		}
		next;
	    }
	    if ($cmd =~ /^l (.*)/) {
		$j = 1;
		$k = $cnt<$1 ? $cnt : $1;
		for($i=$first;$i < $first+$k;$i++) {
		  print "$j:\t", $binhex[$i];
		  $j++;
		}
		next;
	    }
	    if ($cmd =~ /^lt$/) {
		$k = $cnt<$len ? $cnt : $len;
		$j = $k;
		for($i=$last-$k+1;$i <= $last;$i++) {
		  print "$j:\t", $binhex[$i];
		  $j--;
		}
		next;
	    }
	    if ($cmd =~ /^lt (.*)/) {
		$k = $cnt<$1 ? $cnt : $1;
		$j = $k;
		for($i=$last-$k+1;$i <= $last;$i++) {
		  print "$j:\t", $binhex[$i];
		  $j--;
		}
		next;
	    }
	    if ($cmd =~ /^d$/) {
		$k = $cnt<$len ? $cnt : $len;
		$first += $k;
		next;
	    }
	    if ($cmd =~ /^dh (.*)/) {
		$k = $cnt<$1 ? $cnt : $1;
		$first += $k;
		next;
	    }
	    if ($cmd =~ /^dt (.*)/) {
		$last -= $1;
		next;
	    }
	     print "Syntax error: type h for help.\n";
	}  # end of for
}  # end of sub ED
# end of file edbh.pl