lsparse.pl

站点映像程序

 	    return( substr( $file, 1 ), $size, $time, $type, $mode );
	 }
	 else {
	    printf( "Unmatched line: %s", $_ );
	}
    }

    return( '', 0, 0, 0, 0 );
}

# --------------------- parse output from a basic OS2 server
# for each file or directory line found return a tuple of
# (pathname, size, time, type, mode)
# pathname is a full pathname relative to the directory set by reset()
# size is the size in bytes (this is always 0 for directories)
# time is a Un*x time value for the file
# type is "f" for a file, "d" for a directory and
#         "l linkname" for a symlink
#                 0           DIR   04-11-95   16:26  .
#                 0           DIR   04-11-95   16:26  ..
#                 0           DIR   04-11-95   16:26  ADDRESS
#               612      A          07-28-95   16:45  air_tra1.bag
#               195      A          08-09-95   10:23  Alfa1.bag
#                 0           DIR   04-11-95   16:26  ATTACH
#               372      A          08-09-95   10:26  Aussie_1.bag
#            310992                 06-28-94   09:56  INSTALL.EXE

sub lsparse'line_os2
{
	local( $fh ) = @_;

	while( 1 ){
		if( eof( $fh ) ){
			return( "", 0, 0, 0 );
		}

		$_ = <$fh>;

		# Store listing
		print main'STORE $_;

		# Ignore blank lines
		if( /^\s+$/ ){
			next;
		}

		# Stomp on carriage returns
		s/\015//g;

		# I'm about to look at this at lot
		study;

		if( m,(\d+)\s+((\S+)\s+)?((\S+)\s+)?(\d+)-(\d+)-(\d+)\s+(\d+):(\d+)\s+(\S.*), ){
			local( $size, $flags, $dir, $mon, $day, $yr, $hrs, $min, $file ) =
				($1, $3, $5, $6, $7, $8, $9, $10, $11);
			if( $file eq '.' || $file eq '..' ){
				next;
			}

			# Maybe there are no flags just a DIR??
			if( $flags ne '' && $dir eq '' ){
				$dir = $flags;
				$flags = '';
			}

			# TODO: fix hacky 19$yr
			local( $lsdate ) = "$day-$mon-19$yr $hrs:$min";
			local( $time ) = &main'lstime_to_time( $lsdate );
			local( $type ) = ($dir eq 'DIR' ? 'd' : 'f');
			local( $mode ) = 0;

			$size = $dir_or_size if $dir_or_size =~ /^\d/;

			$currdir =~ s,/+,/,g;
			$file =~ s,^/$match,,;
			$file = "/$currdir/$file";
			$file =~ s,/+,/,g;
			return( substr( $file, 1 ), $size, $time, $type, $mode );
		}
		else {
			printf( "Unmatched line: %s", $_ );
		}
	}
	return( '', 0, 0, 0, 0 );
}


# --------------------- parse output from chameleon ftp server
# for each file or directory line found return a tuple of
# (pathname, size, time, type, mode)
# pathname is a full pathname relative to the directory set by reset()
# size is the size in bytes (this is always 0 for directories)
# time is a Un*x time value for the file
# type is "f" for a file, "d" for a directory and
#         "l linkname" for a symlink
sub lsparse'line_chameleon
{
    local( $fh ) = @_;

    while( 1 ) {

	if( $pending ){
	    $_ = $pending;
	    $pending = '';
	}
	else {
	    if( eof( $fh ) ){
		return( "", 0, 0, 0 );
	    }

	    $_ = <$fh>;
	    # Ignore the summary at the end and blank lines
	    if( /^\d+ files?\./ || /^\s+$/ ){
		next;
	    }
	}

	# Stomp on carriage returns
	s/\015//g;
	s/\s+$//;

               # I'm about to look at this at lot
	study;

	local( $file, $dirsize, $mon, $day, $yr, $time, $perm )
	    = split(" ", $_, 7);

	if( defined $file ){

	    next if $file eq '..' || $file eq '.';

	    $pending = $5;

	    local( $lsdate ) = "$day-$mon-$yr $time";
	    local( $time ) = &main'lstime_to_time( $lsdate );
            local( $type ) = '?';
	    local( $mode ) = 0;

            if( $dirsize eq '<DIR>' ){
               $type = 'd';
               $size = 0;
            }
            else {
               $type = 'f';
	       $size = $dirsize;
	       $size =~ s/,//g;
            }

	    $currdir =~ s,/+,/,g;
	    $file =~ s,^/$match,,;
	    $file = "/$currdir/$file";
	    $file =~ s,/+,/,g;

 	    return( substr( $file, 1 ), $size, $time, $type, $mode );
	 }
	 else {
	    printf( "Unmatched line: %s", $_ );
	}
    }

    return( '', 0, 0, 0, 0 );
}


# --------------------- parse standard MACOS Unix-like ls output
# for each file or directory line found return a tuple of
# (pathname, size, time, type, mode)
# pathname is a full pathname relative to the directory set by reset()
# size is the size in bytes (this is always 0 for directories)
# time is a Un*x time value for the file
# type is "f" for a file, "d" for a directory and
#         "l linkname" for a symlink
sub lsparse'line_macos
{
	local( $fh ) = @_;
	local( $non_crud, $perm_denied );

	if( eof( $fh ) ){
		return( "", 0, 0, 0 );
	}

	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		# Stomp on carriage returns
		s/\015//g;

		# I'm about to look at this at lot
		study;

		if( /^([\-rwxd]{10}).*\s(\d+\s+)?(\S+)\s+\d+\s*(\w\w\w\s+\d+\s*(\d+:\d+|\d\d\d\d))\s+(.*)\n/ ){
			local( $kind, $size, $lsdate, $file ) = ($1, $3, $4, $6);
			
			local( $time ) = &main'lstime_to_time( $lsdate );
			local( $type ) = '?';
			local( $mode ) = 0;

			if( $kind =~ /^-/ ){
				# (hopefully) a regular file
				$type = 'f';
			}
			elsif( $kind =~ /^d/ ){
				$type = 'd';	
				$size = 0;   # Don't believe the report size
			}
			
			$currdir =~ s,/+,/,g;
			$file =~ s,^/$match,,;
			$file = "/$currdir/$file";
			$file =~ s,/+,/,g;
			return( substr( $file, 1 ), $size, $time, $type, $mode );
		}
		else {
			printf( "Unmatched line: %s", $_ );
		}
	}
	return( '', 0, 0, 0, 0 );
}


# --------------------- parse lsparse log file format
# lsparse'line_lsparse() is for input in lsparse's internal form,
# as it might have been written to a log file during a previous
# run of a program that uses lsparse.  The format is:
#     filename size time type mode
# where size and time are in decimal, mode is in decimal or octal,
# and type is one or two words.
sub lsparse'line_lsparse
{
	local( $fh ) = @_;

	if( $lsparse'readtime ){
		alarm( $lsparse'readtime );
	}

	if( eof( $fh ) ){
		alarm( 0 );
		return( "", 0, 0, 0 );
	}

	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		if( /^(\S+)\s+(\d+)\s+(\d+)\s+((l\s+)?\S+)\s+(\d+)\n$/ ){
			# looks good.
			# note that $type is two words iff it starts with 'l'
			local( $name, $size, $time, $type, $mode )
				= ( $1, $2, $3, $4, $6 );
			
			$mode = oct($mode) if $mode =~ /^0/;
			return( $name, $size, $time, $type, $mode );
		}
		else {
			printf( "Unmatched line: %s\n", $_ );
		}
	}
	alarm( 0 );
	return( '', 0, 0, 0, 0 );
}


# --------------------- Info-Mac all-files
# -r     1974 Jul 21 00:06 00readme.txt
# lr        3 Sep  8 08:34 AntiVirus -> vir
# ...
# This is the format used at sumex-aim.stanford.edu for the info-mac area.
# (see info-mac/help/all-files.txt.gz).
#
sub lsparse'line_infomac
{
	local( $fh ) = @_;

	if( $lsparse'readtime ){
		alarm( $lsparse'readtime );
	}

	if( eof( $fh ) ){
		alarm( 0 );
		return( "", 0, 0, 0 );
	}

	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		next if /^;/;
		if( /^([l-].)\s*(\d+)\s*(\w\w\w\s+\d+\s*(\d+:\d+|\d\d\d\d))\s+(.*)\n/ ){
			local( $kind, $size, $lsdate, $file ) = ($1, $2, $3, $5);
			
			local( $time ) = &main'lstime_to_time( $lsdate );

			# This should be a symlink
			if( $kind =~ /^l/ && $file =~ /(.*) -> (.*)/ ){
				$file = $1;
				$type = "l $2";
			}
			elsif( $kind =~ /^[\-F]/ ){
				# (hopefully) a regular file
				$type = 'f';
			}
			else {
				printf( "Unparsable info-mac line: %s\n", $_ );
				next;
			}
			
			return( $file, $size, $time, $type, 0444 );
		}
		else {
			printf( "Unmatched line: %s\n", $_ );
		}
	}
	alarm( 0 );
	return( '', 0, 0, 0, 0 );
}


# --------------------- EPLF by Dan Bernstein
# +i8388621.48638,m848117771,r,s1336,     qmsmac.html
# +i8388621.88705,m850544954,/,   txt
#
sub lsparse'line_eplf
{
	local( $fh ) = @_;

	if( $lsparse'readtime ){
		alarm( $lsparse'readtime );
	}

	if( eof( $fh ) ){
		alarm( 0 );
		return( "", 0, 0, 0 );
	}

	while( <$fh> ){
		s/\015//g;

		# Store listing
		print main'STORE $_;

# +i8388621.48638,m848117771,r,s1336,     qmsmac.html
# +i8388621.88705,m850544954,/,   txt
		if( ! m:^\+i(\d+\.\d+),m(\d+),(/|[rw],s(\d+)),\s+(.*)$: ){
			printf( "Unmatched line: %s\n", $_ );
			next;
		}
		local( $dev_ino, $time, $dirrw, $size, $file ) = ($1, $2, $3, $4, $5);
		local( $mode );
		if( $dirrw =~ m:^/: ){
			$type = 'd';
			$size = 0;
			$mode = 0755;
		}
		else {
			$type = 'f';
			$mode = ($dirrw =~ /r/ ? 0444 : 0666 );
		}
		return( $file, $size, $time, $type, $mode );
	}
	alarm( 0 );
	return( '', 0, 0, 0, 0 );
}


# --------------------- CTAN files list
#    22670 Mon Jul 20 12:36:34 1992 pub/tex/biblio/bibtex/contrib/aaai-named.bst
#
sub lsparse'line_ctan
{
	local( $fh ) = @_;

	if( $lsparse'readtime ){
		alarm( $lsparse'readtime );
	}

	if( eof( $fh ) ){
		alarm( 0 );
		return( "", 0, 0, 0 );
	}

	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		if( /^\s*(\d+)\s+(\w\w\w\s+\w\w\w\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(.*)\n/ ){
			local( $size, $lsdate, $file ) = ($1, $2, $3);
			
			local( $time ) = &main'lstime_to_time( $lsdate );

			return( $file, $size, $time, 'f', 0444 );
		}
		else {
			printf( "Unmatched line: %s\n", $_ );
		}
	}
	alarm( 0 );
	return( '', 0, 0, 0, 0 );
}

# ------------------------------ VM/CMS
#
# DIRACC   EXEC     A1    F    132         84          3  01/25/93  14:49:47
# DIRUNIX  SCRIPT   A1    V     77       1216         17  01/04/93  20:30:47
# MAIL     PROFILE  A2    F     80          1          1  10/14/92  16:12:27
#
# (pathname, size, time, type, mode)
# pathname is a full pathname relative to the directory set by reset()
# size is the size in bytes (this is always 0 for directories)
# for this we guess that it is record length * nrecords -- usually false
# time is a Un*x time value for the file -- this is good from the m/f
# type is always "f" for a file

sub lsparse'line_cms
{
	local( $fh ) = @_;

	if( $lsparse'readtime ){
		alarm( $lsparse'readtime );
	}

	if( eof( $fh ) ){
		alarm( 0 );
		return( "", 0, 0, 0 );
	}
	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		chop;
		next unless /\d+\/\d+\/\d+\s+\d+:\d+:\d+/;
		s/^\s+//;

		# Upper case is so ugly
		if( ! $lsparse'vms_keep_case ){
			tr/A-Z/a-z/;
		}

		local( $fname, $ftype, $fdisk, $rectype, $lrecl, $recs,
		      $blocks, $ldate, $tod ) = split(/\s+/, $_);
		return( join('.', ($fname, $ftype, $fdisk)),
		       $lrecl * $recs, &main'lstime_to_time( "$ldate $tod" ),
		       'f' );
	}
	alarm( 0 );
	return( '', 0, 0, 0, 0 );
}


# -----
1;