modules/extfs/a

   1 #! /usr/bin/perl
   2 #
   3 # External filesystem for mc, using mtools
   4 # Written Ludek Brukner (lubr@barco.cz), 1997
   5 #
   6 # WARNING - This software is ALPHA - Absolutely NO WARRANTY
   7 #
   8
   9 ### Change this when the commands are outside PATH
  10 $mdir = "mdir";
  11 $mcopy = "mcopy -noQ";
  12 ###
  13
  14 $disk = $0;
  15 $disk =~ s/^.*\/([^\/]*)$/\1/;
  16
  17 sub get_dirs {
  18     my ($path, $name, $size, $date, $time, $longname, @lst, @rv);
  19
  20     $path = shift(@_);
  21     @rv = ();
  22
  23     open(FILE,"$mdir $disk:/$path |");
  24     while ( <FILE> ) {
  25         chomp();
  26         /^ / && next;                            # ignore `non-file' lines
  27         /^$/ && next;                            # ignore empty lines
  28         /^\.\.?/ && next;                        # ignore `.' and `..'
  29
  30         $name = substr($_,0,12);
  31         $name =~ s/^([^ ]*) +([^ ]+)[ \t]*$/$1.$2/;
  32         $name =~ s/[ .]+$//;
  33
  34         $_ = substr($_,12);
  35         s/^[ ]+//;
  36
  37         ($size,$date,$time,$longname) = split(/[ \t]+/);
  38
  39         @lst = split(/([:ap])/, $time);
  40         $lst[0] += 12 if ($lst[3] eq "p");
  41         $time = sprintf("%02d:%02d", $lst[0], $lst[2]);
  42         @lst = split(/-/, $date);
  43         $lst[2] %= 100 if ($lst[2] > 100);
  44         $date = sprintf ("%02d-%02d-%02d", @lst);
  45
  46         $name = $path . lc(($longname) ? $longname : $name);
  47
  48         if ($size =~ /DIR/) {
  49             printf("drwxr-xr-x   1 %-8d %-8d %8d %s %s %s\n", 0, 0, 0, $date, $time, $name);
  50            push @rv, $name;
  51         }
  52         else {
  53             printf("-rw-r--r--   1 %-8d %-8d %8d %s %s %s\n", 0, 0, $size, $date, $time, $name);
  54         }
  55     }
  56     close(FILE);
  57     return @rv;
  58 }
  59
  60 sub a_list
  61 {
  62     my (@files, $file);
  63
  64     @files = get_dirs("");
  65     while ($file = shift(@files)) {
  66             push @files, get_dirs("$file/");
  67     }
  68 }
  69
  70 sub a_copyout
  71 {
  72     my($archname,$filename,$dest) = @_;
  73     system "$mcopy $disk:/$filename $dest >& /dev/null";
  74 }
  75
  76 #    system "touch /tmp/deb";
  77
  78 sub a_copyin
  79 {
  80     my($archname,$filename,$dest) = @_;
  81     system "$mcopy $dest $disk:/$filename >& /dev/null";
  82 }
  83
  84 if($ARGV[0] eq "list") { shift; &a_list(@ARGV); exit 0; }
  85 elsif($ARGV[0] eq "copyout") { shift; &a_copyout(@ARGV); exit 0; }
  86 elsif($ARGV[0] eq "copyin") { shift; &a_copyin(@ARGV); exit 0; }
  87
  88 exit 1;
  89