summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorThierry Vignaud <tvignaud@mandriva.org>2002-11-12 12:05:40 +0000
committerThierry Vignaud <tvignaud@mandriva.org>2002-11-12 12:05:40 +0000
commit046406ab6b13659f4be843d3d2d5639efaf425fe (patch)
tree2304d9911b495ea5262815f2b3cca305f53d83f4
parent57582cf77904240eee6c29874866b9d62e4a9951 (diff)
downloaddrakx-046406ab6b13659f4be843d3d2d5639efaf425fe.tar
drakx-046406ab6b13659f4be843d3d2d5639efaf425fe.tar.gz
drakx-046406ab6b13659f4be843d3d2d5639efaf425fe.tar.bz2
drakx-046406ab6b13659f4be843d3d2d5639efaf425fe.tar.xz
drakx-046406ab6b13659f4be843d3d2d5639efaf425fe.zip
printer related modules cleaning :
- create the printer/ hierarchy - split services related stuff into services.pm & printer::services, - move things that've nothing to do with printers into common.pm (alternatives, permissions, ...) - move eveything related to cups, gimp-print, detection, {star,open}office to the corresponding splited printer:: module - big consolidation of printer::office (it was obvious there were tons of duplication between staroffice and openoffice managment) - move other stuff into printer::main, printer::common, status : print.pm has been heavily splited (now one can begin to understand the little bits). printerdrake still needs to be splited/cleaned and eventually removed since printer/printerdrake modules separation is not understandable by other people till, in printer::gimp, $lprcommand is neither declared nor setted nowhere. idem in mdk9.0 ...
-rw-r--r--perl-install/common.pm59
-rw-r--r--perl-install/printer/common.pm91
-rw-r--r--perl-install/printer/cups.pm30
-rw-r--r--perl-install/printer/data.pm37
-rw-r--r--perl-install/printer/default.pm51
-rw-r--r--perl-install/printer/detect.pm306
-rw-r--r--perl-install/printer/gimp.pm412
-rw-r--r--perl-install/printer/main.pm (renamed from perl-install/printer.pm)1678
-rw-r--r--perl-install/printer/office.pm384
-rw-r--r--perl-install/printer/printerdrake.pm (renamed from perl-install/printerdrake.pm)439
-rw-r--r--perl-install/printer/services.pm61
-rw-r--r--perl-install/services.pm87
-rwxr-xr-xperl-install/standalone/printerdrake28
13 files changed, 1766 insertions, 1897 deletions
diff --git a/perl-install/common.pm b/perl-install/common.pm
index 3e46d89aa..4093c1b02 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -4,11 +4,12 @@ use MDK::Common;
use MDK::Common::System;
use diagnostics;
use strict;
+use run_program;
use vars qw(@ISA @EXPORT $SECTORSIZE);
@ISA = qw(Exporter);
# no need to export ``_''
-@EXPORT = qw($SECTORSIZE N N_ translate untranslate formatXiB removeXiBSuffix formatTime setVirtual makedev unmakedev salt);
+@EXPORT = qw($SECTORSIZE N N_ translate untranslate formatXiB removeXiBSuffix formatTime setVirtual makedev unmakedev salt set_permissions files_exist set_alternative);
# perl_checker: RE-EXPORT-ALL
push @EXPORT, @MDK::Common::EXPORT;
@@ -185,4 +186,60 @@ sub join_lines {
@l, if_($s, $s);
}
+
+sub set_alternative {
+ my ($command, $executable) = @_;
+ local *F;
+ # Read the list of executables for the given command to find the number
+ # of the desired executable
+ open F, ($::testing ? $::prefix : "chroot $::prefix/ ") .
+ "/bin/sh -c \"export LC_ALL=C; /bin/echo | update-alternatives --config $command \" |" or
+ die "Could not run \"update-alternatives\"!";
+ my $choice = 0;
+ while (my $line = <F>) {
+ chomp $line;
+ if ($line =~ m/^[\* ][\+ ]\s*([0-9]+)\s+(\S+)\s*$/) { # list entry?
+ if ($2 eq $executable) {
+ $choice = $1;
+ last;
+ }
+ }
+ }
+ close F;
+ # If the executable was found, assign the command to it
+ if ($choice > 0) {
+ system(($::testing ? $::prefix : "chroot $::prefix/ ") .
+ "/bin/sh -c \"/bin/echo $choice | update-alternatives --config $command > /dev/null 2>&1\"");
+ }
+ return 1;
+}
+
+sub files_exist {
+ my @files = @_;
+ foreach my $file (@files) {
+ return 0 unless -f "$::prefix$file"
+ }
+ return 1;
+}
+
+sub set_permissions {
+ my ($file, $perms, $owner, $group) = @_;
+ # We only need to set the permissions during installation to be able to
+ # print test pages. After installation the devfsd daemon does the business
+ # automatically.
+ return 1 unless $::isInstall;
+ if ($owner && $group) {
+ run_program::rooted($::prefix, "/bin/chown", "$owner.$group", $file)
+ or die "Could not start chown!";
+ } elsif ($owner) {
+ run_program::rooted($::prefix, "/bin/chown", $owner, $file)
+ or die "Could not start chown!";
+ } elsif ($group) {
+ run_program::rooted($::prefix, "/bin/chgrp", $group, $file)
+ or die "Could not start chgrp!";
+ }
+ run_program::rooted($::prefix, "/bin/chmod", $perms, $file)
+ or die "Could not start chmod!";
+}
+
1;
diff --git a/perl-install/printer/common.pm b/perl-install/printer/common.pm
new file mode 100644
index 000000000..13e5919f9
--- /dev/null
+++ b/perl-install/printer/common.pm
@@ -0,0 +1,91 @@
+package printer::common;
+
+use strict;
+
+
+sub addentry {
+ my ($section, $entry, $filecontent) = @_;
+ my $sectionfound = 0;
+ my $entryinserted = 0;
+ my @lines = split("\n", $filecontent);
+ foreach (@lines) {
+ if (!$sectionfound) {
+ if (/^\s*\[\s*$section\s*\]\s*$/) {
+ $sectionfound = 1;
+ }
+ } else {
+ if (!/^\s*$/ && !/^\s*;/) { #-#
+ $_ = "$entry\n$_";
+ $entryinserted = 1;
+ last;
+ }
+ }
+ }
+ if ($sectionfound && !$entryinserted) {
+ push(@lines, $entry);
+ }
+ return join ("\n", @lines);
+}
+
+sub addsection {
+ my ($section, $filecontent) = @_;
+ my $entryinserted = 0;
+ my @lines = split("\n", $filecontent);
+ foreach (@lines) {
+ if (/^\s*\[\s*$section\s*\]\s*$/) {
+ # section already there, nothing to be done
+ return $filecontent;
+ }
+ }
+ return $filecontent . "\n[$section]";
+}
+
+sub removeentry {
+ my ($section, $entry, $filecontent) = @_;
+ my $sectionfound = 0;
+ my $done = 0;
+ my @lines = split("\n", $filecontent);
+ foreach (@lines) {
+ $_ = "$_\n";
+ next if $done;
+ if (!$sectionfound) {
+ if (/^\s*\[\s*$section\s*\]\s*$/) {
+ $sectionfound = 1;
+ }
+ } else {
+ if (/^\s*\[.*\]\s*$/) { # Next section
+ $done = 1;
+ } elsif (/^\s*$entry/) {
+ $_ = "";
+ $done = 1;
+ }
+ }
+ }
+ return join ("", @lines);
+}
+
+sub removesection {
+ my ($section, $filecontent) = @_;
+ my $sectionfound = 0;
+ my $done = 0;
+ my @lines = split("\n", $filecontent);
+ foreach (@lines) {
+ $_ = "$_\n";
+ next if $done;
+ if (!$sectionfound) {
+ if (/^\s*\[\s*$section\s*\]\s*$/) {
+ $_ = "";
+ $sectionfound = 1;
+ }
+ } else {
+ if (/^\s*\[.*\]\s*$/) { # Next section
+ $done = 1;
+ } else {
+ $_ = "";
+ }
+ }
+ }
+ return join ("", @lines);
+}
+
+1;
diff --git a/perl-install/printer/cups.pm b/perl-install/printer/cups.pm
new file mode 100644
index 000000000..1de54edf2
--- /dev/null
+++ b/perl-install/printer/cups.pm
@@ -0,0 +1,30 @@
+package printer::cups;
+
+use strict;
+use printer::data;
+
+sub get_remote_queues {
+ my ($printer) = $_[0];
+ # The following code reads in a list of all remote printers which the
+ # local CUPS daemon knows due to broadcasting of remote servers or
+ # "BrowsePoll" entries in the local /etc/cups/cupsd.conf
+ local *F;
+ open F, ($::testing ? $::prefix : "chroot $::prefix/ ") .
+ "lpstat -v |" or return ();
+ my @printerlist;
+ my $line;
+ while ($line = <F>) {
+ if ($line =~ m/^\s*device\s+for\s+([^:\s]+):\s*(\S+)\s*$/) {
+ my $queuename = $1;
+ if (($2 =~ m!^ipp://([^/:]+)[:/]!) &&
+ (!$printer->{configured}{$queuename})) {
+ my $server = $1;
+ push (@printerlist, "$queuename|$server");
+ }
+ }
+ }
+ close F;
+ return @printerlist;
+}
+
+1;
diff --git a/perl-install/printer/data.pm b/perl-install/printer/data.pm
new file mode 100644
index 000000000..0c7a29eed
--- /dev/null
+++ b/perl-install/printer/data.pm
@@ -0,0 +1,37 @@
+package printer::data;
+
+use strict;
+use common;
+
+# BUG, FIXME : this was neither declered nor setted anywhere before :
+# maybe this should be swtiched :
+# $lprcommand{stuff} => $spoolers{stuff}{print_command}
+
+our %lprcommand;
+
+our %spoolers = ('ppq' => {
+ 'help' => "/usr/bin/lphelp %s |",
+ 'print_command' => 'lpr-pdq',
+ 'long_name' =>N("PDQ - Print, Don't Queue"),
+ 'short_name' => N("PDQ")
+ },
+ 'lpd' => {
+ 'help' => "/usr/bin/pdq -h -P %s 2>&1 |",
+ 'print_command' => 'lpr',
+ 'long_name' => N("LPD - Line Printer Daemon"),
+ 'short_name' => N("LPD")
+ },
+ 'lprng' => {
+ 'print_command' => 'lpr-lpd',
+ 'long_name' => N("LPRng - LPR New Generation"),
+ 'short_name' => N("LPRng")
+ },
+ 'cups' => {
+ 'print_command' => 'lpr-cups',
+ 'long_name' => N("CUPS - Common Unix Printing System"),
+ 'short_name' => N("CUPS")
+ }
+ );
+our %spooler_inv = map { $spoolers{$_}{long_name} => $_ } keys %spoolers;
+
+our %shortspooler_inv = map { $spoolers{$_}{short_name} => $_ } keys %spoolers;
diff --git a/perl-install/printer/default.pm b/perl-install/printer/default.pm
new file mode 100644
index 000000000..5c15645d2
--- /dev/null
+++ b/perl-install/printer/default.pm
@@ -0,0 +1,51 @@
+package printer::default;
+
+use strict;
+use run_program;
+use common;
+
+#-configuration directory of Foomatic
+my $FOOMATICCONFDIR = "/etc/foomatic";
+#-location of the file containing the default spooler's name
+my $FOOMATIC_DEFAULT_SPOOLER = "$FOOMATICCONFDIR/defaultspooler";
+
+sub set_printer {
+ my ($printer) = $_[0];
+ run_program::rooted($::prefix, "foomatic-configure",
+ "-D", "-q", "-s", $printer->{SPOOLER},
+ "-n", $printer->{DEFAULT}) or return 0;
+ return 1;
+}
+
+sub get_printer {
+ my $printer = $_[0];
+ local *F;
+ open F, ($::testing ? $::prefix : "chroot $::prefix/ ") .
+ "foomatic-configure -Q -q -s $printer->{SPOOLER} |" or return undef;
+ my $line;
+ while ($line = <F>) {
+ if ($line =~ m!^\s*<defaultqueue>(.*)</defaultqueue>\s*$!) {
+ return $1;
+ }
+ }
+ return undef;
+}
+
+sub printer_type($) { "LOCAL" }
+
+sub get_spooler () {
+ if (-f "$::prefix$FOOMATIC_DEFAULT_SPOOLER") {
+ my $spool = cat_("$::prefix$FOOMATIC_DEFAULT_SPOOLER");
+ chomp $spool;
+ return $spool if $spool =~ /cups|lpd|lprng|pdq/;
+ }
+}
+
+sub set_spooler ($) {
+ my ($printer) = @_;
+ # Mark the default driver in a file
+ output_p("$::prefix$FOOMATIC_DEFAULT_SPOOLER", $printer->{SPOOLER});
+}
+
+
+1;
diff --git a/perl-install/printer/detect.pm b/perl-install/printer/detect.pm
new file mode 100644
index 000000000..8439f9a37
--- /dev/null
+++ b/perl-install/printer/detect.pm
@@ -0,0 +1,306 @@
+package printer::detect;
+
+use strict;
+use common;
+use detect_devices;
+use modules;
+
+sub local_detect {
+ modules::get_probeall("usb-interface") and eval { modules::load("printer") };
+ eval { modules::unload(qw(lp parport_pc parport_probe parport)) }; #- on kernel 2.4 parport has to be unloaded to probe again
+ eval { modules::load(qw(parport_pc lp parport_probe)) }; #- take care as not available on 2.4 kernel (silent error).
+ my $b = before_leaving { eval { modules::unload("parport_probe") } };
+ detect_devices::whatPrinter();
+}
+
+sub net_detect { whatNetPrinter(1, 0) }
+
+sub net_smb_detect { whatNetPrinter(0, 1) }
+
+sub detect {
+ local_detect(), net_detect(), net_smb_detect();
+}
+
+sub whatNetPrinter {
+ my ($network, $smb) = @_;
+
+ my ($i,@res);
+
+ # Which ports should be scanned?
+ my @portstoscan;
+ push @portstoscan, "139" if $smb;
+ push @portstoscan, "4010", "4020", "4030", "5503", "9100-9104" if $network;
+
+ return () if $#portstoscan < 0;
+ my $portlist = join (",", @portstoscan);
+
+ # Which hosts should be scanned?
+ # (Applying nmap to a whole network is very time-consuming, because nmap
+ # waits for a certain timeout period on non-existing hosts, so we get a
+ # lists of existing hosts by pinging the broadcast addresses for existing
+ # hosts and then scanning only them, which is much faster)
+ my @hostips = getIPsInLocalNetworks();
+ return () if $#hostips < 0;
+ my $hostlist = join (" ", @hostips);
+
+ # Scan network for printers, the timeout settings are there to avoid
+ # delays caused by machines blocking their ports with a firewall
+ local *F;
+ open F, ($::testing ? "" : "chroot $::prefix/ ") .
+ "/bin/sh -c \"export LC_ALL=C; nmap -r -P0 --host_timeout 400 --initial_rtt_timeout 200 -p $portlist $hostlist\" |"
+ or return @res;
+ my ($host, $ip, $port, $modelinfo) = ("", "", "", "");
+ while (my $line = <F>) {
+ chomp $line;
+
+ # head line of the report of a host with the ports in question open
+ #if ($line =~ m/^\s*Interesting\s+ports\s+on\s+(\S*)\s*\(([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\)\s*:\s*$/i) {
+ if ($line =~ m/^\s*Interesting\s+ports\s+on\s+(\S*)\s*\((\S+)\)\s*:\s*$/i) {
+ ($host, $ip) = ($1, $2);
+ $host = $ip if $host eq "";
+ $port = "";
+
+ undef $modelinfo;
+
+ } elsif ($line =~ m/^\s*(\d+)\/\S+\s+open\s+/i) {
+ next if $ip eq "";
+ $port = $1;
+
+ # Now we have all info for one printer
+ # Store this auto-detection result in the data structure
+
+ # Determine the protocol by the port number
+
+ # SMB/Windows
+ if ($port eq "139") {
+ my @shares = getSMBPrinterShares($ip);
+ foreach my $share (@shares) {
+ push @res, { port => "smb://$host/$share->{name}",
+ val => { CLASS => 'PRINTER',
+ MODEL => N("Unknown Model"),
+ MANUFACTURER => "",
+ DESCRIPTION => "$share->{description}",
+ SERIALNUMBER => ""
+ }
+ };
+ }
+ } else {
+ if (!defined($modelinfo)) {
+ # SNMP request to auto-detect model
+ $modelinfo = getSNMPModel ($ip);
+ }
+ if (defined($modelinfo)) {
+ push @res, { port => "socket://$host:$port",
+ val => $modelinfo
+ };
+ }
+ }
+ }
+ }
+ close F;
+ @res;
+}
+
+sub getIPsInLocalNetworks {
+
+ # subroutine determines the list of all hosts reachable in the local
+ # networks by means of pinging the broadcast addresses.
+
+ # Return an empty list if no network is running
+ return () unless network_running();
+
+ # Read the output of "ifconfig" to determine the broadcast addresses of
+ # the local networks
+ my $dev_is_localnet = 0;
+ my @local_bcasts;
+ my $current_bcast = "";
+
+ local *IFCONFIG_OUT;
+ open IFCONFIG_OUT, ($::testing ? "" : "chroot $::prefix/ ") .
+ "/bin/sh -c \"export LC_ALL=C; ifconfig\" |" or return ();
+ while (my $readline = <IFCONFIG_OUT>) {
+ # New entry ...
+ if ($readline =~ /^(\S+)\s/) {
+ my $dev = $1;
+ # ... for a local network (eth = ethernet,
+ # vmnet = VMWare,
+ # ethernet card connected to ISP excluded)?
+ $dev_is_localnet = (($dev =~ /^eth/) || ($dev =~ /^vmnet/));
+ # delete previous address
+ $current_bcast = "";
+ }
+ # Are we in the important line now?
+ if ($readline =~ /\sBcast:([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\s/) {
+ # Rip out the broadcast IP address
+ $current_bcast = $1;
+
+ # Are we in an entry for a local network?
+ if ($dev_is_localnet == 1) {
+ # Store current IP address
+ push @local_bcasts, $current_bcast;
+ }
+ }
+ }
+ close(IFCONFIG_OUT);
+
+ my @addresses;
+ # Now ping all broadcast addresses and additionally "nmblookup" the
+ # networks (to find Windows servers which do not answer to ping)
+ foreach my $bcast (@local_bcasts) {
+ local *F;
+ open F, ($::testing ? "" : "chroot $::prefix/ ") .
+ "/bin/sh -c \"export LC_ALL=C; ping -w 1 -b -n $bcast | cut -f 4 -d ' ' | sed s/:// | egrep '^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+' | uniq | sort\" |"
+ or next;
+ local $_;
+ while (<F>) { chomp; push @addresses, $_ }
+ close F;
+ if (-x "/usr/bin/nmblookup") {
+ local *F;
+ open F, ($::testing ? "" : "chroot $::prefix/ ") .
+ "/bin/sh -c \"export LC_ALL=C; nmblookup -B $bcast \\* | cut -f 1 -d ' ' | egrep '^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+' | uniq | sort\" |"
+ or next;
+ local $_;
+ while (<F>) {
+ chomp;
+ push @addresses, $_ if !(member($_,@addresses));
+ }
+ }
+ }
+
+ @addresses;
+}
+
+sub getSMBPrinterShares {
+ my ($host) = @_;
+
+ # SMB request to auto-detect shares
+ local *F;
+ open F, ($::testing ? "" : "chroot $::prefix/ ") .
+ "/bin/sh -c \"export LC_ALL=C; smbclient -N -L $host\" |" or return ();
+ my $insharelist = 0;
+ my @shares;
+ while (my $l = <F>) {
+ chomp $l;
+ if ($l =~ /^\s*Sharename\s+Type\s+Comment\s*$/i) {
+ $insharelist = 1;
+ } elsif ($l =~ /^\s*Server\s+Comment\s*$/i) {
+ $insharelist = 0;
+ } elsif (($l =~ /^\s*(\S+)\s+Printer\s*(.*)$/i) &&
+ ($insharelist)) {
+ my $name = $1;
+ my $description = $2;
+ $description =~ s/^(\s*)//;
+ push (@shares, { name => $name, description => $description });
+ }
+ }
+ close F;
+
+ return @shares;
+}
+
+sub getSNMPModel {
+ my ($host) = @_;
+ my $manufacturer = "";
+ my $model = "";
+ my $description = "";
+ my $serialnumber = "";
+
+ # SNMP request to auto-detect model
+ local *F;
+ open F, ($::testing ? $::prefix : "chroot $::prefix/ ") .
+ "/bin/sh -c \"scli -1 -c 'show printer info' $host\" |" or
+ return { CLASS => 'PRINTER',
+ MODEL => N("Unknown Model"),
+ MANUFACTURER => "",
+ DESCRIPTION => "",
+ SERIALNUMBER => ""
+ };
+ while (my $l = <F>) {
+ chomp $l;
+ if (($l =~ /^\s*Manufacturer:\s*(\S.*)$/i) &&
+ ($l =~ /^\s*Vendor:\s*(\S.*)$/i)) {
+ $manufacturer = $1;
+ $manufacturer =~ s/Hewlett[-\s_]Packard/HP/;
+ $manufacturer =~ s/HEWLETT[-\s_]PACKARD/HP/;
+ } elsif ($l =~ /^\s*Model:\s*(\S.*)$/i) {
+ $model = $1;
+ } elsif ($l =~ /^\s*Description:\s*(\S.*)$/i) {
+ $description = $1;
+ $description =~ s/Hewlett[-\s_]Packard/HP/;
+ $description =~ s/HEWLETT[-\s_]PACKARD/HP/;
+ } elsif ($l =~ /^\s*Serial\s*Number:\s*(\S.*)$/i) {
+ $serialnumber = $1;
+ }
+ }
+ close F;
+
+ # Was there a manufacturer and a model in the output?
+ # If not, get them from the description
+ if (($manufacturer eq "") || ($model eq "")) {
+ if ($description =~ /^\s*(\S*)\s+(\S.*)$/) {
+ $manufacturer = $1 if $manufacturer eq "";
+ $model = $2 if $model eq "";
+ }
+ # No description field? Make one out of manufacturer and model.
+ } elsif ($description eq "") {
+ $description = "$manufacturer $model";
+ }
+
+ # We couldn't determine a model
+ $model = N("Unknown Model") if $model eq "";
+
+ # Remove trailing spaces
+ $manufacturer =~ s/(\S+)\s+$/$1/;
+ $model =~ s/(\S+)\s+$/$1/;
+ $description =~ s/(\S+)\s+$/$1/;
+ $serialnumber =~ s/(\S+)\s+$/$1/;
+
+ # Now we have all info for one printer
+ # Store this auto-detection result in the data structure
+ return { CLASS => 'PRINTER',
+ MODEL => $model,
+ MANUFACTURER => $manufacturer,
+ DESCRIPTION => $description,
+ SERIALNUMBER => $serialnumber
+ };
+}
+
+sub network_running {
+ # If the network is not running return 0, otherwise 1.
+ local *F;
+ open F, ($::testing ? $::prefix : "chroot $::prefix/ ") .
+ "/bin/sh -c \"export LC_ALL=C; /sbin/ifconfig\" |" or
+ die "Could not run \"ifconfig\"!";
+ while (my $line = <F>) {
+ if (($line !~ /^lo\s+/) && # The loopback device can have been
+ # started by the spooler's startup script
+ ($line =~ /^(\S+)\s+/)) { # In this line starts an entry for a
+ # running network
+ close F;
+ return 1;
+ }
+ }
+ close F;
+ return 0;
+}
+
+sub parport_addr {
+ # auto-detect the parallel port addresses
+ my ($device) = @_;
+ $device =~ m!^/dev/lp(\d+)$! or
+ $device =~ m!^/dev/printers/(\d+)$!;
+ my $portnumber = $1;
+ my $parport_addresses =
+ `cat /proc/sys/dev/parport/parport$portnumber/base-addr`;
+ my $address_arg;
+ if ($parport_addresses =~ /^\s*(\d+)\s+(\d+)\s*$/) {
+ $address_arg = sprintf(" -base 0x%x -basehigh 0x%x", $1, $2);
+ } elsif ($parport_addresses =~ /^\s*(\d+)\s*$/) {
+ $address_arg = sprintf(" -base 0x%x", $1);
+ } else {
+ $address_arg = "";
+ }
+ return $address_arg;
+}
+
+1;
diff --git a/perl-install/printer/gimp.pm b/perl-install/printer/gimp.pm
new file mode 100644
index 000000000..6d92d5fe3
--- /dev/null
+++ b/perl-install/printer/gimp.pm
@@ -0,0 +1,412 @@
+package printer::gimp;
+
+use strict;
+use run_program;
+use common;
+use printer::common;
+use printer::data;
+use printer::cups;
+
+# ------------------------------------------------------------------
+# GIMP-print related stuff
+# ------------------------------------------------------------------
+
+sub configure {
+ my ($printer, $queue) = @_;
+ # Do we have files to treat?
+ my @configfilenames = findconfigfiles();
+ return 1 if $#configfilenames < 0;
+ # There is no system-wide config file, treat every user's config file
+ foreach my $configfilename (@configfilenames) {
+ # Load GIMP's printer config file
+ my $configfilecontent = readconfigfile($configfilename);
+ # Update local printer queues
+ foreach my $queue (keys(%{$printer->{configured}})) {
+ # Check if we have a PPD file
+ if (! -r "$::prefix/etc/foomatic/$queue.ppd") {
+ if (-r "$::prefix/etc/cups/ppd/$queue.ppd") {
+ # If we have a PPD file in the CUPS config dir, link to it
+ run_program::rooted($::prefix,
+ "ln", "-sf",
+ "/etc/cups/ppd/$queue.ppd",
+ "/etc/foomatic/$queue.ppd");
+ } elsif (-r "$::prefix/usr/share/postscript/ppd/$queue.ppd") {
+ # Check PPD directory of GPR, too
+ run_program::rooted
+ ($::prefix,
+ "ln", "-sf",
+ "/usr/share/postscript/ppd/$queue.ppd",
+ "/etc/foomatic/$queue.ppd");
+ } else {
+ # No PPD file at all? We cannot set up this printer
+ next;
+ }
+ }
+ # Add the printer entry
+ if (!isprinterconfigured ($queue, $configfilecontent)) {
+ # Remove the old printer entry
+ $configfilecontent =
+ removeprinter($queue, $configfilecontent);
+ # Add the new printer entry
+ $configfilecontent =
+ makeprinterentry($printer, $queue,
+ $configfilecontent);
+ }
+ }
+ # Default printer
+ if ($printer->{DEFAULT}) {
+ if ($configfilecontent !~ /^\s*Current\-Printer\s*:/m) {
+ $configfilecontent =~
+ s/\n/\nCurrent-Printer: $printer->{DEFAULT}\n/s;
+ } else {
+ $configfilecontent =~ /^\s*Current\-Printer\s*:\s*(\S+)\s*$/m;
+ if (!isprinterconfigured ($1, $configfilecontent)) {
+ $configfilecontent =~
+ s/(Current\-Printer\s*:\s*)\S+/$1$printer->{DEFAULT}/;
+ }
+ }
+ }
+ # Write back GIMP's printer configuration file
+ writeconfigfile($configfilename, $configfilecontent);
+ }
+ return 1;
+}
+
+sub addcupsremoteto {
+ my ($printer, $queue) = @_;
+ # Do we have files to treat?
+ my @configfilenames = findconfigfiles();
+ return 1 if $#configfilenames < 0;
+ my @printerlist = printer::cups::get_remote_queues();
+ my $ppdfile = "";
+ if (($printer->{SPOOLER} eq "cups") &&
+ ((-x "$::prefix/usr/bin/curl") || (-x "$::prefix/usr/bin/wget"))) {
+ foreach my $listentry (@printerlist) {
+ next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
+ my $q = $1;
+ next if $q ne $queue;
+ my $server = $2;
+ # Remove server name from queue name
+ $q =~ s/^([^@]*)@.*$/$1/;
+ if (-x "$::prefix/usr/bin/wget") {
+ eval(run_program::rooted
+ ($::prefix, "/usr/bin/wget", "-O",
+ "/etc/foomatic/$queue.ppd",
+ "http://$server:631/printers/$q.ppd"));
+ } else {
+ eval(run_program::rooted
+ ($::prefix, "/usr/bin/curl", "-o",
+ "/etc/foomatic/$queue.ppd",
+ "http://$server:631/printers/$q.ppd"));
+ }
+ # Does the file exist and is it not an error message?
+ if ((-r "$::prefix/etc/foomatic/$queue.ppd") &&
+ (cat_("$::prefix/etc/foomatic/$queue.ppd") =~
+ /^\*PPD-Adobe/)) {
+ $ppdfile = "/etc/foomatic/$queue.ppd";
+ } else {
+ unlink ("$::prefix/etc/foomatic/$queue.ppd");
+ return 0;
+ }
+ }
+ } else {
+ return 1;
+ }
+ # There is no system-wide config file, treat every user's config file
+ foreach my $configfilename (@configfilenames) {
+ # Load GIMP's printer config file
+ my $configfilecontent = readconfigfile($configfilename);
+ # Add the printer entry
+ if (!isprinterconfigured ($queue, $configfilecontent)) {
+ # Remove the old printer entry
+ $configfilecontent =
+ removeprinter($queue, $configfilecontent);
+ # Add the new printer entry
+ $configfilecontent =
+ makeprinterentry($printer, $queue,
+ $configfilecontent);
+ }
+ # Write back GIMP's printer configuration file
+ writeconfigfile($configfilename, $configfilecontent);
+ }
+ return 1;
+}
+
+sub removeprinterfrom {
+ my ($printer, $queue) = @_;
+ # Do we have files to treat?
+ my @configfilenames = findconfigfiles();
+ return 1 if $#configfilenames < 0;
+ # There is no system-wide config file, treat every user's config file
+ foreach my $configfilename (@configfilenames) {
+ # Load GIMP's printer config file
+ my $configfilecontent = readconfigfile($configfilename);
+ # Remove the printer entry
+ $configfilecontent =
+ removeprinter($queue, $configfilecontent);
+ # Write back GIMP's printer configuration file
+ writeconfigfile($configfilename, $configfilecontent);
+ }
+ return 1;
+}
+
+sub removelocalprintersfrom {
+ my ($printer) = @_;
+ # Do we have files to treat?
+ my @configfilenames = findconfigfiles();
+ return 1 if $#configfilenames < 0;
+ # There is no system-wide config file, treat every user's config file
+ foreach my $configfilename (@configfilenames) {
+ # Load GIMP's printer config file
+ my $configfilecontent = readconfigfile($configfilename);
+ # Remove the printer entries
+ foreach my $queue (keys(%{$printer->{configured}})) {
+ $configfilecontent =
+ removeprinter($queue, $configfilecontent);
+ }
+ # Write back GIMP's printer configuration file
+ writeconfigfile($configfilename, $configfilecontent);
+ }
+ return 1;
+}
+
+sub makeprinterentry {
+ my ($printer, $queue, $configfile) = @_;
+ # Make printer's section
+ $configfile = addprinter($queue, $configfile);
+ # Load PPD file
+ my $ppd = cat_("$::prefix/etc/foomatic/$queue.ppd");
+ # Is the printer configured with GIMP-Print?
+ my $gimpprintqueue = 0;
+ my $gimpprintdriver = "ps2";
+ if ($ppd =~ /CUPS\s*\+\s*GIMP\s*\-\s*Print/im) {
+ # Native CUPS driver
+ $gimpprintqueue = 1;
+ $ppd =~ /\s*\*ModelName:\s*\"(\S+)\"\s*$/im;
+ $gimpprintdriver = $1;
+ } elsif ($ppd =~ /Foomatic\s*\+\s*gimp\s*\-\s*print/im) {
+ # GhostScript + Foomatic driver
+ $gimpprintqueue = 1;
+ $ppd =~
+ /'idx'\s*=>\s*'ev\/gimp-print-((escp2|pcl|bjc|lexmark)\-\S*)'/im;
+ $gimpprintdriver = $1;
+ }
+ if ($gimpprintqueue) {
+ # Get the paper size from the PPD file
+ if ($ppd =~ /^\s*\*DefaultPageSize:\s*(\S+)\s*$/m) {
+ my $papersize = $1;
+ $configfile = removeentry($queue,
+ "Media-Size", $configfile);
+ $configfile = addentry($queue,
+ "Media-Size: $papersize", $configfile);
+ }
+ $configfile = removeentry($queue,
+ "PPD-File:", $configfile);
+ $configfile = addentry($queue,
+ "PPD-File:", $configfile);
+ $configfile = removeentry($queue,
+ "Driver:", $configfile);
+ $configfile = addentry($queue,
+ "Driver: $gimpprintdriver", $configfile);
+ $configfile = removeentry($queue,
+ "Destination:", $configfile);
+ $configfile = addentry($queue,
+ "Destination: /usr/bin/$printer::data::lprcommand{$printer->{SPOOLER}{print_command}} -P $queue -o raw", $configfile);
+ } else {
+ $configfile = removeentry($queue,
+ "PPD-File:", $configfile);
+ $configfile = addentry($queue,
+ "PPD-File: /etc/foomatic/$queue.ppd", $configfile);
+ $configfile = removeentry($queue,
+ "Driver:", $configfile);
+ $configfile = addentry($queue,
+ "Driver: ps2", $configfile);
+ $configfile = removeentry($queue,
+ "Destination:", $configfile);
+ $configfile = addentry($queue,
+ "Destination: /usr/bin/$printer::data::lprcommand{$printer->{SPOOLER}{print_command}} -P $queue", $configfile);
+ }
+ return $configfile;
+}
+
+sub findconfigfiles {
+ my @configfilenames;
+ push (@configfilenames, ".gimp-1.2/printrc") if -d "$::prefix/usr/lib/gimp/1.2";
+ push (@configfilenames, ".gimp-1.3/printrc") if -d "$::prefix/usr/lib/gimp/1.3";
+ my @filestotreat;
+ local *PASSWD;
+ open PASSWD, "< $::prefix/etc/passwd" or die "Cannot read /etc/passwd!\n";
+ local $_;
+ while (<PASSWD>) {
+ chomp;
+ if (/^([^:]+):[^:]*:([^:]+):([^:]+):[^:]*:([^:]+):[^:]*$/) {
+ my ($username, $uid, $gid, $homedir) = ($1, $2, $3, $4);
+ if ((($uid == 0) || ($uid >= 500)) && ($username ne "nobody")) {
+ foreach my $file (@configfilenames) {
+ my $dir = "$homedir/$file";
+ $dir =~ s,/[^/]*$,,;
+ next if (-f $dir) && (! -d $dir);
+ if (! -d "$::prefix$dir") {
+ run_program::rooted($::prefix,
+ "/bin/mkdir", $dir)
+ or next;
+ run_program::rooted($::prefix,
+ "/bin/chown", "$uid.$gid", $dir)
+ or next;
+ }
+ if (! -f "$::prefix$homedir/$file") {
+ local *F;
+ open F, "> $::prefix$homedir/$file" or next;
+ print F "#PRINTRCv1 written by GIMP-PRINT 4.2.2 - 13 Sep 2002\n";
+ close F;
+ run_program::rooted($::prefix,
+ "/bin/chown", "$uid.$gid",
+ "$homedir/$file")
+ or next;
+ }
+ push (@filestotreat, "$homedir/$file");
+ }
+ }
+ }
+ }
+ @filestotreat;
+}
+
+sub readconfigfile {
+ my ($file) = @_;
+ local *F;
+ open F, "< $::prefix$file" or return "";
+ my $filecontent = join("", <F>);
+ close F;
+ return $filecontent;
+}
+
+sub writeconfigfile {
+ my ($file, $filecontent) = @_;
+ local *F;
+ open F, "> $::prefix$file" or return 0;
+ print F $filecontent;
+ close F;
+ return 1;
+}
+
+sub addentry {
+ my ($section, $entry, $filecontent) = @_;
+ my $sectionfound = 0;
+ my $entryinserted = 0;
+ my @lines = split("\n", $filecontent);
+ foreach (@lines) {
+ if (!$sectionfound) {
+ if (/^\s*Printer\s*:\s*($section)\s*$/) {
+ $sectionfound = 1;
+ }
+ } else {
+ if (!/^\s*$/ && !/^\s*;/) { #-#
+ $_ = "$entry\n$_";
+ $entryinserted = 1;
+ last;
+ }
+ }
+ }
+ if ($sectionfound && !$entryinserted) {
+ push(@lines, $entry);
+ }
+ return join ("\n", @lines);
+}
+
+sub addprinter {
+ my ($section, $filecontent) = @_;
+ my $entryinserted = 0;
+ my @lines = split("\n", $filecontent);
+ foreach (@lines) {
+ if (/^\s*Printer\s*:\s*($section)\s*$/) {
+ # section already there, nothing to be done
+ return $filecontent;
+ }
+ }
+ return $filecontent . "\nPrinter: $section";
+}
+
+sub removeentry {
+ my ($section, $entry, $filecontent) = @_;
+ my $sectionfound = 0;
+ my $done = 0;
+ my @lines = split("\n", $filecontent);
+ foreach (@lines) {
+ $_ = "$_\n";
+ next if $done;
+ if (!$sectionfound) {
+ if (/^\s*Printer\s*:\s*($section)\s*$/) {
+ $sectionfound = 1;
+ }
+ } else {
+ if (/^\s*Printer\s*:\s*.*\s*$/) { # Next section
+ $done = 1;
+ } elsif (/^\s*$entry/) {
+ $_ = "";
+ $done = 1;
+ }
+ }
+ }
+ return join ("", @lines);
+}
+
+sub removeprinter {
+ my ($section, $filecontent) = @_;
+ my $sectionfound = 0;
+ my $done = 0;
+ my @lines = split("\n", $filecontent);
+ foreach (@lines) {
+ $_ = "$_\n";
+ next if $done;
+ if (!$sectionfound) {
+ if (/^\s*Printer\s*:\s*($section)\s*$/) {
+ $_ = "";
+ $sectionfound = 1;
+ }
+ } else {
+ if (/^\s*Printer\s*:\s*.*\s*$/) { # Next section
+ $done = 1;
+ } else {
+ $_ = "";
+ }
+ }
+ }
+ return join ("", @lines);
+}
+
+sub isprinterconfigured {
+ my ($queue, $filecontent) = @_;
+ my $sectionfound = 0;
+ my $done = 0;
+ my $drivernotps2 = 0;
+ my $ppdfileset = 0;
+ my $nonrawprinting = 0;
+ my @lines = split("\n", $filecontent);
+ foreach (@lines) {
+ last if $done;
+ if (!$sectionfound) {
+ if (/^\s*Printer\s*:\s*($queue)\s*$/) {
+ $sectionfound = 1;
+ }
+ } else {
+ if (/^\s*Printer\s*:\s*.*\s*$/) { # Next section
+ $done = 1;
+ } elsif (/^\s*Driver:\s*(\S+)\s*$/) {
+ $drivernotps2 = ($1 ne "ps2");
+ } elsif (/^\s*PPD\-File:\s*(\S+)\s*$/) {
+ $ppdfileset = 1;
+ } elsif (/^\s*Destination:\s*(\S+.*)$/) {
+ $nonrawprinting = ($1 !~ /\-o\s*raw/);
+ }
+ }
+ }
+ return 0 if $done && !$sectionfound;
+ return 1 if $ppdfileset || $drivernotps2 || $nonrawprinting;
+ return 0;
+}
+
+
+# ------------------------------------------------------------------
+
+1;
diff --git a/perl-install/printer.pm b/perl-install/printer/main.pm
index 11f451442..ad525b0d6 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer/main.pm
@@ -1,54 +1,29 @@
-package printer;
+package printer::main;
# $Id$
-#use diagnostics;
-#use strict;
+#
+#
use common;
use run_program;
+use printer::services;
+use printer::default;
+use printer::gimp;
+use printer::cups;
+use printer::office;
+use printer::detect;
+use printer::data;
+use services;
-#-if we are in an DrakX config
-my $prefix = "";
#-location of the printer database in an installed system
my $PRINTER_DB_FILE = "/usr/share/foomatic/db/compiled/overview.xml";
-#-configuration directory of Foomatic
-my $FOOMATICCONFDIR = "/etc/foomatic";
-#-location of the file containing the default spooler's name
-my $FOOMATIC_DEFAULT_SPOOLER = "$FOOMATICCONFDIR/defaultspooler";
#-Did we already read the subroutines of /usr/sbin/ptal-init?
my $ptalinitread = 0;
-our %spoolers = ('ppq' => {
- 'help' => "/usr/bin/lphelp %s |",
- 'print_command' => 'lpr-pdq',
- 'long_name' =>N("PDQ - Print, Don't Queue"),
- 'short_name' => N("PDQ")
- },
- 'lpd' => {
- 'help' => "/usr/bin/pdq -h -P %s 2>&1 |",
- 'print_command' => 'lpr-cups',
- 'long_name' => N("LPD - Line Printer Daemon"),
- 'short_name' => N("LPD")
- },
- 'lprng' => {
- 'print_command' => 'lpr-lpd',
- 'long_name' => N("LPRng - LPR New Generation"),
- 'short_name' => N("LPRng")
- },
- 'cups' => {
- 'print_command' => 'lpr-cups',
- 'long_name' => N("CUPS - Common Unix Printing System"),
- 'short_name' => N("CUPS")
- }
- );
-our %spooler_inv = map { $spooler{$_}{long_name} => $_ } keys %spoolers;
-
-our %shortspooler_inv = map { $spooler{$_}{short_name} => $_ } keys %spoolers;
-
%printer_type = (
N("Local printer") => "LOCAL",
N("Remote printer") => "REMOTE",
@@ -66,8 +41,6 @@ our %printer_type_inv = reverse %printer_type;
sub set_prefix($) { $prefix = $_[0] }
-sub default_printer_type($) { "LOCAL" }
-
sub spooler {
# LPD is taken from the menu for the moment because the classic LPD is
# highly unsecure. Depending on how the GNU lpr development is going on
@@ -78,8 +51,7 @@ sub spooler {
# LPRng is not officially supported any more since Mandrake 9.0, so
# show it only in the spooler menu when it was manually installed.
my @res;
- if (files_exist((qw(/usr/lib/filters/lpf
- /usr/sbin/lpd)))) {
+ if (files_exist((qw(/usr/lib/filters/lpf /usr/sbin/lpd)))) {
foreach (qw(cups lprng pdq)) { push @res, $spooler_inv{$_}{long_name} };
# {qw(cups lprng pdq)}{long_name};
} else {
@@ -104,133 +76,6 @@ sub printer_type($) {
}
}
-sub get_default_spooler () {
- if (-f "$prefix$FOOMATIC_DEFAULT_SPOOLER") {
- my $spool = cat_("$prefix$FOOMATIC_DEFAULT_SPOOLER");
- chomp $spool;
- return $spool if $spool =~ /cups|lpd|lprng|pdq/;
- }
-}
-
-sub set_default_spooler ($) {
- my ($printer) = @_;
- # Mark the default driver in a file
- output_p("$prefix$FOOMATIC_DEFAULT_SPOOLER", $printer->{SPOOLER});
-}
-
-sub set_permissions {
- my ($file, $perms, $owner, $group) = @_;
- # We only need to set the permissions during installation to be able to
- # print test pages. After installation the devfsd daemon does the business
- # automatically.
- if (!$::isInstall) { return 1 }
- if ($owner && $group) {
- run_program::rooted($prefix, "/bin/chown", "$owner.$group", $file)
- or die "Could not start chown!";
- } elsif ($owner) {
- run_program::rooted($prefix, "/bin/chown", $owner, $file)
- or die "Could not start chown!";
- } elsif ($group) {
- run_program::rooted($prefix, "/bin/chgrp", $group, $file)
- or die "Could not start chgrp!";
- }
- run_program::rooted($prefix, "/bin/chmod", $perms, $file)
- or die "Could not start chmod!";
-}
-
-sub restart_service ($) {
- my ($service) = @_;
- # Exit silently if the service is not installed
- return 1 if !(-x "$prefix/etc/rc.d/init.d/$service");
- run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "restart");
- if (($? >> 8) != 0) {
- return 0;
- } else {
- # CUPS needs some time to come up.
- wait_for_cups() if $service eq "cups";
- return 1;
- }
-}
-
-sub start_service ($) {
- my ($service) = @_;
- # Exit silently if the service is not installed
- return 1 if !(-x "$prefix/etc/rc.d/init.d/$service");
- run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "start");
- if (($? >> 8) != 0) {
- return 0;
- } else {
- # CUPS needs some time to come up.
- wait_for_cups() if $service eq "cups";
- return 1;
- }
-}
-
-sub start_not_running_service ($) {
- my ($service) = @_;
- # Exit silently if the service is not installed
- return 1 if !(-x "$prefix/etc/rc.d/init.d/$service");
- run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "status");
- # The exit status is not zero when the service is not running
- if (($? >> 8) != 0) {
- run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "start");
- if (($? >> 8) != 0) {
- return 0;
- } else {
- # CUPS needs some time to come up.
- wait_for_cups() if $service eq "cups";
- return 1;
- }
- } else {
- return 1;
- }
-}
-
-sub stop_service ($) {
- my ($service) = @_;
- # Exit silently if the service is not installed
- return 1 if !(-x "$prefix/etc/rc.d/init.d/$service");
- run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "stop");
- if (($? >> 8) != 0) { return 0 } else { return 1 }
-}
-
-sub service_running ($) {
- my ($service) = @_;
- # Exit silently if the service is not installed
- return 0 if !(-x "$prefix/etc/rc.d/init.d/$service");
- run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "status");
- # The exit status is not zero when the service is not running
- if (($? >> 8) != 0) {
- return 0;
- } else {
- return 1;
- }
-}
-
-sub service_starts_on_boot ($) {
- my ($service) = @_;
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") .
- "/bin/sh -c \"export LC_ALL=C; /sbin/chkconfig --list $service 2>&1\" |" or
- return 0;
- while (my $line = <F>) {
- chomp $line;
- if ($line =~ /:on/) {
- close F;
- return 1;
- }
- }
- close F;
- return 0;
-}
-
-sub start_service_on_boot ($) {
- my ($service) = @_;
- run_program::rooted($prefix, "/sbin/chkconfig", "--add", $service)
- or return 0;
- return 1;
-}
-
sub SIGHUP_daemon {
my ($service) = @_;
if ($service eq "cupsd") { $service = "cups" };
@@ -250,39 +95,21 @@ sub SIGHUP_daemon {
$daemon = $service if ! defined $daemon;
# if ($service eq "cups") {
# # The current CUPS (1.1.13) dies on SIGHUP, do the normal restart.
-# restart_service($service);
+# printer::services::restart($service);
# # CUPS needs some time to come up.
-# wait_for_cups();
+# printer::services::wait_for_cups();
# } else {
# Send the SIGHUP
run_program::rooted($prefix, "/usr/bin/killall", "-HUP", $daemon);
if ($service eq "cups") {
# CUPS needs some time to come up.
- wait_for_cups();
+ printer::services::wait_for_cups();
}
return 1;
}
-sub wait_for_cups {
- # CUPS needs some time to come up. Wait up to 30 seconds, checking
- # whether CUPS is ready.
- my $cupsready = 0;
- my $i;
- for ($i = 0; $i < 30; $i++) {
- run_program::rooted($prefix, "/usr/bin/lpstat", "-r");
- if (($? >> 8) != 0) {
- # CUPS is not ready, continue
- sleep 1;
- } else {
- # CUPS is ready, quit
- $cupsready = 1;
- last;
- }
- }
- return $cupsready;
-}
sub assure_device_is_available_for_cups {
# Checks whether CUPS already "knows" a certain port, it does not
@@ -312,285 +139,6 @@ sub assure_device_is_available_for_cups {
return $result;
}
-sub network_running {
- # If the network is not running return 0, otherwise 1.
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") .
- "/bin/sh -c \"export LC_ALL=C; /sbin/ifconfig\" |" or
- die "Could not run \"ifconfig\"!";
- while (my $line = <F>) {
- if (($line !~ /^lo\s+/) && # The loopback device can have been
- # started by the spooler's startup script
- ($line =~ /^(\S+)\s+/)) { # In this line starts an entry for a
- # running network
- close F;
- return 1;
- }
- }
- close F;
- return 0;
-}
-
-sub getSNMPModel {
-
- my ($host) = @_;
- my $manufacturer = "";
- my $model = "";
- my $description = "";
- my $serialnumber = "";
-
- # SNMP request to auto-detect model
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") .
- "/bin/sh -c \"scli -1 -c 'show printer info' $host\" |" or
- return { CLASS => 'PRINTER',
- MODEL => N("Unknown Model"),
- MANUFACTURER => "",
- DESCRIPTION => "",
- SERIALNUMBER => ""
- };
- while (my $l = <F>) {
- chomp $l;
- if (($l =~ /^\s*Manufacturer:\s*(\S.*)$/i) &&
- ($l =~ /^\s*Vendor:\s*(\S.*)$/i)) {
- $manufacturer = $1;
- $manufacturer =~ s/Hewlett[-\s_]Packard/HP/;
- $manufacturer =~ s/HEWLETT[-\s_]PACKARD/HP/;
- } elsif ($l =~ /^\s*Model:\s*(\S.*)$/i) {
- $model = $1;
- } elsif ($l =~ /^\s*Description:\s*(\S.*)$/i) {
- $description = $1;
- $description =~ s/Hewlett[-\s_]Packard/HP/;
- $description =~ s/HEWLETT[-\s_]PACKARD/HP/;
- } elsif ($l =~ /^\s*Serial\s*Number:\s*(\S.*)$/i) {
- $serialnumber = $1;
- }
- }
- close F;
-
- # Was there a manufacturer and a model in the output?
- # If not, get them from the description
- if (($manufacturer eq "") || ($model eq "")) {
- if ($description =~ /^\s*(\S*)\s+(\S.*)$/) {
- if ($manufacturer eq "") {
- $manufacturer = $1;
- }
- if ($model eq "") {
- $model = $2;
- }
- }
- # No description field? Make one out of manufacturer and model.
- } elsif ($description eq "") {
- $description = "$manufacturer $model";
- }
-
- # We couldn't determine a model
- if ($model eq "") {
- $model = N("Unknown Model");
- }
-
- # Remove trailing spaces
- $manufacturer =~ s/(\S+)\s+$/$1/;
- $model =~ s/(\S+)\s+$/$1/;
- $description =~ s/(\S+)\s+$/$1/;
- $serialnumber =~ s/(\S+)\s+$/$1/;
-
- # Now we have all info for one printer
- # Store this auto-detection result in the data structure
- return { CLASS => 'PRINTER',
- MODEL => $model,
- MANUFACTURER => $manufacturer,
- DESCRIPTION => $description,
- SERIALNUMBER => $serialnumber
- };
-}
-
-sub getSMBPrinterShares {
-
- my ($host) = @_;
-
- # SMB request to auto-detect shares
- local *F;
- open F, ($::testing ? "" : "chroot $prefix/ ") .
- "/bin/sh -c \"export LC_ALL=C; smbclient -N -L $host\" |" or return ();
- my $insharelist = 0;
- my @shares;
- while (my $l = <F>) {
- chomp $l;
- if ($l =~ /^\s*Sharename\s+Type\s+Comment\s*$/i) {
- $insharelist = 1;
- } elsif ($l =~ /^\s*Server\s+Comment\s*$/i) {
- $insharelist = 0;
- } elsif (($l =~ /^\s*(\S+)\s+Printer\s*(.*)$/i) &&
- ($insharelist)) {
- my $name = $1;
- my $description = $2;
- $description =~ s/^(\s*)//;
- push (@shares, { name => $name, description => $description });
- }
- }
- close F;
-
- return @shares;
-}
-
-sub getIPsInLocalNetworks {
-
- # subroutine determines the list of all hosts reachable in the local
- # networks by means of pinging the broadcast addresses.
-
- # Return an empty list if no network is running
- if (!network_running()) {
- return ();
- }
-
- # Read the output of "ifconfig" to determine the broadcast addresses of
- # the local networks
- my $dev_is_localnet = 0;
- my @local_bcasts;
- my $current_bcast = "";
-
- local *IFCONFIG_OUT;
- open IFCONFIG_OUT, ($::testing ? "" : "chroot $prefix/ ") .
- "/bin/sh -c \"export LC_ALL=C; ifconfig\" |" or return ();
- while (my $readline = <IFCONFIG_OUT>) {
- # New entry ...
- if ($readline =~ /^(\S+)\s/) {
- my $dev = $1;
- # ... for a local network (eth = ethernet,
- # vmnet = VMWare,
- # ethernet card connected to ISP excluded)?
- $dev_is_localnet = (($dev =~ /^eth/) || ($dev =~ /^vmnet/));
- # delete previous address
- $current_bcast = "";
- }
- # Are we in the important line now?
- if ($readline =~ /\sBcast:([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\s/) {
- # Rip out the broadcast IP address
- $current_bcast = $1;
-
- # Are we in an entry for a local network?
- if ($dev_is_localnet == 1) {
- # Store current IP address
- push @local_bcasts, $current_bcast;
- }
- }
- }
- close(IFCONFIG_OUT);
-
- my @addresses;
- # Now ping all broadcast addresses and additionally "nmblookup" the
- # networks (to find Windows servers which do not answer to ping)
- foreach my $bcast (@local_bcasts) {
- local *F;
- open F, ($::testing ? "" : "chroot $prefix/ ") .
- "/bin/sh -c \"export LC_ALL=C; ping -w 1 -b -n $bcast | cut -f 4 -d ' ' | sed s/:// | egrep '^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+' | uniq | sort\" |"
- or next;
- local $_;
- while (<F>) { chomp; push @addresses, $_ }
- close F;
- if (-x "/usr/bin/nmblookup") {
- local *F;
- open F, ($::testing ? "" : "chroot $prefix/ ") .
- "/bin/sh -c \"export LC_ALL=C; nmblookup -B $bcast \\* | cut -f 1 -d ' ' | egrep '^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+' | uniq | sort\" |"
- or next;
- local $_;
- while (<F>) { chomp;
- push @addresses, $_ if !(member($_,@addresses)) }
- }
- }
-
- @addresses;
-}
-
-sub whatNetPrinter {
-
- my ($network, $smb) = @_;
-
- my $i;
- my @res;
-
- # Which ports should be scanned?
- my @portstoscan;
- push @portstoscan, "139" if $smb;
- push @portstoscan, "4010", "4020", "4030", "5503", "9100-9104" if $network;
-
- return () if $#portstoscan < 0;
- my $portlist = join (",", @portstoscan);
-
- # Which hosts should be scanned?
- # (Applying nmap to a whole network is very time-consuming, because nmap
- # waits for a certain timeout period on non-existing hosts, so we get a
- # lists of existing hosts by pinging the broadcast addresses for existing
- # hosts and then scanning only them, which is much faster)
- my @hostips = getIPsInLocalNetworks();
- return () if $#hostips < 0;
- my $hostlist = join (" ", @hostips);
-
- # Scan network for printers, the timeout settings are there to avoid
- # delays caused by machines blocking their ports with a firewall
- local *F;
- open F, ($::testing ? "" : "chroot $prefix/ ") .
- "/bin/sh -c \"export LC_ALL=C; nmap -r -P0 --host_timeout 400 --initial_rtt_timeout 200 -p $portlist $hostlist\" |"
- or return @res;
- my $host = "";
- my $ip = "";
- my $port = "";
- my $modelinfo = "";
- while (my $line = <F>) {
- chomp $line;
-
- # head line of the report of a host with the ports in question open
- #if ($line =~ m/^\s*Interesting\s+ports\s+on\s+(\S*)\s*\(([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\)\s*:\s*$/i) {
- if ($line =~ m/^\s*Interesting\s+ports\s+on\s+(\S*)\s*\((\S+)\)\s*:\s*$/i) {
- $host = $1;
- $ip = $2;
- if ($host eq "") {
- $host = $ip;
- }
- $port = "";
-
- undef $modelinfo;
-
- } elsif ($line =~ m/^\s*(\d+)\/\S+\s+open\s+/i) {
- next if $ip eq "";
- $port = $1;
-
- # Now we have all info for one printer
- # Store this auto-detection result in the data structure
-
- # Determine the protocol by the port number
-
- # SMB/Windows
- if ($port eq "139") {
- my @shares = getSMBPrinterShares($ip);
- foreach my $share (@shares) {
- push @res, { port => "smb://$host/$share->{name}",
- val => { CLASS => 'PRINTER',
- MODEL => N("Unknown Model"),
- MANUFACTURER => "",
- DESCRIPTION =>
- "$share->{description}",
- SERIALNUMBER => ""
- }
- };
- }
- } else {
- if (!defined($modelinfo)) {
- # SNMP request to auto-detect model
- $modelinfo = getSNMPModel ($ip);
- }
- if (defined($modelinfo)) {
- push @res, { port => "socket://$host:$port",
- val => $modelinfo
- };
- }
- }
- }
- }
- close F;
- @res;
-}
sub spooler_in_security_level {
# Was the current spooler already added to the current security level?
@@ -626,41 +174,6 @@ sub add_spooler_to_security_level {
return 1;
}
-sub files_exist {
- my @files = @_;
- foreach my $file (@files) {
- return 0 if ! -f "$prefix$file";
- }
- return 1;
-}
-
-sub set_alternative {
- my ($command, $executable) = @_;
- local *F;
- # Read the list of executables for the given command to find the number
- # of the desired executable
- open F, ($::testing ? $prefix : "chroot $prefix/ ") .
- "/bin/sh -c \"export LC_ALL=C; /bin/echo | update-alternatives --config $command \" |" or
- die "Could not run \"update-alternatives\"!";
- my $choice = 0;
- while (my $line = <F>) {
- chomp $line;
- if ($line =~ m/^[\* ][\+ ]\s*([0-9]+)\s+(\S+)\s*$/) { # list entry?
- if ($2 eq $executable) {
- $choice = $1;
- last;
- }
- }
- }
- close F;
- # If the executable was found, assign the command to it
- if ($choice > 0) {
- system(($::testing ? $prefix : "chroot $prefix/ ") .
- "/bin/sh -c \"/bin/echo $choice | update-alternatives --config $command > /dev/null 2>&1\"");
- }
- return 1;
-}
-
sub pdq_panic_button {
my $setting = $_[0];
if (-f "$prefix/usr/sbin/pdqpanicbutton") {
@@ -707,7 +220,7 @@ sub read_configured_queues($) {
my ($printer) = @_;
my @QUEUES;
# Get the default spooler choice from the config file
- $printer->{SPOOLER} ||= get_default_spooler();
+ $printer->{SPOOLER} ||= printer::default::get_spooler();
if (!$printer->{SPOOLER}) {
#- Find the first spooler where there are queues
foreach my $spooler (qw(cups pdq lprng lpd)) {
@@ -717,9 +230,7 @@ sub read_configured_queues($) {
$service = "lpd";
}
if ($service ne "pdq") {
- if (!service_running($service)) {
- next;
- }
+ next unless services::is_service_running($service);
# daemon is running, spooler found
$printer->{SPOOLER} = $spooler;
}
@@ -1205,7 +716,7 @@ sub set_cups_autoconf {
output($file, @file_content);
# Restart CUPS
- restart_service("cups");
+ printer::services::restart("cups");
return 1;
}
@@ -1259,28 +770,6 @@ sub get_usermode {
return 0;
}
-sub set_default_printer {
- my ($printer) = $_[0];
- run_program::rooted($prefix, "foomatic-configure",
- "-D", "-q", "-s", $printer->{SPOOLER},
- "-n", $printer->{DEFAULT}) or return 0;
- return 1;
-}
-
-sub get_default_printer {
- my $printer = $_[0];
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") .
- "foomatic-configure -Q -q -s $printer->{SPOOLER} |" or return undef;
- my $line;
- while ($line = <F>) {
- if ($line =~ m!^\s*<defaultqueue>(.*)</defaultqueue>\s*$!) {
- return $1;
- }
- }
- return undef;
-}
-
sub read_cupsd_conf {
cat_("$prefix/etc/cups/cupsd.conf");
}
@@ -1290,7 +779,7 @@ sub write_cupsd_conf {
output("$prefix/etc/cups/cupsd.conf", @cupsd_conf);
#- restart cups after updating configuration.
- restart_service("cups");
+ printer::services::restart("cups");
}
sub read_printers_conf {
@@ -1390,7 +879,7 @@ sub poll_ppd_base {
#- if cups continue to modify it (because it reads the ppd files available), the
#- poll_ppd_base program simply cores :-)
run_program::rooted($prefix, "ifconfig lo 127.0.0.1"); #- else cups will not be happy! and ifup lo don't run ?
- start_not_running_service("cups");
+ printer::services::start_not_running_service("cups");
my $driversthere = scalar(keys %thedb);
foreach (1..60) {
local *PPDS; open PPDS, ($::testing ? $prefix : "chroot $prefix/ ") . "/usr/bin/poll_ppd_base -a |";
@@ -1591,7 +1080,7 @@ sub restart_queue($) {
foreach ($printer->{SPOOLER}) {
/cups/ && do {
#- restart cups.
- restart_service("cups");
+ printer::services::restart("cups");
last };
/lpr|lprng/ && do {
#- restart lpd.
@@ -1600,7 +1089,7 @@ sub restart_queue($) {
kill 'TERM', $pidlpd if $pidlpd;
unlink "$prefix$_";
}
- restart_service("lpd"); sleep 1;
+ printer::services::restart("lpd"); sleep 1;
last };
}
# Kill the jobs
@@ -1846,7 +1335,7 @@ sub configure_hpoj {
($device =~ /\/dev\/lp/) ||
($device =~ /printers/)) {
$bus = "par";
- $address_arg = parport_addr($device);
+ $address_arg = printer::detect::parport_addr($device);
$address_arg =~ /^\s*-base\s+(\S+)/;
eval ("$base_address = $1");
} elsif ($device =~ /socket/) {
@@ -1877,7 +1366,7 @@ sub configure_hpoj {
# Check if the device is really an HP multi-function device
if ($bus ne "hpjd") {
# Start ptal-mlcd daemon for locally connected devices
- stop_service("hpoj");
+ services::stop("hpoj");
run_program::rooted($prefix,
"ptal-mlcd", "$bus:probe", "-device",
$device, split(' ',$address_arg));
@@ -1926,7 +1415,7 @@ sub configure_hpoj {
}
close F;
}
- start_service("hpoj");
+ printer::services::start("hpoj");
}
last;
}
@@ -2089,31 +1578,12 @@ sub configure_hpoj {
readOneDevice ($ptaldevice);
# Restart HPOJ
- restart_service("hpoj");
+ printer::services::restart("hpoj");
# Return HPOJ device name to form the URI
return $ptaldevice;
}
-sub parport_addr {
- # auto-detect the parallel port addresses
- my ($device) = @_;
- $device =~ m!^/dev/lp(\d+)$! or
- $device =~ m!^/dev/printers/(\d+)$!;
- my $portnumber = $1;
- my $parport_addresses =
- `cat /proc/sys/dev/parport/parport$portnumber/base-addr`;
- my $address_arg;
- if ($parport_addresses =~ /^\s*(\d+)\s+(\d+)\s*$/) {
- $address_arg = sprintf(" -base 0x%x -basehigh 0x%x", $1, $2);
- } elsif ($parport_addresses =~ /^\s*(\d+)\s*$/) {
- $address_arg = sprintf(" -base 0x%x", $1);
- } else {
- $address_arg = "";
- }
- return $address_arg;
-}
-
sub config_sane {
# Add HPOJ backend to /etc/sane.d/dll.conf if needed (no individual
# config file /etc/sane.d/hpoj.conf necessary, the HPOJ driver finds the
@@ -2192,33 +1662,33 @@ RIGHTDRIVE=\" \"
sub configureapplications {
my ($printer) = @_;
setcupslink ($printer);
- configurestaroffice($printer);
- configureopenoffice($printer);
- configuregimp($printer);
+ printer::office::configureoffice('Star Office', $printer);
+ printer::office::configureoffice('OpenOffice.Org', $printer);
+ printer::gimp::configure($printer);
}
sub addcupsremotetoapplications {
my ($printer, $queue) = @_;
setcupslink ($printer);
- return (addcupsremotetostaroffice($printer, $queue) &&
- addcupsremotetoopenoffice($printer, $queue) &&
- addcupsremotetogimp($printer, $queue));
+ return (printer::office::add_cups_remote_to_office('Star Office', $printer, $queue) &&
+ printer::office::add_cups_remote_to_office('OpenOffice.Org', $printer, $queue) &&
+ printer::gimp::addcupsremoteto($printer, $queue));
}
sub removeprinterfromapplications {
my ($printer, $queue) = @_;
setcupslink ($printer);
- return (removeprinterfromstaroffice($printer, $queue) &&
- removeprinterfromopenoffice($printer, $queue) &&
- removeprinterfromgimp($printer, $queue));
+ return (printer::office::remove_printer_from_office('Star Office', $printer, $queue) &&
+ printer::office::remove_printer_from_office('OpenOffice.Org', $printer, $queue) &&
+ printer::gimp::removeprinterfrom($printer, $queue));
}
sub removelocalprintersfromapplications {
my ($printer) = @_;
setcupslink ($printer);
- removelocalprintersfromstaroffice($printer);
- removelocalprintersfromopenoffice($printer);
- removelocalprintersfromgimp($printer);
+ printer::office::remove_local_printers_from_office('Star Office', $printer);
+ printer::office::remove_local_printers_from_office('OpenOffice.Org', $printer);
+ printer::gimp::removelocalprintersfrom($printer);
}
sub setcupslink {
@@ -2230,1077 +1700,5 @@ sub setcupslink {
return 1;
}
-sub getcupsremotequeues {
- # The following code reads in a list of all remote printers which the
- # local CUPS daemon knows due to broadcasting of remote servers or
- # "BrowsePoll" entries in the local /etc/cups/cupsd.conf
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") .
- "lpstat -v |" or return ();
- my @printerlist;
- my $line;
- while ($line = <F>) {
- if ($line =~ m/^\s*device\s+for\s+([^:\s]+):\s*(\S+)\s*$/) {
- my $queuename = $1;
- if (($2 =~ m!^ipp://([^/:]+)[:/]!) &&
- (!$printer->{configured}{$queuename})) {
- my $server = $1;
- push (@printerlist, "$queuename|$server");
- }
- }
- }
- close F;
- return @printerlist;
-}
-
-# ------------------------------------------------------------------
-# Star Offica/OpenOffice.org
-# ------------------------------------------------------------------
-
-sub configurestaroffice {
- my ($printer) = @_;
- # Do we have Star Office installed?
- my $configfilename = findsofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/xp3/Xpdefaults$!;
- my $configprefix = $1;
- # Load Star Office printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Update remote CUPS queues
- if (0 && ($printer->{SPOOLER} eq "cups") &&
- ((-x "$prefix/usr/bin/curl") || (-x "$prefix/usr/bin/wget"))) {
- my @printerlist = getcupsremotequeues();
- foreach my $listentry (@printerlist) {
- next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
- my $queue = $1;
- my $server = $2;
- if (-x "$prefix/usr/bin/wget") {
- eval(run_program::rooted
- ($prefix, "/usr/bin/wget", "-O",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$queue.ppd"));
- } else {
- eval(run_program::rooted
- ($prefix, "/usr/bin/curl", "-o",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$queue.ppd"));
- }
- if (-r "$prefix/etc/foomatic/$queue.ppd") {
- $configfilecontent =
- makestarofficeprinterentry($printer, $queue,
- $configprefix,
- $configfilecontent);
- }
- }
- }
- # Update local printer queues
- foreach my $queue (keys(%{$printer->{configured}})) {
- # Check if we have a PPD file
- if (! -r "$prefix/etc/foomatic/$queue.ppd") {
- if (-r "$prefix/etc/cups/ppd/$queue.ppd") {
- # If we have a PPD file in the CUPS config dir, link to it
- run_program::rooted($prefix,
- "ln", "-sf",
- "/etc/cups/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } elsif (-r "$prefix/usr/share/postscript/ppd/$queue.ppd") {
- # Check PPD directory of GPR, too
- run_program::rooted($prefix,
- "ln", "-sf",
- "/usr/share/postscript/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } else {
- # No PPD file at all? We cannot set up this printer
- next;
- }
- }
- $configfilecontent =
- makestarofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- }
- # Patch PostScript output to print Euro symbol correctly also for
- # the "Generic Printer"
- $configfilecontent = removeentry
- ("ports", "default_queue=", $configfilecontent);
- $configfilecontent = addentry
- ("ports",
- "default_queue=/usr/bin/perl -p -e \"s=16#80 /euro=16#80 /Euro=\" | /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}}",
- $configfilecontent);
- # Write back Star Office configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub configureopenoffice {
- my ($printer) = @_;
- # Do we have OpenOffice.org installed?
- my $configfilename = findopenofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/psprint/psprint.conf$!;
- my $configprefix = $1;
- # Load OpenOffice.org printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Update remote CUPS queues
- if (0 && ($printer->{SPOOLER} eq "cups") &&
- ((-x "$prefix/usr/bin/curl") || (-x "$prefix/usr/bin/wget"))) {
- my @printerlist = getcupsremotequeues();
- foreach my $listentry (@printerlist) {
- next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
- my $queue = $1;
- my $server = $2;
- if (-x "$prefix/usr/bin/wget") {
- eval(run_program::rooted
- ($prefix, "/usr/bin/wget", "-O",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$queue.ppd"));
- } else {
- eval(run_program::rooted
- ($prefix, "/usr/bin/curl", "-o",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$queue.ppd"));
- }
- if (-r "$prefix/etc/foomatic/$queue.ppd") {
- $configfilecontent =
- makeopenofficeprinterentry($printer, $queue,
- $configprefix,
- $configfilecontent);
- }
- }
- }
- # Update local printer queues
- foreach my $queue (keys(%{$printer->{configured}})) {
- # Check if we have a PPD file
- if (! -r "$prefix/etc/foomatic/$queue.ppd") {
- if (-r "$prefix/etc/cups/ppd/$queue.ppd") {
- # If we have a PPD file in the CUPS config dir, link to it
- run_program::rooted($prefix,
- "ln", "-sf",
- "/etc/cups/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } elsif (-r "$prefix/usr/share/postscript/ppd/$queue.ppd") {
- # Check PPD directory of GPR, too
- run_program::rooted($prefix,
- "ln", "-sf",
- "/usr/share/postscript/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } else {
- # No PPD file at all? We cannot set up this printer
- next;
- }
- }
- $configfilecontent =
- makeopenofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- }
- # Patch PostScript output to print Euro symbol correctly also for
- # the "Generic Printer"
- $configfilecontent = removeentry
- ("Generic Printer", "Command=", $configfilecontent);
- $configfilecontent = addentry
- ("Generic Printer",
- "Command=/usr/bin/perl -p -e \"s=/euro /unused=/Euro /unused=\" | /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}}",
- $configfilecontent);
- # Write back OpenOffice.org configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub addcupsremotetostaroffice {
- my ($printer, $queue) = @_;
- # Do we have Star Office installed?
- my $configfilename = findsofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/xp3/Xpdefaults$!;
- my $configprefix = $1;
- # Load Star Office printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Update remote CUPS queues
- if (($printer->{SPOOLER} eq "cups") &&
- ((-x "$prefix/usr/bin/curl") || (-x "$prefix/usr/bin/wget"))) {
- my @printerlist = getcupsremotequeues();
- foreach my $listentry (@printerlist) {
- next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
- my $q = $1;
- next if $q ne $queue;
- my $server = $2;
- # Remove server name from queue name
- $q =~ s/^([^@]*)@.*$/$1/;
- if (-x "$prefix/usr/bin/wget") {
- eval(run_program::rooted
- ($prefix, "/usr/bin/wget", "-O",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- } else {
- eval(run_program::rooted
- ($prefix, "/usr/bin/curl", "-o",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- }
- # Does the file exist and is it not an error message?
- if ((-r "$prefix/etc/foomatic/$queue.ppd") &&
- (cat_("$prefix/etc/foomatic/$queue.ppd") =~
- /^\*PPD-Adobe/)) {
- $configfilecontent =
- makestarofficeprinterentry($printer, $queue,
- $configprefix,
- $configfilecontent);
- } else {
- unlink ("$prefix/etc/foomatic/$queue.ppd");
- return 0;
- }
- last;
- }
- }
- # Write back Star Office configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub addcupsremotetoopenoffice {
- my ($printer, $queue) = @_;
- # Do we have OpenOffice.org installed?
- my $configfilename = findopenofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/psprint/psprint.conf$!;
- my $configprefix = $1;
- # Load OpenOffice.org printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Update remote CUPS queues
- if (($printer->{SPOOLER} eq "cups") &&
- ((-x "$prefix/usr/bin/curl") || (-x "$prefix/usr/bin/wget"))) {
- my @printerlist = getcupsremotequeues();
- foreach my $listentry (@printerlist) {
- next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
- my $q = $1;
- next if $q ne $queue;
- my $server = $2;
- # Remove server name from queue name
- $q =~ s/^([^@]*)@.*$/$1/;
- if (-x "$prefix/usr/bin/wget") {
- eval(run_program::rooted
- ($prefix, "/usr/bin/wget", "-O",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- } else {
- eval(run_program::rooted
- ($prefix, "/usr/bin/curl", "-o",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- }
- # Does the file exist and is it not an error message?
- if ((-r "$prefix/etc/foomatic/$queue.ppd") &&
- (cat_("$prefix/etc/foomatic/$queue.ppd") =~
- /^\*PPD-Adobe/)) {
- $configfilecontent =
- makeopenofficeprinterentry($printer, $queue,
- $configprefix,
- $configfilecontent);
- } else {
- unlink ("$prefix/etc/foomatic/$queue.ppd");
- return 0;
- }
- }
- }
- # Write back OpenOffice.org configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub removeprinterfromstaroffice {
- my ($printer, $queue) = @_;
- # Do we have Star Office installed?
- my $configfilename = findsofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/xp3/Xpdefaults$!;
- my $configprefix = $1;
- # Load Star Office printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Remove the printer entry
- $configfilecontent =
- removestarofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- # Write back Star Office configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub removeprinterfromopenoffice {
- my ($printer, $queue) = @_;
- # Do we have OpenOffice.org installed?
- my $configfilename = findopenofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/psprint/psprint.conf$!;
- my $configprefix = $1;
- # Load OpenOffice.org printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Remove the printer entry
- $configfilecontent =
- removeopenofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- # Write back OpenOffice.org configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub removelocalprintersfromstaroffice {
- my ($printer) = @_;
- # Do we have Star Office installed?
- my $configfilename = findsofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/xp3/Xpdefaults$!;
- my $configprefix = $1;
- # Load Star Office printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Remove the printer entries
- foreach my $queue (keys(%{$printer->{configured}})) {
- $configfilecontent =
- removestarofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- }
- # Write back Star Office configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub removelocalprintersfromopenoffice {
- my ($printer) = @_;
- # Do we have OpenOffice.org installed?
- my $configfilename = findopenofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/psprint/psprint.conf$!;
- my $configprefix = $1;
- # Load OpenOffice.org printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Remove the printer entries
- foreach my $queue (keys(%{$printer->{configured}})) {
- $configfilecontent =
- removeopenofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- }
- # Write back OpenOffice.org configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub makestarofficeprinterentry {
- my ($printer, $queue, $configprefix, $configfile) = @_;
- # Set default printer
- if ($queue eq $printer->{DEFAULT}) {
- $configfile = removeentry("windows", "device=", $configfile);
- $configfile = addentry("windows",
- "device=$queue,$queue PostScript,$queue",
- $configfile);
- }
- # Make an entry in the "[devices]" section
- $configfile = removeentry("devices", "$queue=", $configfile);
- $configfile = addentry("devices",
- "$queue=$queue PostScript,$queue",
- $configfile);
- # Make an entry in the "[ports]" section
- # The "perl" command patches the PostScript output to print the Euro
- # symbol correctly.
- $configfile = removeentry("ports", "$queue=", $configfile);
- $configfile = addentry("ports",
- "$queue=/usr/bin/perl -p -e \"s=16#80 /euro=16#80 /Euro=\" | /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}} -P $queue",
- $configfile);
- # Make printer's section
- $configfile = addsection("$queue,PostScript,$queue", $configfile);
- # Load PPD file
- my $ppd = cat_("$prefix/etc/foomatic/$queue.ppd");
- # Set the PostScript level
- my $pslevel;
- if ($ppd =~ /^\s*\*LanguageLevel:\s*\"?([^\s\"]+)\"?\s*$/m) {
- $pslevel = $1;
- $pslevel = "2" if $pslevel eq "3";
- } else {
- $pslevel = "2";
- }
- $configfile = removeentry("$queue.PostScript.$queue",
- "Level=", $configfile);
- $configfile = addentry("$queue.PostScript.$queue",
- "Level=$pslevel", $configfile);
- # Set Color/BW
- my $color;
- if ($ppd =~ /^\s*\*ColorDevice:\s*\"?([Tt]rue)\"?\s*$/m) {
- $color = "1";
- } else {
- $color = "0";
- }
- $configfile = removeentry("$queue.PostScript.$queue",
- "BitmapColor=", $configfile);
- $configfile = addentry("$queue.PostScript.$queue",
- "BitmapColor=$color", $configfile);
- # Set the default paper size
- if ($ppd =~ /^\s*\*DefaultPageSize:\s*(\S+)\s*$/m) {
- my $papersize = $1;
- $configfile = removeentry("$queue.PostScript.$queue",
- "PageSize=", $configfile);
- $configfile = removeentry("$queue.PostScript.$queue",
- "PPD_PageSize=", $configfile);
- $configfile = addentry("$queue.PostScript.$queue",
- "PageSize=$papersize", $configfile);
- $configfile = addentry("$queue.PostScript.$queue",
- "PPD_PageSize=$papersize", $configfile);
- }
- # Link the PPD file
- run_program::rooted($prefix,
- "ln", "-sf", "/etc/foomatic/$queue.ppd",
- "$configprefix/share/xp3/ppds/$queue.PS");
- return $configfile;
-}
-
-sub makeopenofficeprinterentry {
- my ($printer, $queue, $configprefix, $configfile) = @_;
- # Make printer's section
- $configfile = addsection($queue, $configfile);
- # Load PPD file
- my $ppd = cat_("$prefix/etc/foomatic/$queue.ppd");
- # "PPD_PageSize" line
- if ($ppd =~ /^\s*\*DefaultPageSize:\s*(\S+)\s*$/m) {
- my $papersize = $1;
- $configfile = removeentry($queue,
- "PPD_PageSize=", $configfile);
- $configfile = addentry($queue,
- "PPD_PageSize=$papersize", $configfile);
- }
- # "Command" line
- # The "perl" command patches the PostScript output to print the Euro
- # symbol correctly.
- $configfile = removeentry($queue, "Command=", $configfile);
- $configfile = addentry($queue,
- "Command=/usr/bin/perl -p -e \"s=/euro /unused=/Euro /unused=\" | /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}} -P $queue",
- $configfile);
- # "Comment" line
- $configfile = removeentry($queue, "Comment=", $configfile);
- if (($printer->{configured}{$queue}) &&
- ($printer->{configured}{$queue}{queuedata}{desc})) {
- $configfile = addentry
- ($queue,
- "Comment=$printer->{configured}{$queue}{queuedata}{desc}",
- $configfile);
- } else {
- $configfile = addentry($queue,
- "Comment=",
- $configfile);
- }
- # "Location" line
- $configfile = removeentry($queue, "Location=", $configfile);
- if (($printer->{configured}{$queue}) &&
- ($printer->{configured}{$queue}{queuedata}{loc})) {
- $configfile = addentry
- ($queue,
- "Location=$printer->{configured}{$queue}{queuedata}{loc}",
- $configfile);
- } else {
- $configfile = addentry($queue,
- "Location=",
- $configfile);
- }
- # "DefaultPrinter" line
- $configfile = removeentry($queue, "DefaultPrinter=", $configfile);
- my $default = "0";
- if ($queue eq $printer->{DEFAULT}) {
- $default = "1";
- # "DefaultPrinter=0" for the "Generic Printer"
- $configfile = removeentry("Generic Printer", "DefaultPrinter=",
- $configfile);
- $configfile = addentry("Generic Printer",
- "DefaultPrinter=0",
- $configfile);
- }
- $configfile = addentry($queue,
- "DefaultPrinter=$default",
- $configfile);
- # "Printer" line
- $configfile = removeentry($queue, "Printer=", $configfile);
- $configfile = addentry($queue,
- "Printer=$queue/$queue",
- $configfile);
- # Link the PPD file
- run_program::rooted($prefix,
- "ln", "-sf", "/etc/foomatic/$queue.ppd",
- "$configprefix/share/psprint/driver/$queue.PS");
- return $configfile;
-}
-
-sub removestarofficeprinterentry {
- my ($printer, $queue, $configprefix, $configfile) = @_;
- # Remove default printer entry
- $configfile = removeentry("windows", "device=$queue,", $configfile);
- # Remove entry in the "[devices]" section
- $configfile = removeentry("devices", "$queue=", $configfile);
- # Remove entry in the "[ports]" section
- $configfile = removeentry("ports", "$queue=", $configfile);
- # Remove "[$queue,PostScript,$queue]" section
- $configfile = removesection("$queue,PostScript,$queue", $configfile);
- # Remove Link of PPD file
- run_program::rooted($prefix,
- "rm", "-f",
- "$configprefix/share/xp3/ppds/$queue.PS");
- return $configfile;
-}
-
-sub removeopenofficeprinterentry {
- my ($printer, $queue, $configprefix, $configfile) = @_;
- # Remove printer's section
- $configfile = removesection($queue, $configfile);
- # Remove Link of PPD file
- run_program::rooted($prefix,
- "rm", "-f",
- "$configprefix/share/psprint/driver/$queue.PS");
- return $configfile;
-}
-
-sub findsofficeconfigfile {
- my @configfilenames =
- ("/usr/lib/*/share/xp3/Xpdefaults",
- "/usr/local/lib/*/share/xp3/Xpdefaults",
- "/usr/local/*/share/xp3/Xpdefaults",
- "/opt/*/share/xp3/Xpdefaults");
- foreach my $configfilename (@configfilenames) {
- local *F;
- if (open F, "ls -r $prefix$configfilename 2> /dev/null |") {
- my $filename = <F>;
- close F;
- if ($filename) {
- if ($prefix ne "") {
- $filename =~ s/^$prefix//;
- }
- # Work around a bug in the "ls" of "busybox". During
- # installation it outputs the mask given on the command line
- # instead of nothing when the mask does not match any file
- next if $filename =~ /\*/;
- return $filename;
- }
- }
- }
- return "";
-}
-
-sub findopenofficeconfigfile {
- my @configfilenames =
- ("/usr/lib/*/share/psprint/psprint.conf",
- "/usr/local/lib/*/share/psprint/psprint.conf",
- "/usr/local/*/share/psprint/psprint.conf",
- "/opt/*/share/psprint/psprint.conf");
- foreach my $configfilename (@configfilenames) {
- local *F;
- if (open F, "ls -r $prefix$configfilename 2> /dev/null |") {
- my $filename = <F>;
- close F;
- if ($filename) {
- if ($prefix ne "") {
- $filename =~ s/^$prefix//;
- }
- # Work around a bug in the "ls" of "busybox". During
- # installation it outputs the mask given on the command line
- # instead of nothing when the mask does not match any file
- next if $filename =~ /\*/;
- return $filename;
- }
- }
- }
- return "";
-}
-
-sub readsofficeconfigfile {
- my ($file) = @_;
- local *F;
- open F, "< $prefix$file" or return "";
- my $filecontent = join("", <F>);
- close F;
- return $filecontent;
-}
-
-sub writesofficeconfigfile {
- my ($file, $filecontent) = @_;
- local *F;
- open F, "> $prefix$file" or return 0;
- print F $filecontent;
- close F;
- return 1;
-}
-
-sub addentry {
- my ($section, $entry, $filecontent) = @_;
- my $sectionfound = 0;
- my $entryinserted = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- if (!$sectionfound) {
- if (/^\s*\[\s*$section\s*\]\s*$/) {
- $sectionfound = 1;
- }
- } else {
- if (!/^\s*$/ && !/^\s*;/) { #-#
- $_ = "$entry\n$_";
- $entryinserted = 1;
- last;
- }
- }
- }
- if ($sectionfound && !$entryinserted) {
- push(@lines, $entry);
- }
- return join ("\n", @lines);
-}
-
-sub addsection {
- my ($section, $filecontent) = @_;
- my $entryinserted = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- if (/^\s*\[\s*$section\s*\]\s*$/) {
- # section already there, nothing to be done
- return $filecontent;
- }
- }
- return $filecontent . "\n[$section]";
-}
-
-sub removeentry {
- my ($section, $entry, $filecontent) = @_;
- my $sectionfound = 0;
- my $done = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- $_ = "$_\n";
- next if $done;
- if (!$sectionfound) {
- if (/^\s*\[\s*$section\s*\]\s*$/) {
- $sectionfound = 1;
- }
- } else {
- if (/^\s*\[.*\]\s*$/) { # Next section
- $done = 1;
- } elsif (/^\s*$entry/) {
- $_ = "";
- $done = 1;
- }
- }
- }
- return join ("", @lines);
-}
-
-sub removesection {
- my ($section, $filecontent) = @_;
- my $sectionfound = 0;
- my $done = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- $_ = "$_\n";
- next if $done;
- if (!$sectionfound) {
- if (/^\s*\[\s*$section\s*\]\s*$/) {
- $_ = "";
- $sectionfound = 1;
- }
- } else {
- if (/^\s*\[.*\]\s*$/) { # Next section
- $done = 1;
- } else {
- $_ = "";
- }
- }
- }
- return join ("", @lines);
-}
-
-# ------------------------------------------------------------------
-# GIMP
-# ------------------------------------------------------------------
-
-sub configuregimp {
- my ($printer, $queue) = @_;
- # Do we have files to treat?
- my @configfilenames = findgimpconfigfiles();
- return 1 if $#configfilenames < 0;
- # There is no system-wide config file, treat every user's config file
- foreach my $configfilename (@configfilenames) {
- # Load GIMP's printer config file
- my $configfilecontent = readgimpconfigfile($configfilename);
- # Update local printer queues
- foreach my $queue (keys(%{$printer->{configured}})) {
- # Check if we have a PPD file
- if (! -r "$prefix/etc/foomatic/$queue.ppd") {
- if (-r "$prefix/etc/cups/ppd/$queue.ppd") {
- # If we have a PPD file in the CUPS config dir, link to it
- run_program::rooted($prefix,
- "ln", "-sf",
- "/etc/cups/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } elsif (-r "$prefix/usr/share/postscript/ppd/$queue.ppd") {
- # Check PPD directory of GPR, too
- run_program::rooted
- ($prefix,
- "ln", "-sf",
- "/usr/share/postscript/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } else {
- # No PPD file at all? We cannot set up this printer
- next;
- }
- }
- # Add the printer entry
- if (!isgimpprinterconfigured ($queue, $configfilecontent)) {
- # Remove the old printer entry
- $configfilecontent =
- removegimpprinter($queue, $configfilecontent);
- # Add the new printer entry
- $configfilecontent =
- makegimpprinterentry($printer, $queue,
- $configfilecontent);
- }
- }
- # Default printer
- if ($printer->{DEFAULT}) {
- if ($configfilecontent !~ /^\s*Current\-Printer\s*:/m) {
- $configfilecontent =~
- s/\n/\nCurrent-Printer: $printer->{DEFAULT}\n/s;
- } else {
- $configfilecontent =~ /^\s*Current\-Printer\s*:\s*(\S+)\s*$/m;
- if (!isgimpprinterconfigured ($1, $configfilecontent)) {
- $configfilecontent =~
- s/(Current\-Printer\s*:\s*)\S+/$1$printer->{DEFAULT}/;
- }
- }
- }
- # Write back GIMP's printer configuration file
- writegimpconfigfile($configfilename, $configfilecontent);
- }
- return 1;
-}
-
-sub addcupsremotetogimp {
- my ($printer, $queue) = @_;
- # Do we have files to treat?
- my @configfilenames = findgimpconfigfiles();
- return 1 if $#configfilenames < 0;
- my @printerlist = getcupsremotequeues();
- my $ppdfile = "";
- if (($printer->{SPOOLER} eq "cups") &&
- ((-x "$prefix/usr/bin/curl") || (-x "$prefix/usr/bin/wget"))) {
- foreach my $listentry (@printerlist) {
- next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
- my $q = $1;
- next if $q ne $queue;
- my $server = $2;
- # Remove server name from queue name
- $q =~ s/^([^@]*)@.*$/$1/;
- if (-x "$prefix/usr/bin/wget") {
- eval(run_program::rooted
- ($prefix, "/usr/bin/wget", "-O",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- } else {
- eval(run_program::rooted
- ($prefix, "/usr/bin/curl", "-o",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- }
- # Does the file exist and is it not an error message?
- if ((-r "$prefix/etc/foomatic/$queue.ppd") &&
- (cat_("$prefix/etc/foomatic/$queue.ppd") =~
- /^\*PPD-Adobe/)) {
- $ppdfile = "/etc/foomatic/$queue.ppd";
- } else {
- unlink ("$prefix/etc/foomatic/$queue.ppd");
- return 0;
- }
- }
- } else {
- return 1;
- }
- # There is no system-wide config file, treat every user's config file
- foreach my $configfilename (@configfilenames) {
- # Load GIMP's printer config file
- my $configfilecontent = readgimpconfigfile($configfilename);
- # Add the printer entry
- if (!isgimpprinterconfigured ($queue, $configfilecontent)) {
- # Remove the old printer entry
- $configfilecontent =
- removegimpprinter($queue, $configfilecontent);
- # Add the new printer entry
- $configfilecontent =
- makegimpprinterentry($printer, $queue,
- $configfilecontent);
- }
- # Write back GIMP's printer configuration file
- writegimpconfigfile($configfilename, $configfilecontent);
- }
- return 1;
-}
-
-sub removeprinterfromgimp {
- my ($printer, $queue) = @_;
- # Do we have files to treat?
- my @configfilenames = findgimpconfigfiles();
- return 1 if $#configfilenames < 0;
- # There is no system-wide config file, treat every user's config file
- foreach my $configfilename (@configfilenames) {
- # Load GIMP's printer config file
- my $configfilecontent = readgimpconfigfile($configfilename);
- # Remove the printer entry
- $configfilecontent =
- removegimpprinter($queue, $configfilecontent);
- # Write back GIMP's printer configuration file
- writegimpconfigfile($configfilename, $configfilecontent);
- }
- return 1;
-}
-
-sub removelocalprintersfromgimp {
- my ($printer) = @_;
- # Do we have files to treat?
- my @configfilenames = findgimpconfigfiles();
- return 1 if $#configfilenames < 0;
- # There is no system-wide config file, treat every user's config file
- foreach my $configfilename (@configfilenames) {
- # Load GIMP's printer config file
- my $configfilecontent = readgimpconfigfile($configfilename);
- # Remove the printer entries
- foreach my $queue (keys(%{$printer->{configured}})) {
- $configfilecontent =
- removegimpprinter($queue, $configfilecontent);
- }
- # Write back GIMP's printer configuration file
- writegimpconfigfile($configfilename, $configfilecontent);
- }
- return 1;
-}
-
-sub makegimpprinterentry {
- my ($printer, $queue, $configfile) = @_;
- # Make printer's section
- $configfile = addgimpprinter($queue, $configfile);
- # Load PPD file
- my $ppd = cat_("$prefix/etc/foomatic/$queue.ppd");
- # Is the printer configured with GIMP-Print?
- my $gimpprintqueue = 0;
- my $gimpprintdriver = "ps2";
- if ($ppd =~ /CUPS\s*\+\s*GIMP\s*\-\s*Print/im) {
- # Native CUPS driver
- $gimpprintqueue = 1;
- $ppd =~ /\s*\*ModelName:\s*\"(\S+)\"\s*$/im;
- $gimpprintdriver = $1;
- } elsif ($ppd =~ /Foomatic\s*\+\s*gimp\s*\-\s*print/im) {
- # GhostScript + Foomatic driver
- $gimpprintqueue = 1;
- $ppd =~
- /'idx'\s*=>\s*'ev\/gimp-print-((escp2|pcl|bjc|lexmark)\-\S*)'/im;
- $gimpprintdriver = $1;
- }
- if ($gimpprintqueue) {
- # Get the paper size from the PPD file
- if ($ppd =~ /^\s*\*DefaultPageSize:\s*(\S+)\s*$/m) {
- my $papersize = $1;
- $configfile = removegimpentry($queue,
- "Media-Size", $configfile);
- $configfile = addgimpentry($queue,
- "Media-Size: $papersize", $configfile);
- }
- $configfile = removegimpentry($queue,
- "PPD-File:", $configfile);
- $configfile = addgimpentry($queue,
- "PPD-File:", $configfile);
- $configfile = removegimpentry($queue,
- "Driver:", $configfile);
- $configfile = addgimpentry($queue,
- "Driver: $gimpprintdriver", $configfile);
- $configfile = removegimpentry($queue,
- "Destination:", $configfile);
- $configfile = addgimpentry($queue,
- "Destination: /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}} -P $queue -o raw", $configfile);
- } else {
- $configfile = removegimpentry($queue,
- "PPD-File:", $configfile);
- $configfile = addgimpentry($queue,
- "PPD-File: /etc/foomatic/$queue.ppd", $configfile);
- $configfile = removegimpentry($queue,
- "Driver:", $configfile);
- $configfile = addgimpentry($queue,
- "Driver: ps2", $configfile);
- $configfile = removegimpentry($queue,
- "Destination:", $configfile);
- $configfile = addgimpentry($queue,
- "Destination: /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}} -P $queue", $configfile);
- }
- return $configfile;
-}
-
-sub findgimpconfigfiles {
- my @configfilenames;
- if (-d "$prefix/usr/lib/gimp/1.2") {
- push (@configfilenames, ".gimp-1.2/printrc");
- }
- if (-d "$prefix/usr/lib/gimp/1.3") {
- push (@configfilenames, ".gimp-1.3/printrc");
- }
- my @filestotreat;
- local *PASSWD;
- open PASSWD, "< $prefix/etc/passwd" or die "Cannot read /etc/passwd!\n";
- local $_;
- while (<PASSWD>) {
- chomp;
- if (/^([^:]+):[^:]*:([^:]+):([^:]+):[^:]*:([^:]+):[^:]*$/) {
- my ($username, $uid, $gid, $homedir) = ($1, $2, $3, $4);
- if ((($uid == 0) || ($uid >= 500)) && ($username ne "nobody")) {
- foreach my $file (@configfilenames) {
- my $dir = "$homedir/$file";
- $dir =~ s,/[^/]*$,,;
- next if (-f $dir) && (! -d $dir);
- if (! -d "$prefix$dir") {
- run_program::rooted($prefix,
- "/bin/mkdir", $dir)
- or next;
- run_program::rooted($prefix,
- "/bin/chown", "$uid.$gid", $dir)
- or next;
- }
- if (! -f "$prefix$homedir/$file") {
- local *F;
- open F, "> $prefix$homedir/$file" or next;
- print F "#PRINTRCv1 written by GIMP-PRINT 4.2.2 - 13 Sep 2002\n";
- close F;
- run_program::rooted($prefix,
- "/bin/chown", "$uid.$gid",
- "$homedir/$file")
- or next;
- }
- push (@filestotreat, "$homedir/$file");
- }
- }
- }
- }
- @filestotreat;
-}
-
-sub readgimpconfigfile {
- my ($file) = @_;
- local *F;
- open F, "< $prefix$file" or return "";
- my $filecontent = join("", <F>);
- close F;
- return $filecontent;
-}
-
-sub writegimpconfigfile {
- my ($file, $filecontent) = @_;
- local *F;
- open F, "> $prefix$file" or return 0;
- print F $filecontent;
- close F;
- return 1;
-}
-
-sub addgimpentry {
- my ($section, $entry, $filecontent) = @_;
- my $sectionfound = 0;
- my $entryinserted = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- if (!$sectionfound) {
- if (/^\s*Printer\s*:\s*($section)\s*$/) {
- $sectionfound = 1;
- }
- } else {
- if (!/^\s*$/ && !/^\s*;/) { #-#
- $_ = "$entry\n$_";
- $entryinserted = 1;
- last;
- }
- }
- }
- if ($sectionfound && !$entryinserted) {
- push(@lines, $entry);
- }
- return join ("\n", @lines);
-}
-
-sub addgimpprinter {
- my ($section, $filecontent) = @_;
- my $entryinserted = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- if (/^\s*Printer\s*:\s*($section)\s*$/) {
- # section already there, nothing to be done
- return $filecontent;
- }
- }
- return $filecontent . "\nPrinter: $section";
-}
-
-sub removegimpentry {
- my ($section, $entry, $filecontent) = @_;
- my $sectionfound = 0;
- my $done = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- $_ = "$_\n";
- next if $done;
- if (!$sectionfound) {
- if (/^\s*Printer\s*:\s*($section)\s*$/) {
- $sectionfound = 1;
- }
- } else {
- if (/^\s*Printer\s*:\s*.*\s*$/) { # Next section
- $done = 1;
- } elsif (/^\s*$entry/) {
- $_ = "";
- $done = 1;
- }
- }
- }
- return join ("", @lines);
-}
-
-sub removegimpprinter {
- my ($section, $filecontent) = @_;
- my $sectionfound = 0;
- my $done = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- $_ = "$_\n";
- next if $done;
- if (!$sectionfound) {
- if (/^\s*Printer\s*:\s*($section)\s*$/) {
- $_ = "";
- $sectionfound = 1;
- }
- } else {
- if (/^\s*Printer\s*:\s*.*\s*$/) { # Next section
- $done = 1;
- } else {
- $_ = "";
- }
- }
- }
- return join ("", @lines);
-}
-
-sub isgimpprinterconfigured {
- my ($queue, $filecontent) = @_;
- my $sectionfound = 0;
- my $done = 0;
- my $drivernotps2 = 0;
- my $ppdfileset = 0;
- my $nonrawprinting = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- last if $done;
- if (!$sectionfound) {
- if (/^\s*Printer\s*:\s*($queue)\s*$/) {
- $sectionfound = 1;
- }
- } else {
- if (/^\s*Printer\s*:\s*.*\s*$/) { # Next section
- $done = 1;
- } elsif (/^\s*Driver:\s*(\S+)\s*$/) {
- $drivernotps2 = ($1 ne "ps2");
- } elsif (/^\s*PPD\-File:\s*(\S+)\s*$/) {
- $ppdfileset = 1;
- } elsif (/^\s*Destination:\s*(\S+.*)$/) {
- $nonrawprinting = ($1 !~ /\-o\s*raw/);
- }
- }
- }
- return 0 if $done && !$sectionfound;
- return 1 if $ppdfileset || $drivernotps2 || $nonrawprinting;
- return 0;
-}
-
-# ------------------------------------------------------------------
1;
diff --git a/perl-install/printer/office.pm b/perl-install/printer/office.pm
new file mode 100644
index 000000000..037d40601
--- /dev/null
+++ b/perl-install/printer/office.pm
@@ -0,0 +1,384 @@
+package printer::office;
+
+use strict;
+use common;
+use run_program;
+use printer::common;
+use printer::cups;
+
+# ------------------------------------------------------------------
+# Star Offica/OpenOffice.org
+# ------------------------------------------------------------------
+
+
+our %suites =
+ (
+ 'Star Office' => {
+ 'make' => \&makestarofficeprinterentry,
+ 'file_name' => '^(.*)/share/psprint/psprint.conf$',
+ 'param' => ["Generic Printer", "Command="],
+ 'perl' => "/usr/bin/perl -p -e \"s=16#80 /euro=16#80 /Euro=\" | /usr/bin/",
+ 'files' => [qw(/usr/lib/*/share/xp3/Xpdefaults
+ /usr/local/lib/*/share/xp3/Xpdefaults
+ /usr/local/*/share/xp3/Xpdefaults
+ /opt/*/share/xp3/Xpdefaults)]
+
+ },
+ 'OpenOffice.Org' => {
+ 'make' => \&makeopenofficeprinterentry,
+ 'file_name' => '^(.*)/share/xp3/Xpdefaults$',
+ 'param' => ["ports", "default_queue="],
+ 'perl' => "usr/bin/perl -p -e \"s=/euro /unused=/Euro /unused=\" | /usr/bin/",
+ 'files' => [qw(/usr/lib/*/share/psprint/psprint.conf
+ /usr/local/lib/*/share/psprint/psprint.conf
+ /usr/local/*/share/psprint/psprint.conf
+ /opt/*/share/psprint/psprint.conf)]
+ }
+ );
+
+sub configureoffice {
+ my ($suite, $printer) = @_;
+ # Do we have Star Office installed?
+ my $configfilename = find_config_file($suite);
+ return 1 if !$configfilename;
+ $configfilename =~ m!$suites{$suite}{file_name}!;
+ my $configprefix = $1;
+ # Load Star Office printer config file
+ my $configfilecontent = readsofficeconfigfile($configfilename);
+ # Update remote CUPS queues
+ if (0 && ($printer->{SPOOLER} eq "cups") &&
+ ((-x "$::prefix/usr/bin/curl") || (-x "$::prefix/usr/bin/wget"))) {
+ my @printerlist = printer::cups::get_remote_queues();
+ foreach my $listentry (@printerlist) {
+ next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
+ my $queue = $1;
+ my $server = $2;
+ if (-x "$::prefix/usr/bin/wget") {
+ eval(run_program::rooted
+ ($::prefix, "/usr/bin/wget", "-O",
+ "/etc/foomatic/$queue.ppd",
+ "http://$server:631/printers/$queue.ppd"));
+ } else {
+ eval(run_program::rooted
+ ($::prefix, "/usr/bin/curl", "-o",
+ "/etc/foomatic/$queue.ppd",
+ "http://$server:631/printers/$queue.ppd"));
+ }
+ if (-r "$::prefix/etc/foomatic/$queue.ppd") {
+ $configfilecontent = $suites{$suite}{make}($printer, $queue, $configprefix, $configfilecontent);
+ }
+ }
+ }
+ # Update local printer queues
+ foreach my $queue (keys(%{$printer->{configured}})) {
+ # Check if we have a PPD file
+ if (! -r "$::prefix/etc/foomatic/$queue.ppd") {
+ if (-r "$::prefix/etc/cups/ppd/$queue.ppd") {
+ # If we have a PPD file in the CUPS config dir, link to it
+ run_program::rooted($::prefix,
+ "ln", "-sf",
+ "/etc/cups/ppd/$queue.ppd",
+ "/etc/foomatic/$queue.ppd");
+ } elsif (-r "$::prefix/usr/share/postscript/ppd/$queue.ppd") {
+ # Check PPD directory of GPR, too
+ run_program::rooted($::prefix,
+ "ln", "-sf",
+ "/usr/share/postscript/ppd/$queue.ppd",
+ "/etc/foomatic/$queue.ppd");
+ } else {
+ # No PPD file at all? We cannot set up this printer
+ next;
+ }
+ }
+ $configfilecontent =
+ $suites{$suite}{make}($printer, $queue, $configprefix,
+ $configfilecontent);
+ }
+ # Patch PostScript output to print Euro symbol correctly also for
+ # the "Generic Printer"
+ my @parameters = $suites{$suite}{param};
+ $configfilecontent =printer::common::removeentry
+ (@parameters, $configfilecontent);
+ $configfilecontent =printer::common::addentry($parameters[0],$parameters[1] . $suites{$suite}{perl} . $printer::data::lprcommand{$printer->{SPOOLER}{print_command}}, $configfilecontent);
+ # Write back Star Office configuration file
+ return writesofficeconfigfile($configfilename, $configfilecontent);
+}
+
+sub add_cups_remote_to_office {
+ my ($suite, $printer, $queue) = @_;
+ # Do we have Star Office installed?
+ my $configfilename = find_config_file($suite);
+ return 1 if !$configfilename;
+ $configfilename =~ m!$suites{$suite}{file_name}!;
+ my $configprefix = $1;
+ # Load Star Office printer config file
+ my $configfilecontent = readsofficeconfigfile($configfilename);
+ # Update remote CUPS queues
+ if (($printer->{SPOOLER} eq "cups") &&
+ ((-x "$::prefix/usr/bin/curl") || (-x "$::prefix/usr/bin/wget"))) {
+ my @printerlist = printer::cups::get_remote_queues();
+ foreach my $listentry (@printerlist) {
+ next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
+ my $q = $1;
+ next if $q ne $queue;
+ my $server = $2;
+ # Remove server name from queue name
+ $q =~ s/^([^@]*)@.*$/$1/;
+ if (-x "$::prefix/usr/bin/wget") {
+ eval(run_program::rooted
+ ($::prefix, "/usr/bin/wget", "-O",
+ "/etc/foomatic/$queue.ppd",
+ "http://$server:631/printers/$q.ppd"));
+ } else {
+ eval(run_program::rooted
+ ($::prefix, "/usr/bin/curl", "-o",
+ "/etc/foomatic/$queue.ppd",
+ "http://$server:631/printers/$q.ppd"));
+ }
+ # Does the file exist and is it not an error message?
+ if ((-r "$::prefix/etc/foomatic/$queue.ppd") &&
+ (cat_("$::prefix/etc/foomatic/$queue.ppd") =~
+ /^\*PPD-Adobe/)) {
+ $configfilecontent =
+ $suites{$suite}{make}($printer, $queue,
+ $configprefix,
+ $configfilecontent);
+ } else {
+ unlink ("$::prefix/etc/foomatic/$queue.ppd");
+ return 0;
+ }
+ last if $suite eq 'Star Office';
+ }
+ }
+ # Write back Star Office configuration file
+ return writesofficeconfigfile($configfilename, $configfilecontent);
+}
+
+sub remove_printer_from_office {
+ my ($suite, $printer, $queue) = @_;
+ # Do we have Star Office installed?
+ my $configfilename = find_config_file($suite);
+ return 1 if !$configfilename;
+ $configfilename =~ m!$suites{$suite}{file_name}!;
+ my $configprefix = $1;
+ # Load Star Office printer config file
+ my $configfilecontent = readsofficeconfigfile($configfilename);
+ # Remove the printer entry
+ $configfilecontent =
+ removestarofficeprinterentry($printer, $queue, $configprefix,
+ $configfilecontent);
+ # Write back Star Office configuration file
+ return writesofficeconfigfile($configfilename, $configfilecontent);
+}
+
+sub remove_local_printers_from_office {
+ my ($suite, $printer) = @_;
+ # Do we have Star Office installed?
+ my $configfilename = find_config_file($suite);
+ return 1 if !$configfilename;
+ $configfilename =~ m!$suites{$suite}{file_name}!;
+ my $configprefix = $1;
+ # Load Star Office printer config file
+ my $configfilecontent = readsofficeconfigfile($configfilename);
+ # Remove the printer entries
+ foreach my $queue (keys(%{$printer->{configured}})) {
+ $configfilecontent =
+ removestarofficeprinterentry($printer, $queue, $configprefix,
+ $configfilecontent);
+ }
+ # Write back Star Office configuration file
+ return writesofficeconfigfile($configfilename, $configfilecontent);
+}
+
+
+sub makestarofficeprinterentry {
+ my ($printer, $queue, $configprefix, $configfile) = @_;
+ # Set default printer
+ if ($queue eq $printer->{DEFAULT}) {
+ $configfile =printer::common::removeentry("windows", "device=", $configfile);
+ $configfile =printer::common::addentry("windows",
+ "device=$queue,$queue PostScript,$queue",
+ $configfile);
+ }
+ # Make an entry in the "[devices]" section
+ $configfile =printer::common::removeentry("devices", "$queue=", $configfile);
+ $configfile =printer::common::addentry("devices",
+ "$queue=$queue PostScript,$queue",
+ $configfile);
+ # Make an entry in the "[ports]" section
+ # The "perl" command patches the PostScript output to print the Euro
+ # symbol correctly.
+ $configfile =printer::common::removeentry("ports", "$queue=", $configfile);
+ $configfile =printer::common::addentry("ports",
+ "$queue=/usr/bin/perl -p -e \"s=16#80 /euro=16#80 /Euro=\" | /usr/bin/$printer::data::lprcommand{$printer->{SPOOLER}{print_command}} -P $queue",
+ $configfile);
+ # Make printer's section
+ $configfile = printer::common::addsection("$queue,PostScript,$queue", $configfile);
+ # Load PPD file
+ my $ppd = cat_("$::prefix/etc/foomatic/$queue.ppd");
+ # Set the PostScript level
+ my $pslevel;
+ if ($ppd =~ /^\s*\*LanguageLevel:\s*\"?([^\s\"]+)\"?\s*$/m) {
+ $pslevel = $1;
+ $pslevel = "2" if $pslevel eq "3";
+ } else { $pslevel = "2" }
+ $configfile =printer::common::removeentry("$queue.PostScript.$queue",
+ "Level=", $configfile);
+ $configfile =printer::common::addentry("$queue.PostScript.$queue",
+ "Level=$pslevel", $configfile);
+ # Set Color/BW
+ my $color = ($ppd =~ /^\s*\*ColorDevice:\s*\"?([Tt]rue)\"?\s*$/m) ? "1" : "0";
+ $configfile =printer::common::removeentry("$queue.PostScript.$queue", "BitmapColor=", $configfile);
+ $configfile =printer::common::addentry("$queue.PostScript.$queue", "BitmapColor=$color", $configfile);
+ # Set the default paper size
+ if ($ppd =~ /^\s*\*DefaultPageSize:\s*(\S+)\s*$/m) {
+ my $papersize = $1;
+ $configfile =printer::common::removeentry("$queue.PostScript.$queue", "PageSize=", $configfile);
+ $configfile =printer::common::removeentry("$queue.PostScript.$queue", "PPD_PageSize=", $configfile);
+ $configfile =printer::common::addentry("$queue.PostScript.$queue", "PageSize=$papersize", $configfile);
+ $configfile =printer::common::addentry("$queue.PostScript.$queue", "PPD_PageSize=$papersize", $configfile);
+ }
+ # Link the PPD file
+ run_program::rooted($::prefix,
+ "ln", "-sf", "/etc/foomatic/$queue.ppd",
+ "$configprefix/share/xp3/ppds/$queue.PS");
+ return $configfile;
+}
+
+sub makeopenofficeprinterentry {
+ my ($printer, $queue, $configprefix, $configfile) = @_;
+ # Make printer's section
+ $configfile = printer::common::addsection($queue, $configfile);
+ # Load PPD file
+ my $ppd = cat_("$::prefix/etc/foomatic/$queue.ppd");
+ # "PPD_PageSize" line
+ if ($ppd =~ /^\s*\*DefaultPageSize:\s*(\S+)\s*$/m) {
+ my $papersize = $1;
+ $configfile = printer::common::removeentry($queue,
+ "PPD_PageSize=", $configfile);
+ $configfile = printer::common::addentry($queue,
+ "PPD_PageSize=$papersize", $configfile);
+ }
+ # "Command" line
+ # The "perl" command patches the PostScript output to print the Euro
+ # symbol correctly.
+ $configfile = printer::common::removeentry($queue, "Command=", $configfile);
+ $configfile = printer::common::addentry($queue,
+ "Command=/usr/bin/perl -p -e \"s=/euro /unused=/Euro /unused=\" | /usr/bin/$printer::data::lprcommand{$printer->{SPOOLER}{print_command}} -P $queue",
+ $configfile);
+ # "Comment" line
+ $configfile = printer::common::removeentry($queue, "Comment=", $configfile);
+ if (($printer->{configured}{$queue}) &&
+ ($printer->{configured}{$queue}{queuedata}{desc})) {
+ $configfile =printer::common::addentry
+ ($queue,
+ "Comment=$printer->{configured}{$queue}{queuedata}{desc}",
+ $configfile);
+ } else {
+ $configfile = printer::common::addentry($queue,
+ "Comment=",
+ $configfile);
+ }
+ # "Location" line
+ $configfile = printer::common::removeentry($queue, "Location=", $configfile);
+ if (($printer->{configured}{$queue}) &&
+ ($printer->{configured}{$queue}{queuedata}{loc})) {
+ $configfile = printer::common::addentry
+ ($queue,
+ "Location=$printer->{configured}{$queue}{queuedata}{loc}",
+ $configfile);
+ } else {
+ $configfile = printer::common::addentry($queue, "Location=", $configfile);
+ }
+ # "DefaultPrinter" line
+ $configfile = printer::common::removeentry($queue, "DefaultPrinter=", $configfile);
+ my $default = "0";
+ if ($queue eq $printer->{DEFAULT}) {
+ $default = "1";
+ # "DefaultPrinter=0" for the "Generic Printer"
+ $configfile = printer::common::removeentry("Generic Printer", "DefaultPrinter=",
+ $configfile);
+ $configfile = printer::common::addentry("Generic Printer",
+ "DefaultPrinter=0",
+ $configfile);
+ }
+ $configfile = printer::common::addentry($queue, "DefaultPrinter=$default", $configfile);
+ # "Printer" line
+ $configfile = printer::common::removeentry($queue, "Printer=", $configfile);
+ $configfile = printer::common::addentry($queue, "Printer=$queue/$queue", $configfile);
+ # Link the PPD file
+ run_program::rooted($::prefix,
+ "ln", "-sf", "/etc/foomatic/$queue.ppd",
+ "$configprefix/share/psprint/driver/$queue.PS");
+ return $configfile;
+}
+
+sub removestarofficeprinterentry {
+ my ($printer, $queue, $configprefix, $configfile) = @_;
+ # Remove default printer entry
+ $configfile = printer::common::removeentry("windows", "device=$queue,", $configfile);
+ # Remove entry in the "[devices]" section
+ $configfile = printer::common::removeentry("devices", "$queue=", $configfile);
+ # Remove entry in the "[ports]" section
+ $configfile = printer::common::removeentry("ports", "$queue=", $configfile);
+ # Remove "[$queue,PostScript,$queue]" section
+ $configfile = printer::common::removesection("$queue,PostScript,$queue", $configfile);
+ # Remove Link of PPD file
+ run_program::rooted($::prefix,
+ "rm", "-f",
+ "$configprefix/share/xp3/ppds/$queue.PS");
+ return $configfile;
+}
+
+sub removeopenofficeprinterentry {
+ my ($printer, $queue, $configprefix, $configfile) = @_;
+ # Remove printer's section
+ $configfile = printer::common::removesection($queue, $configfile);
+ # Remove Link of PPD file
+ run_program::rooted($::prefix,
+ "rm", "-f",
+ "$configprefix/share/psprint/driver/$queue.PS");
+ return $configfile;
+}
+
+sub find_config_file {
+ my ($suite) = @_;
+ my @configfilenames = $suites{$suite}{files};
+ foreach my $configfilename (@configfilenames) {
+ local *F;
+ if (open F, "ls -r $::prefix$configfilename 2> /dev/null |") {
+ my $filename = <F>;
+ close F;
+ if ($filename) {
+ if ($::prefix ne "") {
+ $filename =~ s/^$::prefix//;
+ }
+ # Work around a bug in the "ls" of "busybox". During
+ # installation it outputs the mask given on the command line
+ # instead of nothing when the mask does not match any file
+ next if $filename =~ /\*/;
+ return $filename;
+ }
+ }
+ }
+ return "";
+}
+
+sub readsofficeconfigfile {
+ my ($file) = @_;
+ local *F;
+ open F, "< $::prefix$file" or return "";
+ my $filecontent = join("", <F>);
+ close F;
+ return $filecontent;
+}
+
+sub writesofficeconfigfile {
+ my ($file, $filecontent) = @_;
+ local *F;
+ open F, "> $::prefix$file" or return 0;
+ print F $filecontent;
+ close F;
+ return 1;
+}
+
diff --git a/perl-install/printerdrake.pm b/perl-install/printer/printerdrake.pm
index 06f1119b9..57e57fe28 100644
--- a/perl-install/printerdrake.pm
+++ b/perl-install/printer/printerdrake.pm
@@ -1,7 +1,7 @@
-package printerdrake;
+package printer::printerdrake;
# $Id$
-use diagnostics;
-use strict;
+
+
use common;
@@ -9,7 +9,10 @@ use detect_devices;
use modules;
use network;
use log;
-use printer;
+use printer::main;
+use printer::services;
+use printer::detect;
+use printer::default;
1;
@@ -20,7 +23,7 @@ sub choose_printer_type {
$printer->{str_type} = $printer::printer_type_inv{$printer->{TYPE}};
my $autodetect = 0;
$autodetect = 1 if $printer->{AUTODETECT};
- my @printertypes = printer::printer_type($printer);
+ my @printertypes = printer::main::printer_type($printer);
$in->ask_from_(
{ title => N("Select Printer Connection"),
messages => N("How is the printer connected?") .
@@ -63,13 +66,13 @@ sub config_cups {
# when "Apply" was at least pressed once.
my $retvalue = 0;
# Read CUPS config file
- my @cupsd_conf = printer::read_cupsd_conf();
+ my @cupsd_conf = printer::main::read_cupsd_conf();
foreach (@cupsd_conf) {
/^\s*BrowsePoll\s+(\S+)/ and $server = $1, last;
}
$server =~ /([^:]*):(.*)/ and ($server, $port) = ($1, $2);
#- Did we have automatic or manual configuration mode for CUPS
- $autoconf = printer::get_cups_autoconf();
+ $autoconf = printer::main::get_cups_autoconf();
#- Remember the server/port/autoconf settings to check whether the user
#- has changed them.
my $oldserver = $server;
@@ -123,11 +126,11 @@ Normally, CUPS is automatically configured according to your network environment
map { s/^\s*BrowsePoll\s+(\S+)/\#BrowsePoll $1/;
$_ } @cupsd_conf;
}
- printer::write_cupsd_conf(@cupsd_conf);
+ printer::main::write_cupsd_conf(@cupsd_conf);
}
# Set auto-configuration state
if ($autoconf != $oldautoconf) {
- printer::set_cups_autoconf($autoconf);
+ printer::main::set_cups_autoconf($autoconf);
}
# Save user settings for auto-install
$printer->{BROWSEPOLLADDR} = $server;
@@ -142,49 +145,28 @@ sub setup_printer_connection {
# Choose the appropriate connection config dialog
my $done = 1;
foreach ($printer->{TYPE}) {
- /LOCAL/ and setup_local_autoscan ($printer, $in, $upNetwork)
- and last;
- /LPD/ and setup_lpd ($printer, $in, $upNetwork) and last;
- /SOCKET/ and setup_socket ($printer, $in, $upNetwork) and last;
- /SMB/ and setup_smb ($printer, $in, $upNetwork) and last;
- /NCP/ and setup_ncp ($printer, $in, $upNetwork) and last;
- /URI/ and setup_uri ($printer, $in, $upNetwork) and last;
- /POSTPIPE/ and setup_postpipe ($printer, $in) and last;
+ /LOCAL/ and setup_local_autoscan ($printer, $in, $upNetwork) and last;
+ /LPD/ and setup_lpd ($printer, $in, $upNetwork) and last;
+ /SOCKET/ and setup_socket ($printer, $in, $upNetwork) and last;
+ /SMB/ and setup_smb ($printer, $in, $upNetwork) and last;
+ /NCP/ and setup_ncp ($printer, $in, $upNetwork) and last;
+ /URI/ and setup_uri ($printer, $in, $upNetwork) and last;
+ /POSTPIPE/ and setup_postpipe ($printer, $in) and last;
$done = 0; last;
}
return $done;
}
-sub local_detect {
- modules::get_probeall("usb-interface") and eval { modules::load("printer") };
- eval { modules::unload(qw(lp parport_pc parport_probe parport)) }; #- on kernel 2.4 parport has to be unloaded to probe again
- eval { modules::load(qw(parport_pc lp parport_probe)) }; #- take care as not available on 2.4 kernel (silent error).
- my $b = before_leaving { eval { modules::unload("parport_probe") } };
- detect_devices::whatPrinter();
-}
-
-sub net_detect {
- printer::whatNetPrinter(1, 0)
-}
-
-sub net_smb_detect {
- printer::whatNetPrinter(0, 1)
-}
-
-sub detect {
- local_detect(), net_detect(), net_smb_detect();
-}
-
sub first_time_dialog {
my ($printer, $in, $upNetwork) = @_;
- return 1 if printer::get_default_spooler () or $::isInstall;
+ return 1 if printer::default::get_spooler () or $::isInstall;
# Wait message
my $w = $in->wait_message(N("Printerdrake"),
N("Checking your system..."));
# Auto-detect local printers
- my @autodetected = local_detect();
+ my @autodetected = printer::detect::local_detect();
my @printerlist;
my $localprinterspresent;
if (@autodetected == ()) {
@@ -233,7 +215,7 @@ sub first_time_dialog {
# configure networking.
my $havelocalnetworks =
(check_network($printer, $in, $upNetwork, 1) &&
- (printer::getIPsInLocalNetworks() != ()));
+ (printer::detect::getIPsInLocalNetworks() != ()));
# Finish building the dialog text
my $question = ($havelocalnetworks ?
@@ -268,7 +250,7 @@ sub wizard_welcome {
undef $printer->{AUTODETECTSMB};
} else {
$havelocalnetworks = ((check_network($printer, $in, $upNetwork, 1)) &&
- (printer::getIPsInLocalNetworks() != ()));
+ (printer::detect::getIPsInLocalNetworks() != ()));
if (!$havelocalnetworks) {
undef $printer->{AUTODETECTNETWORK};
undef $printer->{AUTODETECTSMB};
@@ -340,21 +322,9 @@ If you have printer(s) connected to this machine, Please plug it/them in on this
{ text => N("Auto-detect printers connected to machines running Microsoft Windows"), type => 'bool',
val => \$autodetectsmb } : ())) : ())
]);
- if ($autodetectlocal) {
- $printer->{AUTODETECTLOCAL} = 1;
- } else {
- undef $printer->{AUTODETECTLOCAL};
- }
- if ($autodetectnetwork) {
- $printer->{AUTODETECTNETWORK} = 1;
- } else {
- undef $printer->{AUTODETECTNETWORK};
- }
- if ($autodetectsmb && ($printer->{SPOOLER} ne "pdq")) {
- $printer->{AUTODETECTSMB} = 1;
- } else {
- undef $printer->{AUTODETECTSMB};
- }
+ $printer->{AUTODETECTLOCAL} = $autodetectlocal ? 1 : undef;
+ $printer->{AUTODETECTNETWORK} = $autodetectnetwork ? 1 : undef;
+ $printer->{AUTODETECTSMB} = ($autodetectsmb && ($printer->{SPOOLER} ne "pdq")) ? 1 : undef;
}
};
return ($@ =~ /wizcancel/) ? 0 : $ret;
@@ -390,7 +360,7 @@ sub setup_local_autoscan {
# If the user requested auto-detection of remote printers, check
# whether the network functionality is configured and running
if ($printer->{AUTODETECTNETWORK} || $printer->{AUTODETECTSMB}) {
- if (!check_network($printer, $in, $upNetwork, 0)) { return 0 };
+ return 0 unless check_network($printer, $in, $upNetwork, 0);
}
my @autodetected;
@@ -399,17 +369,18 @@ sub setup_local_autoscan {
if ($do_auto_detect) {
if ((!$::testing) &&
(!$expert_or_modify) && ($printer->{AUTODETECTSMB}) &&
- (!printer::files_exist((qw(/usr/bin/smbclient))))) {
+ (!files_exist((qw(/usr/bin/smbclient))))) {
$in->do_pkgs->install('samba-client');
}
my $w = $in->wait_message(N("Printer auto-detection"), N("Detecting devices..."));
# When HPOJ is running, it blocks the printer ports on which it is
# configured, so we stop it here. If it is not installed or not
# configured, this command has no effect.
- printer::stop_service("hpoj");
- @autodetected = ($expert_or_modify || $printer->{AUTODETECTLOCAL}) and local_detect,
- (!$expert_or_modify && $printer->{AUTODETECTNETWORK}) and net_detect,
- (!$expert_or_modify && $printer->{AUTODETECTSMB}) and net_smb_detect;
+ require services;
+ services::stop("hpoj");
+ @autodetected = ($expert_or_modify || $printer->{AUTODETECTLOCAL}) and printer::detect::local_detect(),
+ (!$expert_or_modify && $printer->{AUTODETECTNETWORK}) and printer::detect::net_detect(),
+ (!$expert_or_modify && $printer->{AUTODETECTSMB}) and printer::detect::net_smb_detect();
# We have more than one printer, so we must ask the user for a queue
# name in the fully automatic printer configuration.
$printer->{MORETHANONE} = ($#autodetected > 0);
@@ -476,7 +447,7 @@ sub setup_local_autoscan {
}
# We are ready with auto-detection, so we restart HPOJ here. If it
# is not installed or not configured, this command has no effect.
- printer::start_service("hpoj");
+ printer::services::start("hpoj");
} else {
# Always ask for queue name in recommended mode when no auto-
# detection was done
@@ -557,15 +528,11 @@ sub setup_local_autoscan {
last;
}
}
- } else {
- $device = "";
- }
+ } else { $device = "" }
if (($menuchoice eq "") && (@menuentrieslist > -1)) {
$menuchoice = $menuentrieslist[0];
$oldmenuchoice = $menuchoice;
- if ($device eq "") {
- $device = $menuentries->{$menuchoice};
- }
+ $device = $menuentries->{$menuchoice} if $device eq "";
}
if ($in) {
$::expert or $in->set_help('configurePrinterDev') if $::isInstall;
@@ -660,7 +627,7 @@ sub setup_local_autoscan {
#- LPD and LPRng need netcat ('nc') to access to socket printers
if ((($printer->{SPOOLER} eq 'lpd') || ($printer->{SPOOLER} eq 'lprng')) &&
(!$::testing) && ($device =~ /^socket:/) &&
- (!printer::files_exist((qw(/usr/bin/nc))))) {
+ (!files_exist((qw(/usr/bin/nc))))) {
$in->do_pkgs->install('nc');
}
@@ -716,13 +683,13 @@ complete => sub {
#- LPD does not support filtered queues to a remote LPD server by itself
#- It needs an additional program as "rlpr"
if (($printer->{SPOOLER} eq 'lpd') && (!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/rlpr))))) {
+ (!files_exist((qw(/usr/bin/rlpr))))) {
$in->do_pkgs->install('rlpr');
}
# Auto-detect printer model (works if host is an ethernet-connected
# printer)
- my $modelinfo = printer::getSNMPModel ($remotehost);
+ my $modelinfo = printer::detect::getSNMPModel ($remotehost);
my $auto_hpoj;
if ((defined($modelinfo)) &&
($modelinfo->{MANUFACTURER} ne "") &&
@@ -740,7 +707,7 @@ complete => sub {
"$modelinfo->{MANUFACTURER} $modelinfo->{MODEL}",
$printer->{currentqueue}{connect}, $auto_hpoj,
({port => $printer->{currentqueue}{connect},
- val => $modelinfo }));
+ val => $modelinfo}));
1;
}
@@ -802,11 +769,11 @@ sub setup_smb {
if ($printer->{AUTODETECT}) {
$autodetect = 1;
if ((!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/smbclient))))) {
+ (!files_exist((qw(/usr/bin/smbclient))))) {
$in->do_pkgs->install('samba-client');
}
my $w = $in->wait_message(N("Printer auto-detection"), N("Scanning network..."));
- @autodetected = net_smb_detect();
+ @autodetected = printer::detect::net_smb_detect();
foreach my $p (@autodetected) {
my $menustr;
$p->{port} =~ m!^smb://([^/:]+)/([^/:]+)$!;
@@ -872,7 +839,7 @@ sub setup_smb {
val => \$menuchoice, list => \@menuentrieslist,
not_edit => 1, format => \&translate, sort => 0,
allow_empty_list => 1, type => 'combo' } :
- ()) ],
+ ()) ],
complete => sub {
if (!network::is_ip($smbserverip) && $smbserverip ne "") {
$in->ask_warn('', N("IP address should be in format 1.2.3.4"));
@@ -930,10 +897,10 @@ Do you really want to continue setting up this printer as you are doing now?"),
($smbserver || $smbserverip), "/$smbshare");
if ((!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/smbclient))))) {
+ (!files_exist((qw(/usr/bin/smbclient))))) {
$in->do_pkgs->install('samba-client');
}
- $printer->{SPOOLER} eq 'cups' and printer::restart_queue($printer);
+ $printer->{SPOOLER} eq 'cups' and printer::main::restart_queue($printer);
1;
}
@@ -1000,7 +967,7 @@ complete => sub {
"$ncpserver/$ncpqueue");
if ((!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/nprint))))) {
+ (!files_exist((qw(/usr/bin/nprint))))) {
$in->do_pkgs->install('ncpfs');
}
@@ -1046,7 +1013,7 @@ sub setup_socket {
if ($printer->{AUTODETECT}) {
$autodetect = 1;
my $w = $in->wait_message(N("Printer auto-detection"), N("Scanning network..."));
- @autodetected = net_detect();
+ @autodetected = printer::detect::net_detect();
foreach my $p (@autodetected) {
my $menustr;
$p->{port} =~ m!^socket://([^:]+):(\d+)$!;
@@ -1134,7 +1101,7 @@ sub setup_socket {
{ val => \$menuchoice, list => \@menuentrieslist,
not_edit => 0, format => \&translate, sort => 0,
allow_empty_list => 1, type => 'list' } :
- ())
+ ())
]
);
@@ -1145,14 +1112,14 @@ sub setup_socket {
#- LPD and LPRng need netcat ('nc') to access to socket printers
if ((($printer->{SPOOLER} eq 'lpd') || ($printer->{SPOOLER} eq 'lprng'))&&
(!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/nc))))) {
+ (!files_exist((qw(/usr/bin/nc))))) {
$in->do_pkgs->install('nc');
}
# Auto-detect printer model
my $modelinfo;
if ($printer->{AUTODETECT}) {
- $modelinfo = printer::getSNMPModel ($remotehost);
+ $modelinfo = printer::detect::getSNMPModel ($remotehost);
}
my $auto_hpoj;
if ((defined($modelinfo)) &&
@@ -1210,24 +1177,24 @@ complete => sub {
# It needs an additional program as "rlpr"
if (($printer->{currentqueue}{connect} =~ /^lpd:/) &&
($printer->{SPOOLER} eq 'lpd') && (!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/rlpr))))) {
+ (!files_exist((qw(/usr/bin/rlpr))))) {
$in->do_pkgs->install('rlpr');
}
if (($printer->{currentqueue}{connect} =~ /^smb:/) &&
(!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/smbclient))))) {
+ (!files_exist((qw(/usr/bin/smbclient))))) {
$in->do_pkgs->install('samba-client');
}
if (($printer->{currentqueue}{connect} =~ /^ncp:/) &&
(!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/nprint))))) {
+ (!files_exist((qw(/usr/bin/nprint))))) {
$in->do_pkgs->install('ncpfs');
}
#- LPD and LPRng need netcat ('nc') to access to socket printers
if (($printer->{currentqueue}{connect} =~ /^socket:/) &&
(($printer->{SPOOLER} eq 'lpd') || ($printer->{SPOOLER} eq 'lprng')) &&
(!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/nc))))) {
+ (!files_exist((qw(/usr/bin/nc))))) {
$in->do_pkgs->install('nc');
}
@@ -1239,7 +1206,7 @@ complete => sub {
# Auto-detect printer model (works if host is an ethernet-connected
# printer)
my $remotehost = $1;
- my $modelinfo = printer::getSNMPModel ($remotehost);
+ my $modelinfo = printer::main::getSNMPModel ($remotehost);
my $auto_hpoj;
if ((defined($modelinfo)) &&
($modelinfo->{MANUFACTURER} ne "") &&
@@ -1325,7 +1292,7 @@ sub setup_common {
($isHPOJ)) {
# Install HPOJ package
if ((!$::testing) &&
- (!printer::files_exist((qw(/usr/sbin/ptal-mlcd
+ (!files_exist((qw(/usr/sbin/ptal-mlcd
/usr/sbin/ptal-init
/usr/bin/xojpanel))))) {
my $w = $in->wait_message(N("Printerdrake"),
@@ -1336,7 +1303,7 @@ sub setup_common {
my $w = $in->wait_message
(N("Printerdrake"),
N("Checking device and configuring HPOJ..."));
- $ptaldevice = printer::configure_hpoj($device, @autodetected);
+ $ptaldevice = printer::main::configure_hpoj($device, @autodetected);
if ($ptaldevice) {
# Configure scanning with SANE on the MF device
@@ -1344,12 +1311,12 @@ sub setup_common {
($makemodel !~ /HP\s+LaserJet\s+2200/i)) {
# Install SANE
if ((!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/scanimage
+ (!files_exist((qw(/usr/bin/scanimage
/usr/bin/xscanimage
/usr/bin/xsane
/etc/sane.d/dll.conf
/usr/lib/libsane-hpoj.so.1),
- (printer::files_exist
+ (files_exist
('/usr/bin/gimp') ?
'/usr/bin/xsane-gimp' :
()))))) {
@@ -1363,7 +1330,7 @@ sub setup_common {
('gimp'),'xsane-gimp'));
}
# Configure the HPOJ SANE backend
- printer::config_sane();
+ printer::main::config_sane();
}
# Configure photo card access with mtools and MToolsFM
if ((($makemodel =~ /HP\s+PhotoSmart/i) ||
@@ -1373,7 +1340,7 @@ sub setup_common {
($makemodel !~ /HP\s+PhotoSmart\s+7150/i)) {
# Install mtools and MToolsFM
if ((!$::testing) &&
- (!printer::files_exist(qw(/usr/bin/mdir
+ (!files_exist(qw(/usr/bin/mdir
/usr/bin/mcopy
/usr/bin/MToolsFM
)))) {
@@ -1383,7 +1350,7 @@ sub setup_common {
$in->do_pkgs->install('mtools', 'mtoolsfm');
}
# Configure mtools/MToolsFM for photo card access
- printer::config_photocard();
+ printer::main::config_photocard();
}
my $text = "";
@@ -1429,14 +1396,14 @@ sub setup_common {
($device !~ /^http:/) &&
($device !~ /^ipp:/)) {
my $w = $in->wait_message(N("Printerdrake"), N("Making printer port available for CUPS..."));
- printer::assure_device_is_available_for_cups($ptaldevice || $device);
+ printer::main::assure_device_is_available_for_cups($ptaldevice || $device);
}
#- Read the printer driver database if necessary
- if ((keys %printer::thedb) == 0) {
+ if ((keys %printer::main::thedb) == 0) {
my $w = $in->wait_message(N("Printerdrake"),
N("Reading printer database..."));
- printer::read_printer_db($printer->{SPOOLER});
+ printer::main::read_printer_db($printer->{SPOOLER});
}
#- Search the database entry which matches the detected printer best
@@ -1467,7 +1434,7 @@ sub setup_common {
# If there is more than one matching database entry, the longest match
# counts.
my $matchlength = 0;
- foreach my $entry (keys %printer::thedb) {
+ foreach my $entry (keys %printer::main::thedb) {
my $dbmakemodel;
if ($::expert) {
$entry =~ m/^(.*)\|[^\|]*$/;
@@ -1494,7 +1461,7 @@ sub setup_common {
}
if (!$printer->{DBENTRY}) {
$printer->{DBENTRY} =
- bestMatchSentence ($descr, keys %printer::thedb);
+ bestMatchSentence ($descr, keys %printer::main::thedb);
}
# If the manufacturer was not guessed correctly, discard the
# guess.
@@ -1559,10 +1526,10 @@ N("Every printer needs a name (for example \"printer\"). The Description and Loc
sub get_db_entry {
my ($printer, $in) = @_;
#- Read the printer driver database if necessary
- if ((keys %printer::thedb) == 0) {
+ if ((keys %printer::main::thedb) == 0) {
my $w = $in->wait_message(N("Printerdrake"),
N("Reading printer database..."));
- printer::read_printer_db($printer->{SPOOLER});
+ printer::main::read_printer_db($printer->{SPOOLER});
}
my $w = $in->wait_message(N("Printerdrake"),
N("Preparing printer database..."));
@@ -1583,7 +1550,7 @@ sub get_db_entry {
$printer->{DBENTRY} = "$make|$model|$driverstr";
# database key contains the "(recommended)" for the
# recommended driver, so add it if necessary
- if (!member($printer->{DBENTRY}, keys(%printer::thedb))) {
+ if (!member($printer->{DBENTRY}, keys(%printer::main::thedb))) {
$printer->{DBENTRY} .= " (recommended)";
}
} else {
@@ -1593,7 +1560,7 @@ sub get_db_entry {
} elsif (($printer->{SPOOLER} eq "cups") && ($::expert) &&
($printer->{configured}{$queue}{queuedata}{ppd})) {
# Do we have a native CUPS driver or a PostScript PPD file?
- $printer->{DBENTRY} = printer::get_descr_from_ppd($printer) || $printer->{DBENTRY};
+ $printer->{DBENTRY} = printer::main::get_descr_from_ppd($printer) || $printer->{DBENTRY};
$printer->{OLD_CHOICE} = $printer->{DBENTRY};
} else {
# Point the list cursor at least to manufacturer and model of the
@@ -1601,7 +1568,7 @@ sub get_db_entry {
$printer->{DBENTRY} = "";
my $make = uc($printer->{configured}{$queue}{queuedata}{make});
my $model = $printer->{configured}{$queue}{queuedata}{model};
- foreach my $key (keys %printer::thedb) {
+ foreach my $key (keys %printer::main::thedb) {
if ((($::expert) && ($key =~ /^$make\|$model\|.*\(recommended\)$/)) ||
((!$::expert) && ($key =~ /^$make\|$model$/))) {
$printer->{DBENTRY} = $key;
@@ -1613,7 +1580,7 @@ sub get_db_entry {
$model =~ s/PS//;
$model =~ s/PostScript//;
$model =~ s/Series//;
- foreach my $key (keys %printer::thedb) {
+ for $key (keys %printer::main::thedb) {
if ((($::expert) && ($key =~ /^$make\|$model\|.*\(recommended\)$/)) ||
((!$::expert) && ($key =~ /^$make\|$model$/))) {
$printer->{DBENTRY} = $key;
@@ -1623,7 +1590,7 @@ sub get_db_entry {
if (($printer->{DBENTRY} eq "") && ($make ne "")) {
# Exact match with cleaned-up model did not work, try a best match
my $matchstr = "$make|$model";
- $printer->{DBENTRY} = bestMatchSentence($matchstr, keys %printer::thedb);
+ $printer->{DBENTRY} = bestMatchSentence($matchstr, keys %printer::main::thedb);
# If the manufacturer was not guessed correctly, discard the
# guess.
$printer->{DBENTRY} =~ /^([^\|]+)\|/;
@@ -1639,7 +1606,7 @@ sub get_db_entry {
} else {
if (($::expert) && ($printer->{DBENTRY} !~ /(recommended)/)) {
my ($make, $model) = $printer->{DBENTRY} =~ /^([^\|]+)\|([^\|]+)\|/;
- foreach my $key (keys %printer::thedb) {
+ foreach my $key (keys %printer::main::thedb) {
if ($key =~ /^$make\|$model\|.*\(recommended\)$/) {
$printer->{DBENTRY} = $key;
}
@@ -1680,12 +1647,12 @@ sub choose_model {
my ($printer, $in) = @_;
$in->set_help('chooseModel') if $::isInstall;
#- Read the printer driver database if necessary
- if ((keys %printer::thedb) == 0) {
+ if ((keys %printer::main::thedb) == 0) {
my $w = $in->wait_message(N("Printerdrake"),
N("Reading printer database..."));
- printer::read_printer_db($printer->{SPOOLER});
+ printer::main::read_printer_db($printer->{SPOOLER});
}
- if (!member($printer->{DBENTRY}, keys(%printer::thedb))) {
+ if (!member($printer->{DBENTRY}, keys(%printer::main::thedb))) {
$printer->{DBENTRY} = N("Raw printer (No driver)");
}
# Choose the printer/driver from the list
@@ -1695,17 +1662,17 @@ sub choose_model {
Please check whether Printerdrake did the auto-detection of your printer model correctly. Search the correct model in the list when the cursor is standing on a wrong model or on \"Raw printer\".") . " " .
N("If your printer is not listed, choose a compatible (see printer manual) or a similar one."), '|',
- [ keys %printer::thedb ], $printer->{DBENTRY}));
+ [ keys %printer::main::thedb ], $printer->{DBENTRY}));
}
sub get_printer_info {
my ($printer, $in) = @_;
#- Read the printer driver database if necessary
- #if ((keys %printer::thedb) == 0) {
+ #if ((keys %printer::main::thedb) == 0) {
# my $w = $in->wait_message(N("Printerdrake"),
# N("Reading printer database..."));
- # printer::read_printer_db($printer->{SPOOLER});
+ # printer::main::read_printer_db($printer->{SPOOLER});
#}
my $queue = $printer->{OLD_QUEUE};
my $oldchoice = $printer->{OLD_CHOICE};
@@ -1714,13 +1681,13 @@ sub get_printer_info {
(($oldchoice) && ($printer->{DBENTRY}) && # make/model/driver changed
(($oldchoice ne $printer->{DBENTRY}) ||
($printer->{currentqueue}{driver} ne
- $printer::thedb{$printer->{DBENTRY}}{driver})))) {
+ $printer::main::thedb{$printer->{DBENTRY}}{driver})))) {
delete($printer->{currentqueue}{printer});
delete($printer->{currentqueue}{ppd});
$printer->{currentqueue}{foomatic} = 0;
# Read info from printer database
foreach (qw(printer ppd driver make model)) { #- copy some parameter, shorter that way...
- $printer->{currentqueue}{$_} = $printer::thedb{$printer->{DBENTRY}}{$_};
+ $printer->{currentqueue}{$_} = $printer::main::thedb{$printer->{DBENTRY}}{$_};
}
$newdriver = 1;
}
@@ -1739,7 +1706,7 @@ sub get_printer_info {
$printer->{ARGS} = $printer->{configured}{$queue}{args};
} else {
# ... and the user has chosen another printer/driver
- $printer->{ARGS} = printer::read_foomatic_options($printer);
+ $printer->{ARGS} = printer::main::read_foomatic_options($printer);
}
} else {
# The queue was not configured with Foomatic before
@@ -1776,16 +1743,16 @@ sub get_printer_info {
}
$printer->{currentqueue}{connect} = 'file:/dev/null';
# Start the oki4daemon
- printer::start_service_on_boot('oki4daemon');
- printer::start_service('oki4daemon');
+ services::start_service_on_boot('oki4daemon');
+ printer::services::start('oki4daemon');
# Set permissions
if ($printer->{SPOOLER} eq 'cups') {
- printer::set_permissions('/dev/oki4drv', '660', 'lp',
+ set_permissions('/dev/oki4drv', '660', 'lp',
'sys');
} elsif ($printer->{SPOOLER} eq 'pdq') {
- printer::set_permissions('/dev/oki4drv', '666');
+ set_permissions('/dev/oki4drv', '666');
} else {
- printer::set_permissions('/dev/oki4drv', '660', 'lp',
+ set_permissions('/dev/oki4drv', '660', 'lp',
'lp');
}
} elsif ($printer->{currentqueue}{driver} eq 'lexmarkinkjet') {
@@ -1822,11 +1789,11 @@ sub get_printer_info {
# Set device permissions
$printer->{currentqueue}{connect} =~ /^\s*file:(\S*)\s*$/;
if ($printer->{SPOOLER} eq 'cups') {
- printer::set_permissions($1, '660', 'lp', 'sys');
+ set_permissions($1, '660', 'lp', 'sys');
} elsif ($printer->{SPOOLER} eq 'pdq') {
- printer::set_permissions($1, '666');
+ set_permissions($1, '666');
} else {
- printer::set_permissions($1, '660', 'lp', 'lp');
+ set_permissions($1, '660', 'lp', 'lp');
}
# This is needed to have the device not blocked by the
# spooler backend.
@@ -1836,10 +1803,10 @@ sub get_printer_info {
if ($drivertype eq 'Z22') { $drivertype = 'Z32' }
if ($drivertype eq 'Z23') { $drivertype = 'Z33' }
$drivertype = lc($drivertype);
- if (!printer::files_exist("/usr/local/lexmark/$drivertype/$drivertype")) {
+ if (!files_exist("/usr/local/lexmark/$drivertype/$drivertype")) {
eval { $in->do_pkgs->install("lexmark-drivers-$drivertype") };
}
- if (!printer::files_exist("/usr/local/lexmark/$drivertype/$drivertype")) {
+ if (!files_exist("/usr/local/lexmark/$drivertype/$drivertype")) {
# Driver installation failed, probably we do not have
# the commercial CDs
$in->ask_warn(N("Lexmark inkjet configuration"),
@@ -1857,7 +1824,7 @@ Some of these printers, as the HP LaserJet 1000, for which this driver was origi
The first command can be given by any normal user, the second must be given as root. After having done so you can print normally.
"));
}
- $printer->{ARGS} = printer::read_foomatic_options($printer);
+ $printer->{ARGS} = printer::main::read_foomatic_options($printer);
delete($printer->{SPECIAL_OPTIONS});
}
} elsif ($printer->{currentqueue}{ppd}) { # CUPS+PPD queue?
@@ -1872,14 +1839,14 @@ The first command can be given by any normal user, the second must be given as r
if ((!$printer->{DBENTRY}) || (!$oldchoice) ||
($printer->{DBENTRY} eq $oldchoice)) {
# ... and the user didn't change the printer/driver
- $printer->{ARGS} = printer::read_cups_options($queue);
+ $printer->{ARGS} = printer::main::read_cups_options($queue);
} else {
# ... and the user has chosen another printer/driver
- $printer->{ARGS} = printer::read_cups_options("/usr/share/cups/model/$printer->{currentqueue}{ppd}");
+ $printer->{ARGS} = printer::main::read_cups_options("/usr/share/cups/model/$printer->{currentqueue}{ppd}");
}
} else {
# The queue was not configured before
- $printer->{ARGS} = printer::read_cups_options("/usr/share/cups/model/$printer->{currentqueue}{ppd}");
+ $printer->{ARGS} = printer::main::read_cups_options("/usr/share/cups/model/$printer->{currentqueue}{ppd}");
}
}
}
@@ -2050,7 +2017,7 @@ sub setup_options {
$printer->{DBENTRY} =~ /^[^\|]*\|[^\|]*\|(.*)$/;
$driver = $1;
} else {
- $driver = printer::get_descr_from_ppd($printer);
+ $driver = printer::main::get_descr_from_ppd($printer);
if ($driver =~ /^[^\|]*\|[^\|]*$/) { # No driver info
$driver = "CUPS/PPD";
} else {
@@ -2092,7 +2059,7 @@ You should make sure that the page size and the ink type/printing mode (if avail
}
}
return (0);
- });
+ } );
}
# Read out the user's choices and generate the appropriate command
# line arguments
@@ -2127,7 +2094,7 @@ sub setasdefault {
# so set the current one as default
($in->ask_yesorno('', N("Do you want to set this printer (\"%s\")\nas the default printer?", $printer->{QUEUE}), 0))) { # Ask the user
$printer->{DEFAULT} = $printer->{QUEUE};
- printer::set_default_printer($printer);
+ printer::default::set_printer($printer);
}
}
@@ -2226,7 +2193,7 @@ Note: the photo test page can take a rather long time to get printed and on lase
{ text => N("Do not print any test page"), type => 'bool',
val => \$res2 } : ())
]);
- $res2 = 1 if !($standard || $altletter || $alta4 || $photo || $ascii);
+ $res2 = 1 unless $standard || $altletter || $alta4 || $photo || $ascii;
if ($res1 && !$res2) {
my @lpq_output;
{
@@ -2242,7 +2209,7 @@ Note: the photo test page can take a rather long time to get printed and on lase
my @testpages;
# Install the filter to convert the photo test page to PS
if (($printer->{SPOOLER} ne "cups") && ($photo) && (!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/convert))))) {
+ (!files_exist((qw(/usr/bin/convert))))) {
$in->do_pkgs->install('ImageMagick');
}
# set up list of pages to print
@@ -2252,7 +2219,7 @@ Note: the photo test page can take a rather long time to get printed and on lase
$photo && push (@testpages, $phototestpage);
$ascii && push (@testpages, $asciitestpage);
# print the stuff
- @lpq_output = printer::print_pages($printer, @testpages);
+ @lpq_output = printer::main::print_pages($printer, @testpages);
}
my $dialogtext;
if (@lpq_output) {
@@ -2325,11 +2292,11 @@ The \"%s\" command also allows to modify the option settings for a particular pr
(!$cupsremote ?
N("To know about the options available for the current printer read either the list shown below or click on the \"Print option list\" button.%s%s
-", $scanning, $photocard) . printer::help_output($printer, 'lpd') :
+", $scanning, $photocard) . printer::main::help_output($printer, 'lpd') :
$scanning . $photocard .
N("Here is a list of the available printing options for the current printer:
-") . printer::help_output($printer, 'lpd')) : $scanning . $photocard);
+") . printer::main::help_output($printer, 'lpd')) : $scanning . $photocard);
} elsif ($spooler eq "lprng") {
$dialogtext =
N("To print a file from the command line (terminal window) use the command \"%s <file>\".
@@ -2365,7 +2332,7 @@ The \"%s\" and \"%s\" commands also allow to modify the option settings for a pa
", "pdq", "lpr", ($queue ne $default ? "pdq -P $queue -aoption=setting -oswitch" : "pdq -aoption=setting -oswitch")) .
N("To know about the options available for the current printer read either the list shown below or click on the \"Print option list\" button.%s%s
-", $scanning, $photocard) . printer::help_output($printer, 'pdq') :
+", $scanning, $photocard) . printer::main::help_output($printer, 'pdq') :
$scanning . $photocard);
}
my $windowtitle = ($scanning ?
@@ -2385,7 +2352,7 @@ N("To know about the options available for the current printer read either the l
if ($choice ne N("Close")) {
my $w = $in->wait_message(N("Printerdrake"),
N("Printing test page(s)..."));
- printer::print_optionlist($printer);
+ printer::main::print_optionlist($printer);
}
}
} else {
@@ -2444,14 +2411,14 @@ sub copy_queues_from {
{
my $w = $in->wait_message(N("Printerdrake"),
N("Reading printer data..."));
- @oldqueues = printer::get_copiable_queues($oldspooler, $newspooler);
+ @oldqueues = printer::main::get_copiable_queues($oldspooler, $newspooler);
@oldqueues = sort(@oldqueues);
$newspoolerstr = $printer::shortspooler_inv{$newspooler};
$oldspoolerstr = $printer::shortspooler_inv{$oldspooler};
foreach (@oldqueues) {
push (@queuesselected, 1);
push (@queueentries, { text => $_, type => 'bool',
- val => \$queuesselected[$#queuesselected] });
+ val => \$queuesselected[$#queuesselected] } );
}
# LPRng and LPD use the same config files, therefore one sees the
# queues of LPD when one uses LPRng and vice versa, but these queues
@@ -2517,7 +2484,7 @@ You can also type a new name or skip this printer.",
{
my $w = $in->wait_message(N("Printerdrake"),
N("Transferring %s...", $oldqueue));
- printer::copy_foomatic_queue($printer, $oldqueue,
+ printer::main::copy_foomatic_queue($printer, $oldqueue,
$oldspooler, $newqueue) and
$queuecopied = 1;
}
@@ -2529,7 +2496,7 @@ You can also type a new name or skip this printer.",
(N("Transfer printer configuration"),
N("You have transferred your former default printer (\"%s\"), Should it be also the default printer under the new printing system %s?", $oldqueue, $newspoolerstr), 1))) {
$printer->{DEFAULT} = $newqueue;
- printer::set_default_printer($printer);
+ printer::default::set_printer($printer);
}
}
}
@@ -2538,7 +2505,7 @@ You can also type a new name or skip this printer.",
if ($queuecopied) {
my $w = $in->wait_message(N("Printerdrake"),
N("Refreshing printer data..."));
- printer::read_configured_queues($printer);
+ printer::main::read_configured_queues($printer);
}
}
}
@@ -2553,9 +2520,7 @@ sub start_network {
undef $upNetwork;
sleep(1);
$ret });
- } else {
- return printer::start_service("network");
- }
+ } else { return printer::services::start("network") }
}
sub check_network {
@@ -2577,7 +2542,7 @@ sub check_network {
# (otherwise the network is not configured yet and drakconnect has to be
# started)
- if ((!printer::files_exist("/etc/sysconfig/network-scripts/drakconnect_conf")) &&
+ if ((!files_exist("/etc/sysconfig/network-scripts/drakconnect_conf")) &&
(!$dontconfigure)) {
my $go_on = 0;
while (!$go_on) {
@@ -2599,7 +2564,7 @@ sub check_network {
} else {
system("/usr/sbin/drakconnect");
}
- if (printer::files_exist("/etc/sysconfig/network-scripts/drakconnect_conf")) {
+ if (files_exist("/etc/sysconfig/network-scripts/drakconnect_conf")) {
$go_on = 1;
}
} else {
@@ -2612,11 +2577,11 @@ sub check_network {
}
# Do not try to start the network if it is not configured
- if (!printer::files_exist("/etc/sysconfig/network-scripts/drakconnect_conf")) { return 0 }
+ if (!files_exist("/etc/sysconfig/network-scripts/drakconnect_conf")) { return 0 }
# Second check: Is the network running?
- if (printer::network_running()) { return 1 }
+ if (printer::detect::network_running()) { return 1 }
# The network is configured now, start it.
if ((!start_network($in, $upNetwork)) && (!$dontconfigure)) {
@@ -2635,7 +2600,7 @@ N("The network access was not running and could not be started. Please check you
my $w = $in->wait_message(N("Configuration of a remote printer"),
N("Restarting printing system..."));
- return printer::SIGHUP_daemon($printer->{SPOOLER});
+ return printer::main::SIGHUP_daemon($printer->{SPOOLER});
}
@@ -2667,7 +2632,7 @@ sub security_check {
# Exit silently if the current spooler is already activated for the current
# security level
- if (printer::spooler_in_security_level($spooler, $security)) { return 1 }
+ if (printer::main::spooler_in_security_level($spooler, $security)) { return 1 }
# Tell user in which security mode he is and ask him whether he really
# wants to activate the spooler in the given security mode. Stop the
@@ -2679,16 +2644,16 @@ sub security_check {
This printing system runs a daemon (background process) which waits for print jobs and handles them. This daemon is also accessable by remote machines through the network and so it is a possible point for attacks. Therefore only a few selected daemons are started by default in this security level.
Do you really want to configure printing on this machine?",
- $printer::shortspooler_inv{$spooler},
+ $printer::main::shortspooler_inv{$spooler},
$securitystr))) {
- printer::add_spooler_to_security_level($spooler, $security);
+ printer::main::add_spooler_to_security_level($spooler, $security);
my $service;
if (($spooler eq "lpr") || ($spooler eq "lprng")) {
$service = "lpd";
} else {
$service = $spooler;
}
- printer::start_service_on_boot($service);
+ services::start_service_on_boot($service); #TV
return 1;
} else {
return 0;
@@ -2705,15 +2670,15 @@ sub start_spooler_on_boot {
local $::isWizard = 0;
$in->set_help('startSpoolerOnBoot') if $::isInstall;
- if (!printer::service_starts_on_boot($service)) {
+ if (!services::starts_on_boot($service)) {
if ($in->ask_yesorno(N("Starting the printing system at boot time"),
N("The printing system (%s) will not be started automatically when the machine is booted.
It is possible that the automatic starting was turned off by changing to a higher security level, because the printing system is a potential point for attacks.
Do you want to have the automatic starting of the printing system turned on again?",
- $printer::shortspooler_inv{$printer->{SPOOLER}}))) {
- printer::start_service_on_boot($service);
+ $printer::main::shortspooler_inv{$printer->{SPOOLER}}))) {
+ services::start_service_on_boot($service);
}
}
1;
@@ -2725,15 +2690,13 @@ sub install_spooler {
if (!$::testing) {
# If the user refuses to install the spooler in high or paranoid
# security level, exit.
- if (!security_check($printer, $in, $printer->{SPOOLER})) {
- return 0;
- }
+ return 0 unless security_check($printer, $in, $printer->{SPOOLER});
if ($printer->{SPOOLER} eq "cups") {
{
my $w = $in->wait_message(N("Printerdrake"),
N("Checking installed software..."));
if ((!$::testing) &&
- (!printer::files_exist((qw(/usr/lib/cups/cgi-bin/printers.cgi
+ (!files_exist((qw(/usr/lib/cups/cgi-bin/printers.cgi
/sbin/ifconfig
/usr/bin/xpp),
($::expert ?
@@ -2743,8 +2706,8 @@ sub install_spooler {
($::expert ? 'cups-drivers' : ())));
}
if ((!$::testing) &&
- ((!printer::files_exist((qw(/usr/bin/wget)))) &&
- (!printer::files_exist((qw(/usr/bin/curl)))))) {
+ ((!files_exist((qw(/usr/bin/wget)))) &&
+ (!files_exist((qw(/usr/bin/curl)))))) {
$in->do_pkgs->install
($::isInstall ? 'curl' : 'webfetch');
}
@@ -2759,17 +2722,17 @@ sub install_spooler {
# Start daemon
# Avoid unnecessary restarting of CUPS, this blocks the
# startup of printerdrake for several seconds.
- printer::start_not_running_service("cups");
+ printer::services::start_not_running_service("cups");
# Set the CUPS tools as defaults for "lpr", "lpq", "lprm", ...
- printer::set_alternative("lpr","/usr/bin/lpr-cups");
- printer::set_alternative("lpq","/usr/bin/lpq-cups");
- printer::set_alternative("lprm","/usr/bin/lprm-cups");
- printer::set_alternative("lp","/usr/bin/lp-cups");
- printer::set_alternative("cancel","/usr/bin/cancel-cups");
- printer::set_alternative("lpstat","/usr/bin/lpstat-cups");
- printer::set_alternative("lpc","/usr/sbin/lpc-cups");
+ set_alternative("lpr","/usr/bin/lpr-cups");
+ set_alternative("lpq","/usr/bin/lpq-cups");
+ set_alternative("lprm","/usr/bin/lprm-cups");
+ set_alternative("lp","/usr/bin/lp-cups");
+ set_alternative("cancel","/usr/bin/cancel-cups");
+ set_alternative("lpstat","/usr/bin/lpstat-cups");
+ set_alternative("lpc","/usr/sbin/lpc-cups");
# Remove PDQ panic buttons from the user's KDE Desktops
- printer::pdq_panic_button("remove");
+ printer::main::pdq_panic_button("remove");
}
# Should it be started at boot time?
start_spooler_on_boot($printer, $in, "cups");
@@ -2779,13 +2742,13 @@ sub install_spooler {
N("Checking installed software..."));
# "lpr" conflicts with "LPRng", remove "LPRng"
if ((!$::testing) &&
- (printer::files_exist((qw(/usr/lib/filters/lpf))))) {
+ (files_exist((qw(/usr/lib/filters/lpf))))) {
my $w = $in->wait_message(N("Printerdrake"),
N("Removing LPRng..."));
$in->do_pkgs->remove_nodeps('LPRng');
}
if ((!$::testing) &&
- (!printer::files_exist((qw(/usr/sbin/lpf
+ (!files_exist((qw(/usr/sbin/lpf
/usr/sbin/lpd
/sbin/ifconfig
/usr/bin/gpr
@@ -2801,14 +2764,14 @@ sub install_spooler {
sleep(1);
};
# Start daemon
- printer::restart_service("lpd");
+ printer::services::restart("lpd");
# Set the LPD tools as defaults for "lpr", "lpq", "lprm", ...
- printer::set_alternative("lpr","/usr/bin/lpr-lpd");
- printer::set_alternative("lpq","/usr/bin/lpq-lpd");
- printer::set_alternative("lprm","/usr/bin/lprm-lpd");
- printer::set_alternative("lpc","/usr/sbin/lpc-lpd");
+ set_alternative("lpr","/usr/bin/lpr-lpd");
+ set_alternative("lpq","/usr/bin/lpq-lpd");
+ set_alternative("lprm","/usr/bin/lprm-lpd");
+ set_alternative("lpc","/usr/sbin/lpc-lpd");
# Remove PDQ panic buttons from the user's KDE Desktops
- printer::pdq_panic_button("remove");
+ printer::main::pdq_panic_button("remove");
}
# Should it be started at boot time?
start_spooler_on_boot($printer, $in, "lpd");
@@ -2818,13 +2781,13 @@ sub install_spooler {
N("Checking installed software..."));
# "LPRng" conflicts with "lpr", remove "lpr"
if ((!$::testing) &&
- (printer::files_exist((qw(/usr/sbin/lpf))))) {
+ (files_exist((qw(/usr/sbin/lpf))))) {
my $w = $in->wait_message(N("Printerdrake"),
N("Removing LPD..."));
$in->do_pkgs->remove_nodeps('lpr');
}
if ((!$::testing) &&
- (!printer::files_exist((qw(/usr/lib/filters/lpf
+ (!files_exist((qw(/usr/lib/filters/lpf
/usr/sbin/lpd
/sbin/ifconfig
/usr/bin/gpr
@@ -2840,17 +2803,17 @@ sub install_spooler {
sleep(1);
};
# Start daemon
- printer::restart_service("lpd");
+ printer::services::restart("lpd");
# Set the LPRng tools as defaults for "lpr", "lpq", "lprm", ...
- printer::set_alternative("lpr","/usr/bin/lpr-lpd");
- printer::set_alternative("lpq","/usr/bin/lpq-lpd");
- printer::set_alternative("lprm","/usr/bin/lprm-lpd");
- printer::set_alternative("lp","/usr/bin/lp-lpd");
- printer::set_alternative("cancel","/usr/bin/cancel-lpd");
- printer::set_alternative("lpstat","/usr/bin/lpstat-lpd");
- printer::set_alternative("lpc","/usr/sbin/lpc-lpd");
+ set_alternative("lpr","/usr/bin/lpr-lpd");
+ set_alternative("lpq","/usr/bin/lpq-lpd");
+ set_alternative("lprm","/usr/bin/lprm-lpd");
+ set_alternative("lp","/usr/bin/lp-lpd");
+ set_alternative("cancel","/usr/bin/cancel-lpd");
+ set_alternative("lpstat","/usr/bin/lpstat-lpd");
+ set_alternative("lpc","/usr/sbin/lpc-lpd");
# Remove PDQ panic buttons from the user's KDE Desktops
- printer::pdq_panic_button("remove");
+ printer::main::pdq_panic_button("remove");
}
# Should it be started at boot time?
start_spooler_on_boot($printer, $in, "lpd");
@@ -2859,7 +2822,7 @@ sub install_spooler {
my $w = $in->wait_message(N("Printerdrake"),
N("Checking installed software..."));
if ((!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/pdq
+ (!files_exist((qw(/usr/bin/pdq
/usr/X11R6/bin/xpdq))))) {
$in->do_pkgs->install('pdq');
}
@@ -2873,16 +2836,16 @@ sub install_spooler {
# PDQ has no daemon, so nothing needs to be started
# Set the PDQ tools as defaults for "lpr", "lpq", "lprm", ...
- printer::set_alternative("lpr","/usr/bin/lpr-pdq");
- printer::set_alternative("lpq","/usr/bin/lpq-foomatic");
- printer::set_alternative("lprm","/usr/bin/lprm-foomatic");
+ set_alternative("lpr","/usr/bin/lpr-pdq");
+ set_alternative("lpq","/usr/bin/lpq-foomatic");
+ set_alternative("lprm","/usr/bin/lprm-foomatic");
# Add PDQ panic buttons to the user's KDE Desktops
- printer::pdq_panic_button("add");
+ printer::main::pdq_panic_button("add");
}
}
# Give a SIGHUP to the devfsd daemon to correct the permissions
# for the /dev/... files according to the spooler
- printer::SIGHUP_daemon("devfs");
+ printer::main::SIGHUP_daemon("devfs");
}
1;
}
@@ -2895,7 +2858,7 @@ sub setup_default_spooler {
my $str_spooler =
$in->ask_from_list_(N("Select Printer Spooler"),
N("Which printing system (spooler) do you want to use?"),
- [ printer::spooler() ],
+ [ printer::main::spooler() ],
$printer::spooler_inv{$printer->{SPOOLER}},
) or return;
$printer->{SPOOLER} = $printer::spooler{$str_spooler};
@@ -2906,24 +2869,24 @@ sub setup_default_spooler {
}
if ($printer->{SPOOLER} ne $oldspooler) {
# Remove the local printers from Star Office/OpenOffice.org/GIMP
- printer::removelocalprintersfromapplications($printer);
+ printer::main::removelocalprintersfromapplications($printer);
# Get the queues of this spooler
{
my $w = $in->wait_message(N("Printerdrake"),
N("Reading printer data..."));
- printer::read_configured_queues($printer);
+ printer::main::read_configured_queues($printer);
}
# Copy queues from former spooler
copy_queues_from($printer, $in, $oldspooler);
# Re-read the printer database (CUPS has additional drivers, PDQ
# has no raw queue)
- %printer::thedb = ();
+ %printer::main::thedb = ();
#my $w = $in->wait_message(N("Printerdrake"),
# N("Reading printer database..."));
- #printer::read_printer_db($printer->{SPOOLER});
+ #printer::main::read_printer_db($printer->{SPOOLER});
}
# Save spooler choice
- printer::set_default_spooler($printer);
+ printer::default::set_spooler($printer);
return $printer->{SPOOLER};
}
@@ -2933,14 +2896,14 @@ sub configure_queue {
N("Configuring printer \"%s\"...",
$printer->{currentqueue}{queue}));
$printer->{complete} = 1;
- printer::configure_queue($printer);
+ printer::main::configure_queue($printer);
$printer->{complete} = 0;
}
sub install_foomatic {
my ($in) = @_;
if ((!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/foomatic-configure
+ (!files_exist((qw(/usr/bin/foomatic-configure
/usr/lib/perl5/vendor_perl/5.8.0/Foomatic/DB.pm)
)))) {
my $w = $in->wait_message(N("Printerdrake"),
@@ -2967,7 +2930,7 @@ sub main {
# Save the user mode, so that the same one is used on the next start
# of Printerdrake
- printer::set_usermode($::expert);
+ printer::main::set_usermode($::expert);
# Default printer name, we do not use "lp" so that one can switch the
# default printer under LPD without needing to rename another printer.
@@ -2980,14 +2943,14 @@ sub main {
my $w = $in->wait_message(N("Printerdrake"),
N("Checking installed software..."));
if ((!$::testing) &&
- (!printer::files_exist((qw(/usr/bin/foomatic-configure
+ (!files_exist((qw(/usr/bin/foomatic-configure
/usr/lib/perl5/vendor_perl/5.8.0/Foomatic/DB.pm
/usr/bin/escputil
/usr/share/printer-testpages/testprint.ps
/usr/bin/nmap
/usr/bin/scli
),
- (printer::files_exist("/usr/bin/gimp") ?
+ (files_exist("/usr/bin/gimp") ?
"/usr/lib/gimp/1.2/plug-ins/print" : ())
)))) {
$in->do_pkgs->install('foomatic','printer-utils','printer-testpages','nmap','scli',
@@ -2995,14 +2958,14 @@ sub main {
}
# only experts should be asked for the spooler
- !$::expert and $printer->{SPOOLER} ||= 'cups';
+ $printer->{SPOOLER} ||= 'cups' if $::expert;
}
# If we have chosen a spooler, install it and mark it as default spooler
if (($printer->{SPOOLER}) && ($printer->{SPOOLER} ne '')) {
if (!install_spooler($printer, $in, $upNetwork)) { return }
- printer::set_default_spooler($printer);
+ printer::default::set_spooler($printer);
}
# Turn on printer autodetection by default
@@ -3025,7 +2988,7 @@ sub main {
((!defined($printer->{DEFAULT})) || ($printer->{DEFAULT} eq ''))) {
my $w = $in->wait_message(N("Printerdrake"),
N("Preparing Printerdrake..."));
- $printer->{DEFAULT} = printer::get_default_printer($printer);
+ $printer->{DEFAULT} = printer::default::get_printer($printer);
if ($printer->{DEFAULT}) {
# If a CUPS system has only remote printers and no default
# printer defined, it defines the first printer whose
@@ -3033,17 +2996,15 @@ sub main {
# daemon, so on every start another printer gets the default
# printer. To avoid this, make sure that the default printer
# is defined.
- printer::set_default_printer($printer);
- } else {
- $printer->{DEFAULT} = '';
- }
+ printer::default::set_printer($printer);
+ } else { $printer->{DEFAULT} = '' }
}
# Configure the current printer queues in applications
{
my $w = $in->wait_message(N("Printerdrake"),
N("Configuring applications..."));
- printer::configureapplications($printer);
+ printer::main::configureapplications($printer);
}
if ($editqueue) {
@@ -3082,7 +3043,7 @@ sub main {
my $havelocalnetworks_or_expert =
(($::expert) ||
(check_network($printer, $in, $upNetwork, 1) &&
- (printer::getIPsInLocalNetworks() != ())));
+ (printer::detect::getIPsInLocalNetworks() != ())));
# Show a queue list window when there is at least one queue,
# when we are in expert mode, or when we are not in the
# installation.
@@ -3109,7 +3070,7 @@ sub main {
} elsif ($printer->{SPOOLER} eq "cups") {
($cursorpos) =
grep { /!$printer->{DEFAULT}:[^!]*$/ }
- printer::get_cups_remote_queues($printer);
+ printer::main::get_cups_remote_queues($printer);
}
}
# Generate the list of available printers
@@ -3120,7 +3081,7 @@ sub main {
keys(%{$printer->{configured}
|| {}})),
($printer->{SPOOLER} eq "cups" ?
- printer::get_cups_remote_queues($printer) :
+ printer::main::get_cups_remote_queues($printer) :
())))
);
my $noprinters = ($#printerlist < 0);
@@ -3194,23 +3155,23 @@ sub main {
);
# Toggle expert mode and standard mode
if ($menuchoice eq "\@usermode") {
- printer::set_usermode(!$::expert);
+ printer::main::set_usermode(!$::expert);
# make sure that the "cups-drivers" package gets
# installed when switching into expert mode
if (($::expert) && ($printer->{SPOOLER} eq "cups")) {
install_spooler($printer, $in, $upNetwork);
}
# Read printer database for the new user mode
- %printer::thedb = ();
+ %printer::main::thedb = ();
#my $w = $in->wait_message(N("Printerdrake"),
# N("Reading printer database..."));
- #printer::read_printer_db($printer->{SPOOLER});
+ #printer::main::read_printer_db($printer->{SPOOLER});
# Re-read printer queues to switch the tree
# structure between expert/normal mode.
my $w = $in->wait_message
(N("Printerdrake"),
N("Reading printer data..."));
- printer::read_configured_queues($printer);
+ printer::main::read_configured_queues($printer);
$cursorpos = "::";
next;
}
@@ -3249,7 +3210,7 @@ sub main {
}
}
# Save the default spooler
- printer::set_default_spooler($printer);
+ printer::default::set_spooler($printer);
#- Close printerdrake
$menuchoice eq "\@quit" and last;
}
@@ -3257,7 +3218,7 @@ sub main {
$printer->{NEW} = 1;
#- Set default values for a new queue
$printer::printer_type_inv{$printer->{TYPE}} or
- $printer->{TYPE} = printer::default_printer_type($printer);
+ $printer->{TYPE} = printer::default::printer_type($printer);
$printer->{currentqueue} = { queue => $queue,
foomatic => 0,
desc => "",
@@ -3416,7 +3377,7 @@ sub main {
if ($printer->{configured}{$queue}) {
# Here we must regenerate the menu entry, because the
# parameters can be changed.
- printer::make_menuentry($printer,$queue);
+ printer::main::make_menuentry($printer,$queue);
$printer->{configured}{$queue}{queuedata}{menuentry} =~
/!([^!]+)$/;
$infoline = $1 .
@@ -3473,7 +3434,7 @@ What do you want to modify on this printer?",
$printer->{currentqueue} = {};
my $driver;
if ($printer->{configured}{$queue}) {
- printer::copy_printer_params($printer->{configured}{$queue}{queuedata}, $printer->{currentqueue});
+ printer::main::copy_printer_params($printer->{configured}{$queue}{queuedata}, $printer->{currentqueue});
#- Keep in mind the printer driver which was used, so it
#- can be determined whether the driver is only
#- available in expert and so for setting the options
@@ -3512,12 +3473,12 @@ What do you want to modify on this printer?",
(N("Printerdrake"),
N("Removing old printer \"%s\"...",
$printer->{OLD_QUEUE}));
- printer::remove_queue($printer, $printer->{OLD_QUEUE});
+ printer::main::remove_queue($printer, $printer->{OLD_QUEUE});
# If the default printer was renamed, correct the
# the default printer setting of the spooler
if ($queue eq $printer->{DEFAULT}) {
$printer->{DEFAULT} = $printer->{QUEUE};
- printer::set_default_printer($printer);
+ printer::default::set_printer($printer);
}
$queue = $printer->{QUEUE};
}
@@ -3534,11 +3495,11 @@ What do you want to modify on this printer?",
configure_queue($printer, $in);
} elsif ($modify eq N("Set this printer as the default")) {
$printer->{DEFAULT} = $queue;
- printer::set_default_printer($printer);
+ printer::default::set_printer($printer);
$in->ask_warn(N("Default printer"),
N("The printer \"%s\" is set as the default printer now.", $queue));
} elsif ($modify eq N("Add this printer to Star Office/OpenOffice.org/GIMP")) {
- if (printer::addcupsremotetoapplications
+ if (printer::main::addcupsremotetoapplications
($printer, $queue)) {
$in->ask_warn(N("Adding printer to Star Office/OpenOffice.org/GIMP"),
N("The printer \"%s\" was successfully added to Star Office/OpenOffice.org/GIMP.", $queue));
@@ -3547,7 +3508,7 @@ What do you want to modify on this printer?",
N("Failed to add the printer \"%s\" to Star Office/OpenOffice.org/GIMP.", $queue));
}
} elsif ($modify eq N("Remove this printer from Star Office/OpenOffice.org/GIMP")) {
- if (printer::removeprinterfromapplications
+ if (printer::main::removeprinterfromapplications
($printer, $queue)) {
$in->ask_warn(N("Removing printer from Star Office/OpenOffice.org/GIMP"),
N("The printer \"%s\" was successfully removed from Star Office/OpenOffice.org/GIMP.", $queue));
@@ -3566,7 +3527,7 @@ What do you want to modify on this printer?",
my $w = $in->wait_message
(N("Printerdrake"),
N("Removing printer \"%s\"...", $queue));
- if (printer::remove_queue($printer, $queue)) {
+ if (printer::main::remove_queue($printer, $queue)) {
$editqueue = 0;
# Define a new default printer if we have
# removed the default one
@@ -3574,7 +3535,7 @@ What do you want to modify on this printer?",
my @k = sort(keys(%{$printer->{configured}}));
if (@k) {
$printer->{DEFAULT} = $k[0];
- printer::set_default_printer($printer);
+ printer::default::set_printer($printer);
} else {
$printer->{DEFAULT} = "";
}
@@ -3619,7 +3580,7 @@ What do you want to modify on this printer?",
if ($::isInstall && !$::expert && !$menushown && !$continue) {
my $w = $in->wait_message(N("Printerdrake"),
N("Configuring applications..."));
- printer::configureapplications($printer);
+ printer::main::configureapplications($printer);
}
# Delete some variables
diff --git a/perl-install/printer/services.pm b/perl-install/printer/services.pm
new file mode 100644
index 000000000..1b68da96a
--- /dev/null
+++ b/perl-install/printer/services.pm
@@ -0,0 +1,61 @@
+package printer::services;
+
+use strict;
+use services;
+use run_program;
+
+sub restart ($) {
+ my ($service) = @_;
+ if (services::restart($service)) {
+ # CUPS needs some time to come up.
+ wait_for_cups() if $service eq "cups";
+ return 1;
+ } else { return 0 }
+}
+
+sub start ($) {
+ my ($service) = @_;
+ if (services::start($service)) {
+ # CUPS needs some time to come up.
+ wait_for_cups() if $service eq "cups";
+ return 1;
+ } else { return 0 }
+}
+
+sub start_not_running_service ($) {
+ my ($service) = @_;
+ # The exit status is not zero when the service is not running
+ if (services::start_not_running_service($service)) {
+ return 0;
+ } else {
+ run_program::rooted($::prefix, "/etc/rc.d/init.d/$service", "start");
+ if (($? >> 8) != 0) {
+ return 0;
+ } else {
+ # CUPS needs some time to come up.
+ wait_for_cups() if $service eq "cups";
+ return 1;
+ }
+ }
+}
+
+sub wait_for_cups {
+ # CUPS needs some time to come up. Wait up to 30 seconds, checking
+ # whether CUPS is ready.
+ my $cupsready = 0;
+ my $i;
+ for ($i = 0; $i < 30; $i++) {
+ run_program::rooted($::prefix, "/usr/bin/lpstat", "-r");
+ if (($? >> 8) != 0) {
+ # CUPS is not ready, continue
+ sleep 1;
+ } else {
+ # CUPS is ready, quit
+ $cupsready = 1;
+ last;
+ }
+ }
+ return $cupsready;
+}
+
+1;
diff --git a/perl-install/services.pm b/perl-install/services.pm
index c48518816..3348b2bf6 100644
--- a/perl-install/services.pm
+++ b/perl-install/services.pm
@@ -1,11 +1,16 @@
package services; # $Id$
-use diagnostics;
-use strict;
+
+
#-######################################################################################
#- misc imports
#-######################################################################################
+
+use strict;
+use common;
+use run_program;
+
use common;
use run_program;
@@ -226,7 +231,7 @@ sub ask_standalone_gtk {
push @$on_services, $service if !member($service, @$on_services);
} else {
@$on_services = grep { $_ ne $service } @$on_services;
- } }), member($service, @$on_services))),
+ }}), member($service, @$on_services))),
map { my $a = $_;
gtkpack__(new Gtk::HBox(0,0), gtksignal_connect(new Gtk::Button(translate($a)),
clicked => sub { my $c = "service $service " . (lc($a) eq "start" ? "restart" : lc($a)) . " 2>&1"; local $_ = `$c`; s/\033\[[^mG]*[mG]//g;
@@ -286,4 +291,80 @@ sub services {
[ map { $_->[0] } @l ], [ map { $_->[0] } grep { $_->[1] } @l ];
}
+
+
+
+
+
+# the following functions are mostly by printer related modules
+
+#-if we are in an DrakX config
+our $prefix = "";
+
+
+sub restart ($) {
+ my ($service) = @_;
+ # Exit silently if the service is not installed
+ return 1 if !(-x "$prefix/etc/rc.d/init.d/$service");
+ run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "restart");
+}
+
+sub start ($) {
+ my ($service) = @_;
+ # Exit silently if the service is not installed
+ return 1 if !(-x "$prefix/etc/rc.d/init.d/$service");
+ run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "start");
+ return (($? >> 8) != 0) ? 0 : 1;
+}
+
+sub start_not_running_service ($) {
+ my ($service) = @_;
+ # Exit silently if the service is not installed
+ return 1 if !(-x "$prefix/etc/rc.d/init.d/$service");
+ run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "status");
+ return (($? >> 8) != 0) ? 0 : 1;
+}
+
+sub stop ($) {
+ my ($service) = @_;
+ # Exit silently if the service is not installed
+ return 1 if !(-x "$prefix/etc/rc.d/init.d/$service");
+ run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "stop");
+ return (($? >> 8) != 0) ? 0 : 1;
+}
+
+sub is_service_running ($) {
+ my ($service) = @_;
+ # Exit silently if the service is not installed
+ return 0 if !(-x "$prefix/etc/rc.d/init.d/$service");
+ run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "status");
+ # The exit status is not zero when the service is not running
+ return (($? >> 8) != 0) ? 0 : 1;
+}
+
+sub starts_on_boot ($) {
+ my ($service) = @_;
+ local *F;
+ open F, ($::testing ? $prefix : "chroot $prefix/ ") .
+ "/bin/sh -c \"export LC_ALL=C; /sbin/chkconfig --list $service 2>&1\" |" or
+ return 0;
+ while (my $line = <F>) {
+ chomp $line;
+ if ($line =~ /:on/) {
+ close F;
+ return 1;
+ }
+ }
+ close F;
+ return 0;
+}
+
+sub start_service_on_boot ($) {
+ my ($service) = @_;
+ run_program::rooted($prefix, "/sbin/chkconfig", "--add", $service)
+ or return 0;
+ return 1;
+}
+
+
1;
diff --git a/perl-install/standalone/printerdrake b/perl-install/standalone/printerdrake
index 19770d97f..a73253d05 100755
--- a/perl-install/standalone/printerdrake
+++ b/perl-install/standalone/printerdrake
@@ -21,11 +21,11 @@
use lib qw(/usr/lib/libDrakX);
use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use printerdrake;
-use printer;
use common;
+use interactive;
+use printer::printerdrake;
+use printer::main;
+use modules;
use c;
local $_ = join '', @ARGV;
@@ -38,7 +38,7 @@ if (/-expert/) {
} elsif (/-beginner/) {
$::expert = 0;
} else {
- printer::get_usermode ();
+ printer::main::get_usermode ();
}
$::noauto = /-noauto/;
$::testing = /-testing/;
@@ -49,33 +49,33 @@ my $in = 'interactive'->vnew('su', 'printer-mdk');
my $commandline = $_;
-exit 0 if !printerdrake::first_time_dialog($printer, $in, 1);
+exit 0 unless printer::printerdrake::first_time_dialog($printer, $in, 1);
{
# Check whether Foomatic is installed and install it if necessary
-printerdrake::install_foomatic($in);
+printer::printerdrake::install_foomatic($in);
my $w = $in->wait_message(N("Printerdrake"), N("Reading printer data ..."));
# Get what was installed before
-eval { $printer = printer::getinfo('') };
+eval { $printer = printer::main::getinfo('') };
# Choose the spooler by command line options
$commandline =~ /-cups/ and
- $printer->{SPOOLER} = 'cups' and printer::read_configured_queues($printer);
+ $printer->{SPOOLER} = 'cups' and printer::main::read_configured_queues($printer);
$commandline =~ /-lpr/ and
- $printer->{SPOOLER} = 'lpd' and printer::read_configured_queues($printer);
+ $printer->{SPOOLER} = 'lpd' and printer::main::read_configured_queues($printer);
$commandline =~ /-lpd/ and
- $printer->{SPOOLER} = 'lpd' and printer::read_configured_queues($printer);
+ $printer->{SPOOLER} = 'lpd' and printer::main::read_configured_queues($printer);
$commandline =~ /-lprng/ and
- $printer->{SPOOLER} ='lprng' and printer::read_configured_queues($printer);
+ $printer->{SPOOLER} ='lprng' and printer::main::read_configured_queues($printer);
$commandline =~ /-pdq/ and
- $printer->{SPOOLER} = 'pdq' and printer::read_configured_queues($printer);
+ $printer->{SPOOLER} = 'pdq' and printer::main::read_configured_queues($printer);
-r '/etc/modules.conf' and modules::mergein_conf('/etc/modules.conf');
}
begin:
$::isEmbedded and kill 'USR2', $::CCPID;
-printerdrake::main($printer, $in, 1);
+printer::printerdrake::main($printer, $in, 1);
$::isEmbedded ? kill('USR1', $::CCPID) : $in->exit(0);
goto begin;