From jv@mh.nl Wed Apr 15 05:45:42 1992 To: Perl-Users@fuggles.acc.Virginia.EDU From: jv@mh.nl (Johan Vromans) Crossposted-To: comp.sources.d Subject: Re: v29i058: ls_archive - produce ls-like (but better) listings of archives, Part01/01 Date: 5 Apr 92 09:21:15 GMT SUB: Re: v29i058: ls_archive - produce ls-like (but better) listings of archives, Part01/01 SUM: jv@mh.nl (Johan Vromans)->Perl-Users@fuggles.acc.Virginia.EDU In article <1992Apr5.033019.199@sparky.imd.sterling.com> dave@galaxia.newport.ri.us (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 info-server@nluug.nl 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 ( ) { 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 jv@mh.nl 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" =========================