src/vfs/extfs/helpers/a+.in

   1 #! @PERL@ -w
   2 #
   3 # External filesystem for mc, using mtools
   4 # Written Ludek Brukner <lubr@barco.cz>, 1997
   5 # Much improved by Tom Perkins <968794022@noid.net>, 2000
   6 #
   7 # WARNING - This software is ALPHA - Absolutely NO WARRANTY
   8 #
   9
  10 # These mtools components must be in PATH for this to work
  11
  12 sub quote {
  13     $_ = shift(@_);
  14     s/([^\w\/.+-])/\\$1/g;
  15     return($_);
  16 }
  17
  18 $mmd = "mmd";
  19 $mrd = "mrd";
  20 $mdel = "mdel";
  21 $mdir = "mdir -a";
  22 $mcopy = "mcopy -noQ";
  23
  24 $0 =~ s|.*/||;
  25 $qdisk = quote($0);
  26
  27 $ENV{MTOOLS_DATE_STRING} = "mm-dd-yyyy";
  28 $ENV{MTOOLS_TWENTY_FOUR_HOUR_CLOCK} = "1";
  29
  30 SWITCH: for ( $ARGV[0] ) {
  31   /list/ && do {
  32     @dirs = get_dirs("");
  33     while ($dir = shift(@dirs)) {
  34       push @dirs, get_dirs("$dir/");
  35     } exit 0; };
  36   /mkdir/ && do {
  37     shift; shift;
  38     exit 1 if scalar(@ARGV) != 1;
  39     $qname = quote($ARGV[0]);
  40     system("$mmd $qdisk:/$qname >/dev/null");
  41     exit 0; };
  42   /rmdir/ && do {
  43     shift; shift;
  44     exit 1 if scalar(@ARGV) != 1;
  45     $qname = quote($ARGV[0]);
  46     system("$mrd $qdisk:/$qname >/dev/null");
  47     exit 0; };
  48   /rm/ && do {
  49     shift; shift;
  50     exit 1 if scalar(@ARGV) != 1;
  51     $qname = quote($ARGV[0]);
  52     system("$mdel $qdisk:/$qname >/dev/null");
  53     exit 0; };
  54   /copyout/ && do {
  55     shift; shift;
  56     exit 1 if scalar(@ARGV) != 2;
  57     ( $qsrc, $qdest ) = @ARGV;
  58     $qsrc = quote($qsrc);
  59     $qdest = quote($qdest);
  60     system("$mcopy $qdisk:/$qsrc $qdest >/dev/null");
  61     exit 0; };
  62   /copyin/ && do {
  63     shift; shift;
  64     exit 1 if scalar(@ARGV) != 2;
  65     ( $qdest, $qsrc ) = @ARGV;
  66     $qsrc = quote($qsrc);
  67     $qdest = quote($qdest);
  68     system("$mcopy $qsrc $qdisk:/$qdest >/dev/null");
  69     exit 0; };
  70   /.*/ && do {                               # an unfamiliar command
  71     exit 1; };
  72 }
  73
  74 sub get_dirs {
  75   my ($path, $name, $size, $date, $time, $longname, @lst, @rv);
  76   $path = shift(@_);
  77   my $qpath = quote($path);
  78   @rv = ();
  79
  80   open(FILE,"$mdir $qdisk:/$qpath |");
  81   while ( <FILE> ) {
  82     chomp();
  83     /^ / && next;                            # ignore `non-file' lines
  84     m{^Directory for $0:/}i && next;         # ignore `non-file' lines
  85     /^$/ && next;                            # ignore empty lines
  86     /^\.\.?/ && next;                        # ignore `.' and `..'
  87
  88     $name = substr($_,0,12);
  89     $name =~ s/^([^ ]*) +([^ ]+)[ \t]*$/$1.$2/;
  90     $name =~ s/[ .]+$//;
  91
  92     $_ = substr($_,12);
  93     s/^[ ]+//;
  94
  95     ($size,$date,$time,$longname) = split(/[ \t]+/, $_, 4);
  96
  97     defined $time || next;
  98
  99     # process "am" and "pm".  Should not be needed if
 100     # MTOOLS_TWENTY_FOUR_HOUR_CLOCK is respected.
 101     @lst = split(/([:ap])/, $time);
 102     $lst[0] += 12 if (defined $lst[3] && $lst[3] eq "p");
 103
 104     $time = sprintf("%02d:%02d", $lst[0], $lst[2]);
 105     @lst = split(/-/, $date);
 106     $lst[2] %= 100 if ($lst[2] > 100);
 107     $date = sprintf ("%02d-%02d-%02d", @lst);
 108
 109     $name = $path . lc(($longname) ? $longname : $name);
 110
 111     if ($size =~ /DIR/) {
 112       printf("drwxr-xr-x   1 %-8d %-8d %8d %s %s %s\n",
 113         0, 0, 0, $date, $time, $name);
 114       push @rv, $name;
 115     } else {
 116       printf("-rw-r--r--   1 %-8d %-8d %8d %s %s %s\n",
 117         0, 0, $size, $date, $time, $name);
 118     }
 119   }
 120   close(FILE);
 121   return @rv;
 122 }
 123
 124 1;