home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / sbin / dpkg-preconfigure < prev    next >
Encoding:
Text File  |  2006-07-24  |  3.3 KB  |  142 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5.  
  6. BEGIN {
  7.     eval qq{
  8.         use strict;
  9.         use FileHandle;
  10.         use Debconf::Log qw(:all);
  11.         use Debconf::Db;
  12.         use Debconf::Template;
  13.         use Debconf::Config;
  14.         use Debconf::AutoSelect qw(:all);
  15.         use Debconf::Gettext;
  16.     };
  17.     if ($@) {
  18.         print STDERR "debconf: Perl may be unconfigured ($@) -- aborting\n";
  19.         exit 0;
  20.     }
  21. }
  22.  
  23. Debconf::Db->load;
  24.  
  25. my $apt=0;
  26. Debconf::Config->getopt(
  27. qq{Usage: dpkg-preconfigure [options] [debs]
  28.        --apt            Apt mode.},
  29.     "apt"            => \$apt,
  30. );
  31.  
  32. $|=1;
  33.  
  34. my @debs=@ARGV;
  35. @ARGV=();
  36.  
  37. if ($apt) {
  38.     while (<>) {
  39.         chomp;
  40.         push @debs, $_ if length $_;
  41.     }
  42.     
  43.     exit unless @debs;
  44.     
  45.     open (STDIN, "/dev/tty") ||
  46.         (print STDERR sprintf("dpkg-preconfigure: ".gettext("unable to re-open stdin: %s"), $!)."\n", exit 0);
  47. }
  48. elsif (! @debs) {
  49.     print STDERR sprintf("dpkg-preconfigure: ".gettext("must specify some debs to preconfigure")), "\n";
  50.     exit(1);
  51. }
  52.  
  53. if (! -x "/usr/bin/apt-extracttemplates") {
  54.     warn gettext("delaying package configuration, since apt-utils is not installed");
  55.     exit;
  56. }
  57.  
  58. my $frontend=make_frontend();
  59.  
  60. my ($package, $version, $template, $config);
  61. unless (open(INFO, "-|")) {
  62.     my $command_max=20000; # LINUX SPECIFIC!!
  63.     my $static_len=length("apt-extracttemplates");
  64.     my $len=$static_len;
  65.     my @collect;
  66.     if ($apt && @debs > 30) {
  67.         STDERR->autoflush(1);
  68.     }
  69.     foreach my $deb (@debs) {
  70.         $len += length($deb) + 1;
  71.         if ($len < $command_max && @collect < 30) {
  72.             push @collect, $deb;
  73.         }
  74.         else {
  75.             if (system("apt-extracttemplates", @collect) != 0) {
  76.                 print STDERR sprintf("debconf: ".gettext("apt-extracttemplates failed: %s"),$!);
  77.             }
  78.             if ($apt && @debs > 30) {
  79.                 $progress += @collect;
  80.                 printf STDERR "\r".gettext("Extracting templates from packages: %d%%"), $progress * 100 / @debs;
  81.             }
  82.                 
  83.             @collect=($deb);
  84.             $len=$static_len + length($deb) + 1;
  85.         }
  86.     }
  87.     if (system("apt-extracttemplates", @collect) != 0) {
  88.         print STDERR sprintf("debconf: ".gettext("apt-extracttemplates failed: %s"),$!);
  89.     }
  90.     if ($apt && @debs > 30) {
  91.         $progress += @collect;
  92.         printf STDERR "\r".gettext("Extracting templates from packages: %d%%")."\n", $progress * 100 / @debs;
  93.     }
  94.     exit;
  95. }
  96. my @buffer=<INFO>;
  97. if ($apt && @buffer) {
  98.     print gettext("Preconfiguring packages ...\n");
  99. }
  100. foreach my $line (@buffer) {
  101.     ($package, $version, $template, $config)=split /\s/, $line;
  102.     
  103.     if (defined $template && length $template) {
  104.         eval q{
  105.             Debconf::Template->load($template, $package)
  106.         };
  107.         unlink $template;
  108.         if ($@) {
  109.             print STDERR "$package ".sprintf(gettext("template parse error: %s"), $@)."\n";
  110.             unlink $config;
  111.             next;
  112.         }
  113.     }
  114. }
  115.  
  116. foreach my $line (@buffer) {
  117.     ($package, $version, $template, $config)=split /\s/, $line;
  118.  
  119.     if (defined $config && length $config && -e $config) {
  120.         debug user => sprintf("preconfiguring %s (%s)",$package,$version);
  121.         chmod(0755, $config) or
  122.             die sprintf(gettext("debconf: can't chmod: %s"), $!);
  123.         $frontend->default_title($package);
  124.         $frontend->info(undef);
  125.         my $confmodule=make_confmodule($config, 'configure', $version);
  126.         $confmodule->owner($package);
  127.         1 while ($confmodule->communicate);
  128.         if ($confmodule->exitcode > 0) {
  129.             print STDERR sprintf(
  130.                 gettext("%s failed to preconfigure, with exit status %s"),
  131.                 $package, $confmodule->exitcode)."\n";
  132.         }
  133.         unlink $config;
  134.     }
  135. }
  136.  
  137. $frontend->shutdown;
  138.  
  139. Debconf::Db->save;
  140.  
  141.  
  142.