Subject: Re: v29i058: ls_archive - produce ls-like (but better) listings of archives, Part01/01

From: [email-masked] (Johan Vromans)
Date: 5 Apr 92 09:21:15 GMT

In article <[email-masked]> [email-masked] (David H. Brierley) writes:

   This program produces a recursive listing of a directory tree, similar to
   "ls -lR" but with a few major differences. ...

I strongly agree. However, since most archives maintain a ls-lR type
listing, I wrote a little program to turn these into a better format
(that --surprise!-- closely matches yours).

It is written in perl, of course.

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 04/05/1992 09:17 UTC by jv@pasta
# Source directory /beethoven/work/PD/lsa
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   4570 -rw-r--r-- makelist.pl
#
# ============= makelist.pl ==============
if test -f 'makelist.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping makelist.pl (File already exists)'
else
echo 'x - extracting makelist.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'makelist.pl' &&
X#!/usr/bin/perl -s
X
X# Author          : Johan Vromans
X# Created On      : Mon Oct 29 16:06:40 1990
X# Last Modified By: Johan Vromans
X# Last Modified On: Mon Jun 24 17:54:21 1991
X# Update Count    : 56
X# Status          : OK
X#
X
X# HISTORY 
X# 24-Jun-1991		Johan Vromans	
X#    Add info-server format.
X#    Add -sort option.
X#    Add sort/merge facility.
X#    
X# 3-Feb-1991		Johan Vromans	
X#    Add error counting and "-ignore" option.
X#
X# 3-Feb-1991		Johan Vromans	
X#    Allow "ls -lgL" output (same as System V "ls -lR".
X#    Strip useless "./" prefix if present.
X
X# Process a ls -lR output and turn it into a useful list of files
X# with sizes and dat info only.
X#
X# Format of entries:
X#
X# pub:
X# total 4
X# dr--r--r--  4 root          512 Nov 26 14:03 DEC
X# 
X# pub/DEC:
X# total 4
X# dr--r--r--  5 root         1024 Nov 26 14:03 CCgc
X# 
X# pub/DEC/CCgc:
X# total 47
X# -r--r--r--  1 root        43725 Nov 26 14:03 26nov90.tar.Z
X# -r--r--r--  1 root         3505 Nov 26 14:03 README
X# 
X# Ouput (sans headers):
X#
X# 1990/11/26    43,725  pub/DEC/GGgc/26nov90.tar.Z
X# 1990/11/26     3,505  pub/DEC/GGgc/README
X#
X# Other formats are possible.
X#
X# When more than one input stream is specified, the additional files
X# are taken to be updates on the primary data. 
X
X$ignore = defined $ignore;
Xif ( $sort = (defined $sort || $#ARGV > 0) ) {
X    $tmpfile = "/usr/tmp/mh$$";
X    open (TMP, ">" . $tmpfile) || die ("Cannot create temp file\n");
X}
X@now = localtime (time);
X$thisyear = (1900 + $now[5]) . "";
X$thismonth = $now[4];
X%months = ("Jan",0,"Feb",1,"Mar",2,"Apr",3,"May",4,"Jun",5,
X	   "Jul",6,"Aug",7,"Sep",8,"Oct",9,"Nov",10,"Dec",11);
X$dir = "";
X
Xselect (STDOUT);
X$~ = "OUT";
X$^ = "OUT_HDR";
X$= = 99999999;			# really don't want paging
X$tag = "";
X
Xwhile ( <> ) {
X    chop;
X
X    # Common formats:
X    # -r--r--r--  1 root          309 May  2 19:12 README
X    # -r--r--r--  1 root system      309 May  2 19:12 README
X    #     12578 Jan 21 14:35 EUUGD10.Z
X    
X    # Parse entry line, ls -l or ls -lg format
X
X    if (($junk,$size, $month, $day, $time, $file) =
X	/^-r........\s+\d+\s+\S+(\s+\S+\s+|\s+)(\d+) +([A-Z][a-z][a-z]) +(\d+) +(\d\d\d\d|\d\d:\d\d) +(.+)$/ ) {
X	
X	# Always use year
X        $time = $thisyear - ( $months{$month} > $thismonth ) if $time =~ /:/;
X	$date = sprintf ("%4d/%02d/%02d", $time, 1+$months{$month}, $day);
X	$size = &numfmt ($size);
X	$date .= $tag if $tag;
X	if ( $sort ) {
X	    print TMP ($dir, $file, "\t", $date, "\t", $size, "\n");
X	}
X	else {
X	    write;
X	}
X	next;
X    }
X
X    # Else, try [email-masked] format
X    if (($size, $month, $day, $time, $file) =
X	/^\s*(\d+) +([A-Z][a-z][a-z]) +(\d+) +(\d\d\d\d|\d\d:\d\d) +(.+)$/ ) {
X	
X	# Always use year
X        $time = $thisyear - ( $months{$month} > $thismonth ) if $time =~ /:/;
X	$date = sprintf ("%4d/%02d/%02d", $time, 1+$months{$month}, $day);
X	$size = &numfmt ($size);
X	$date .= $tag if $tag;
X	if ( $sort ) {
X	    print TMP ($dir, $file, "\t", $date, "\t", $size, "\n");
X	}
X	else {
X	    write;
X	}
X	next;
X    }
X
X    # Else, try path specification
X    if ( /^[^ :]+:$/ ) {
X	chop;
X	$dir = $_ . "/";
X	$dir = $' if $dir =~ m|^./|; # strip useless ./ prefix
X	next;
X    }
X
X    # Skip empty and blank lines
X    next if /^\s*$/;
X
X    # Skip directories, symlinks and total lines
X    next if /^[dl][-r]/ || /\s*total\b/i;
X
X    # Unknown
X    next if $ignore;
X    print STDERR "?? ", $_, "\n";
X    die ("Too many errors - use \"-ignore\" to override\n")
X	if $errcnt++ > 10;
X
X}
Xcontinue {
X    # At the end of the first current stream merge other inputs.
X    if ( $tag eq "" && eof ) {
X	$tag = "*";		# mark
X	$ignore++;		# be forgiving
X	$dir = "";		# assume absolute filenames
X    }
X
X}
X
Xexit (0) unless $sort;
X
Xclose (TMP);
Xopen (DATA, "sort $tmpfile|") || die ("Cannot read sorted data\n");
X$dir = 1;
Xwhile ( <DATA> ) {
X    if ( $dir ) {
X	unlink ($tmpfile);
X	$dir = "";
X    }
X    chop;
X    ($file, $date, $size) = split;
X    write;
X}
X
Xexit (0);
X
X################ subroutines ################
X
Xsub numfmt {
X    local ($temp) = "" . $_[0];
X    local ($size) = "";
X    while ( $temp =~ /^(.+)(...)$/ ) {
X	$size = "," . $2 . $size;
X	$temp = $1;
X    }
X    $temp . $size;
X}
X
X################ formats ################
X
Xformat OUT_HDR =
X   Date            Size  Filename                                  @>>>>>>>>
X"Page: $%"
X----------    ---------  ------------------------
X.
Xformat OUT =
X@<<<<<<<<<< @>>>>>>>>>>  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
X$date, $size, $dir . $file
X.
X
X# Emacs support
X# Local Variables:
X# mode:perl
X# eval:(headers)
X# End:
Xpronto:jv [~/archives] 
SHAR_EOF
chmod 0644 makelist.pl ||
echo 'restore of makelist.pl failed'
Wc_c="`wc -c < 'makelist.pl'`"
test 4570 -eq "$Wc_c" ||
	echo 'makelist.pl: original size 4570, current size' "$Wc_c"
fi
exit 0
-- 
Johan Vromans				       [email-masked] via internet backbones
Multihouse Automatisering bv		       uucp:..!{uunet,sun4nl}!mh.nl!jv
Doesburgweg 7, 2803 PL Gouda, The Netherlands  phone/fax: +31 1820 62911/62500
======================== "Arms are made for hugging" =========================