diff options
Diffstat (limited to 'perl-install/printer/office.pm')
| -rw-r--r-- | perl-install/printer/office.pm | 384 |
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; +} + |