a+.in 3.1 KB

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