summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>1999-11-26 18:53:55 +0000
committerFrancois Pons <fpons@mandriva.com>1999-11-26 18:53:55 +0000
commit481c1e409ed37daad82aaf3e9e6344379b87fd27 (patch)
tree1e3f321087dd32186139fe36bff2533dd5d1ff59 /perl-install
parent6dbd6e6db0495ddd9774f20f0fb3c239b15e13a2 (diff)
downloaddrakx-481c1e409ed37daad82aaf3e9e6344379b87fd27.tar
drakx-481c1e409ed37daad82aaf3e9e6344379b87fd27.tar.gz
drakx-481c1e409ed37daad82aaf3e9e6344379b87fd27.tar.bz2
drakx-481c1e409ed37daad82aaf3e9e6344379b87fd27.tar.xz
drakx-481c1e409ed37daad82aaf3e9e6344379b87fd27.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Makefile2
-rw-r--r--perl-install/install_steps_interactive.pm196
-rw-r--r--perl-install/printer.pm145
-rw-r--r--perl-install/printerdrake.pm260
-rwxr-xr-xperl-install/standalone/printerdrake42
5 files changed, 420 insertions, 225 deletions
diff --git a/perl-install/Makefile b/perl-install/Makefile
index b24f61ceb..80ff66f1f 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -2,7 +2,7 @@ VERSION = 2.2.10-BOOT
SUDO = sudo
SO_FILES = c/blib/arch/auto/c/c.so
PMS = *.pm Newt/*.pm c/stuff.pm resize_fat/*.pm pci_probing/*.pm commands install2 g_auto_install
-PMS += $(patsubst %, standalone/%,diskdrake XFdrake rpmdrake mousedrake)
+PMS += $(patsubst %, standalone/%,diskdrake XFdrake rpmdrake mousedrake printerdrake)
REP4PMS = /usr/bin/perl-install
ROOTDEST = /export
DEST = $(ROOTDEST)/Mandrake/mdkinst
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 6e2555cf2..4b6d3dc74 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -32,7 +32,7 @@ use keyboard;
use fs;
use modparm;
use log;
-use printer;
+use printerdrake;
use lilo;
#-######################################################################################
#- In/Out Steps Functions
@@ -426,201 +426,9 @@ sub printerConfig($) {
$o->{printer}{want});
return if !$o->{printer}{want};
- unless (($::testing)) {
- printer::set_prefix($o->{prefix});
- install_any::pkg_install($o, 'rhs-printfilters');
- }
- printer::read_printer_db();
-
- $o->{printer}{complete} = 0;
- if ($::expert) {
- $o->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:")],
- [\$o->{printer}{QUEUE}, \$o->{printer}{SPOOLDIR}],
- changed => sub
- {
- $o->{printer}{SPOOLDIR}
- = "$printer::spooldir/$o->{printer}{QUEUE}" unless $_[0];
- },
- );
- }
-
- $o->{printer}{str_type} =
- $o->ask_from_list_(_("Select Printer Connection"),
- _("How is the printer connected?"),
- [ keys %printer::printer_type ],
- ${$o->{printer}}{str_type},
- );
- $o->{printer}{TYPE} = $printer::printer_type{$o->{printer}{str_type}};
-
- if ($o->{printer}{TYPE} eq "LOCAL") {
- {
- my $w = $o->wait_message(_("Test ports"), _("Detecting devices..."));
- eval { modules::load("parport_pc"); modules::load("parport_probe"); modules::load("lp"); };
- }
-
- my @port = ();
- my @parport = detect_devices::whatPrinter();
- eval { modules::unload("parport_probe") };
- my $str;
- if ($parport[0]) {
- my $port = $parport[0]{port};
- $o->{printer}{DEVICE} = $port;
- my $descr = common::bestMatchSentence2($parport[0]{val}{DESCRIPTION}, @printer::entry_db_description);
- $o->{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();
- }
- $o->{printer}{DEVICE} = $port[0] if $port[0];
-
- return if !$o->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 => \$o->{printer}{DEVICE}, list => \@port }],
- );
- } elsif ($o->{printer}{TYPE} eq "REMOTE") {
- return if !$o->ask_from_entries_ref(_("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")],
- [\$o->{printer}{REMOTEHOST}, \$o->{printer}{REMOTEQUEUE}],
- );
- } elsif ($o->{printer}{TYPE} eq "SMB") {
- return if !$o->ask_from_entries_ref(
- _("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:")],
- [\$o->{printer}{SMBHOST}, \$o->{printer}{SMBHOSTIP},
- \$o->{printer}{SMBSHARE}, \$o->{printer}{SMBUSER},
- {val => \$o->{printer}{SMBPASSWD}, hidden => 1}, \$o->{printer}{SMBWORKGROUP}
- ],
- complete => sub {
- unless (network::is_ip($o->{printer}{SMBHOSTIP})) {
- $o->ask_warn('', _("IP address should be in format 1.2.3.4"));
- return (1,1);
- }
- return 0;
- },
- );
- install_any::pkg_install($o, 'samba');
- } elsif ($o->{printer}{TYPE} eq "NCP") {
- return if !$o->ask_from_entries_ref(_("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:")],
- [\$o->{printer}{NCPHOST}, \$o->{printer}{NCPQUEUE},
- \$o->{printer}{NCPUSER}, {val => \$o->{printer}{NCPPASSWD}, hidden => 1}],
- );
- install_any::pkg_install($o, 'ncpfs');
- }
-
- my $action;
- my @action = qw(ascii ps both done);
- my %action = (
- ascii => _("Yes, print ASCII test page"),
- ps => _("Yes, print PostScript test page"),
- both => _("Yes, print both test pages"),
- done => _("No"),
- );
-
- do {
- $o->{printer}{DBENTRY} =
- $printer::descr_to_db{
- $o->ask_from_list_(_("Configure Printer"),
- _("What type of printer do you have?"),
- [@printer::entry_db_description],
- $printer::db_to_descr{$o->{printer}{DBENTRY}},
- )
- };
-
- my %db_entry = %{$printer::thedb{$o->{printer}{DBENTRY}}};
-
- my @list_res = @{$db_entry{RESOLUTION} || []};
- my @res = map { "$_->{XDPI}x$_->{YDPI}" } @list_res;
- my @list_col = @{$db_entry{BITSPERPIXEL} || []};
- my @col = map { "$_->{DEPTH} $_->{DESCR}" } @list_col;
- my %col_to_depth = map { ("$_->{DEPTH} $_->{DESCR}", $_->{DEPTH}) } @list_col;
- my %depth_to_col = reverse %col_to_depth;
- my $is_uniprint = $db_entry{GSDRIVER} eq "uniprint";
-
- $o->{printer}{RESOLUTION} = "Default" unless @list_res;
- $o->{printer}{CRLF} = $db_entry{DESCR} =~ /HP/;
- $o->{printer}{BITSPERPIXEL} = "Default" unless @list_col;
-
- $o->{printer}{BITSPERPIXEL} = $depth_to_col{$o->{printer}{BITSPERPIXEL}} || $o->{printer}{BITSPERPIXEL}; #- translate.
-
- $o->ask_from_entries_refH('', _("Printer options"), [
-_("Paper Size") => { val => \$o->{printer}{PAPERSIZE}, type => 'list', , not_edit => !$::expert, list => \@printer::papersize_type },
-_("Eject page after job?") => { val => \$o->{printer}{AUTOSENDEOF}, type => 'bool' },
-@list_res > 1 ? (
-_("Resolution") => { val => \$o->{printer}{RESOLUTION}, type => 'list', , not_edit => !$::expert, list => \@res } ) : (),
-_("Fix stair-stepping text?") => { val => \$o->{printer}{CRLF}, type => "bool" },
-@list_col > 1 ? (
-$is_uniprint ? (
-_("Uniprint driver options") => { val => \$o->{printer}{BITSPERPIXEL}, type => 'list', , not_edit => !$::expert, list => \@col } ) : (
-_("Color depth options") => { val => \$o->{printer}{BITSPERPIXEL}, type => 'list', , not_edit => !$::expert, list => \@col } ), ) : ()
-]);;
-
- $o->{printer}{BITSPERPIXEL} = $col_to_depth{$o->{printer}{BITSPERPIXEL}} || $o->{printer}{BITSPERPIXEL}; #- translate.
-
- $o->{printer}{complete} = 1;
- install_steps::printerConfig($o);
- $o->{printer}{complete} = 0;
-
- $action = ${{reverse %action}}{$o->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";
- push @testpages, "/usr/lib/rhs/rhs-printfilters/testpage". ($o->{printer}{PAPERSIZE} eq 'a4' && '-a4') .".ps"
- if $action eq "ps" || $action eq "both";
-
- if (@testpages) {
- my $w = $o->wait_message('', _(@testpages > 1 ? "Printing tests pages..." : "Printing test page..."));
-
- #- restart lpd with blank spool queue.
- foreach (("/var/spool/lpd/$o->{printer}{QUEUE}/lock", "/var/spool/lpd/lpd.lock")) {
- $pidlpd = (cat_("$o->{prefix}$_"))[0]; kill 'TERM', $pidlpd if $pidlpd;
- unlink "$o->{prefix}$_";
- }
- run_program::rooted($o->{prefix}, "lprm", "-P$o->{printer}{QUEUE}", "-"); sleep 1;
- run_program::rooted($o->{prefix}, "lpd"); sleep 1;
-
- run_program::rooted($o->{prefix}, "lpr", "-P$o->{printer}{QUEUE}", $_) foreach @testpages;
-
- sleep 3; #- allow lpr to send pages.
- local *F; open F, "chroot $o->{prefix} /usr/bin/lpq |";
- my @lpq_output = grep { !/^no entries/ && !(/^Rank\s+Owner/ .. /^\s*$/) } <F>;
-
- undef $w; #- erase wait message window.
- if (@lpq_output) {
- $action = $o->ask_yesorno('', _("Is this correct? Printing status:\n%s", "@lpq_output"), 1) ? 'done' : 'change';
- } else {
- $action = $o->ask_yesorno('', _("Is this correct?"), 1) ? 'done' : 'change';
- }
- }
- } while ($action ne 'done');
- $o->{printer}{complete} = 1;
+ printerdrake::main($o->{prefix}, $o->{printer}, $o, sub { install_any::pkg_install($o, $_[0]) });
}
-
#------------------------------------------------------------------------------
sub setRootPassword($) {
my ($o, $clicked) = @_;
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index c414f496d..e95ccbe78 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -28,7 +28,7 @@ use strict;
=cut
#-#####################################################################################
-use vars qw(%thedb %printer_type %printer_type_inv $printer_type_default @papersize_type %fields $spooldir @entries_db_short @entry_db_description %descr_to_db %db_to_descr);
+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_db %db_to_descr);
#-#####################################################################################
=head2 Imports
@@ -315,6 +315,7 @@ sub read_printer_db(;$) {
}
}
$thedb{$entryname} = $entry;
+ $thedb_gsdriver{$entry->{GSDRIVER}} = $entry;
}
}
@@ -388,6 +389,87 @@ my $intro_printcap_test = "
";
+sub read_configured_queue($) {
+ my ($entry) = @_;
+ my $current = undef;
+
+ #- read /etc/printcap file.
+ local *PRINTCAP; open PRINTCAP, "$prefix/etc/printcap" or die "Can't open 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;
+ }
+ $current = {
+ TYPE => $1 || $2,
+ GSDRIVER => $3 || $4,
+ RESOLUTION => $5 || $6,
+ PAPERSIZE => $7 || $8,
+ #- ignored $9 || $10,
+ DBENTRY => $11 || $12,
+ BITSPERPIXEL => $13 || $14,
+ CRLF => $15 || $16,
+ };
+ print STDERR "found printer $current->{QUEUE} of type $current->{TYPE} in $prefix/etc/printcap\n";
+ } elsif (/^([^:]*):\\/) {
+ $current->{QUEUE} = $1;
+ print STDERR "found printer $current->{QUEUE} of type $current->{TYPE} in $prefix/etc/printcap\n";
+ } elsif (/^\s+:sd=([^:]*):\\/) {
+ $current->{SPOOLDIR} = $1;
+ } elsif (/^\s+:lp=([^:]*):\\/) {
+ $current->{DEVICE} = $1;
+ } elsif (/^\s+:rm=([^:]*):\\/) {
+ $current->{REMOTEHOST} = $1;
+ } elsif (/^\s+:rp=([^:]*):\\/) {
+ $current->{REMOTEQUEUE} = $1;
+ }
+ }
+ if ($current) {
+ add2hash($entry->{configured}{$current->{QUEUE}} ||= {}, $current);
+ $current = undef;
+ }
+
+ #- get extra parameters for SMB or NCP type queue.
+ foreach (values %{$entry->{configured}}) {
+ if ($_->{TYPE} eq 'SMB') {
+ my $config_file = "$prefix$_->{SPOOLDIR}/.config";
+ local *F; open F, "$config_file" or die "Can't open $config_file $!";
+ foreach (<F>) {
+ chomp;
+ if (/^\s*share='\\\\(.*?)\\(.*?)'/) {
+ $_->{SMBHOST} = $1;
+ $_->{SMBSHARE} = $2;
+ } elsif (/^\s*hostip=(.*)/) {
+ $_->{SMBHOSTIP} = $1;
+ } elsif (/^\s*user='(.*)'/) {
+ $_->{SMBUSER} = $1;
+ } elsif (/^\s*password='(.*)'/) {
+ $_->{SMBPASSWD} = $1;
+ } elsif (/^\s*workgroup='(.*)'/) {
+ $_->{SMBWORKGROUP} = $1;
+ }
+ }
+ } elsif ($_->{TYPE} eq 'NCP') {
+ my $config_file = "$prefix$_->{SPOOLDIR}/.config";
+ local *F; open F, "$config_file" or die "Can't open $config_file $!";
+ foreach (<F>) {
+ chomp;
+ if (/^\s*server=(.*)/) {
+ $_->{NCPHOST} = $1;
+ } elsif (/^\s*user='(.*)'/) {
+ $_->{NCPUSER} = $1;
+ } elsif (/^\s*password='(.*)'/) {
+ $_->{NCPPASSWD} = $1;
+ } elsif (/^\s*queue='(.*)'/) {
+ $_->{NCPQUEUE} = $1;
+ }
+ }
+ }
+ }
+}
sub configure_queue($) {
my ($entry) = @_;
@@ -462,7 +544,7 @@ sub configure_queue($) {
copy_master_filter($queue_path);
- #-now the printcap file
+ #-now the printcap file, note this one contains all the printer (use configured for that).
local *PRINTCAP;
if ($::testing) {
*PRINTCAP = *STDOUT;
@@ -471,35 +553,38 @@ sub configure_queue($) {
}
print PRINTCAP $intro_printcap_test;
- printf PRINTCAP "##PRINTTOOL3## %s %s %s %s %s %s %s%s\n",
- $entry->{TYPE},
- $dbentry->{GSDRIVER},
- $entry->{RESOLUTION},
- $entry->{PAPERSIZE},
- "{}",
- $dbentry->{ENTRY},
- $entry->{BITSPERPIXEL},
- $entry->{CRLF} ? " 1" : "";
-
-
- print PRINTCAP "$entry->{QUEUE}:\\\n";
- print PRINTCAP "\t:sd=$entry->{SPOOLDIR}:\\\n";
- print PRINTCAP "\t:mx#0:\\\n\t:sh:\\\n";
-
- if ($entry->{TYPE} eq "LOCAL") {
- print PRINTCAP "\t:lp=$entry->{DEVICE}:\\\n";
- } elsif ($entry->{TYPE} eq "REMOTE") {
- print PRINTCAP "\t:rm=$entry->{REMOTEHOST}:\\\n";
- print PRINTCAP "\t:rp=$entry->{REMOTEQUEUE}:\\\n";
- } else {
- #- (pcentry->Type == (PRINTER_SMB | PRINTER_NCP))
- print PRINTCAP "\t:lp=/dev/null:\\\n";
- print PRINTCAP "\t:af=$entry->{SPOOLDIR}/acct\\\n";
- }
-
- #- cheating to get the input filter!
- print PRINTCAP "\t:if=$entry->{SPOOLDIR}/filter:\n";
+ foreach (values %{$entry->{configured}}) {
+ my $db_ = $thedb{($_->{DBENTRY})} or die "no dbentry";
+
+ 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=$_->{SPOOLDIR}/acct\\\n";
+ }
+ #- cheating to get the input filter!
+ print PRINTCAP "\t:if=$_->{SPOOLDIR}/filter:\n";
+ print PRINTCAP "\n";
+ }
}
diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm
new file mode 100644
index 000000000..28bcd3b1e
--- /dev/null
+++ b/perl-install/printerdrake.pm
@@ -0,0 +1,260 @@
+package printerdrake;
+
+use diagnostics;
+use strict;
+
+use common qw(:common :file :functional :system);
+use detect_devices;
+use run_program;
+use commands;
+use modules;
+use log;
+use printer;
+
+1;
+
+sub getinfo($) {
+ my ($prefix) = @_;
+ my $entry = {};
+
+ 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;
+}
+
+sub copy_printer_params($$) {
+ my ($from, $to) = @_;
+
+ foreach (keys %$from) {
+ $to->{$_} = $from->{$_} if $_ ne 'configured'; #- avoid cycles.
+ }
+}
+
+#- Program entry point.
+sub main($$$$) {
+ my ($prefix, $printer, $in, $install) = @_;
+
+ unless ($::testing) {
+ printer::set_prefix($prefix);
+ &$install('rhs-printfilters');
+ }
+ 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];
+ },
+ );
+ }
+ 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"); };
+ }
+
+ 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
+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
+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
+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');
+ }
+
+ my $action;
+ my @action = qw(ascii ps both done);
+ my %action = (
+ ascii => _("Yes, print ASCII test page"),
+ ps => _("Yes, print PostScript test page"),
+ both => _("Yes, print both test pages"),
+ done => _("No"),
+ );
+
+ do {
+ $printer->{DBENTRY} ||= $printer::thedb_gsdriver{$printer->{GSDRIVER}}{ENTRY};
+ $printer->{DBENTRY} =
+ $printer::descr_to_db{
+ $in->ask_from_list_(_("Configure Printer"),
+ _("What type of printer do you have?"),
+ [@printer::entry_db_description],
+ $printer::db_to_descr{$printer->{DBENTRY}},
+ )
+ };
+
+ my %db_entry = %{$printer::thedb{$printer->{DBENTRY}}};
+
+ my @list_res = @{$db_entry{RESOLUTION} || []};
+ my @res = map { "$_->{XDPI}x$_->{YDPI}" } @list_res;
+ my @list_col = @{$db_entry{BITSPERPIXEL} || []};
+ my @col = map { "$_->{DEPTH} $_->{DESCR}" } @list_col;
+ my %col_to_depth = map { ("$_->{DEPTH} $_->{DESCR}", $_->{DEPTH}) } @list_col;
+ my %depth_to_col = reverse %col_to_depth;
+ my $is_uniprint = $db_entry{GSDRIVER} eq "uniprint";
+
+ $printer->{RESOLUTION} = "Default" unless @list_res;
+ $printer->{CRLF} = $db_entry{DESCR} =~ /HP/;
+ $printer->{BITSPERPIXEL} = "Default" unless @list_col;
+
+ $printer->{BITSPERPIXEL} = $depth_to_col{$printer->{BITSPERPIXEL}} || $printer->{BITSPERPIXEL}; #- translate.
+
+ $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" },
+@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.
+
+ $printer->{complete} = 1;
+ copy_printer_params($printer, $printer->{configured}{$printer->{QUEUE}} ||= {});
+ printer::configure_queue($printer);
+ $printer->{complete} = 0;
+
+ $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";
+ push @testpages, "/usr/lib/rhs/rhs-printfilters/testpage". ($printer->{PAPERSIZE} eq 'a4' && '-a4') .".ps"
+ if $action eq "ps" || $action eq "both";
+
+ if (@testpages) {
+ my $w = $in->wait_message('', _(@testpages > 1 ? "Printing tests pages..." : "Printing test page..."));
+
+ #- 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$_";
+ }
+ 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 3; #- 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('', _("Is this correct? Printing status:\n%s", "@lpq_output"), 1) ? 'done' : 'change';
+ } else {
+ $action = $in->ask_yesorno('', _("Is this correct?"), 1) ? 'done' : 'change';
+ }
+ }
+ } while ($action ne 'done');
+ $printer->{complete} = 1;
+}
diff --git a/perl-install/standalone/printerdrake b/perl-install/standalone/printerdrake
new file mode 100755
index 000000000..3ccd01311
--- /dev/null
+++ b/perl-install/standalone/printerdrake
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+
+# printerdrake
+# Copyright (C) 1999 MandrakeSoft (fpons@linux-mandrake.com)
+# Original version for printer configuration from pad.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+use lib qw(/usr/lib/libDrakX);
+
+use interactive;
+use printerdrake;
+
+local $_ = join '', @ARGV;
+
+/-h/ and die "usage: printerdrake [--beginner] [--expert] [--auto] [--noauto] [--skiptest] [--testing]\n";
+
+$::beginner = /--beginner/;
+$::expert = /--expert/;
+$::auto = /--auto/;
+$::noauto = /--noauto/;
+$::skiptest = /--skiptest/;
+$::testing = /--testing/;
+$::isStandalone = 1;
+
+my $in = vnew interactive;
+
+printerdrake::main('', printerdrake::getinfo(''), $in, sub { `urpmi --auto $_[0]` });
+
+exec 'true' if ref($in) =~ /gtk/; #- workaround for perl-GTK