diff options
-rw-r--r-- | perl-install/Makefile | 2 | ||||
-rw-r--r-- | perl-install/install_steps_interactive.pm | 196 | ||||
-rw-r--r-- | perl-install/printer.pm | 145 | ||||
-rw-r--r-- | perl-install/printerdrake.pm | 260 | ||||
-rwxr-xr-x | perl-install/standalone/printerdrake | 42 |
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 |