diff options
Diffstat (limited to 'perl-install/printerdrake.pm')
| -rw-r--r-- | perl-install/printerdrake.pm | 401 |
1 files changed, 242 insertions, 159 deletions
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'); +} |