summaryrefslogtreecommitdiffstats
path: root/perl-install/printer.pm
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2000-08-31 14:58:10 +0000
committerFrancois Pons <fpons@mandriva.com>2000-08-31 14:58:10 +0000
commit4518333f00c36f19b3425202e07e5db5d32a10ce (patch)
tree6862a673a807aeda6020a82302c701a2079a32c9 /perl-install/printer.pm
parent352b6ae2a540ce8f56e96a2284721cd27cc3d9d1 (diff)
downloaddrakx-4518333f00c36f19b3425202e07e5db5d32a10ce.tar
drakx-4518333f00c36f19b3425202e07e5db5d32a10ce.tar.gz
drakx-4518333f00c36f19b3425202e07e5db5d32a10ce.tar.bz2
drakx-4518333f00c36f19b3425202e07e5db5d32a10ce.tar.xz
drakx-4518333f00c36f19b3425202e07e5db5d32a10ce.zip
*** empty log message ***
Diffstat (limited to 'perl-install/printer.pm')
-rw-r--r--perl-install/printer.pm962
1 files changed, 413 insertions, 549 deletions
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index 704c45ec6..ad6e46359 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -1,227 +1,13 @@
package printer;
-#-#####################################################################################
-
-=head1 NAME
-
-printer - supply methods for manage the printer related files directory handles
-
-=head1 SYNOPSIS
-
-use printer;
-
-=head1 DESCRIPTION
-
-Use the source.
-
-=cut
-
-#-#####################################################################################
use diagnostics;
use strict;
-
-#-#####################################################################################
-
-=head2 Exported variable
-
-=cut
-
-#-#####################################################################################
-use vars qw(%thedb %thedb_gsdriver %printer_type %printer_type_inv $printer_type_default @papersize_type %fields $spooldir @entries_db_short @entry_db_description %descr_to_help %descr_to_db %db_to_descr);
-#-#####################################################################################
-
-=head2 Imports
-
-=cut
-
-#-#####################################################################################
-use Data::Dumper;
-
-#-#####################################################################################
-
-=head2 pixel imports
-
-=cut
+use vars qw(%thedb %thedb_gsdriver %printer_type %printer_type_inv @papersize_type %fields @entries_db_short @entry_db_description %descr_to_help %descr_to_db %db_to_descr %descr_to_ppd);
use common qw(:common :system :file);
use commands;
-#-#####################################################################################
-
-#-#####################################################################################
-
-=head2 Examples and types
-
-=over 4
-
-=item *
-
-an entry in the 'printerdb' file, which describes each type of
-supported printer:
-
- StartEntry: DeskJet550
- GSDriver: cdj550
- Description: {HP DeskJet 550C/560C/6xxC series}
- About: { \
- This driver supports the HP inkjet printers which have \
- color capability using both black and color cartridges \
- simultaneously. Known to work with the 682C and the 694C. \
- Other 600 and 800 series printers may work \
- if they have this feature. \
- If your printer seems to be saturating the paper with ink, \
- try added an extra GS option of '-dDepletion=2'. \
- Ghostscript supports several optional parameters for \
- this driver: see the document 'devices.doc' \
- in the ghostscript directory under /usr/doc. \
- }
- Resolution: {300} {300} {}
- BitsPerPixel: {3} {Normal color printing with color cartridge}
- BitsPerPixel: {8} {Floyd-Steinberg B & W printing for better greys}
- BitsPerPixel: {24} {Floyd-Steinberg Color printing (best, but slow)}
- BitsPerPixel: {32} {Sometimes provides better output than 24}
- EndEntry
-
-Example of data-struct:
-
- my %ex_printerdb_entry =
- (
- ENTRY => "DeskJet550", #-Human-readable name of the entry
- GSDRIVER => "cdj550", #-gs driver used by this printer
- DESCR => "HP DeskJet 550C/560C/6xxC series", #-Single line description of printer
- ABOUT => "
- This driver supports the HP inkjet printers which have
- color capability using both black and color cartridges
- ...", #-Lengthy description of printer
- RESOLUTION => [ #-List of resolutions supported
- {
- XDPI => 300,
- YDPI => 300,
- DESCR => "commentaire",
- },
- ],
- BITSPERPIXEL => [ #-List of color depths supported
- {
- DEPTH => 3,
- DESCR => "Normal color printing with color cartridge",
- },
- ],
- )
- ;
-
-=item *
-
-A printcap entry only represents a subset of possible options available
-Sufficient for the simple configuration we are interested in
-there is also some text in the template (.in) file in the spooldir
-
- # /etc/printcap
- #
- # Please don't edit this file directly unless you know what you are doing
- # Be warned that the control-panel printtool requires a very strict forma
- # Look at the printcap(5) man page for more info.
- #
- # This file can be edited with the printtool in the control-panel.
-
- ##PRINTTOOL3## LOCAL uniprint NAxNA letter {} U_NECPrinwriter2X necp2x6 1
- lpname:\
- :sd=/var/spool/lpd/lpnamespool:\
- :mx#45:\
- :sh:\
- :lp=/dev/device:\
- :if=/var/spool/lpd/lpnamespool/filter:
- ##PRINTTOOL3## REMOTE st800 360x180 a4 {} EpsonStylus800 Default 1
- remote:\
- :sd=/var/spool/lpd/remotespool:\
- :mx#47:\
- :sh:\
- :rm=remotehost:\
- :rp=remotequeue:\
- :if=/var/spool/lpd/remotespool/filter:
- ##PRINTTOOL3## SMB la75plus 180x180 letter {} DECLA75P Default {}
- smb:\
- :sd=/var/spool/lpd/smbspool:\
- :mx#46:\
- :sh:\
- :if=/var/spool/lpd/smbspool/filter:\
- :af=/var/spool/lpd/smbspool/acct:\
- :lp=/dev/null:
- ##PRINTTOOL3## NCP ap3250 180x180 letter {} EpsonAP3250 Default {}
- ncp:\
- :sd=/var/spool/lpd/ncpspool:\
- :mx#46:\
- :sh:\
- :if=/var/spool/lpd/ncpspool/filter:\
- :af=/var/spool/lpd/ncpspool/acct:\
- :lp=/dev/null:
-
-Example of data-struct:
-
- my %ex_printcap_entry =
- (
- QUEUE => "lpname", #-Queue name, can have multi separated by '|'
-
- #-if you want something different from the default
- SPOOLDIR => "/var/spool/lpd/lpnamespool/", #-Spool directory
- IF => "/var/spool/lpd/lpnamespool/filter", #-input filter
-
- #- commentaire inserer dans le printcap pour que printtool retrouve ses petits
- DBENTRY => "DeskJet670", #-entry in printer database for this printer
-
- RESOLUTION => "NAxNA", #-ghostscript resolution to use
- PAPERSIZE => "letter", #-Papersize
- BITSPERPIXEL => "necp2x6", #-ghostscript color option
- CRLF => 1 , #-Whether or not to do CR/LF xlation
-
- TYPE => "LOCAL",
-
- #- LOCAL
- DEVICE => "/dev/device", #-Print device
-
- #- REMOTE (lpd) printers only
- REMOTEHOST => "remotehost", #-Remote host (not used for all entries)
- REMOTEQUEUE => "remotequeue", #-Queue on the remote machine
-
-
- #-SMB (LAN Manager) only
- #- in spooldir/.config
- #-share='\\hostname\printername'
- #-hostip=1.2.3.4
- #-user='user'
- #-password='passowrd'
- #-workgroup='AS3'
- SMBHOST => "hostname", #-Server name (NMB name, can have spaces)
- SMBHOSTIP => "1.2.3.4", #-Can optional specify and IP address for host
- SMBSHARE => "printername", #-Name of share on the SMB server
- SMBUSER => "user", #-User to log in as on SMB server
- SMBPASSWD => "passowrd", #-Corresponding password
- SMBWORKGROUP => "AS3", #-SMB workgroup name
- AF => "/var/spool/lpd/smbspool/acct", #-accounting filter (needed for smbprint)
-
- #- NCP (NetWare) only
- #- in spooldir/.config
- #-server=printerservername
- #-queue=queuename
- #-user=user
- #-password=pass
- NCPHOST => "printerservername", #-Server name (NCP name)
- NCPQUEUE => "queuename", #-Queue on server
- NCPUSER => "user", #-User to log in as on NCP server
- NCPPASSWD => "pass", #-Corresponding password
-
- )
- ;
-
-=cut
-
-#-#####################################################################################
-
-=head2 Intern constant
-
-=cut
-
-#-#####################################################################################
-
#-if we are in an DrakX config
my $prefix = "";
@@ -229,25 +15,15 @@ my $prefix = "";
my $PRINTER_DB_FILE = "/usr/lib/rhs/rhs-printfilters/printerdb";
my $PRINTER_FILTER_DIR = "/usr/lib/rhs/rhs-printfilters";
-
-
-
-#-#####################################################################################
-
-=head2 Exported constant
-
-=cut
-
-#-#####################################################################################
-
%printer_type = (
- __("Local printer") => "LOCAL",
- __("Remote lpd") => "REMOTE",
- __("SMB/Windows 95/98/NT") => "SMB",
- __("NetWare") => "NCP",
+ __("Local printer") => "LOCAL",
+ __("Remote lpd") => "REMOTE",
+ __("SMB/Windows 95/98/NT") => "SMB",
+ __("NetWare") => "NCP",
+ __("URI for Local printer") => "URI_LOCAL",
+ __("URI for Network printer") => "URI_NET",
);
%printer_type_inv = reverse %printer_type;
-$printer_type_default = "Local printer";
%fields = (
STANDARD => [qw(QUEUE SPOOLDIR IF)],
@@ -258,19 +34,20 @@ $printer_type_default = "Local printer";
NCP => [qw(NCPHOST NCPQUEUE NCPUSER NCPPASSWD)],
);
@papersize_type = qw(letter legal ledger a3 a4);
-$spooldir = "/var/spool/lpd";
-
-#-#####################################################################################
-
-=head2 Functions
-
-=cut
-
-#-#####################################################################################
+#------------------------------------------------------------------------------
sub set_prefix($) { $prefix = $_[0]; }
-sub default_queue($) { (split '\|', $_[0])[0] }
+sub default_queue($) { (split '\|', $_[0]{QUEUE})[0] }
+sub default_spooldir($) { "/var/spool/lpd/" . default_queue($_[0]) }
+
+sub default_printer_type($) { ($_[0]{mode} eq /cups/ && "URI_") . "LOCAL" }
+sub printer_type($) {
+ for ($_[0]{mode}) {
+ /cups/ && return @printer_type_inv{qw(URI_LOCAL URI_NET LOCAL REMOTE SMB)};
+ /lpr/ && return @printer_type_inv{qw(LOCAL REMOTE SMB NCP)};
+ }
+}
sub copy_printer_params($$) {
my ($from, $to) = @_;
@@ -282,13 +59,20 @@ sub getinfo($) {
my $printer = {};
set_prefix($prefix);
- read_configured_queue($printer);
+
+ #- try to detect which printing system has been previously installed.
+ #- the first detected is the default.
+ read_printers_conf($printer); #- try to read existing cups (local only) queues.
+ read_configured_queue($printer); #- try to read existing lpr queues.
add2hash($printer, {
+ #- global parameters.
want => 0,
complete => 0,
- str_type => $printer::printer_type_default,
+ str_type => undef,
QUEUE => "lp",
+
+ #- lpr parameters.
SPOOLDIR => "/var/spool/lpd/lp",
DBENTRY => "PostScript",
PAPERSIZE => "",
@@ -315,141 +99,18 @@ sub getinfo($) {
SMBUSER => "", #-"user",
SMBPASSWD => "", #-"passowrd",
SMBWORKGROUP => "", #-"AS3",
+
+ #- cups parameters.
+ DeviceURI => "parallel:/dev/lp0",
+ Info => "",
+ Location => "",
+ State => "Idle",
+ Accepting => "Yes",
});
$printer;
}
-#-*****************************************************************************
-#- read function
-#-*****************************************************************************
-#------------------------------------------------------------------------------
-#- Read the printer database from dbpath into memory
-#------------------------------------------------------------------------------
-sub read_printer_db(;$) {
- my $dbpath = $prefix . ($_[0] || $PRINTER_DB_FILE);
-
- scalar(keys %thedb) > 4 and return; #- try reparse if using only ppa, POSTSCRIPT, TEXT.
-
- my %available_devices; #- keep only available devices in our database.
- local *AVAIL; open AVAIL, ($::testing ? "$prefix" : "chroot $prefix/ ") . "/usr/bin/gs --help |";
- foreach (<AVAIL>) {
- if (/^Available devices:/ ... /^\S/) {
- @available_devices{split /\s+/, $_} = () if /^\s+/;
- }
- }
- close AVAIL;
- $available_devices{ppa} = undef; #- if -x "$prefix/usr/bin/pbm2ppa" && -x "$prefix/usr/bin/pnm2ppa";
- delete $available_devices{''};
- @available_devices{qw/POSTSCRIPT TEXT/} = (); #- these are always available.
-
- local $_; #- use of while (<...
- local *DBPATH; #- don't have to do close ... and don't modify globals at least
- open DBPATH, $dbpath or die "An error has occurred on $dbpath : $!";
-
- while (<DBPATH>) {
- if (/^StartEntry:\s(\w*)/) {
- my $entry = { ENTRY => $1 };
-
- WHILE :
- while (<DBPATH>) {
- SWITCH: {
- /GSDriver:\s*(\w*)/ and do { $entry->{GSDRIVER} = $1; last SWITCH };
- /Description:\s*{(.*)}/ and do { $entry->{DESCR} = $1; last SWITCH };
- /About:\s*{\s*(.*?)\s*}/ and do { $entry->{ABOUT} = $1; last SWITCH };
- /About:\s*{\s*(.*?)\s*\\\s*$/
- and do {
- my $string = $1;
- while (<DBPATH>) {
- $string =~ /\S$/ and $string .= ' ';
- /^\s*(.*?)\s*\\\s*$/ and $string .= $1;
- /^\s*(.*?)\s*}\s*$/ and do { $entry->{ABOUT} = $string . $1; last SWITCH };
- }
- };
- /Resolution:\s*{(.*)}\s*{(.*)}\s*{(.*)}/
- and do { push @{$entry->{RESOLUTION} ||= []}, { XDPI => $1, YDPI => $2, DESCR => $3 }; last SWITCH };
- /BitsPerPixel:\s*{(.*)}\s*{(.*)}/
- and do { push @{$entry->{BITSPERPIXEL} ||= []}, {DEPTH => $1, DESCR => $2}; last SWITCH };
-
- /EndEntry/ and last WHILE;
- }
- }
- if (exists $available_devices{$entry->{GSDRIVER}}) {
- $thedb{$entry->{ENTRY}} = $entry;
- $thedb_gsdriver{$entry->{GSDRIVER}} = $entry;
- }
- }
- }
-
- @entries_db_short = sort keys %printer::thedb;
- %descr_to_db = map { $printer::thedb{$_}{DESCR}, $_ } @entries_db_short;
- %descr_to_help = map { $printer::thedb{$_}{DESCR}, $printer::thedb{$_}{ABOUT} } @entries_db_short;
- @entry_db_description = keys %descr_to_db;
- %db_to_descr = reverse %descr_to_db;
-}
-
-
-#-******************************************************************************
-#- write functions
-#-******************************************************************************
-
-#------------------------------------------------------------------------------
-#- given the path queue_path, we create all the required spool directory
-#------------------------------------------------------------------------------
-sub create_spool_dir($) {
- my ($queue_path) = @_;
- my $complete_path = "$prefix/$queue_path";
-
- commands::mkdir_("-p", $complete_path);
-
- unless ($::testing) {
- #-redhat want that "drwxr-xr-x root lp"
- my $gid_lp = (getpwnam("lp"))[3];
- chown 0, $gid_lp, $complete_path
- or die "An error has occurred - can't chgrp $complete_path to lp $!";
- }
-}
-
-#------------------------------------------------------------------------------
-#-given the input spec file 'input', and the target output file 'output'
-#-we set the fields specified by fieldname to the values in fieldval
-#-nval is the number of fields to set
-#-Doesnt currently catch error exec'ing sed yet
-#------------------------------------------------------------------------------
-sub create_config_file($$%) {
- my ($inputfile, $outputfile, %toreplace) = @_;
- template2file("$prefix/$inputfile", "$prefix/$outputfile", %toreplace);
- eval { commands::chown_("root.lp", "$prefix/$outputfile") };
-}
-
-
-#------------------------------------------------------------------------------
-#-copy master filter to the spool dir
-#------------------------------------------------------------------------------
-sub copy_master_filter($) {
- my ($queue_path) = @_;
- my $complete_path = "$prefix/$queue_path/filter";
- my $master_filter = "$prefix/$PRINTER_FILTER_DIR/master-filter";
-
- eval { commands::cp('-f', $master_filter, $complete_path) };
- $@ and die "Can't copy $master_filter to $complete_path $!";
- eval { commands::chown_("root.lp", $complete_path); };
-}
-
#------------------------------------------------------------------------------
-#- given a PrintCap Entry, create the spool dir and special
-#- rhs-printfilters related config files which are required
-#------------------------------------------------------------------------------
-my $intro_printcap_test = "
-#
-# Please don't edit this file directly unless you know what you are doing!
-# Look at the printcap(5) man page for more info.
-# Be warned that the control-panel printtool requires a very strict format!
-#
-# This file can be edited with printerdrake or printtool.
-#
-
-";
-
sub read_configured_queue($) {
my ($printer) = @_;
my $current = undef;
@@ -461,7 +122,7 @@ sub read_configured_queue($) {
};
#- read /etc/printcap file.
- local *PRINTCAP; open PRINTCAP, "$prefix/etc/printcap" or die "Can't open $prefix/etc/printcap file: $!";
+ local *PRINTCAP; open PRINTCAP, "$prefix/etc/printcap" or return;
foreach (<PRINTCAP>) {
chomp;
my $p = '(?:\{(.*?)\}|(\S+))';
@@ -576,210 +237,413 @@ sub read_configured_queue($) {
close F;
}
}
+
+ #- assume this printing system.
+ $printer->{mode} ||= 'lpr';
}
-sub configure_queue($) {
- my ($entry) = @_;
- my $queue_path = "$entry->{SPOOLDIR}";
- create_spool_dir($queue_path);
+sub read_printer_db(;$) {
+ my $dbpath = $prefix . ($_[0] || $PRINTER_DB_FILE);
- my $get_name_file = sub {
- my ($name) = @_;
- ("$PRINTER_FILTER_DIR/$name.in", "$entry->{SPOOLDIR}/$name")
- };
- my ($filein, $file);
- my %fieldname = ();
- my $dbentry = $thedb{($entry->{DBENTRY})} or die "no dbentry";
-
- #- make general.cfg
- ($filein, $file) = &$get_name_file("general.cfg");
- $fieldname{ascps_trans} = $entry->{ASCII_TO_PS} || $dbentry->{GSDRIVER} eq 'ppa' ? "YES" : "NO";
- $fieldname{desiredto} = $dbentry->{GSDRIVER} ne "TEXT" ? "ps" : "asc";
- $fieldname{papersize} = $entry->{PAPERSIZE} ? $entry->{PAPERSIZE} : "letter";
- $fieldname{printertype} = $entry->{TYPE};
- create_config_file($filein, $file, %fieldname);
-
- #- now do postscript.cfg
- ($filein, $file) = &$get_name_file("postscript.cfg");
- %fieldname = ();
- $fieldname{gsdevice} = $dbentry->{GSDRIVER};
- $fieldname{papersize} = $entry->{PAPERSIZE} ? $entry->{PAPERSIZE} : "letter";
- $fieldname{resolution} = $entry->{RESOLUTION};
- $fieldname{color} = $entry->{BITSPERPIXEL} ne "Default" &&
- (($dbentry->{GSDRIVER} ne "uniprint" && "-dBitsPerPixel=") . $entry->{BITSPERPIXEL});
- $fieldname{reversepages} = $entry->{REVERSE_ORDER} ? "YES" : "";
- $fieldname{extragsoptions} = "\"$entry->{EXTRA_GS_OPTIONS}\"";
- $fieldname{pssendeof} = $entry->{AUTOSENDEOF} ? ($dbentry->{GSDRIVER} eq "POSTSCRIPT" ? "YES" : "NO") : "NO";
- $fieldname{nup} = $entry->{NUP};
- $fieldname{rtlftmar} = $entry->{RTLFTMAR};
- $fieldname{topbotmar} = $entry->{TOPBOTMAR};
- create_config_file($filein, $file, %fieldname);
-
- #- finally, make textonly.cfg
- ($filein, $file) = &$get_name_file("textonly.cfg");
- %fieldname = ();
- $fieldname{textonlyoptions} = "\"$entry->{TEXTONLYOPTIONS}\"";
- $fieldname{crlftrans} = $entry->{CRLF} ? "YES" : "";
- $fieldname{textsendeof} = $entry->{AUTOSENDEOF} ? ($dbentry->{GSDRIVER} eq "POSTSCRIPT" ? "NO" : "YES") : "NO";
- create_config_file($filein, $file, %fieldname);
-
- if ($entry->{TYPE} eq "SMB") {
- #- simple config file required if SMB printer
- my $config_file = "$prefix$queue_path/.config";
- local *F;
- open F, ">$config_file" or die "Can't create $config_file $!";
- print F "share='\\\\$entry->{SMBHOST}\\$entry->{SMBSHARE}'\n";
- print F "hostip=$entry->{SMBHOSTIP}\n";
- print F "user='$entry->{SMBUSER}'\n";
- print F "password='$entry->{SMBPASSWD}'\n";
- print F "workgroup='$entry->{SMBWORKGROUP}'\n";
- close F;
- eval { chmod 0640, $config_file; commands::chown_("root.lp", $config_file) };
- } elsif ($entry->{TYPE} eq "NCP") {
- #- same for NCP printer
- my $config_file = "$prefix$queue_path/.config";
- local *F;
- open F, ">$config_file" or die "Can't create $config_file $!";
- print F "server=$entry->{NCPHOST}\n";
- print F "queue=$entry->{NCPQUEUE}\n";
- print F "user=$entry->{NCPUSER}\n";
- print F "password=$entry->{NCPPASSWD}\n";
- close F;
- eval { chmod 0640, $config_file; commands::chown_("root.lp", $config_file) };
- }
+ scalar(keys %thedb) > 4 and return; #- try reparse if using only ppa, POSTSCRIPT, TEXT.
- copy_master_filter($queue_path);
-
- #-now the printcap file, note this one contains all the printer (use configured for that).
- local *PRINTCAP;
- open PRINTCAP, ">$prefix/etc/printcap" or die "Can't open printcap file $!";
- print PRINTCAP $intro_printcap_test;
- foreach (values %{$entry->{configured}}) {
- $_->{DBENTRY} = $thedb_gsdriver{$_->{GSDRIVER}}{ENTRY} unless defined $_->{DBENTRY};
- my $db_ = $thedb{$_->{DBENTRY}} or next; #die "no dbentry";
-
- $_->{SPOOLDIR} ||= "$spooldir/" . default_queue($_->{QUEUE});
- $_->{IF} ||= "$_->{SPOOLDIR}/filter";
- $_->{AF} ||= "$_->{SPOOLDIR}/acct";
-
- printf PRINTCAP "##PRINTTOOL3## %s %s %s %s %s %s %s%s\n",
- $_->{TYPE} || '{}',
- $db_->{GSDRIVER} || '{}',
- $_->{RESOLUTION} || '{}',
- $_->{PAPERSIZE} || '{}',
- '{}',
- $db_->{ENTRY} || '{}',
- $_->{BITSPERPIXEL} || '{}',
- $_->{CRLF} ? " 1" : "";
-
- print PRINTCAP "$_->{QUEUE}:\\\n";
- print PRINTCAP "\t:sd=$_->{SPOOLDIR}:\\\n";
- print PRINTCAP "\t:mx#0:\\\n\t:sh:\\\n";
-
- if ($_->{TYPE} eq "LOCAL") {
- print PRINTCAP "\t:lp=$_->{DEVICE}:\\\n";
- } elsif ($_->{TYPE} eq "REMOTE") {
- print PRINTCAP "\t:rm=$_->{REMOTEHOST}:\\\n";
- print PRINTCAP "\t:rp=$_->{REMOTEQUEUE}:\\\n";
- } else {
- #- (pcentry->Type == (PRINTER_SMB | PRINTER_NCP))
- print PRINTCAP "\t:lp=/dev/null:\\\n";
- print PRINTCAP "\t:af=$_->{AF}\\\n";
+ my %available_devices; #- keep only available devices in our database.
+ local *AVAIL; open AVAIL, ($::testing ? "$prefix" : "chroot $prefix/ ") . "/usr/bin/gs --help |";
+ foreach (<AVAIL>) {
+ if (/^Available devices:/ ... /^\S/) {
+ @available_devices{split /\s+/, $_} = () if /^\s+/;
}
+ }
+ close AVAIL;
+ $available_devices{ppa} = undef; #- if -x "$prefix/usr/bin/pbm2ppa" && -x "$prefix/usr/bin/pnm2ppa";
+ delete $available_devices{''};
+ @available_devices{qw/POSTSCRIPT TEXT/} = (); #- these are always available.
- #- cheating to get the input filter!
- print PRINTCAP "\t:if=$_->{IF}:\n";
- print PRINTCAP "\n";
+ local $_; #- use of while (<...
+ local *DBPATH; #- don't have to do close ... and don't modify globals at least
+ open DBPATH, $dbpath or die "An error has occurred on $dbpath : $!";
+
+ while (<DBPATH>) {
+ if (/^StartEntry:\s(\w*)/) {
+ my $entry = { ENTRY => $1 };
+
+ WHILE :
+ while (<DBPATH>) {
+ SWITCH: {
+ /GSDriver:\s*(\w*)/ and do { $entry->{GSDRIVER} = $1; last SWITCH };
+ /Description:\s*{(.*)}/ and do { $entry->{DESCR} = $1; last SWITCH };
+ /About:\s*{\s*(.*?)\s*}/ and do { $entry->{ABOUT} = $1; last SWITCH };
+ /About:\s*{\s*(.*?)\s*\\\s*$/
+ and do {
+ my $string = $1;
+ while (<DBPATH>) {
+ $string =~ /\S$/ and $string .= ' ';
+ /^\s*(.*?)\s*\\\s*$/ and $string .= $1;
+ /^\s*(.*?)\s*}\s*$/ and do { $entry->{ABOUT} = $string . $1; last SWITCH };
+ }
+ };
+ /Resolution:\s*{(.*)}\s*{(.*)}\s*{(.*)}/
+ and do { push @{$entry->{RESOLUTION} ||= []}, { XDPI => $1, YDPI => $2, DESCR => $3 }; last SWITCH };
+ /BitsPerPixel:\s*{(.*)}\s*{(.*)}/
+ and do { push @{$entry->{BITSPERPIXEL} ||= []}, {DEPTH => $1, DESCR => $2}; last SWITCH };
+
+ /EndEntry/ and last WHILE;
+ }
+ }
+ if (exists $available_devices{$entry->{GSDRIVER}}) {
+ $thedb{$entry->{ENTRY}} = $entry;
+ $thedb_gsdriver{$entry->{GSDRIVER}} = $entry;
+ }
+ }
}
- eval { commands::chown_("root.lp", "$prefix/etc/printcap") };
- my $useUSB = 0;
- foreach (values %{$entry->{configured}}) {
- $useUSB ||= $_->{DEVICE} =~ /usb/;
+ @entries_db_short = sort keys %printer::thedb;
+ %descr_to_db = map { $printer::thedb{$_}{DESCR}, $_ } @entries_db_short;
+ %descr_to_help = map { $printer::thedb{$_}{DESCR}, $printer::thedb{$_}{ABOUT} } @entries_db_short;
+ @entry_db_description = keys %descr_to_db;
+ %db_to_descr = reverse %descr_to_db;
+}
+
+#------------------------------------------------------------------------------
+sub read_printers_conf {
+ my ($printer) = @_;
+ my $current = undef;
+
+ #- read /etc/cups/printers.conf file.
+ #- according to this code, we are now using the following keys for each queues.
+ #- DeviceURI > lpd://printer6/lp
+ #- Info > Info Text
+ #- Location > Location Text
+ #- State > Idle|Stopped
+ #- Accepting > Yes|No
+ local *PRINTERS; open PRINTERS, "$prefix/etc/cups/printers.conf" or return;
+ foreach (<PRINTERS>) {
+ chomp;
+ /^\s*#/ and next;
+ if (/^\s*<(?:DefaultPrinter|Printer)\s+([^>]*)>/) { $current = { QUEUE => $1, } }
+ elsif (/\s*<\/Printer>/) { $current->{QUEUE} && $current->{DeviceURI} or next; #- minimal check of synthax.
+ add2hash($printer->{configured}{$current->{QUEUE}} ||= {}, $current); $current = undef }
+ elsif (/\s*(\S*)\s+(.*)/) { $current->{$1} = $2 }
}
- if ($useUSB) {
- my $f = "$prefix/etc/sysconfig/usb";
- my %usb = getVarsFromSh($f);
- $usb{PRINTER} = "yes";
- setVarsInSh($f, \%usb);
+ close PRINTERS;
+
+ #- assume this printing system.
+ $printer->{mode} ||= 'cups';
+}
+
+sub get_direct_uri {
+ #- get the local printer to access via a Device URI.
+ my @direct_uri;
+ local *F; open F, "chroot $prefix/ /usr/sbin/lpinfo -v |";
+ foreach (<F>) {
+ /^(direct|usb|serial)\s+(\S*)/ and push @direct_uri, $2;
}
+ close F;
+ @direct_uri;
}
-sub restart_queue($) {
- my ($queue) = @_;
+sub get_descr_from_ppd {
+ my ($printer) = @_;
+ my %ppd;
- #- restart lpd after cleaning the queue.
- foreach (("/var/spool/lpd/$queue/lock", "/var/spool/lpd/lpd.lock")) {
- my $pidlpd = (cat_("$prefix$_"))[0];
- kill 'TERM', $pidlpd if $pidlpd;
- unlink "$prefix$_";
+ local *F; open F, "$prefix/etc/cups/ppd/$printer->{QUEUE}.ppd" or return;
+ foreach (<F>) {
+ /^\*([^\s:]*)\s*:\s*\"([^\"]*)\"/ and do { $ppd{$1} = $2; next };
+ /^\*([^\s:]*)\s*:\s*([^\s\"]*)/ and do { $ppd{$1} = $2; next };
}
- require run_program;
- run_program::rooted($prefix, "lprm", "-P$queue", "-"); sleep 1;
- run_program::rooted($prefix, "lpd"); sleep 1;
+ close F;
+
+ $ppd{Manufacturer} . '|' . ($ppd{NickName} || $ppd{ShortNickName} || $ppd{ModelName}) .
+ ($ppd{LanguageVersion} && (" (" . lc(substr($ppd{LanguageVersion}, 0, 2)) . ")"));
}
-sub print_pages($@) {
- my ($queue, @pages) = @_;
+sub poll_ppd_base {
+ #- before trying to poll the ppd database available to cups, we have to make sure
+ #- the file /etc/cups/ppds.dat is no more modified.
+ #- if cups continue to modify it (because it reads the ppd files available), the
+ #- poll_ppd_base program simply cores :-)
+ run_program::rooted($prefix, "/etc/rc.d/init.d/cups start");
- require run_program;
- foreach (@pages) {
- run_program::rooted($prefix, "lpr", "-P$queue", $_);
+ foreach (1..10) {
+ local *PPDS; open PPDS, "chroot $prefix/ /usr/bin/poll_ppd_base -a |";
+ foreach (<PPDS>) {
+ chomp;
+ my ($ppd, $mf, $descr, $lang) = split /\|/;
+ $ppd && $mf && $descr and $descr_to_ppd{"$mf|$descr" . ($lang && " ($lang)")} = $ppd;
+ }
+ close PPDS;
+ scalar(keys %descr_to_ppd) > 5 and last;
+ sleep 1; #- we have to try again running the program, wait here a little before.
}
+}
- sleep 5; #- allow lpr to send pages.
- local *F;
- open F, "chroot $prefix/ /usr/bin/lpq -P$queue |";
- my @lpq_output = grep { !/^no entries/ && !(/^Rank\s+Owner/ .. /^\s*$/) } <F>;
- close F;
+#-******************************************************************************
+#- write functions
+#-******************************************************************************
- @lpq_output;
+#------------------------------------------------------------------------------
+#- given the path queue_path, we create all the required spool directory
+#------------------------------------------------------------------------------
+sub create_spool_dir($) {
+ my ($queue_path) = @_;
+ my $complete_path = "$prefix/$queue_path";
+
+ commands::mkdir_("-p", $complete_path);
+
+ unless ($::testing) {
+ #-redhat want that "drwxr-xr-x root lp"
+ my $gid_lp = (getpwnam("lp"))[3];
+ chown 0, $gid_lp, $complete_path
+ or die "An error has occurred - can't chgrp $complete_path to lp $!";
+ }
}
#------------------------------------------------------------------------------
-#- interface function
+#-given the input spec file 'input', and the target output file 'output'
+#-we set the fields specified by fieldname to the values in fieldval
+#-nval is the number of fields to set
+#-Doesnt currently catch error exec'ing sed yet
#------------------------------------------------------------------------------
+sub create_config_file($$%) {
+ my ($inputfile, $outputfile, %toreplace) = @_;
+ template2file("$prefix/$inputfile", "$prefix/$outputfile", %toreplace);
+ eval { commands::chown_("root.lp", "$prefix/$outputfile") };
+}
+
#------------------------------------------------------------------------------
-#- fonction de test
+#-copy master filter to the spool dir
#------------------------------------------------------------------------------
-sub test {
- $::testing = 1;
- $printer::prefix="";
-
- read_printer_db();
-
- print "the dump\n";
- print Dumper(%thedb);
-
-
- #
- #eval { printer::create_spool_dir("/tmp/titi/", ".") };
- #print $@;
- #eval { printer::copy_master_filter("/tmp/titi/", ".") };
- #print $@;
- #
- #
- #eval { printer::create_config_file("files/postscript.cfg.in", "files/postscript.cfg","./",
- # (
- # gsdevice => "titi",
- # resolution => "tata",
- # ));
- # };
- #print $@;
- #
- #
- #
- #printer::configure_queue(\%printer::ex_printcap_entry, "/");
+sub copy_master_filter($) {
+ my ($queue_path) = @_;
+ my $complete_path = "$prefix/$queue_path/filter";
+ my $master_filter = "$prefix/$PRINTER_FILTER_DIR/master-filter";
+
+ eval { commands::cp('-f', $master_filter, $complete_path) };
+ $@ and die "Can't copy $master_filter to $complete_path $!";
+ eval { commands::chown_("root.lp", $complete_path); };
}
-#-######################################################################################
-#- Wonderful perl :(
-#-######################################################################################
-1; #
+#------------------------------------------------------------------------------
+#- given a PrintCap Entry, create the spool dir and special
+#- rhs-printfilters related config files which are required
+#------------------------------------------------------------------------------
+my $intro_printcap_test = "
+#
+# Please don't edit this file directly unless you know what you are doing!
+# Look at the printcap(5) man page for more info.
+# Be warned that the control-panel printtool requires a very strict format!
+#
+# This file can be edited with printerdrake or printtool.
+#
+
+";
+
+sub configure_queue($) {
+ my ($entry) = @_;
+
+ for ($entry->{mode}) {
+ /cups/ && do {
+ #- at this level, we are using lpadmin to create a local printer (only local
+ #- printer are supported with printerdrake).
+ require run_program;
+ run_program::rooted($prefix, "lpadmin",
+ "-p", $entry->{QUEUE},
+ $entry->{State} eq 'Idle' && $entry->{Accepting} eq 'Yes' ? ("-E") : (),
+ "-v", $entry->{DeviceURI},
+ "-m", $entry->{cupsPPD},
+ $entry->{Info} ? ("-D", $entry->{Info}) : (),
+ $entry->{Location} ? ("-L", $entry->{Location}) : (),
+ );
+ last };
+ /lpr/ && do {
+ #- old style configuration scheme for lpr.
+ my $queue_path = "$entry->{SPOOLDIR}";
+ create_spool_dir($queue_path);
+
+ my $get_name_file = sub {
+ my ($name) = @_;
+ ("$PRINTER_FILTER_DIR/$name.in", "$entry->{SPOOLDIR}/$name")
+ };
+ my ($filein, $file);
+ my %fieldname = ();
+ my $dbentry = $thedb{($entry->{DBENTRY})} or die "no dbentry";
+
+ #- make general.cfg
+ ($filein, $file) = &$get_name_file("general.cfg");
+ $fieldname{ascps_trans} = $entry->{ASCII_TO_PS} || $dbentry->{GSDRIVER} eq 'ppa' ? "YES" : "NO";
+ $fieldname{desiredto} = $dbentry->{GSDRIVER} ne "TEXT" ? "ps" : "asc";
+ $fieldname{papersize} = $entry->{PAPERSIZE} ? $entry->{PAPERSIZE} : "letter";
+ $fieldname{printertype} = $entry->{TYPE};
+ create_config_file($filein, $file, %fieldname);
+
+ #- now do postscript.cfg
+ ($filein, $file) = &$get_name_file("postscript.cfg");
+ %fieldname = ();
+ $fieldname{gsdevice} = $dbentry->{GSDRIVER};
+ $fieldname{papersize} = $entry->{PAPERSIZE} ? $entry->{PAPERSIZE} : "letter";
+ $fieldname{resolution} = $entry->{RESOLUTION};
+ $fieldname{color} = $entry->{BITSPERPIXEL} ne "Default" &&
+ (($dbentry->{GSDRIVER} ne "uniprint" && "-dBitsPerPixel=") . $entry->{BITSPERPIXEL});
+ $fieldname{reversepages} = $entry->{REVERSE_ORDER} ? "YES" : "";
+ $fieldname{extragsoptions} = "\"$entry->{EXTRA_GS_OPTIONS}\"";
+ $fieldname{pssendeof} = $entry->{AUTOSENDEOF} ? ($dbentry->{GSDRIVER} eq "POSTSCRIPT" ? "YES" : "NO") : "NO";
+ $fieldname{nup} = $entry->{NUP};
+ $fieldname{rtlftmar} = $entry->{RTLFTMAR};
+ $fieldname{topbotmar} = $entry->{TOPBOTMAR};
+ create_config_file($filein, $file, %fieldname);
+
+ #- finally, make textonly.cfg
+ ($filein, $file) = &$get_name_file("textonly.cfg");
+ %fieldname = ();
+ $fieldname{textonlyoptions} = "\"$entry->{TEXTONLYOPTIONS}\"";
+ $fieldname{crlftrans} = $entry->{CRLF} ? "YES" : "";
+ $fieldname{textsendeof} = $entry->{AUTOSENDEOF} ? ($dbentry->{GSDRIVER} eq "POSTSCRIPT" ? "NO" : "YES") : "NO";
+ create_config_file($filein, $file, %fieldname);
+
+ if ($entry->{TYPE} eq "SMB") {
+ #- simple config file required if SMB printer
+ my $config_file = "$prefix$queue_path/.config";
+ local *F;
+ open F, ">$config_file" or die "Can't create $config_file $!";
+ print F "share='\\\\$entry->{SMBHOST}\\$entry->{SMBSHARE}'\n";
+ print F "hostip=$entry->{SMBHOSTIP}\n";
+ print F "user='$entry->{SMBUSER}'\n";
+ print F "password='$entry->{SMBPASSWD}'\n";
+ print F "workgroup='$entry->{SMBWORKGROUP}'\n";
+ close F;
+ eval { chmod 0640, $config_file; commands::chown_("root.lp", $config_file) };
+ } elsif ($entry->{TYPE} eq "NCP") {
+ #- same for NCP printer
+ my $config_file = "$prefix$queue_path/.config";
+ local *F;
+ open F, ">$config_file" or die "Can't create $config_file $!";
+ print F "server=$entry->{NCPHOST}\n";
+ print F "queue=$entry->{NCPQUEUE}\n";
+ print F "user=$entry->{NCPUSER}\n";
+ print F "password=$entry->{NCPPASSWD}\n";
+ close F;
+ eval { chmod 0640, $config_file; commands::chown_("root.lp", $config_file) };
+ }
+
+ copy_master_filter($queue_path);
+
+ #-now the printcap file, note this one contains all the printer (use configured for that).
+ local *PRINTCAP;
+ open PRINTCAP, ">$prefix/etc/printcap" or die "Can't open printcap file $!";
+ print PRINTCAP $intro_printcap_test;
+ foreach (values %{$entry->{configured}}) {
+ $_->{DBENTRY} = $thedb_gsdriver{$_->{GSDRIVER}}{ENTRY} unless defined $_->{DBENTRY};
+ my $db_ = $thedb{$_->{DBENTRY}} or next; #die "no dbentry";
+
+ $_->{SPOOLDIR} ||= default_spooldir($_);
+ $_->{IF} ||= "$_->{SPOOLDIR}/filter";
+ $_->{AF} ||= "$_->{SPOOLDIR}/acct";
+
+ printf PRINTCAP "##PRINTTOOL3## %s %s %s %s %s %s %s%s\n",
+ $_->{TYPE} || '{}',
+ $db_->{GSDRIVER} || '{}',
+ $_->{RESOLUTION} || '{}',
+ $_->{PAPERSIZE} || '{}',
+ '{}',
+ $db_->{ENTRY} || '{}',
+ $_->{BITSPERPIXEL} || '{}',
+ $_->{CRLF} ? " 1" : "";
+
+ print PRINTCAP "$_->{QUEUE}:\\\n";
+ print PRINTCAP "\t:sd=$_->{SPOOLDIR}:\\\n";
+ print PRINTCAP "\t:mx#0:\\\n\t:sh:\\\n";
+
+ if ($_->{TYPE} eq "LOCAL") {
+ print PRINTCAP "\t:lp=$_->{DEVICE}:\\\n";
+ } elsif ($_->{TYPE} eq "REMOTE") {
+ print PRINTCAP "\t:rm=$_->{REMOTEHOST}:\\\n";
+ print PRINTCAP "\t:rp=$_->{REMOTEQUEUE}:\\\n";
+ } else {
+ #- (pcentry->Type == (PRINTER_SMB | PRINTER_NCP))
+ print PRINTCAP "\t:lp=/dev/null:\\\n";
+ print PRINTCAP "\t:af=$_->{AF}\\\n";
+ }
+
+ #- cheating to get the input filter!
+ print PRINTCAP "\t:if=$_->{IF}:\n";
+ print PRINTCAP "\n";
+ }
+ eval { commands::chown_("root.lp", "$prefix/etc/printcap") };
+
+ my $useUSB = 0;
+ foreach (values %{$entry->{configured}}) {
+ $useUSB ||= $_->{DEVICE} =~ /usb/;
+ }
+ if ($useUSB) {
+ my $f = "$prefix/etc/sysconfig/usb";
+ my %usb = getVarsFromSh($f);
+ $usb{PRINTER} = "yes";
+ setVarsInSh($f, \%usb);
+ }
+ last };
+ }
+}
+
+#- use the queue currently configured at the top of printer hash.
+sub remove_queue($) {
+ my ($printer) = @_;
+ $printer->{configured}{$printer->{QUEUE}} or return; #- something strange at this point.
+
+ if ($printer->{mode} eq 'cups') {
+ require run_program;
+ run_program::rooted($prefix, "lpadmin", "-x", $printer->{QUEUE});
+ }
+ delete $printer->{configured}{$printer->{queue}};
+}
-=head1 AUTHOR
+sub restart_queue($) {
+ my ($printer) = @_;
+ my $queue = default_queue($printer);
+
+ for ($printer->{mode}) {
+ /cups/ && do {
+ #- restart cups before cleaning the queue.
+ require run_program;
+ run_program::rooted($prefix, "/etc/rc.d/init.d/cups start"); sleep 1;
+ run_program::rooted($prefix, "lprm-cups", "-P$queue", "-");
+ last };
+ /lpr/ && do {
+ #- restart lpd after cleaning the queue.
+ foreach (("/var/spool/lpd/$queue/lock", "/var/spool/lpd/lpd.lock")) {
+ my $pidlpd = (cat_("$prefix$_"))[0];
+ kill 'TERM', $pidlpd if $pidlpd;
+ unlink "$prefix$_";
+ }
+ require run_program;
+ run_program::rooted($prefix, "lprm-lpd", "-P$queue", "-"); sleep 1;
+ run_program::rooted($prefix, "lpd"); sleep 1;
+ last };
+ }
+}
-pad.
+sub print_pages($@) {
+ my ($printer, @pages) = @_;
+ my $queue = default_queue($printer);
+ my ($lpr, $lpq);
+
+ for ($printer->{mode}) {
+ /cups/ and ($lpr, $lpq) = ("/usr/bin/lpr-cups", "/usr/bin/lpq-cups");
+ /lpr/ and ($lpr, $lpq) = ("/usr/bin/lpq-lpd", "/usr/bin/lpq-lpd");
+ }
-=cut
+ require run_program;
+ foreach (@pages) {
+ run_program::rooted($prefix, $lpr, "-P$queue", $_);
+ }
+ sleep 5; #- allow lpr to send pages.
+ local *F; open F, "chroot $prefix/ $lpq -P$queue |";
+ my @lpq_output = grep { !/^no entries/ && !(/^Rank\s+Owner/ .. /^\s*$/) } <F>;
+ close F;
+ @lpq_output;
+}
+
+#-######################################################################################
+#- Wonderful perl :(
+#-######################################################################################
+1;