home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / sbin / update-mime < prev    next >
Encoding:
Text File  |  2006-06-15  |  5.8 KB  |  243 lines
  1. #! /usr/bin/perl
  2. ###############################################################################
  3. #
  4. #  Update-MIME:  Install programs into "/etc/mailcap", resolve conflicts,
  5. #                 auto-uninstall, make dinner, and wash dishes.
  6. #
  7. #  Written by Brian White <bcwhite@pobox.com>.
  8. #
  9. #  This program has been placed in the public domain (the only true "free").
  10. #  Do whatever you wish with it, though I'd appreciate it if my name stayed
  11. #  on it as the original author.
  12. #
  13. ###############################################################################
  14.  
  15. umask(022);
  16.  
  17.  
  18.  
  19. #
  20. # Program Constants
  21. #
  22. $debug        = 0;
  23. $mailcap    = "/etc/mailcap";
  24. $mailcapdef    = "/usr/lib/mime/mailcap";
  25. $mimedir    = "/usr/lib/mime/packages";
  26. $orderfile    = "/etc/mailcap.order";
  27. $defpriority= 5;
  28.  
  29. #$mailcap    = "/home/bcwhite/tmp/mailcap";
  30. #$mimedir    = "/home/bcwhite/tmp/mime";
  31. #$orderfile    = "/home/bcwhite/tmp/mime.order";
  32.  
  33.  
  34.  
  35. #
  36. # Global Variables
  37. #
  38. %entries;
  39. %packages;
  40. %priorities;
  41. @order;
  42.  
  43.  
  44.  
  45. sub ReadEntries
  46. {
  47.     my($pkg,$priority,$counter);
  48.  
  49.     $counter=1;
  50.  
  51.     foreach $file (glob "$mimedir/*") {
  52.         next if ($file =~ m!(^|/)(\.|\#)|(\~)$!);
  53.         ($pkg) = ($file =~ m|/([^/]*)$|);
  54.         print STDERR "$pkg:\n" if $debug;
  55.  
  56.         if (!defined $packages{$pkg}) {
  57.             $packages{$pkg} = [];
  58.         }
  59.  
  60.         if (open(FILE,"<$file")) {
  61.             while (<FILE>) {
  62.                 chomp;
  63.                 next if m/^\s*$|^\s*\#/;
  64.                 if (m/priority\s*=\s*(\d+)\s*($|;)/i) {
  65.                     $priority=$1;
  66.                 } else {
  67.                     $priority=$defpriority;
  68.                 }
  69.                 if ($priority < 0 || $priority > 9) {
  70.                     print STDERR "Error: priority of $priority is out of range (0 <= pri <= 9)\n";
  71.                     print STDERR "       $_\n";
  72.                     $priority=$defpriority;
  73.                 }
  74.                 s/([^\s;]\s+)(?![\'\"])([^\s;]*)%s([^\s;]*)/$1'$2%s$3'/g;
  75.                 $entries{$counter} = $_;
  76.                 push @{$packages{$pkg}},$counter;
  77.                 push @{$priorities{$priority}},$counter;
  78.                 print STDERR "$counter: $_\n" if $debug;
  79.                 $counter++;
  80.             }
  81.             close(FILE);
  82.         } else {
  83.             print STDERR "Warning: could not open file '$file' -- $!\n";
  84.         }
  85.     }
  86. }
  87.  
  88.  
  89.  
  90. sub ReadOrder
  91. {
  92.     if (-e $orderfile) {
  93.         if (open(FILE,"<$orderfile")) {
  94.             while (<FILE>) {
  95.                 chomp;
  96.                 s/\s*\#.*$//;
  97.                 next if m/^\s*$/;
  98.                 push @order,$_;
  99.             }
  100.             close(FILE);
  101.         } else {
  102.             print STDERR "Warning: could not open file '$orderfile' -- $!\n";
  103.         }
  104.     }
  105. }
  106.  
  107.  
  108.  
  109. sub OrderEntries
  110. {
  111.     my(@entrylist,@orderlist,@templist,$priority,$entrycode,$ordercode);
  112.  
  113.     foreach $priority (sort {$b <=> $a} keys %priorities) {
  114.         print STDERR " - Priority $priority:" if $debug;
  115.         @templist = @{$priorities{$priority}};
  116.         @templist = sort {
  117.             $ae  = $entries{$a};
  118.             $ac  = 0;
  119.             $ac += 1 if $ae =~ m!^\S+/\*!;
  120.             $ac += 2 if $ae =~ m!^\*/!;
  121.             $be  = $entries{$b};
  122.             $bc  = 0;
  123.             $bc += 1 if $be =~ m!^\S+/\*!;
  124.             $bc += 2 if $be =~ m!^\*/!;
  125.             $ac <=> $bc;
  126.         } @templist;
  127.         foreach $entry (@templist) {
  128.             print STDERR " $entry" if $debug;
  129.             push @entrylist,$entry;
  130.         }
  131.         print STDERR "\n" if $debug;
  132.     }
  133.  
  134.     print STDERR "entrylist: @entrylist\n" if $debug;
  135.     foreach $ordercode (@order) {
  136.         my($pkg,$typ);
  137.         if ($ordercode =~ m/:/) {
  138.             ($pkg,$typ) = ($ordercode =~ m/^(.*):(\S*)/);
  139.         } else {
  140.             $pkg = $ordercode;
  141.             $typ = "*/*";
  142.         }
  143.         $typ = "*/*" unless $typ;
  144.         print STDERR " - Ordering '$ordercode'...  (package=$pkg, type=$typ, orderlist=@orderlist)\n" if $debug;
  145.         $typ =~ s/\*/\.\*/g;
  146.         foreach $entrycode (@entrylist) {
  147.             next if grep(/^\Q$entrycode\E$/,@orderlist);
  148.             print STDERR "    - Checking entrycode '$entrycode' against (@{$packages{$pkg}})...\n" if $debug;
  149.             if (grep(/^\Q$entrycode\E$/,@{$packages{$pkg}})) {
  150.                 $entry = $entries{$entrycode};
  151.                 my($etype) = ($entry =~ m/^(.*?)(;|\s)/);
  152.                 print STDERR "       - entry found, type=$etype, checking against '$typ'\n" if $debug;
  153.                 if ($etype =~ m!^$typ$!) {
  154. #                    print STDERR "       - matched!\n" if $debug;
  155. #                    my($oaction) = ($ordercode =~ m/action=([^\s;]*)/i);
  156. #                    my($eaction) = ($entry     =~ m/action=([^\s;]*)/i);
  157. #                    $eaction="view" unless $eaction;
  158. #                    print STDERR "       - checking entry action '$eaction' against '$oaction'\n" if $debug;
  159. #                    if (!$oaction || $eaction =~ m/^($oaction)$/) {
  160.                         push @orderlist,$entrycode;
  161.                         print STDERR "       - matched!  (orderlist=@orderlist)\n" if $debug;
  162. #                    }
  163.                 }
  164.             }
  165.         }
  166.     }
  167.  
  168.     foreach $entrycode (@entrylist) {
  169.         next if grep(/^\Q$entrycode\E$/,@orderlist);
  170.         push @orderlist,$entrycode;
  171.     }
  172.  
  173.     print STDERR "orderlist: @orderlist\n" if $debug;
  174.     return @orderlist;
  175. }
  176.  
  177.  
  178.  
  179. #
  180. # Generate new mailcap file
  181. #
  182. sub UpdateMailcap
  183. {
  184.     my(@entrylist) = @_;
  185.     my(@above,@user,@below,$state,$entrycode);
  186.     $state = 0;
  187.     if (!open(PATH,"<$mailcap")) {
  188.         if (!open(PATH,"<$mailcapdef")) {
  189. #            print STDERR "Warning: could not read '$mailcap' (update stopped) -- $!\n";
  190. #            print STDERR "         restore from backup or delete and re-install mime-support package";
  191.             return;
  192.         }
  193.     }
  194.  
  195.     while (<PATH>) {
  196.         s/install-mime/update-mime/g;
  197.         if ($state == 0) {
  198.             push @above,$_;
  199.         }
  200.         $state=2 if ($state == 1 && /^\# ----- .* Ends /);
  201.         if ($state == 1) {
  202.             push @user,$_;
  203.         }
  204.         $state=1 if ($state == 0 && /^\# ----- .* Begins /);
  205.         if ($state == 2) {
  206.             push @below,$_;
  207.         }
  208.         $state=3 if ($state == 2);
  209.     }
  210.  
  211.     close PATH;
  212.  
  213.     if ($state == 3) {
  214.         if (!open(PATH,">$mailcap.new")) {
  215.             print STDERR "Error: could not write '$mailcap.new' -- $!\n";
  216.             exit(1) unless ($debug);
  217.             open(PATH,">-");
  218.         }
  219.         print PATH @above;
  220.         print PATH @user;
  221.         print PATH @below;
  222.         print PATH "\n###############################################################################\n\n";
  223.         foreach $entrycode (@entrylist) {
  224.             my $entry = $entries{$entrycode};
  225.             $entry =~ s/\s*priority\s*=\s*\d+\s*($|;)//;
  226.             $entry =~ s/\s*;\s*$//;
  227.             print PATH $entry,"\n";
  228.         }
  229.         close PATH;
  230.         rename "$mailcap.new","$mailcap";
  231.     } else {
  232.         print STDERR "Error: '$mailcap' is not in required format -- not updated\n";
  233.         print STDERR "       Restore from backup or delete and re-install mime-support package";
  234.     }
  235. }
  236.  
  237.  
  238.  
  239. ReadEntries();
  240. ReadOrder();
  241. @list = OrderEntries();
  242. UpdateMailcap(@list);
  243.