summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2000-03-16 20:04:26 +0000
committerFrancois Pons <fpons@mandriva.com>2000-03-16 20:04:26 +0000
commit28f19070e51ab4752c1c82c2d02b9af1d84d3a37 (patch)
treea18412c3225f914627c74ec887af22a0fbb0eb30 /perl-install
parent633a781cca14d82bdc0c41a59caa79059c3aceb6 (diff)
downloaddrakx-28f19070e51ab4752c1c82c2d02b9af1d84d3a37.tar
drakx-28f19070e51ab4752c1c82c2d02b9af1d84d3a37.tar.gz
drakx-28f19070e51ab4752c1c82c2d02b9af1d84d3a37.tar.bz2
drakx-28f19070e51ab4752c1c82c2d02b9af1d84d3a37.tar.xz
drakx-28f19070e51ab4752c1c82c2d02b9af1d84d3a37.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/ChangeLog9
-rw-r--r--perl-install/install_steps_interactive.pm10
-rw-r--r--perl-install/printer.pm178
-rw-r--r--perl-install/printerdrake.pm401
4 files changed, 381 insertions, 217 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index 8e92626ca..360913b34 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -1,3 +1,12 @@
+2000-03-16 François Pons <fpons@mandrakesoft.com>
+
+ * install_steps_interactive.pm: moved in printerdrake.pm the test
+ of printer usage.
+ * printerdrake.pm: heavy modification to handle multiple queue,
+ corrected some bugs too, added much more features as printtool.
+ * printer.pm: added more features for filter, allow printer to be
+ retrieved without help of printtool id in printcap file (untested).
+
2000-03-14 François Pons <fpons@mandrakesoft.com>
* install_any.pm: corrected for duplicate file on other CD.
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 832b2c52d..157df8c82 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -559,14 +559,10 @@ sub servicesConfig {
#------------------------------------------------------------------------------
sub printerConfig($) {
my ($o) = @_;
- $o->{printer}{want} =
- $o->ask_yesorno(_("Printer"),
- _("Would you like to configure a printer?"),
- $o->{printer}{want});
- return if !$o->{printer}{want};
require printerdrake;
- printerdrake::main($o->{prefix}, $o->{printer}, $o, sub { install_any::pkg_install($o, $_[0]) });
+ eval { add2hash($o->{printer}, printerdrake::getinfo($o->{prefix})) };
+ printerdrake::main($o->{printer}, $o, sub { install_any::pkg_install($o, $_[0]) });
}
#------------------------------------------------------------------------------
@@ -591,7 +587,7 @@ _("Use MD5 passwords") => { val => \$o->{authentication}{md5}, type => 'bool', t
) : (), $::beginner ? () : (
_("Use NIS") => { val => \$o->{authentication}{NIS}, type => 'bool', text => _("yellow pages") },
)
- ],
+ ],
complete => sub {
$sup->{password} eq $sup->{password2} or $o->ask_warn('', [ _("The passwords do not match"), _("Please try again") ]), return (1,1);
length $sup->{password} < 2 * $o->{security}
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index 21098df37..f8e34452c 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -44,7 +44,7 @@ use Data::Dumper;
=cut
-use common qw(:common :system);
+use common qw(:common :system :file);
use commands;
#-#####################################################################################
@@ -281,7 +281,7 @@ sub read_printer_db(;$) {
%thedb and return;
my %available_devices; #- keep only available devices in our database.
- local *AVAIL; open AVAIL, "chroot ". ($prefix || '/') ." /usr/bin/gs --help |";
+ local *AVAIL; open AVAIL, (!$::testing && "chroot ") . "$prefix/usr/bin/gs --help |";
foreach (<AVAIL>) {
if (/^Available devices:/ ... /^\S/) {
@available_devices{split /\s+/, $_} = () if /^\s+/;
@@ -336,7 +336,6 @@ sub read_printer_db(;$) {
@entry_db_description = map { $printer::thedb{$_}{DESCR} } @entries_db_short;
%descr_to_db = map { $printer::thedb{$_}{DESCR}, $_ } @entries_db_short;
%db_to_descr = reverse %descr_to_db;
-
}
@@ -403,19 +402,22 @@ my $intro_printcap_test = "
";
sub read_configured_queue($) {
- my ($entry) = @_;
+ my ($printer) = @_;
my $current = undef;
+ my $flush_current = sub {
+ if ($current) {
+ add2hash($printer->{configured}{$current->{QUEUE}} ||= {}, $current);
+ $current = undef;
+ }
+ };
#- read /etc/printcap file.
- local *PRINTCAP; open PRINTCAP, "$prefix/etc/printcap" or die "Can't open printcap file $!";
+ local *PRINTCAP; open PRINTCAP, "$prefix/etc/printcap" or die "Can't open $prefix/etc/printcap file: $!";
foreach (<PRINTCAP>) {
chomp;
my $p = '(?:\{(.*?)\}|(\S+))';
if (/^##PRINTTOOL3##\s+$p\s+$p\s+$p\s+$p\s+$p\s+$p\s+$p(?:\s+$p)?/) {
- if ($current) {
- add2hash($entry->{configured}{$current->{QUEUE}} ||= {}, $current);
- $current = undef;
- }
+ &$flush_current;
$current = {
TYPE => $1 || $2,
GSDRIVER => $3 || $4,
@@ -426,58 +428,104 @@ sub read_configured_queue($) {
BITSPERPIXEL => $13 || $14,
CRLF => $15 || $16,
};
- } elsif (/^([^:]*):\\/) {
- $current->{QUEUE} = $1;
- } elsif (/^\s+:sd=([^:]*):\\/) {
- $current->{SPOOLDIR} = $1;
- } elsif (/^\s+:lp=([^:]*):\\/) {
- $current->{DEVICE} = $1;
- } elsif (/^\s+:rm=([^:]*):\\/) {
- $current->{REMOTEHOST} = $1;
- } elsif (/^\s+:rp=([^:]*):\\/) {
- $current->{REMOTEQUEUE} = $1;
+ } elsif (/^\s*$/) { &$flush_current }
+ elsif (/^([^:]*):\\/) { $current->{QUEUE} = $1 }
+ if (/^\s+:(?:[^:]*:)*sd=([^:]*):/) { $current->{SPOOLDIR} = $1 }
+ if (/^\s+:(?:[^:]*:)*lp=([^:]*):\\/) { $current->{DEVICE} = $1 }
+ if (/^\s+:(?:[^:]*:)*rm=([^:]*):\\/) { $current->{REMOTEHOST} = $1 }
+ if (/^\s+:(?:[^:]*:)*rp=([^:]*):\\/) { $current->{REMOTEQUEUE} = $1 }
+ if (/^\s+:(?:[^:]*:)*af=([^:]*):\\/) { $current->{AF} = $1 }
+ if (/^\s+:(?:[^:]*:)*if=([^:]*):\\/) { $current->{IF} = $1 }
+ }
+ close PRINTCAP;
+ &$flush_current;
+
+ #- parse general.cfg for any configured queue.
+ foreach (values %{$printer->{configured}}) {
+ my $entry = $_;
+ local *F; open F, "$prefix$entry->{SPOOLDIR}/general.cfg" or next;
+ foreach (<F>) {
+ chomp;
+ if (/^\s*(?:export\s+)PRINTER_TYPE=(.*?)\s*$/) { $entry->{TYPE} = $1 unless defined $entry->{TYPE} }
+ elsif (/^\s*(?:export\s+)ASCII_TO_PS=(.*?)\s*$/) { $entry->{ASCII_TO_PS} = $1 eq 'YES' unless defined $entry->{ASCII_TO_PS} }
+ elsif (/^\s*(?:export\s+)PAPER_SIZE=(.*?)\s*$/) { $entry->{PAPERSIZE} = $1 unless defined $entry->{PAPERSIZE} }
}
+ close F;
}
- if ($current) {
- add2hash($entry->{configured}{$current->{QUEUE}} ||= {}, $current);
- $current = undef;
+
+ #- parse postscript.cfg for any configured queue.
+ foreach (values %{$printer->{configured}}) {
+ my $entry = $_;
+ local *F; open F, "$prefix$entry->{SPOOLDIR}/postscript.cfg" or next;
+ foreach (<F>) {
+ chomp;
+ if (/^\s*(?:export\s+)GSDEVICE=(.*?)\s*$/) { $entry->{DBENTRY} = $thedb_gsdriver{$1}{ENTRY} unless defined $entry->{DBENTRY} }
+ elsif (/^\s*(?:export\s+)RESOLUTION=(.*?)\s*$/) { $entry->{RESOLUTION} = $1 unless defined $entry->{RESOLUTION} }
+ elsif (/^\s*(?:export\s+)COLOR=-dBitsPerPixel=(.*?)\s*$/) { $entry->{COLOR} = $1 unless defined $entry->{COLOR} }
+ elsif (/^\s*(?:export\s+)COLOR=(.*?)\s*$/) { $entry->{COLOR} = $1 ? $1 : 'Default' unless defined $entry->{COLOR} }
+ elsif (/^\s*(?:export\s+)PAPERSIZE=(.*?)\s*$/) { $entry->{PAPERSIZE} = $1 unless defined $entry->{PAPERSIZE} }
+ elsif (/^\s*(?:export\s+)EXTRA_GS_OPTIONS=(.*?)\s*$/) { $entry->{EXTRA_GS_OPTIONS} = $1 unless defined $entry->{EXTRA_GS_OPTIONS}; $entry->{EXTRA_GS_OPTIONS} =~ s/^\"(.*)\"/$1/ }
+ elsif (/^\s*(?:export\s+)REVERSE_ORDER=(.*?)\s*$/) { $entry->{REVERSE_ORDER} = $1 unless defined $entry->{REVERSE_ORDER} }
+ elsif (/^\s*(?:export\s+)PS_SEND_EOF=(.*?)\s*$/) { $entry->{AUTOSENDEOF} = $1 eq 'YES' && $entry->{DBENTRY} eq 'PostScript' unless defined $entry->{AUTOSENDEOF} }
+ elsif (/^\s*(?:export\s+)NUP=(.*?)\s*$/) { $entry->{NUP} = $1 unless defined $entry->{NUP} }
+ elsif (/^\s*(?:export\s+)RTLFTMAR=(.*?)\s*$/) { $entry->{RTLFTMAR} = $1 unless defined $entry->{RTLFTMAR} }
+ elsif (/^\s*(?:export\s+)TOPBOTMAR=(.*?)\s*$/) { $entry->{TOPBOTMAR} = $1 unless defined $entry->{TOPBOTMAR} }
+ }
+ close F;
+ }
+
+ #- parse textonly.cfg for any configured queue.
+ foreach (values %{$printer->{configured}}) {
+ my $entry = $_;
+ local *F; open F, "$prefix$entry->{SPOOLDIR}/textonly.cfg" or next;
+ foreach (<F>) {
+ chomp;
+ if (/^\s*(?:export\s+)TEXTONLYOPTIONS=(.*?)\s*$/) { $entry->{TEXTONLYOPTIONS} = $1 unless defined $entry->{TEXTONLYOPTIONS}; $entry->{TEXTONLYOPTIONS} =~ s/^\"(.*)\"/$1/ }
+ elsif (/^\s*(?:export\s+)CRLFTRANS=(.*?)\s*$/) { $entry->{CRLF} = $1 eq 'YES' unless defined $entry->{CRLF} }
+ elsif (/^\s*(?:export\s+)TEXT_SEND_EOF=(.*?)\s*$/) { $entry->{AUTOSENDEOF} = $1 eq 'YES' && $entry->{DBENTRY} ne 'PostScript' unless defined $entry->{AUTOSENDEOF} }
+ }
+ close F;
}
#- get extra parameters for SMB or NCP type queue.
- foreach (values %{$entry->{configured}}) {
+ foreach (values %{$printer->{configured}}) {
if ($_->{TYPE} eq 'SMB') {
- my $config_file = "$prefix$_->{SPOOLDIR}/.config";
- local *F; open F, "$config_file" or die "Can't open $config_file $!";
+ my $entry = $_;
+ my $config_file = "$prefix$entry->{SPOOLDIR}/.config";
+ local *F; open F, "$config_file" or next; #die "Can't open $config_file $!";
foreach (<F>) {
chomp;
if (/^\s*share='\\\\(.*?)\\(.*?)'/) {
- $_->{SMBHOST} = $1;
- $_->{SMBSHARE} = $2;
+ $entry->{SMBHOST} = $1;
+ $entry->{SMBSHARE} = $2;
} elsif (/^\s*hostip=(.*)/) {
- $_->{SMBHOSTIP} = $1;
+ $entry->{SMBHOSTIP} = $1;
} elsif (/^\s*user='(.*)'/) {
- $_->{SMBUSER} = $1;
+ $entry->{SMBUSER} = $1;
} elsif (/^\s*password='(.*)'/) {
- $_->{SMBPASSWD} = $1;
+ $entry->{SMBPASSWD} = $1;
} elsif (/^\s*workgroup='(.*)'/) {
- $_->{SMBWORKGROUP} = $1;
+ $entry->{SMBWORKGROUP} = $1;
}
}
+ close F;
} elsif ($_->{TYPE} eq 'NCP') {
- my $config_file = "$prefix$_->{SPOOLDIR}/.config";
- local *F; open F, "$config_file" or die "Can't open $config_file $!";
+ my $entry = $_;
+ my $config_file = "$prefix$entry->{SPOOLDIR}/.config";
+ local *F; open F, "$config_file" or next; #die "Can't open $config_file $!";
foreach (<F>) {
chomp;
if (/^\s*server=(.*)/) {
- $_->{NCPHOST} = $1;
+ $entry->{NCPHOST} = $1;
} elsif (/^\s*user='(.*)'/) {
- $_->{NCPUSER} = $1;
+ $entry->{NCPUSER} = $1;
} elsif (/^\s*password='(.*)'/) {
- $_->{NCPPASSWD} = $1;
+ $entry->{NCPPASSWD} = $1;
} elsif (/^\s*queue='(.*)'/) {
- $_->{NCPQUEUE} = $1;
+ $entry->{NCPQUEUE} = $1;
}
}
+ close F;
}
}
}
@@ -485,9 +533,9 @@ sub read_configured_queue($) {
sub configure_queue($) {
my ($entry) = @_;
- $entry->{SPOOLDIR} ||= "$spooldir";
- $entry->{IF} ||= "$spooldir/$entry->{QUEUE}/filter";
- $entry->{AF} ||= "$spooldir/$entry->{QUEUE}/acct";
+ $entry->{SPOOLDIR} ||= "$spooldir/$entry->{QUEUE}";
+ $entry->{IF} ||= "$entry->{SPOOLDIR}/filter";
+ $entry->{AF} ||= "$entry->{SPOOLDIR}/acct";
my $queue_path = "$entry->{SPOOLDIR}";
create_spool_dir($queue_path);
@@ -500,15 +548,15 @@ sub configure_queue($) {
my %fieldname = ();
my $dbentry = $thedb{($entry->{DBENTRY})} or die "no dbentry";
-
+ #- make general.cfg
($filein, $file) = &$get_name_file("general.cfg");
- $fieldname{ascps_trans} = ($dbentry->{GSDRIVER} eq "POSTSCRIPT") ? "YES" : "NO";
+ $fieldname{ascps_trans} = $entry->{ASCII_TO_PS} ? "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);
- #- successfully created general.cfg, now do postscript.cfg
+ #- now do postscript.cfg
($filein, $file) = &$get_name_file("postscript.cfg");
%fieldname = ();
$fieldname{gsdevice} = $dbentry->{GSDRIVER};
@@ -516,18 +564,18 @@ sub configure_queue($) {
$fieldname{resolution} = $entry->{RESOLUTION};
$fieldname{color} = $entry->{BITSPERPIXEL} ne "Default" &&
(($dbentry->{GSDRIVER} ne "uniprint" && "-dBitsPerPixel=") . $entry->{BITSPERPIXEL});
- $fieldname{reversepages} = "NO";
- $fieldname{extragsoptions} = "";
+ $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} = "1";
- $fieldname{rtlftmar} = "18";
- $fieldname{topbotmar} = "18";
+ $fieldname{nup} = $entry->{NUP};
+ $fieldname{rtlftmar} = $entry->{RTFLTMAR};
+ $fieldname{topbotmar} = $entry->{TOPBOTMAR};
create_config_file($filein, $file, %fieldname);
#- finally, make textonly.cfg
($filein, $file) = &$get_name_file("textonly.cfg");
%fieldname = ();
- $fieldname{textonlyoptions} = "";
+ $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);
@@ -589,15 +637,43 @@ sub configure_queue($) {
} else {
#- (pcentry->Type == (PRINTER_SMB | PRINTER_NCP))
print PRINTCAP "\t:lp=/dev/null:\\\n";
- print PRINTCAP "\t:af=$_->{SPOOLDIR}/acct\\\n";
+ print PRINTCAP "\t:af=$_->{AF}\\\n";
}
#- cheating to get the input filter!
- print PRINTCAP "\t:if=$_->{SPOOLDIR}/filter:\n";
+ print PRINTCAP "\t:if=$_->{IF}:\n";
print PRINTCAP "\n";
}
}
+sub restart_queue($) {
+ my ($queue) = @_;
+
+ #- 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", "-P$queue", "-"); sleep 1;
+ run_program::rooted($prefix, "lpd"); sleep 1;
+}
+
+sub print_pages($$@) {
+ my ($queue, @pages) = @_;
+
+ require run_program;
+ run_program::rooted($prefix, "lpr", "-P$queue", $_) foreach @pages;
+
+ 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;
+
+ @lpq_output;
+}
#------------------------------------------------------------------------------
#- interface function
diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm
index bd74efba6..a6a2061f1 100644
--- a/perl-install/printerdrake.pm
+++ b/perl-install/printerdrake.pm
@@ -5,7 +5,6 @@ use strict;
use common qw(:common :file :functional :system);
use detect_devices;
-use run_program;
use commands;
use modules;
use network;
@@ -16,157 +15,147 @@ use printer;
sub getinfo($) {
my ($prefix) = @_;
- my $entry = {};
+ my $printer = {};
printer::set_prefix($prefix);
- printer::read_configured_queue($entry);
-
- add2hash($entry, {
- want => 0,
- complete => 0,
- str_type => $printer::printer_type_default,
- QUEUE => "lp",
- SPOOLDIR => "/var/spool/lpd/lp",
- DBENTRY => "PostScript",
- PAPERSIZE => "legal",
- CRLF => 0,
- AUTOSENDEOF => 1,
-
- DEVICE => "/dev/lp0",
-
- REMOTEHOST => "",
- REMOTEQUEUE => "",
-
- NCPHOST => "", #-"printerservername",
- NCPQUEUE => "", #-"queuename",
- NCPUSER => "", #-"user",
- NCPPASSWD => "", #-"pass",
-
- SMBHOST => "", #-"hostname",
- SMBHOSTIP => "", #-"1.2.3.4",
- SMBSHARE => "", #-"printername",
- SMBUSER => "", #-"user",
- SMBPASSWD => "", #-"passowrd",
- SMBWORKGROUP => "", #-"AS3",
- });
- $entry;
+ printer::read_configured_queue($printer);
+
+ add2hash($printer, {
+ want => 0,
+ complete => 0,
+ str_type => $printer::printer_type_default,
+ QUEUE => "lp",
+ SPOOLDIR => "/var/spool/lpd/lp",
+ DBENTRY => "PostScript",
+ PAPERSIZE => "letter",
+ ASCII_TO_PS => undef,
+ CRLF => undef,
+ NUP => 1,
+ RTLFTMAR => 18,
+ TOPBOTMAR => 18,
+ AUTOSENDEOF => 1,
+
+ DEVICE => "/dev/lp0",
+
+ REMOTEHOST => "",
+ REMOTEQUEUE => "",
+
+ NCPHOST => "", #-"printerservername",
+ NCPQUEUE => "", #-"queuename",
+ NCPUSER => "", #-"user",
+ NCPPASSWD => "", #-"pass",
+
+ SMBHOST => "", #-"hostname",
+ SMBHOSTIP => "", #-"1.2.3.4",
+ SMBSHARE => "", #-"printername",
+ SMBUSER => "", #-"user",
+ SMBPASSWD => "", #-"passowrd",
+ SMBWORKGROUP => "", #-"AS3",
+ });
+ $printer;
}
sub copy_printer_params($$) {
my ($from, $to) = @_;
-
- foreach (keys %$from) {
- $to->{$_} = $from->{$_} if $_ ne 'configured'; #- avoid cycles.
- }
+ map { $to->{$_} = $from->{$_} } grep { $_ ne 'configured' } keys %$from; #- avoid cycles.
}
-#- Program entry point.
-sub main($$$$) {
- my ($prefix, $printer, $in, $install) = @_;
+sub setup_local($$$) {
+ my ($printer, $in, $install) = @_;
- unless ($::testing) {
- printer::set_prefix($prefix);
- &$install('rhs-printfilters');
+ {
+ my $w = $in->wait_message(_("Test ports"), _("Detecting devices..."));
+ eval { modules::load("parport_pc"); modules::load("parport_probe"); modules::load("lp"); };
}
- printer::read_printer_db();
- $printer->{complete} = 0;
- if ($::expert || scalar keys %{$printer->{configured}}) {
- $in->ask_from_entries_ref(_("Local Printer Options"),
- _("Every print queue (which print jobs are directed to) needs a
-name (often lp) and a spool directory associated with it. What
-name and directory should be used for this queue?"),
- [_("Name of queue:"), _("Spool directory:")],
- [\$printer->{QUEUE}, \$printer->{SPOOLDIR}],
- changed => sub
- {
- $printer->{SPOOLDIR} = "$printer::spooldir/$printer->{QUEUE}" unless $_[0];
- },
- ) or return; #- cancel
+ my @port = ();
+ my @str = ();
+ my @parport = detect_devices::whatPrinter();
+ eval { modules::unload("parport_probe") };
+ foreach (@parport) {
+ push @str, _("A printer, model \"%s\", has been detected on ", $_->{val}{DESCRIPTION}) . $_->{port};
}
- copy_printer_params($printer->{configured}{$printer->{QUEUE}}, $printer); #- get default parameters from existing queue.
-
- $printer->{str_type} =
- $in->ask_from_list_(_("Select Printer Connection"),
- _("How is the printer connected?"),
- [ keys %printer::printer_type ],
- $printer::printer_type_inv{$printer->{TYPE}},
- );
- $printer->{TYPE} = $printer::printer_type{$printer->{str_type}};
-
- if ($printer->{TYPE} eq "LOCAL") {
- {
- my $w = $in->wait_message(_("Test ports"), _("Detecting devices..."));
- eval { modules::load("parport_pc"); modules::load("parport_probe"); modules::load("lp"); };
- }
+ if (@str) {
+ @port = map { $_->{port} } @parport;
+ } else {
+ @port = detect_devices::whatPrinterPort();
+ }
+ $printer->{DEVICE} = $port[0] if $port[0];
+
+ return if !$in->ask_from_entries_refH(_("Local Printer Device"),
+ _("What device is your printer connected to
+(note that /dev/lp0 is equivalent to LPT1:)?\n") . (join "\n", @str), [
+_("Printer Device:") => {val => \$printer->{DEVICE}, list => \@port } ],
+ );
+
+ #- select right DBENTRY according to device selected.
+ foreach (@parport) {
+ $printer->{DEVICE} eq $_->{port} or next;
+ $printer->{DBENTRY} = $printer::descr_to_db{common::bestMatchSentence2($parport[0]{val}{DESCRIPTION},
+ @printer::entry_db_description)};
+ }
+ 1;
+}
- my @port = ();
- my @parport = detect_devices::whatPrinter();
- eval { modules::unload("parport_probe") };
- my $str;
- if ($parport[0]) {
- my $port = $parport[0]{port};
- $printer->{DEVICE} = $port;
- my $descr = common::bestMatchSentence2($parport[0]{val}{DESCRIPTION}, @printer::entry_db_description);
- $printer->{DBENTRY} = $printer::descr_to_db{$descr};
- $str = _("A printer, model \"%s\", has been detected on ", $parport[0]{val}{DESCRIPTION}) . $port;
- @port = map { $_->{port}} @parport;
- } else {
- @port = detect_devices::whatPrinterPort();
- }
- $printer->{DEVICE} = $port[0] if $port[0];
-
- return if !$in->ask_from_entries_ref(_("Local Printer Device"),
- _("What device is your printer connected to \n(note that /dev/lp0 is equivalent to LPT1:)?\n") . $str ,
- [_("Printer Device:")],
- [{val => \$printer->{DEVICE}, list => \@port }],
- );
- } elsif ($printer->{TYPE} eq "REMOTE") {
- return if !$in->ask_from_entries_ref(_("Remote lpd Printer Options"),
- _("To use a remote lpd print queue, you need to supply
+sub setup_remote($$$) {
+ my ($printer, $in, $install) = @_;
+
+ $in->ask_from_entries_refH(_("Remote lpd Printer Options"),
+_("To use a remote lpd print queue, you need to supply
the hostname of the printer server and the queue name
-on that server which jobs should be placed in."),
- [_("Remote hostname:"), _("Remote queue")],
- [\$printer->{REMOTEHOST}, \$printer->{REMOTEQUEUE}],
- );
- } elsif ($printer->{TYPE} eq "SMB") {
- return if !$in->ask_from_entries_ref(
- _("SMB (Windows 9x/NT) Printer Options"),
- _("To print to a SMB printer, you need to provide the
+on that server which jobs should be placed in."), [
+_("Remote hostname:") => \$printer->{REMOTEHOST},
+_("Remote queue") => \$printer->{REMOTEQUEUE}, ],
+ );
+}
+
+sub setup_smb($$$) {
+ my ($printer, $in, $install) = @_;
+
+ return if !$in->ask_from_entries_refH(
+ _("SMB (Windows 9x/NT) Printer Options"),
+_("To print to a SMB printer, you need to provide the
SMB host name (Note! It may be different from its
TCP/IP hostname!) and possibly the IP address of the print server, as
well as the share name for the printer you wish to access and any
-applicable user name, password, and workgroup information."),
- [_("SMB server host:"), _("SMB server IP:"),
- _("Share name:"), _("User name:"), _("Password:"),
- _("Workgroup:")],
- [\$printer->{SMBHOST}, \$printer->{SMBHOSTIP},
- \$printer->{SMBSHARE}, \$printer->{SMBUSER},
- {val => \$printer->{SMBPASSWD}, hidden => 1}, \$printer->{SMBWORKGROUP}
- ],
- complete => sub {
- unless (network::is_ip($printer->{SMBHOSTIP})) {
- $in->ask_warn('', _("IP address should be in format 1.2.3.4"));
- return (1,1);
- }
- return 0;
- },
- );
- &$install('samba');
- } elsif ($printer->{TYPE} eq "NCP") {
- return if !$in->ask_from_entries_ref(_("NetWare Printer Options"),
- _("To print to a NetWare printer, you need to provide the
+applicable user name, password, and workgroup information."), [
+_("SMB server host:") => \$printer->{SMBHOST},
+_("SMB server IP:") => \$printer->{SMBHOSTIP},
+_("Share name:") => \$printer->{SMBSHARE},
+_("User name:") => \$printer->{SMBUSER},
+_("Password:") => { val => \$printer->{SMBPASSWD}, hidden => 1 },
+_("Workgroup:") => \$printer->{SMBWORKGROUP} ],
+ complete => sub {
+ unless (network::is_ip($printer->{SMBHOSTIP})) {
+ $in->ask_warn('', _("IP address should be in format 1.2.3.4"));
+ return (1,1);
+ }
+ return 0;
+ },
+ );
+ &$install('samba');
+ 1;
+}
+
+sub setup_ncp($$$) {
+ my ($printer, $in, $install) = @_;
+
+ return if !$in->ask_from_entries_refH(_("NetWare Printer Options"),
+_("To print to a NetWare printer, you need to provide the
NetWare print server name (Note! it may be different from its
TCP/IP hostname!) as well as the print queue name for the printer you
-wish to access and any applicable user name and password."),
- [_("Printer Server:"), _("Print Queue Name:"),
- _("User name:"), _("Password:")],
- [\$printer->{NCPHOST}, \$printer->{NCPQUEUE},
- \$printer->{NCPUSER}, {val => \$printer->{NCPPASSWD}, hidden => 1}],
- );
- &$install('ncpfs');
- }
+wish to access and any applicable user name and password."), [
+_("Printer Server:") => \$printer->{NCPHOST},
+_("Print Queue Name:") => \$printer->{NCPQUEUE},
+_("User name:") => \$printer->{NCPUSER},
+_("Password:") => {val => \$printer->{NCPPASSWD}, hidden => 1} ],
+ );
+ &$install('ncpfs');
+ 1;
+}
+sub setup_gsdriver($$) {
+ my ($printer, $in) = @_;
my $action;
my @action = qw(ascii ps both done);
my %action = (
@@ -197,23 +186,45 @@ wish to access and any applicable user name and password."),
my %depth_to_col = reverse %col_to_depth;
my $is_uniprint = $db_entry{GSDRIVER} eq "uniprint";
- $printer->{RESOLUTION} = @res ? $res[0] || "Default" : "Default";
- $printer->{CRLF} = $db_entry{DESCR} =~ /HP/;
+ $printer->{RESOLUTION} = @res ? $res[0] || "Default" : "Default" unless member($printer->{RESOLUTION}, @res);
+ $printer->{ASCII_TO_PS} = $db_entry{GSDRIVER} eq 'POSTSCRIPT' unless defined($printer->{ASCII_TO_PS});
+ $printer->{CRLF} = $db_entry{DESCR} =~ /HP/ unless defined($printer->{CRLF});
$printer->{BITSPERPIXEL} = @list_col ? $depth_to_col{$printer->{BITSPERPIXEL}} || $col[0] : "Default";
-
- $in->ask_from_entries_refH('', _("Printer options"), [
-_("Paper Size") => { val => \$printer->{PAPERSIZE}, type => 'list', , not_edit => !$::expert, list => \@printer::papersize_type },
+ $printer->{NUP} = 1 unless member($printer->{NUP}, qw(1 2 4 8));
+ $printer->{RTFLTMAP} = 18 unless $printer->{RTFLTMAP} =~ /^\d+$/;
+ $printer->{TOPBOTMAP} = 18 unless $printer->{TOPBOTMAP} =~ /^\d+$/;
+ $printer->{EXTRA_GS_OPTIONS} =~ s/^\"(.*)\"/$1/;
+ $printer->{TEXTONLYOPTIONS} =~ s/^\"(.*)\"/$1/;
+
+ return if !$in->ask_from_entries_refH('', _("Printer options"), [
+_("Paper Size") => { val => \$printer->{PAPERSIZE}, type => 'list', not_edit => !$::expert, list => \@printer::papersize_type },
_("Eject page after job?") => { val => \$printer->{AUTOSENDEOF}, type => 'bool' },
@list_res > 1 ? (
-_("Resolution") => { val => \$printer->{RESOLUTION}, type => 'list', , not_edit => !$::expert, list => \@res } ) : (),
-_("Fix stair-stepping text?") => { val => \$printer->{CRLF}, type => "bool" },
+_("Resolution") => { val => \$printer->{RESOLUTION}, type => 'list', not_edit => !$::expert, list => \@res } ) : (),
@list_col > 1 ? (
$is_uniprint ? (
-_("Uniprint driver options") => { val => \$printer->{BITSPERPIXEL}, type => 'list', , not_edit => !$::expert, list => \@col } ) : (
-_("Color depth options") => { val => \$printer->{BITSPERPIXEL}, type => 'list', , not_edit => !$::expert, list => \@col } ), ) : ()
-]);;
-
- $printer->{BITSPERPIXEL} = $col_to_depth{$printer->{BITSPERPIXEL}} || $printer->{BITSPERPIXEL}; #- translate back.
+_("Uniprint driver options") => { val => \$printer->{BITSPERPIXEL}, type => 'list', not_edit => 1, list => \@col } ) : (
+_("Color depth options") => { val => \$printer->{BITSPERPIXEL}, type => 'list', not_edit => 1, list => \@col } ), ) : (),
+$db_entry{GSDRIVER} ne 'TEXT' && $db_entry{GSDRIVER} ne 'POSTSCRIPT' ? (
+_("Print text as PostScript?") => { val => \$printer->{ASCII_TO_PS}, type => 'bool' }, ) : (),
+_("Reverse page order") => { val => \$printer->{REVERSE_ORDER}, type => 'bool' },
+$db_entry{GSDRIVER} ne 'POSTSCRIPT' ? (
+_("Fix stair-stepping text?") => { val => \$printer->{CRLF}, type => 'bool' },
+) : (),
+$db_entry{GSDRIVER} ne 'TEXT' ? (
+_("Number of pages per output pages") => { val => \$printer->{NUP}, type => 'list', not_edit => !$::expert, list => [1,2,4,8] },
+_("Right/Left margins in points (1/72 of inch)") => \$printer->{RTFLTMAP},
+_("Top/Bottom margins in points (1/72 of inch)") => \$printer->{TOPBOTMAP},
+) : (),
+$::expert && $db_entry{GSDRIVER} ne 'TEXT' && $db_entry{GSDRIVER} ne 'POSTSCRIPT' ? (
+_("Extra GhostScript options") => \$printer->{EXTRA_GS_OPTIONS},
+) : (),
+$::expert && $db_entry{GSDRIVER} ne 'POSTSCRIPT' ? (
+_("Extra Text options") => \$printer->{TEXTONLYOPTIONS},
+) : (),
+]);
+
+ $printer->{BITSPERPIXEL} = $col_to_depth{$printer->{BITSPERPIXEL}} || $printer->{BITSPERPIXEL}; #- translate back.
$printer->{complete} = 1;
copy_printer_params($printer, $printer->{configured}{$printer->{QUEUE}} ||= {});
@@ -223,7 +234,6 @@ _("Color depth options") => { val => \$printer->{BITSPERPIXEL}, type => 'list',
$action = ${{reverse %action}}{$in->ask_from_list('', _("Do you want to test printing?"),
[ map { $action{$_} } @action ], $action{'done'})};
- my $pidlpd;
my @testpages;
push @testpages, "/usr/lib/rhs/rhs-printfilters/testpage.asc"
if $action eq "ascii" || $action eq "both";
@@ -231,23 +241,14 @@ _("Color depth options") => { val => \$printer->{BITSPERPIXEL}, type => 'list',
if $action eq "ps" || $action eq "both";
if (@testpages) {
- my $w = $in->wait_message('', _("Printing test page(s)..."));
+ my @lpq_output;
+ {
+ my $w = $in->wait_message('', _("Printing test page(s)..."));
- #- restart lpd with blank spool queue.
- foreach (("/var/spool/lpd/$printer->{QUEUE}/lock", "/var/spool/lpd/lpd.lock")) {
- $pidlpd = (cat_("$prefix$_"))[0]; kill 'TERM', $pidlpd if $pidlpd;
- unlink "$prefix$_";
+ printer::restart_queue($printer->{QUEUE});
+ @lpq_output = printer::print_pages($printer->{QUEUE}, @testpages);
}
- run_program::rooted($prefix, "lprm", "-P$printer->{QUEUE}", "-"); sleep 1;
- run_program::rooted($prefix, "lpd"); sleep 1;
-
- run_program::rooted($prefix, "lpr", "-P$printer->{QUEUE}", $_) foreach @testpages;
- sleep 5; #- allow lpr to send pages.
- local *F; open F, "chroot $prefix/ /usr/bin/lpq -P$printer->{QUEUE} |";
- my @lpq_output = grep { !/^no entries/ && !(/^Rank\s+Owner/ .. /^\s*$/) } <F>;
-
- undef $w; #- erase wait message window.
if (@lpq_output) {
$action = $in->ask_yesorno('', _("Test page(s) have been sent to the printer daemon.
This may take a little time before printer start.
@@ -261,3 +262,85 @@ Does it work properly?"), 1) ? 'done' : 'change';
} while ($action ne 'done');
$printer->{complete} = 1;
}
+
+#- Program entry point.
+sub main($$$) {
+ my ($printer, $in, $install) = @_;
+ my ($queue, $continue);
+
+ printer::read_printer_db();
+ do {
+ if ($::beginner || !(scalar keys %{$printer->{configured} || {}})) {
+ $queue = $in->ask_yesorno(_("Printer"),
+ _("Would you like to configure a printer?"),
+ $printer->{want}) ? 'lp' : 'Done';
+ } else {
+ $queue = $in->ask_from_list_([''],
+_("Here are the following print queue.
+You can add some more or change the existing ones."),
+ [ (sort keys %{$printer->{configured} || {}}), __("Add"), __("Done") ],
+ );
+ if ($queue eq 'Add') {
+ my $i = '';
+ while ($i < 99) {
+ last unless $printer->{configured}{"lp$i"};
+ ++$i;
+ }
+ unless ($printer->{configured}{"lp$i"}) {
+ $queue = "lp$i";
+ $printer->{QUEUE} = $queue;
+ $printer->{SPOOLDIR} = "$printer::spooldir/$printer->{QUEUE}";
+ }
+ }
+ }
+ $queue eq 'Done' and last;
+
+ copy_printer_params($printer->{configured}{$queue}, $printer) if $printer->{configured}{$queue};
+ $printer->{complete} = 0; #- ??? keep that
+
+ &$install('rhs-printfilters') unless $::testing;
+
+ do {
+ if ($::beginner) {
+ $printer->{str_type} =
+ $in->ask_from_list_(_("Select Printer Connection"),
+ _("How is the printer connected?"),
+ [ keys %printer::printer_type ],
+ $printer::printer_type_inv{$printer->{TYPE}},
+ );
+ $printer->{TYPE} = $printer::printer_type{$printer->{str_type}};
+ } else {
+ $in->ask_from_entries_refH([_("Select Printer Connection"), _("Ok"), _("Remove queue")],
+_("Every print queue (which print jobs are directed to) needs a
+name (often lp) and a spool directory associated with it. What
+name and directory should be used for this queue and how is the printer connected?"), [
+_("Name of queue:") => { val => \$printer->{QUEUE} },
+_("Spool directory:") => { val => \$printer->{SPOOLDIR} },
+_("Printer Connection") => { val => \$printer->{str_type}, list => [ keys %printer::printer_type ] },
+ ],
+ changed => sub {
+ $printer->{SPOOLDIR} = "$printer::spooldir/$printer->{QUEUE}" unless $_[0];
+ },
+ complete => sub {
+ $printer->{TYPE} = $printer::printer_type{$printer->{str_type}} or
+ $in->ask_warn('', _("Unknown printer connection!")), return (1, 2);
+ return 0;
+ }
+ ) or delete $printer->{configured}{$queue}, redo; #- global redo on steps
+ }
+
+ $continue = '';
+ for ($printer->{TYPE}) {
+ /LOCAL/ and setup_local ($printer, $in, $install) and last;
+ /REMOTE/ and setup_remote($printer, $in, $install) and last;
+ /SMB/ and setup_smb ($printer, $in, $install) and last;
+ /NCP/ and setup_ncp ($printer, $in, $install) and last;
+ $continue = 1; last;
+ }
+ } while ($continue);
+
+ #- configure ghostscript driver to be used.
+ setup_gsdriver($printer, $in);
+
+ } until ($::beginner || $queue eq 'Done');
+}