home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / system-tools-backends-2.0 / scripts / Utils / File.pm < prev    next >
Encoding:
Perl POD Document  |  2006-08-14  |  18.5 KB  |  910 lines
  1. #!/usr/bin/env perl
  2. #-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*-
  3.  
  4. # Functions for file manipulation. Find, open, read, write, backup, etc.
  5. #
  6. # Copyright (C) 2000-2001 Ximian, Inc.
  7. #
  8. # Authors: Hans Petter Jansson <hpj@ximian.com>
  9. #          Arturo Espinosa <arturo@ximian.com>
  10. #
  11. # This program is free software; you can redistribute it and/or modify
  12. # it under the terms of the GNU Library General Public License as published
  13. # by the Free Software Foundation; either version 2 of the License, or
  14. # (at your option) any later version.
  15. #
  16. # This program is distributed in the hope that it will be useful,
  17. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. # GNU Library General Public License for more details.
  20. #
  21. # You should have received a copy of the GNU Library General Public License
  22. # along with this program; if not, write to the Free Software
  23. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  24.  
  25. package Utils::File;
  26.  
  27. use Utils::Report;
  28. use File::Path;
  29. use File::Copy;
  30. use File::Temp;
  31. use Carp;
  32.  
  33.  
  34. $FILE_READ  = 1;
  35. $FILE_WRITE = 2;
  36.  
  37.  
  38. # --- File operations --- #
  39.  
  40. sub get_base_path
  41. {
  42.   my $path = "/var/cache/system-tools-backends";
  43.   chmod (0755, $path);
  44.   return $path;
  45. }
  46.  
  47.  
  48. sub get_tmp_path
  49. {
  50.   return (&get_base_path () . "/tmp");
  51. }
  52.  
  53.  
  54. sub get_backup_path
  55. {
  56.   return (&get_base_path () . "/backup");
  57. }
  58.  
  59. # Give a command, and it will put in C locale, some sane PATH values and find
  60. # the program to run in the path. Redirects stderr to null.
  61. sub do_get_cmd_path
  62. {
  63.   my ($cmd) = @_;
  64.   my ($tool_name, @argline, $command, $tool_path);
  65.   
  66.   ($tool_name, @argline) = split("[ \t]+", $cmd);
  67.  
  68.   $tool_path = &locate_tool ($tool_name);
  69.   return -1 if ($tool_path eq "");
  70.  
  71.  
  72.   $command = "$tool_path @argline";
  73.   $command =~ s/\"/\\\"/g;
  74.  
  75.   return $command;
  76. }
  77.  
  78. sub get_cmd_path
  79. {
  80.    my ($cmd) = @_;
  81.  
  82.    my $command = &do_get_cmd_path ($cmd);
  83.  
  84.    return -1 if ($command == -1);
  85.    return ("LC_ALL=C PATH=\$PATH:/sbin:/usr/sbin $command 2> /dev/null");
  86. }
  87.  
  88. # necessary for some programs that output info through stderr
  89. sub get_cmd_path_with_stderr
  90. {
  91.    my ($cmd) = @_;
  92.  
  93.    my $command = &get_cmd_path ($cmd);
  94.    return ("LC_ALL=C PATH=\$PATH:/sbin:/usr/sbin $command 2>&1");
  95. }
  96.  
  97.  
  98. sub create_path
  99. {
  100.   my ($path, $perms) = @_;
  101.   $prems = $perms || 0770;
  102.   my @pelem;
  103.   
  104.   $path =~ tr/\///s;
  105.   @pelem = split(/\//, $path); # 'a/b/c/d/' -> 'a', 'b', 'c', 'd', ''
  106.  
  107.   for ($path = ""; @pelem; shift @pelem)
  108.   {
  109.     $path = "$path$pelem[0]";
  110.     mkdir($path, $perms);
  111.     $path = "$path/";
  112.   }
  113.  
  114.   &Utils::Report::enter ();
  115.   &Utils::Report::do_report ("file_create_path", $_[0]);
  116.   &Utils::Report::leave ();
  117. }
  118.  
  119.  
  120. sub create_path_for_file
  121. {
  122.   my ($path, $perms) = @_;
  123.   $prems = $perms || 0770;
  124.   my @pelem;
  125.   
  126.   $path =~ tr/\///s;
  127.   @pelem = split(/\//, $path); # 'a/b/c/d/' -> 'a', 'b', 'c', 'd', ''
  128.     
  129.   for ($path = ""; @pelem; shift @pelem)
  130.   {
  131.     if ($pelem[1] ne "")
  132.     {
  133.       $path = "$path$pelem[0]";
  134.       mkdir($path, $perms);
  135.       $path = "$path/";
  136.     }
  137.   }
  138.  
  139.   &Utils::Report::enter ();
  140.   &Utils::Report::do_report ("file_create_path", $_[0]);
  141.   &Utils::Report::leave ();
  142. }
  143.  
  144.  
  145. $rotation_was_made = 0;
  146.  
  147. # If this is the first backup created by this tool on this invocation,
  148. # rotate the backup directories and create a new, empty one.
  149. sub rotate_backup_dirs
  150. {
  151.   my $backup_tool_dir = $_[0];
  152.   
  153.   &Utils::Report::enter ();
  154.   
  155.   if (!$rotation_was_made)
  156.   {
  157.     my $i;
  158.  
  159.     $rotation_was_made = 1;
  160.     if (-e "$backup_tool_dir/9")
  161.     {
  162.       if (-s "$backup_tool_dir/9")
  163.       {
  164.         unlink ("$backup_tool_dir/9");
  165.       }
  166.       else
  167.       {
  168.         &rmtree ("$backup_tool_dir/9");
  169.       }
  170.     }
  171.  
  172.     for ($i = 8; $i; $i--)
  173.     {
  174.       if (stat ("$backup_tool_dir/$i"))
  175.       {
  176.         move ("$backup_tool_dir/$i", "$backup_tool_dir/" . ($i+1));
  177.       }
  178.     }
  179.  
  180.     if (!stat ("$backup_tool_dir/First"))
  181.     {
  182.       &create_path ("$backup_tool_dir/First");
  183.       &run ("ln -s First $backup_tool_dir/1");
  184.     }
  185.     else
  186.     {
  187.       &create_path_for_file ("$backup_tool_dir/1/");
  188.     }
  189.  
  190.     &Utils::Report::do_report ("file_backup_rotate", $backup_tool_dir);
  191.   }
  192.   
  193.   &Utils::Report::enter ();
  194. }
  195.  
  196. sub do_backup
  197. {
  198.   my $backup_file = $_[0];
  199.   my $backup_tool_dir;
  200.  
  201.   &Utils::Report::enter ();
  202.   
  203.   $backup_tool_dir = &get_backup_path () . "/$gst_name/";
  204.  
  205.   &rotate_backup_dirs ($backup_tool_dir);
  206.   
  207.   # If the file hasn't already been backed up on this invocation, copy the
  208.   # file to the backup directory.
  209.  
  210.   if (!stat ("$backup_tool_dir/1/$backup_file"))
  211.   {
  212.     &create_path_for_file ("$backup_tool_dir/1/$backup_file");
  213.     copy ($backup_file, "$backup_tool_dir/1/$backup_file");
  214.     &Utils::Report::do_report ("file_backup_success", $backup_tool_dir);
  215.   }
  216.   
  217.   &Utils::Report::leave ();
  218. }
  219.  
  220. # Return 1/0 depending on file existance.
  221. sub exists
  222. {
  223.   my ($file) = @_;
  224.  
  225.   return (-f "$gst_prefix/$file")? 1: 0;
  226. }
  227.  
  228. sub open_read_from_names
  229. {
  230.   local *FILE;
  231.   my $fname = "";
  232.  
  233.   &Utils::Report::enter ();
  234.   
  235.   foreach $name (@_)
  236.   {
  237.     if (open (FILE, "$gst_prefix/$name"))
  238.     {
  239.       $fname = $name;
  240.       last;
  241.     }
  242.   }
  243.   
  244.   (my $fullname = "$gst_prefix/$fname") =~ tr/\//\//s;  # '//' -> '/'    
  245.  
  246.   if ($fname eq "") 
  247.   { 
  248.     &Utils::Report::do_report ("file_open_read_failed", "@_");
  249.     return undef;
  250.   }
  251.  
  252.   &Utils::Report::do_report ("file_open_read_success", $fullname);
  253.   &Utils::Report::leave ();
  254.  
  255.   return *FILE;
  256. }
  257.  
  258.  
  259. sub open_write_from_names
  260. {
  261.   local *FILE;
  262.   my $name;
  263.   my $fullname;
  264.  
  265.   &Utils::Report::enter ();
  266.     
  267.   # Find out where it lives.
  268.     
  269.   foreach $elem (@_) { if (stat($elem) ne "") { $name = $elem; last; } }
  270.     
  271.   if ($name eq "")
  272.   {
  273.     $name = $_[0];
  274.     (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  275.     &Utils::Report::do_report ("file_open_write_create", "@_", $fullname);
  276.   }
  277.   else
  278.   {
  279.     (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  280.     &Utils::Report::do_report ("file_open_write_success", $fullname);
  281.   }
  282.     
  283.   ($name = "$gst_prefix/$name") =~ tr/\//\//s;  # '//' -> '/' 
  284.   &create_path_for_file ($name);
  285.     
  286.   # Make a backup if the file already exists - if the user specified a prefix,
  287.   # it might not.
  288.     
  289.   if (stat ($name))
  290.   {
  291.     &do_backup ($name);
  292.   }
  293.  
  294.   &Utils::Report::leave ();
  295.   
  296.   # Truncate and return filehandle.
  297.  
  298.   if (!open (FILE, ">$name"))
  299.   {
  300.     &Utils::Report::do_report ("file_open_write_failed",  $name);
  301.     return undef;
  302.   }
  303.  
  304.   return *FILE;
  305. }
  306.  
  307. sub open_filter_write_from_names
  308. {
  309.   local *INFILE;
  310.   local *OUTFILE;
  311.   my ($filename, $name, $elem);
  312.  
  313.   &Utils::Report::enter ();
  314.  
  315.   # Find out where it lives.
  316.  
  317.   foreach $coin (@_)
  318.   {
  319.     if (-e $coin) { $name = $coin; last; }
  320.   }
  321.  
  322.   if (! -e $name)
  323.   {
  324.     # If we couldn't locate the file, and have no prefix, give up.
  325.  
  326.     # If we have a prefix, but couldn't locate the file relative to '/',
  327.     # take the first name in the array and let that be created in $prefix.
  328.  
  329.     if ($prefix eq "")
  330.     {
  331.       &Utils::Report::do_report ("file_open_filter_failed", "@_");
  332.       return(0, 0);
  333.     }
  334.     else
  335.     {
  336.       $name = $_[0];
  337.       (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  338.       &Utils::Report::do_report ("file_open_filter_create", "@_", $fullname);
  339.     }
  340.   }
  341.   else
  342.   {
  343.     (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  344.     &Utils::Report::do_report ("file_open_filter_success", $name, $fullname);
  345.   }
  346.  
  347.   ($filename) = $name =~ /.*\/(.+)$/;
  348.   ($name = "$gst_prefix/$name") =~ tr/\//\//s;  # '//' -> '/' 
  349.   &create_path_for_file ($name);
  350.  
  351.   # Make a backup if the file already exists - if the user specified a prefix,
  352.   # it might not.
  353.  
  354.   if (-e $name)
  355.   {
  356.     &do_backup ($name);
  357.   }
  358.  
  359.   # Return filehandles. Make a copy to use as filter input. It might be
  360.   # invalid (no source file), in which case the caller should just write to
  361.   # OUTFILE without bothering with INFILE filtering.
  362.  
  363.   my $tmp_path = &get_tmp_path ();
  364.  
  365.   &create_path ("$tmp_path");
  366.   unlink ("$tmp_path/$gst_name-$filename");
  367.   copy ($name, "$tmp_path/$gst_name-$filename");
  368.  
  369.   open (INFILE, "$tmp_path/$gst_name-$filename");
  370.  
  371.   if (!open (OUTFILE, ">$name"))
  372.   {
  373.     &Utils::Report::do_report ("file_open_filter_failed", $name);
  374.     return (*INFILE, 0);
  375.   }
  376.     
  377.   &Utils::Report::leave ();
  378.  
  379.   return (*INFILE, *OUTFILE);
  380. }
  381.  
  382.  
  383. sub open_write_compressed
  384. {
  385.   local *FILE;
  386.   my ($name, $fullname, $gzip);
  387.  
  388.   $gzip = &locate_tool ("gzip");
  389.   return undef if (!$gzip);
  390.  
  391.   &Utils::Report::enter ();
  392.     
  393.   # Find out where it lives.
  394.     
  395.   foreach $elem (@_) { if (stat($elem) ne "") { $name = $elem; last; } }
  396.     
  397.   if ($name eq "")
  398.   {
  399.     $name = $_[0];
  400.     (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  401.     &Utils::Report::do_report ("file_open_write_create", "@_", $fullname);
  402.   }
  403.   else
  404.   {
  405.     (my $fullname = "$gst_prefix/$name") =~ tr/\//\//s;
  406.     &Utils::Report::do_report ("file_open_write_success", $fullname);
  407.   }
  408.     
  409.   ($name = "$gst_prefix/$name") =~ tr/\//\//s;  # '//' -> '/' 
  410.   &create_path_for_file ($name);
  411.     
  412.   # Make a backup if the file already exists - if the user specified a prefix,
  413.   # it might not.
  414.     
  415.   if (stat ($name))
  416.   {
  417.     &do_backup ($name);
  418.   }
  419.  
  420.   &Utils::Report::leave ();
  421.   
  422.   # Truncate and return filehandle.
  423.  
  424.   if (!open (FILE, "| $gzip -c > $name"))
  425.   {
  426.     &Utils::Report::do_report ("file_open_write_failed",  $name);
  427.     return;
  428.   }
  429.  
  430.   return *FILE;
  431. }
  432.  
  433.  
  434. sub run_pipe
  435. {
  436.   my ($cmd, $mode_mask, $stderr) = @_;
  437.   my ($command);
  438.   local *PIPE;
  439.  
  440.   $mode_mask = $FILE_READ if $mode_mask eq undef;
  441.  
  442.   &Utils::Report::enter ();
  443.   
  444.   if ($stderr)
  445.   {
  446.     $command = &get_cmd_path_with_stderr ($cmd);
  447.   }
  448.   else
  449.   {
  450.     $command = &get_cmd_path ($cmd);
  451.   }
  452.  
  453.   if ($command == -1)
  454.   {
  455.     &Utils::Report::do_report ("file_run_pipe_failed", $command);
  456.     &Utils::Report::leave ();
  457.     return undef;
  458.   }
  459.  
  460.   $command .= " |" if $mode_mask & $FILE_READ;
  461.   $command = "| $command > /dev/null" if $mode_mask & $FILE_WRITE;
  462.  
  463.   open PIPE, $command;
  464.   &Utils::Report::do_report ("file_run_pipe_success", $command);
  465.   &Utils::Report::leave ();
  466.   return *PIPE;
  467. }
  468.  
  469.  
  470. sub run_pipe_read
  471. {
  472.   my ($cmd) = @_;
  473.  
  474.   return &run_pipe ($cmd, $FILE_READ);
  475. }
  476.  
  477. sub run_pipe_read_with_stderr
  478. {
  479.    my ($cmd) = @_;
  480.  
  481.    return &run_pipe ($cmd, $FILE_READ, 1);
  482. }
  483.  
  484. sub run_pipe_write
  485. {
  486.   my ($cmd) = @_;
  487.  
  488.   return &run_pipe ($cmd, $FILE_WRITE);
  489. }
  490.  
  491.  
  492. sub run_backtick
  493. {
  494.   my ($cmd, $stderr) = @_;
  495.   my ($fd, $res);
  496.  
  497.   if ($stderr)
  498.   {
  499.     $fd = &run_pipe_read_with_stderr ($cmd);
  500.   }
  501.   else
  502.   {
  503.     $fd = &run_pipe_read ($cmd);
  504.   }
  505.  
  506.   $res = join ('', <$fd>);
  507.   &close_file ($fd);
  508.  
  509.   return $res;
  510. }
  511.  
  512.  
  513. sub close_file
  514. {
  515.   my ($fd) = @_;
  516.  
  517.   close $fd if (ref \$fd eq "GLOB");
  518. }
  519.  
  520.  
  521. sub remove
  522. {
  523.   my ($name) = @_;
  524.   my ($file);
  525.  
  526.   &Utils::Report::enter ();
  527.   &Utils::Report::do_report ("file_remove", $name);
  528.  
  529.   $file = "$gst_prefix/$name";
  530.  
  531.   if (stat ($file))
  532.   {
  533.     &do_backup ($file);
  534.   }
  535.  
  536.   unlink $file;
  537.   &Utils::Report::leave ();
  538. }
  539.  
  540. sub rmtree
  541. {
  542.   my($roots, $verbose, $safe) = @_;
  543.   my(@files);
  544.   my($count) = 0;
  545.   $verbose ||= 0;
  546.   $safe ||= 0;
  547.  
  548.   if ( defined($roots) && length($roots) ) {
  549.     $roots = [$roots] unless ref $roots;
  550.   }
  551.   else {
  552.     carp "No root path(s) specified\n";
  553.     return 0;
  554.   }
  555.  
  556.   my($root);
  557.   foreach $root (@{$roots}) {
  558.     $root =~ s#/\z##;
  559.     (undef, undef, my $rp) = lstat $root or next;
  560.     $rp &= 07777;    # don't forget setuid, setgid, sticky bits
  561.     
  562.     if ( -d $root ) { # $root used to be _, which is a bug.
  563.                       # this is why we are replicating this function.
  564.       
  565.         # notabene: 0777 is for making readable in the first place,
  566.         # it's also intended to change it to writable in case we have
  567.         # to recurse in which case we are better than rm -rf for 
  568.         # subtrees with strange permissions
  569.         chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
  570.           or carp "Can't make directory $root read+writeable: $!"
  571.               unless $safe;
  572.  
  573.       local *DIR;
  574.         if (opendir DIR, $root) {
  575.         @files = readdir DIR;
  576.         closedir DIR;
  577.         }
  578.         else {
  579.         carp "Can't read $root: $!";
  580.         @files = ();
  581.         }
  582.  
  583.         # Deleting large numbers of files from VMS Files-11 filesystems
  584.         # is faster if done in reverse ASCIIbetical order 
  585.         @files = reverse @files if $Is_VMS;
  586.         ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
  587.         @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
  588.         $count += &rmtree(\@files,$verbose,$safe);
  589.         if ($safe &&
  590.           ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
  591.         print "skipped $root\n" if $verbose;
  592.         next;
  593.         }
  594.         chmod 0777, $root
  595.           or carp "Can't make directory $root writeable: $!"
  596.               if $force_writeable;
  597.         print "rmdir $root\n" if $verbose;
  598.         if (rmdir $root) {
  599.         ++$count;
  600.         }
  601.         else {
  602.         carp "Can't remove directory $root: $!";
  603.         chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
  604.             or carp("and can't restore permissions to "
  605.                     . sprintf("0%o",$rp) . "\n");
  606.         }
  607.     }
  608.     else { 
  609.         if ($safe &&
  610.           ($Is_VMS ? !&VMS::Filespec::candelete($root)
  611.            : !(-l $root || -w $root)))
  612.         {
  613.         print "skipped $root\n" if $verbose;
  614.         next;
  615.         }
  616.         chmod 0666, $root
  617.           or carp "Can't make file $root writeable: $!"
  618.               if $force_writeable;
  619.         print "unlink $root\n" if $verbose;
  620.         # delete all versions under VMS
  621.         for (;;) {
  622.         unless (unlink $root) {
  623.           carp "Can't unlink file $root: $!";
  624.           if ($force_writeable) {
  625.             chmod $rp, $root
  626.                 or carp("and can't restore permissions to "
  627.                         . sprintf("0%o",$rp) . "\n");
  628.           }
  629.           last;
  630.         }
  631.         ++$count;
  632.         last unless $Is_VMS && lstat $root;
  633.         }
  634.     }
  635.   }
  636.  
  637.   $count;
  638. }
  639.  
  640. # --- Buffer operations --- #
  641.  
  642.  
  643. # Open $file and put it into @buffer, for in-line editting.
  644. # \@buffer on success, undef on error.
  645.  
  646. sub load_buffer
  647. {
  648.   my ($file) = @_;
  649.   my @buffer;
  650.   my $fd;
  651.  
  652.   &Utils::Report::enter ();
  653.   &Utils::Report::do_report ("file_buffer_load", $file);
  654.  
  655.   $fd = &open_read_from_names ($file);
  656.   return [] unless $fd;
  657.  
  658.   @buffer = (<$fd>);
  659.  
  660.   &Utils::Report::leave ();
  661.  
  662.   return \@buffer;
  663. }
  664.  
  665. # Same with an already open fd.
  666. sub load_buffer_from_fd
  667. {
  668.   my ($fd) = @_;
  669.   my (@buffer);
  670.   
  671.   &Utils::Report::enter ();
  672.   &Utils::Report::do_report ("file_buffer_load", $file);
  673.  
  674.   @buffer = (<$fd>);
  675.  
  676.   &Utils::Report::leave ();
  677.  
  678.   return \@buffer;
  679. }
  680.  
  681. # Take a $buffer and save it in $file. -1 is error, 0 success.
  682.  
  683. sub save_buffer
  684. {
  685.   my ($buffer, $file) = @_;
  686.   my ($fd, $i);
  687.  
  688.   &Utils::Report::enter ();
  689.   &Utils::Report::do_report ("file_buffer_save", $file);
  690.  
  691.   $fd = &open_write_from_names ($file);
  692.   return -1 if !$fd;
  693.  
  694.   if (@$buffer < 1)
  695.   {
  696.     # We want to write single line.
  697.     # Print only if $buffer is NOT a reference (it'll print ARRAY(0x412493) for example).
  698.     print $fd $buffer if (!ref ($buffer));
  699.   }
  700.  
  701.   else
  702.   {
  703.     # Let's print array
  704.     
  705.     foreach $i (@$buffer)
  706.     {
  707.       print $fd $i;
  708.     }
  709.   }
  710.  
  711.   &close_file ($fd);
  712.  
  713.   &Utils::Report::leave ();
  714.   
  715.   return 0;
  716. }
  717.  
  718.  
  719. # Erase all empty string elements from the $buffer.
  720.  
  721. sub clean_buffer
  722. {
  723.   my $buffer = $_[0];
  724.   my $i;
  725.  
  726.   for ($i = 0; $i <= $#$buffer; $i++)
  727.   {
  728.     splice (@$buffer, $i, 1) if $$buffer[$i] eq "";
  729.   }
  730. }
  731.  
  732.  
  733. sub join_buffer_lines
  734. {
  735.   my $buffer = $_[0];
  736.   my $i;
  737.  
  738.   for ($i = 0; $i <= $#$buffer; $i++)
  739.   {
  740.     while ($$buffer[$i] =~ /\\$/)
  741.     {
  742.       chomp $$buffer[$i];
  743.       chop $$buffer[$i];
  744.       $$buffer[$i] .= $$buffer[$i + 1];
  745.       splice (@$buffer, $i + 1, 1);
  746.     }
  747.   }
  748. }
  749.  
  750.  
  751. # --- Command-line utilities --- #
  752.  
  753.  
  754. # &run (<command line>)
  755. #
  756. # Assumes the first word on the command line is the command-line utility
  757. # to run, and tries to locate it, replacing it with its full path. The path
  758. # is cached in a hash, to avoid searching for it repeatedly. Output
  759. # redirection is appended, to make the utility perfectly silent. The
  760. # preprocessed command line is run, and its exit value is returned.
  761. #
  762. # Example: "mkswap /dev/hda3" -> 'PATH=$PATH:/sbin:/usr/sbin /sbin/mkswap /dev/hda3 2>/dev/null >/dev/null'.
  763.  
  764. sub run
  765. {
  766.   my ($cmd, $background) = @_;
  767.   my ($command, $tool_name, $tool_path, @argline);
  768.  
  769.   &Utils::Report::enter ();
  770.  
  771.   $command = &get_cmd_path ($cmd);
  772.   return -1 if $command == -1;
  773.   $command .= " > /dev/null";
  774.   $command .= " &" if $background;
  775.  
  776.   &Utils::Report::do_report ("file_run", $command);
  777.   &Utils::Report::leave ();
  778.  
  779.   # As documented in perlfunc, divide by 256.
  780.   return (system ($command) / 256);
  781. }
  782.  
  783. sub run_bg
  784. {
  785.   my ($cmd) = @_;
  786.  
  787.   return &run ($cmd, 1);
  788. }
  789.  
  790. # &gst_file_locate_tool
  791. #
  792. # Tries to locate a command-line utility from a set of built-in paths
  793. # and a set of user paths (found in the environment). The path (or a negative
  794. # entry) is cached in a hash, to avoid searching for it repeatedly.
  795.  
  796. @gst_builtin_paths = ( "/sbin", "/usr/sbin", "/usr/local/sbin",
  797.                        "/bin", "/usr/bin", "/usr/local/bin" );
  798.  
  799. %gst_tool_paths = ();
  800.  
  801. sub locate_tool
  802. {
  803.   my ($tool) = @_;
  804.   my $found = "";
  805.   my @user_paths;
  806.  
  807.   # We don't search absolute paths. Arturo.
  808.   if ($tool =~ /^\//)
  809.   {
  810.     if (! (-x $tool))
  811.     {
  812.       &Utils::Report::do_report ("file_locate_tool_failed", $tool);
  813.       return "";
  814.     }
  815.     
  816.     return $tool;
  817.   }
  818.  
  819.   &Utils::Report::enter ();
  820.   
  821.   $found = $gst_tool_paths{$tool};
  822.   if ($found eq "0")
  823.   {
  824.     # Negative cache hit. At this point, the failure has already been reported
  825.     # once.
  826.     return "";
  827.   }
  828.  
  829.   if ($found eq "")
  830.   {
  831.     # Nothing found in cache. Look for real.
  832.  
  833.     # Extract user paths to try.
  834.  
  835.     @user_paths = ($ENV{PATH} =~ /([^:]+):/mg);
  836.  
  837.     # Try user paths.
  838.  
  839.     foreach $path (@user_paths)
  840.     {
  841.       if (-x "$path/$tool" || -u "$path/$tool") { $found = "$path/$tool"; last; }
  842.     }
  843.  
  844.     if (!$found)
  845.     {
  846.       # Try builtin paths.
  847.       foreach $path (@gst_builtin_paths)
  848.       {
  849.         if (-x "$path/$tool" || -u "$path/$tool") { $found = "$path/$tool"; last; }
  850.       }
  851.     }
  852.  
  853.     # Report success/failure and update cache.
  854.  
  855.     if ($found)
  856.     {
  857.       $gst_tool_paths{$tool} = $found;
  858.       &Utils::Report::do_report ("file_locate_tool_success", $tool);
  859.     }
  860.     else
  861.     {
  862.       $gst_tool_paths{$tool} = "0";
  863.       &Utils::Report::do_report ("file_locate_tool_failed", $tool);
  864.     }
  865.   }
  866.   
  867.   &Utils::Report::leave ();
  868.   
  869.   return ($found);
  870. }
  871.  
  872. sub tool_installed
  873. {
  874.   my ($tool) = @_;
  875.   
  876.   $tool = &locate_tool ($tool);
  877.   return 0 if $tool eq "";
  878.   return 1;
  879. }
  880.  
  881. sub copy_file
  882. {
  883.   my ($orig, $dest) = @_;
  884.  
  885.   return if (!&exists ("$gst_prefix/$orig"));
  886.   copy ("$gst_prefix/$orig", "$gst_prefix/$dest");
  887. }
  888.  
  889. sub get_temp_name
  890. {
  891.   my ($prefix) = @_;
  892.  
  893.   return mktemp ($prefix);
  894. }
  895.  
  896. sub copy_file_from_stock
  897. {
  898.   my ($orig, $dest) = @_;
  899.  
  900.   if (!copy ("$FILESDIR/$orig", $dest))
  901.   {
  902.     &Utils::Report::do_report ("file_copy_failed", "$FILESDIR/$orig", $dest);
  903.     return -1;
  904.   }
  905.  
  906.   return 0;
  907. }
  908.  
  909. 1;
  910.