#!/bin/sh
# -*- perl -*-
# This code allows us to start perl from our path or an environment variable
# rather than hardcoding a path into the #! line.  It works from sh or csh.
(exit $?0) && eval 'exec ${QPERLQ-perl} -x $0 ${1+"$@"}'
if (! $?QPERLQ) setenv QPERLQ perl
exec $QPERLQ -x $0 $argv:q

#!/usr/local/bin/perl -w
#
# $Id: vfat_mtools,v 1.1 1996/02/11 00:03:29 qjb Exp $
# $Source: /home/qjb/scripts/RCS/vfat_mtools,v $
# $Author: qjb $
#

require 5.001;
use strict;

my $whoami = ($0 =~ m,([^/]*)$,) ? $1 : $0;

my $root_start = 0;
my $root_length = 8;
my $ext_start = 9;
my $ext_length= 3;
my $dir_start = 13;
my $dir_kwd = "<DIR>";
my $dir_length = length($dir_kwd);
my $longname_start = 42;
my $max_mattrib_length = 1000;
my $m_attrib_start = 0;
my $m_attrib_length = 13;
my $m_name_start = 13;

my $dir = $ARGV[0] || "C:";
&scan($dir);

sub scan
{
    my $dir = shift;
    my @files = ();
    my %files = ();
    my $qdir = $dir;
    &quote($qdir);
    local(*MDIR);
    open(MDIR, "mdir -a $qdir|") || die "mdir $dir failed: $!\n";
    while (defined($_ = <MDIR>))
    {
	chomp;
	if (m/^\S/)
	{
	    my $root = substr($_, $root_start, $root_length);
	    my $ext = substr($_, $ext_start, $ext_length);
	    my $longname = ((length >= $longname_start) ?
			    substr($_, $longname_start) : undef);
	    $root =~ s/\s+$//;
	    $ext =~ s/\s+$//;
	    my $shortname = $root . (length($ext) ? ".$ext" : "");
	    next if (($shortname eq ".") || ($shortname eq ".."));
	    my $name;
	    if (defined $longname)
	    {
		$name = $longname;
	    }
	    else
	    {
		$name = $shortname;
	    }
	    my $isdir = (substr($_, $dir_start, $dir_length) eq $dir_kwd);
	    $name = "$dir/$name";
	    push(@files, $name);
	    $files{$name} = [$shortname, "xxxx", $isdir ? "/" : ""];
	    &scan($name) if $isdir;
	}
    }
    close(MDIR);
    &gen_attribs(\@files, \%files);
    foreach (@files)
    {
	printf("%-12s %-4s $_%s\n", @{$files{$_}});
    }
}

sub quote
{
    $_[0] =~ s,([^\w/:]),\\$1,g;
}

sub parse_attribs
{
    my ($args, $fileshp) = @_;
    return if ($args =~ m/^\s*$/);
    open(MATTRIB, "mattrib $args|") ||
	die "$whoami: mattrib failed: $!\n";
    while (<MATTRIB>)
    {
	chomp;
	my $attr = substr($_, $m_attrib_start, $m_attrib_length);
	my $name = substr($_, $m_name_start);
	$attr =~ s/\s//g;
	$fileshp->{$name}->[1] = $attr;
    }
    close(MATTRIB);
}

sub gen_attribs
{
    my ($filesap, $fileshp) = @_;
    my $f;
    my $args = "";
    foreach $f (@$filesap)
    {
	my $qf = $f;
	&quote($qf);
	if (length($args . " " . $qf) > $max_mattrib_length)
	{
	    &parse_attribs($args, $fileshp);
	    $args = $qf;
	}
	else
	{
	    $args .= " " . $qf;
	}	
    }
    &parse_attribs($args, $fileshp);
}