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 ...

1 files changed, 384 insertions, 0 deletions

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;
+}
+