rox

   1 #!/usr/bin/env perl
   2
   3 sub type_from_path;
   4 sub try_running;
   5 sub set_type;
   6 sub show_help;
   7
   8 if (defined($choices = $ENV{CHOICESPATH})) {
   9         @choices = split(":", $choices);
  10 } else {
  11         @choices = (glob("~/Choices"),
  12                     "/usr/local/share/Choices",
  13                     "/usr/share/Choices");
  14 }
  15
  16 @choices or die("No directories listed in CHOICESPATH!\n");
  17
  18 while ($ARGV[0] =~ /^--?(.*?)(\=(.*))?$/)
  19 {
  20         shift;
  21
  22         ($opt, $value) = ($1, $3);
  23
  24         &show_help, next        if $opt eq "h" or $opt eq "help";
  25         &set_type, next         if $opt eq "t" or $opt eq "type";
  26         $verbose = 1, next      if $opt eq "v" or $opt eq "verbose";
  27         $display = 1, next      if $opt eq "d" or $opt eq "display";
  28
  29         die "Unknown option: $opt\n";
  30 }
  31
  32 $item = shift or '.';
  33
  34 unless ($item =~ /^\//) {
  35         chomp($pwd = `pwd`);
  36         $item = "$pwd/$item";
  37 }
  38
  39 unshift @ARGV, $item;
  40
  41 -e $item or die "File $item not found\n";
  42
  43 $type or
  44 -f _ && ($type = type_from_path($item)) or
  45 -d _ && ($type = "special/directory") or
  46 -p _ && ($type = "special/pipe") or
  47 -S _ && ($type = "special/socket") or
  48 -b _ && ($type = "special/block-device") or
  49 -c _ && ($type = "special/char-device") or
  50         die "Don't know what kind of thing '$item' is!\n";
  51
  52 if ($display) {
  53         print "$type\n";
  54         exit;
  55 }
  56
  57 print "Looking for a handler for files of type '$type'\n" if $verbose;
  58
  59 if ($type =~ /^(.*?)\/(.*)$/) {
  60         ($media, $subtype) = ($1, $2);
  61         foreach (@choices) {
  62                 try_running "$_/MIME-types/${media}_$subtype" if $_;
  63         }
  64 } else {
  65         $media = $type;
  66 }
  67
  68 foreach (@choices) {
  69         try_running "$_/MIME-types/$media" if $_;
  70 }
  71
  72 die "No run action specified for files of type '$type'.\n";
  73
  74 exit;
  75
  76 sub try_running
  77 {
  78         my $path = shift;
  79
  80         print "Checking for '$path'\n" if $verbose;
  81
  82         return unless -e $path;
  83
  84         -f _ and -x _ and (exec("$path", @ARGV), die "exec($path): $!\n");
  85
  86         if (-d _)
  87         {
  88                 die "$path/AppRun is not executable" unless -x "$path/AppRun";
  89
  90                 exec("$path/AppRun", @ARGV), die "exec($path): $!\n";
  91         }
  92
  93         warn "$path exists but cannot be executed!\n";
  94 }
  95
  96 sub check_entry
  97 {
  98         my ($key, $prio, $values) = @_;
  99
 100         return undef if $prio <= $best_rating;
 101
 102         if ($key eq "ext" and $ext) {
 103                 foreach $e (split ' ', $values) {
 104                         return 1 if $e eq $ext;
 105                 }
 106         } elsif ($key eq "regex") {
 107                 return 1 if $leaf =~ /$values/;
 108         }
 109
 110         undef;
 111 }
 112
 113 sub find_type
 114 {
 115         my $file = shift;
 116         my $type = undef;
 117
 118         open(FILE, "<$file") or warn("Can't open $file\n"), return;
 119
 120         while (<FILE>) {
 121                 s/^\s+//;
 122                 s/\s+$//;
 123
 124                 next if /^(#.*)?$/;
 125
 126                 if (/^([^:]*)\/(.*):?/) {
 127                         $type = "$1/$2"
 128                 } elsif (/^([^ :,]+)\s*(,\s*(\d+)\s*)?:\s*(.*)$/) {
 129                         my ($key, $prio, $values) = ($1, $3, $4);
 130
 131                         $prio ||= 1;
 132
 133                         if (check_entry($key, $prio, $values)) {
 134                                 print "New best guess is '$type', " .
 135                                         "rating $prio\n" if $verbose;
 136
 137                                 $best_type = $type;
 138                                 $best_rating = $prio;
 139                         }
 140                 }
 141         }
 142
 143         close FILE;
 144
 145         return $type;
 146 }
 147
 148 sub type_from_path
 149 {
 150         my $type;
 151         local ($best_type, $best_rating) = ("text/plain", 0);
 152         local ($leaf, $ext);
 153
 154         ($leaf = $item) =~ s/.*\///;
 155         ($ext = $leaf) =~ s/.*\.// or $ext = undef;
 156
 157         foreach $dir (@choices) {
 158                 print "Looking inside '$dir'\n" if $verbose;
 159
 160                 if (-d "$dir/MIME-info") {
 161                         foreach (glob("$dir/MIME-info/*")) {
 162                                 print "Scanning '$_'\n" if $verbose;
 163                                 find_type($_);
 164                         }
 165                 }
 166         }
 167
 168         return $best_type;
 169 }
 170
 171 sub show_help
 172 {
 173         print <<"EOF";
 174 Usage: rox [FILE [ARGS]]
 175
 176 Open FILE using an appropriate program, invoking it with additional arguments
 177 ARGS. If no FILE is given then the current directory is used.
 178
 179   -h, --help            display this help and exit
 180   -d, --display         display the guessed type rather than opening the file
 181   -t, --type=TYPE       assume TYPE instead of guessing
 182   -v, --verbose         display lots of extra info
 183
 184 Report bugs to <tal197\@ecs.soton.ac.uk>.
 185 EOF
 186         exit 0;
 187 }
 188
 189 sub set_type
 190 {
 191         $value = shift @ARGV unless $value;
 192
 193         $type = $value or die "Missing argument to --type option\n";
 194 }
 195
 196 sub set_by_drag
 197 {
 198         $prog = `dropbox -l "Drop a program which can open $type files here"`;
 199         die "'dropbox' program failed (is it installed?)\n" if $?;
 200
 201         print "OK, will use $prog to edit $type files.\n";
 202 }