summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorpad <pad@mandriva.com>1999-09-04 14:43:15 +0000
committerpad <pad@mandriva.com>1999-09-04 14:43:15 +0000
commit2d380f59735e2e5b8637447c3db567120b6cd0d3 (patch)
tree6868da2d83a206164c20492bf4a2ab38dc01fcdb /perl-install
parentdd60c7b883a429a626c0d2f98446f34e40aa8620 (diff)
downloaddrakx-backup-do-not-use-2d380f59735e2e5b8637447c3db567120b6cd0d3.tar
drakx-backup-do-not-use-2d380f59735e2e5b8637447c3db567120b6cd0d3.tar.gz
drakx-backup-do-not-use-2d380f59735e2e5b8637447c3db567120b6cd0d3.tar.bz2
drakx-backup-do-not-use-2d380f59735e2e5b8637447c3db567120b6cd0d3.tar.xz
drakx-backup-do-not-use-2d380f59735e2e5b8637447c3db567120b6cd0d3.zip
complete on the spooldir field
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Makefile37
-rwxr-xr-xperl-install/install232
-rw-r--r--perl-install/install2.pm41
-rw-r--r--perl-install/install_steps_interactive.pm99
-rw-r--r--perl-install/interactive.pm12
-rw-r--r--perl-install/interactive_gtk.pm49
-rw-r--r--perl-install/my_gtk.pm10
-rw-r--r--perl-install/printer.pm517
8 files changed, 437 insertions, 360 deletions
diff --git a/perl-install/Makefile b/perl-install/Makefile
index 0d5e921bc..ff95819dc 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -1,20 +1,21 @@
-VERSION = 2.2.10-BOOT
-SUDO = sudo
-SO_FILES = c/blib/arch/auto/c/c.so
-PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm pci_probing/*.pm commands install2 diskdrake XFdrake
-ROOTDEST = /export
-DEST = $(ROOTDEST)/Mandrake/mdkinst
-STAGE2 = $(ROOTDEST)/Mandrake/base/mdkinst_stage2
+VERSION = 2.2.10-BOOT
+SUDO = sudo
+SO_FILES = c/blib/arch/auto/c/c.so
+PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm pci_probing/*.pm commands install2 diskdrake XFdrake
+ROOTDEST = /export
+DEST = $(ROOTDEST)/Mandrake/mdkinst
+STAGE2 = $(ROOTDEST)/Mandrake/base/mdkinst_stage2
+BASE = $(ROOTDEST)/Mandrake/base
DESTREP4PMS = $(DEST)/usr/bin/perl-install
-PERL = perl
-LOCALFILES = $(PERL) mouseconfig
-DIRS = po pci_probing
-EXCLUDE = $(LOCALFILES) boot.img xmodmap keymaps consolefonts install
-
-CFLAGS = -Wall
+PERL = perl
+LOCALFILES = $(PERL) mouseconfig
+DIRS = po pci_probing
+EXCLUDE = $(LOCALFILES) boot.img xmodmap keymaps consolefonts install
+RPMS = $(wildcard $(ROOTDEST)/Mandrake/RPMS/*.rpm)
+CFLAGS = -Wall
override CFLAGS += -pipe
-.PHONY: all $(DIRS) tags install clean stage2 full_stage2 verify_c
+.PHONY: all $(DIRS) tags install clean stage2 full_stage2 verify_c
all: $(SO_FILES) $(DIRS)
@@ -64,11 +65,11 @@ test_pms: verify_c
verify_c:
./verify_c $(PMS)
-gendepslist: %: %.cc
+gendepslist: %: %.cc
$(CXX) -I/usr/include/rpm $(CFLAGS) $< -lrpm -ldb1 -lz -o $@
-depslist: gendepslist
- ./gendepslist $(ROOTDEST)/Mandrake/base/depslist $(ROOTDEST)/Mandrake/RPMS/*.rpm
+$(BASE)/depslist: gendepslist $(RPMS)
+ ./gendepslist $(BASE)depslist $(ROOTDEST)/Mandrake/RPMS/*.rpm
install_pms: all
for i in `perl -ne 's/sub (\w+?)_? {.*/$$1/ and print' commands.pm`; do ln -sf commands $(DEST)/usr/bin/$$i; done
@@ -154,7 +155,7 @@ as_root:
mount /dev/loop0 /mnt/initrd
chmod a+w /mnt/initrd
-full_stage2:
+full_stage2: $(BASE)/depslist
rm -rf $(DEST)
mkdir -p $(DEST)
$(MAKE) get_needed_files
diff --git a/perl-install/install2 b/perl-install/install2
index ff820edd0..9b5aff1f2 100755
--- a/perl-install/install2
+++ b/perl-install/install2
@@ -1,21 +1,21 @@
#!/usr/bin/perl
-# Mandrake Graphic Install
-# Copyright (C) 1999 MandrakeSoft (pixel@linux-mandrake.com)
-#
-# 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.
+#- Mandrake Graphic Install
+#- Copyright (C) 1999 MandrakeSoft (pixel@linux-mandrake.com)
+#-
+#- 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 diagnostics;
use strict;
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 891212ae3..00a9710b7 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -2,8 +2,12 @@ package install2;
use diagnostics;
use strict;
+
use vars qw($o);
+########################################################################################
+# misc imports
+########################################################################################
use common qw(:common :file :system :functional);
use install_any qw(:all);
use log;
@@ -23,6 +27,10 @@ use install_steps_graphical;
use Data::Dumper;
+
+########################################################################################
+# Steps table
+########################################################################################
my %stepsHelp = (
selectLanguage =>
@@ -177,7 +185,7 @@ my @installSteps = (
configureNetwork => [ __("Configure networking"), 1, 1, "formatPartitions" ],
configureTimezone => [ __("Configure timezone"), 1, 1, "doInstallStep" ],
# configureServices => [ __("Configure services"), 0, 0 ],
- configurePrinter => [ __("Configure printer"), 1, 0, ],
+ configurePrinter => [ __("Configure printer"), 1, 0, "doInstallStep" ],
setRootPassword => [ __("Set root password"), 1, 1, "formatPartitions" ],
addUser => [ __("Add a user"), 1, 1, "doInstallStep" ],
createBootdisk => [ __("Create bootdisk"), 1, 0, "doInstallStep" ],
@@ -187,10 +195,11 @@ my @installSteps = (
);
my (%installSteps, %upgradeSteps, @orderedInstallSteps, @orderedUpgradeSteps);
+
for (my $i = 0; $i < @installSteps; $i += 2) {
my %h; @h{@installStepsFields} = @{ $installSteps[$i + 1] };
- $h{help} = $stepsHelp{$installSteps[$i]} || __("Help");
- $h{next} = $installSteps[$i + 2];
+ $h{help} = $stepsHelp{$installSteps[$i]} || __("Help");
+ $h{next} = $installSteps[$i + 2];
$h{onError} = $installSteps[$i + 2 * $h{onError}];
$installSteps{ $installSteps[$i] } = \%h;
push @orderedInstallSteps, $installSteps[$i];
@@ -211,9 +220,14 @@ for (my $i = 0; $i < @installSteps; $i += 2) {
$installSteps{first} = $installSteps[0];
-
+########################################################################################
+# INTERN CONSTANT
+########################################################################################
my @install_classes = (__("beginner"), __("developer"), __("server"), __("expert"));
+########################################################################################
+# Default value
+########################################################################################
# partition layout for a server
#NOT YET USED
my @serverPartitioning = (
@@ -246,7 +260,7 @@ my $default = {
complete => 0,
str_type => $printer::printer_type[0],
QUEUE => "lp",
- SPOOLDIR => "/var/spool/lpd/lp",
+ SPOOLDIR => "/var/spool/lpd/lp/",
DBENTRY => "DeskJet670",
PAPERSIZE => "legal",
CRLF => 0,
@@ -267,18 +281,18 @@ my $default = {
SMBUSER => "user",
SMBPASSWD => "passowrd",
SMBWORKGROUP => "AS3",
-
},
# keyboard => 'de',
# display => "192.168.1.9:0",
-
-
};
+########################################################################################
+#$O
#the big struct which contain, well everything (globals + the interactive methods ...)
#if you want to do a kickstart file, you just have to add all the required fields (see for example
#the variable $default)
+########################################################################################
$o = $::o = {
default => $default,
@@ -305,8 +319,13 @@ $o = $::o = {
};
-# each step function are called with two arguments : clicked(because if you are a beginner you can force the
-# the step) and the entered number
+########################################################################################
+# Steps Functions
+# each step function are called with two arguments : clicked(because if you are a
+# beginner you can force the the step) and the entered number
+########################################################################################
+
+#------------------------------------------------------------------------------
sub selectLanguage {
lang::set($o->{lang} = $o->chooseLanguage);
$o->{keyboard} = $o->default("keyboard") || keyboard::lang2keyboard($o->{lang});
@@ -320,6 +339,7 @@ sub selectLanguage {
} 'doInstallStep';
}
+#------------------------------------------------------------------------------
sub selectKeyboard {
my ($clicked) = $_[0];
return if $o->{installClass} eq "beginner" && !$clicked;
@@ -333,6 +353,7 @@ sub selectKeyboard {
} 'doInstallStep';
}
+#------------------------------------------------------------------------------
sub selectPath {
$o->{isUpgrade} = $o->selectInstallOrUpgrade;
$o->{steps} = $o->{isUpgrade} ? \%upgradeSteps : \%installSteps;
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 28f8622ef..b0bdaf675 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -150,18 +150,29 @@ sub printerConfig($) {
return if !$o->{printer}{want};
$o->{printer}{complete} = 0;
- #std info
- #Don't wait, if the user enter something, you must remember it
- #($o->{default}{printer}{QUEUE}, $o->{default}{printer}{SPOOLDIR}) =
- $o->{printer}{QUEUE} ||= $o->{default}{printer}{QUEUE};
- $o->{printer}{SPOOLDIR} ||= $o->{default}{printer}{SPOOLDIR};
- $o->ask_from_entries_ref(_("Standard 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}],
- );
+ #default value
+ foreach (keys %printer::fields) {
+ foreach (@{$printer::fields{$_}}) {
+ $o->{printer}{$_} ||= $o->{default}{printer}{$_};
+ }
+
+ }
+ if ($::expert) {
+ #std info
+ #Don't wait, if the user enter something, you must remember it
+ $o->ask_from_entries_ref(_("Standard 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"),
@@ -184,20 +195,19 @@ name and directory should be used for this queue?"),
(note that /dev/lp0 is equivalent to LPT1:)?\n");
$string .= _("I detect :");
$string .= join(", ", @port);
-
+ $o->{printer}{DEVICE} ||= $port[0];
$o->{printer}{DEVICE} ||= $o->{default}{printer}{DEVICE};
-
- $o->ask_from_entries_ref(_("Local Printer Device"),
- $string,
- [_("Printer Device:")],
- [\$o->{printer}{DEVICE}],
- );
+
+ return if !$o->ask_from_entries_ref(_("Local Printer Device"),
+ $string,
+ [_("Printer Device:")],
+ [\$o->{printer}{DEVICE}],
+ );
+ #TAKE A GOODDEFAULT TODO
} elsif ($o->{printer}{TYPE} eq "REMOTE") {
- $o->{printer}{REMOTEHOST} ||= $o->{default}{printer}{REMOTEHOST};
- $o->{printer}{REMOTEQUEUE} ||= $o->{default}{printer}{REMOTEQUEUE};
- $o->ask_from_entries_ref(_("Remote lpd Printer Options"),
+ 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."),
@@ -206,15 +216,7 @@ on that server which jobs should be placed in."),
);
} elsif ($o->{printer}{TYPE} eq "SMB") {
- $o->{printer}{SMBHOST} ||= $o->{default}{printer}{SMBHOST};
- $o->{printer}{SMBHOSTIP} ||= $o->{default}{printer}{SMBHOSTIP};
- $o->{printer}{SMBSHARE} ||= $o->{default}{printer}{SMBSHARE};
- $o->{printer}{SMBUSER} ||= $o->{default}{printer}{SMBUSER};
- $o->{printer}{SMBPASSWD} ||= $o->{default}{printer}{SMBPASSWD};
- $o->{printer}{SMBWORKGROUP} ||= $o->{default}{printer}{SMBWORKGROUP};
-
-
- $o->ask_from_entries_ref(_("SMB/Windows 95/NT Printer Options"),
+ return if !$o->ask_from_entries_ref(_("SMB/Windows 95/NT Printer Options"),
_("To print to a SMB printer, you need to provide the
SMB host name (this is not always the same as the machines
TCP/IP hostname) and possibly the IP address of the print server, as
@@ -228,17 +230,8 @@ applicable user name, password, and workgroup information."),
\$o->{printer}{SMBPASSWD}, \$o->{printer}{SMBWORKGROUP}
]
);
-
-
-
} elsif ($o->{printer}{TYPE} eq "NCP") {
- $o->{printer}{NCPHOST} ||= $o->{default}{printer}{NCPHOST};
- $o->{printer}{NCPQUEUE} ||= $o->{default}{printer}{NCPQUEUE};
- $o->{printer}{NCPUSER} ||= $o->{default}{printer}{NCPUSER};
- $o->{printer}{NCPPASSWD} ||= $o->{default}{printer}{NCPPASSWD};
-
-
- $o->ask_from_entries_ref(_("NetWare Printer Options"),
+ 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 (this is not always the same as the machines
TCP/IP hostname) as well as the print queue name for the printer you
@@ -250,15 +243,17 @@ wish to access and any applicable user name and password."),
);
}
-
-# printer::set_prefix($o->{prefix});
+ unless (($::testing)) {
+ printer::set_prefix($o->{prefix});
+ pkgs::select($o->{packages}, $o->{packages}{'rhs-printfilters'});
+ $o->installPackages($o->{packages});
+ }
printer::read_printer_db();
my @entries_db_short = sort keys %printer::thedb;
my @entry_db_description = map { $printer::thedb{$_}{DESCR} } @entries_db_short;
my %descr_to_db = map { $printer::thedb{$_}{DESCR}, $_ } @entries_db_short;
my %db_to_descr = reverse %descr_to_db;
- $o->{printer}{DBENTRY} ||= $o->{default}{printer}{DBENTRY};
$o->{printer}{DBENTRY} =
$descr_to_db{
$o->ask_from_list_(_("Configure Printer"),
@@ -272,7 +267,6 @@ wish to access and any applicable user name and password."),
#paper size conf
- $o->{printer}{PAPERSIZE} ||= $o->{default}{printer}{PAPERSIZE};
$o->{printer}{PAPERSIZE} =
$o->ask_from_list_(_("Paper Size"),
_("Paper Size"),
@@ -281,8 +275,6 @@ wish to access and any applicable user name and password."),
);
#resolution size conf
- $o->{printer}{RESOLUTION} ||= $o->{default}{printer}{RESOLUTION};
-
my @list_res = @{$db_entry{RESOLUTION}};
my @res = map { "${$_}{XDPI}x${$_}{YDPI}" } @list_res;
if (@list_res) {
@@ -300,14 +292,11 @@ wish to access and any applicable user name and password."),
# MAJOR HACK
# if the printer is an HP, let's do stairstep correction
$o->{printer}{CRLF} = $db_entry{DESCR} =~ /HP/;
-
- $o->{printer}{CRLF} ||= $o->{default}{printer}{CRLF};
$o->{printer}{CRLF}= $o->ask_yesorno(_("CRLF"),
_("Fix stair-stepping of text?"),
$o->{printer}{CRLF});
#color_depth
- $o->{printer}{BITSPERPIXEL} ||= $o->{default}{printer}{BITSPERPIXEL};
my @list_col = @{$db_entry{BITSPERPIXEL}};
my @col = map { "$_->{DEPTH} $_->{DESCR}" } @list_col;
my %col_to_depth = map { ("$_->{DEPTH} $_->{DESCR}", $_->{DEPTH}) } @list_col;
@@ -332,20 +321,12 @@ wish to access and any applicable user name and password."),
\@col,
$depth_to_col{$o->{printer}{BITSPERPIXEL}},
)};
-
-
-
-
}
} else {
$o->{default}{printer}{BITSPERPIXEL} = "Default";
}
-
-
-
- # $o->{printer}{complete} = 1;
+ $o->{printer}{complete} = 1;
$o->SUPER::printerConfig;
-
}
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 8ba93a4d9..c466dabbf 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -91,21 +91,21 @@ sub ask_from_entry($$$;$) {
$o->ask_from_entryW($title, $message, $def);
}
-sub ask_from_entries($$$$;$) {
- my ($o, $title, $message, $l, $def) = @_;
+sub ask_from_entries($$$$;$%) {
+ my ($o, $title, $message, $l, $def, %callback) = @_;
my $val = [ map { my $i = $_; \$i } @$def ];
- $o->ask_from_entries_ref($title, $message, $l, $val) ?
+ $o->ask_from_entries_ref($title, $message, $l, $val, %callback) ?
[ map { $$_ } @$val ] : undef;
}
-sub ask_from_entries_ref($$$$;$) {
- my ($o, $title, $message, $l, $val) = @_;
+sub ask_from_entries_ref($$$$;$%) {
+ my ($o, $title, $message, $l, $val, %callback) = @_;
$message = ref $message ? $message : [ $message ];
- $o->ask_from_entries_refW($title, $message, $l, $val)
+ $o->ask_from_entries_refW($title, $message, $l, $val, %callback)
}
sub wait_message($$$) {
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index 7d5397ba1..03f41e745 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -51,7 +51,7 @@ sub ask_from_listW {
}
}
-sub ask_many_from_list_refW {
+sub ask_many_from_list_refW($$$$$) {
my ($o, $title, $messages, $list, $val) = @_;
my $n = 0;
my $w = my_gtk->new('', %$o);
@@ -74,27 +74,50 @@ sub ask_many_from_list_refW {
sub ask_from_entries_refW {
- my ($o, $title, $messages, $l, $val) = @_;
+ my ($o, $title, $messages, $l, $val, %hcallback) = @_;
+ my $num_champs = @{$l};
+ my $ignore = 0;
- my @entry_list = mapn {
- my $entry = new Gtk::Entry;
- my $ref = $_[1];
- my $update = sub {
- ${$ref} = $entry->get_text;
+ my @entries = map { new Gtk::Entry } @{$l};
+ my @updates = mapn {
+ my ($entry, $ref) = @_;
+ return sub { ${$ref} = $entry->get_text };
+ } \@entries, $val;
+
+ my @updates_inv = mapn {
+ my ($entry, $ref) = @_;
+ sub { $entry->set_text(${$ref})
+ };
+ } \@entries, $val;
+
+
+ for (my $i = 0; $i <$num_champs; $i++) {
+ my $ind = $i;
+ my $callback = sub {
+ return if $ignore; #handle recursive deadlock
+ &{$updates[$ind]};
+ if ($hcallback{changed}) {
+ &{$hcallback{changed}}($ind);
+ #update all the value
+ $ignore = 1;
+ foreach (@updates_inv) { &{$_};}
+ $ignore = 0;
+ }
};
- $entry->signal_connect(changed => $update);
- $entry->set_text(${$_[1]}) if ${$_[1]};
+ my $entry = $entries[$i];
+ $entry->signal_connect(changed => $callback);
+ $entry->set_text(${$val->[$i]}) if ${$val->[$i]};
$entry->set_visibility(0) if $_[0] =~ /password/i;
- &$update;
- [($_[0], $entry)];
- } $l, $val;
-
+# &{$updates[$i]};
+ }
+ my @entry_list = mapn { [($_[0], $_[1])]} $l, \@entries;
my $w = my_gtk->new($title, %$o);
gtkadd($w->{window},
gtkpack(
create_box_with_title($w, @$messages),
create_packtable({}, @entry_list),
$w->create_okcancel));
+
$w->main();
}
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index b79014440..f0ccaa028 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -73,11 +73,11 @@ sub bigsize($) {
}
-sub gtkshow($) { $_[0]->show; $_[0] }
-sub gtkdestroy($) { $_[0] and $_[0]->destroy }
-sub gtkset_usize($$$) { $_[0]->set_usize($_[1],$_[2]); $_[0] }
-sub gtkset_justify($$) { $_[0]->set_justify($_[1]); $_[0] }
-sub gtkset_active($$) { $_[0]->set_active($_[1]); $_[0] }
+sub gtkshow($) { $_[0]->show; $_[0] }
+sub gtkdestroy($) { $_[0] and $_[0]->destroy }
+sub gtkset_usize($$$) { $_[0]->set_usize($_[1],$_[2]); $_[0] }
+sub gtkset_justify($$) { $_[0]->set_justify($_[1]); $_[0] }
+sub gtkset_active($$) { $_[0]->set_active($_[1]); $_[0] }
sub gtksignal_connect($@) {
my $w = shift;
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index b86e4de61..873c4d8bf 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -1,242 +1,293 @@
package printer;
+#-#####################################################################################
+
+=head1 NAME
+
+printer - supply methods for manage the printer related files directory handles
+
+=head1 SYNOPSIS
+
+use printer;
+
+=head1 DESCRIPTION
+
+Use the source.
+
+=cut
+
+#-#####################################################################################
use diagnostics;
use strict;
-use vars qw(%thedb %printer_type %printer_type_inv @papersize_type);
-########################################################################################
-# misc imports
-########################################################################################
+#-#####################################################################################
+
+=head2 Exported variable
+
+=cut
+
+#-#####################################################################################
+use vars qw(%thedb %printer_type %printer_type_inv @papersize_type %fields $spooldir);
+
+#-#####################################################################################
+
+=head2 Imports
+
+=cut
+
+#-#####################################################################################
use Data::Dumper;
use commands;
-########################################################################################
-# pixel imports
-########################################################################################
-#
-########################################################################################
-# EXAMPLES AND TYPES
-########################################################################################
-
-# An entry in the 'printerdb' file, which describes each type of
-# supported printer
-
-#ex:
-#StartEntry: DeskJet550
-# GSDriver: cdj550
-# Description: {HP DeskJet 550C/560C/6xxC series}
-# About: { \
-# This driver supports the HP inkjet printers which have \
-# color capability using both black and color cartridges \
-# simultaneously. Known to work with the 682C and the 694C. \
-# Other 600 and 800 series printers may work \
-# if they have this feature. \
-# If your printer seems to be saturating the paper with ink, \
-# try added an extra GS option of '-dDepletion=2'. \
-# Ghostscript supports several optional parameters for \
-# this driver: see the document 'devices.doc' \
-# in the ghostscript directory under /usr/doc. \
-# }
-# Resolution: {300} {300} {}
-# BitsPerPixel: {3} {Normal color printing with color cartridge}
-# BitsPerPixel: {8} {Floyd-Steinberg B&W printing for better greys}
-# BitsPerPixel: {24} {Floyd-Steinberg Color printing (best, but slow)}
-# BitsPerPixel: {32} {Sometimes provides better output than 24}
-#EndEntry
-
-my %ex_printerdb_entry =
- (
- ENTRY => "DeskJet550", #Human-readable name of the entry
- GSDRIVER => "cdj550", #gs driver used by this printer
- DESCR => "HP DeskJet 550C/560C/6xxC series", #Single line description of printer
- ABOUT => "
- This driver supports the HP inkjet printers which have
- color capability using both black and color cartridges
- ...", #Lengthy description of printer
- RESOLUTION => [ #List of resolutions supported
- {
- XDPI => 300,
- YDPI => 300,
- DESCR => "commentaire",
- },
- ],
- BITSPERPIXEL => [ #List of color depths supported
- {
- DEPTH => 3,
- DESCR => "Normal color printing with color cartridge",
- },
- ],
- )
-;
-
-
-
-# A printcap entry
-# Only represents a subset of possible options available
-# Sufficient for the simple configuration we are interested in
-
-# there is also some text in the template (.in) file in the spooldir
-
-#ex:
-## /etc/printcap
-##
-## Please don't edit this file directly unless you know what you are doing!
-## Be warned that the control-panel printtool requires a very strict format!
-## Look at the printcap(5) man page for more info.
-##
-## This file can be edited with the printtool in the control-panel.
-#
-###PRINTTOOL3## LOCAL uniprint NAxNA letter {} U_NECPrinwriter2X necp2x6 1
-#lpname:\
-# :sd=/var/spool/lpd/lpnamespool:\
-# :mx#45:\
-# :sh:\
-# :lp=/dev/device:\
-# :if=/var/spool/lpd/lpnamespool/filter:
-###PRINTTOOL3## REMOTE st800 360x180 a4 {} EpsonStylus800 Default 1
-#remote:\
-# :sd=/var/spool/lpd/remotespool:\
-# :mx#47:\
-# :sh:\
-# :rm=remotehost:\
-# :rp=remotequeue:\
-# :if=/var/spool/lpd/remotespool/filter:
-###PRINTTOOL3## SMB la75plus 180x180 letter {} DECLA75P Default {}
-#smb:\
-# :sd=/var/spool/lpd/smbspool:\
-# :mx#46:\
-# :sh:\
-# :if=/var/spool/lpd/smbspool/filter:\
-# :af=/var/spool/lpd/smbspool/acct:\
-# :lp=/dev/null:
-###PRINTTOOL3## NCP ap3250 180x180 letter {} EpsonAP3250 Default {}
-#ncp:\
-# :sd=/var/spool/lpd/ncpspool:\
-# :mx#46:\
-# :sh:\
-# :if=/var/spool/lpd/ncpspool/filter:\
-# :af=/var/spool/lpd/ncpspool/acct:\
-# :lp=/dev/null:
-
-
-my %ex_printcap_entry =
- (
- QUEUE => "lpname", #Queue name, can have multi separated by '|'
-
- #if you want something different from the default
- SPOOLDIR => "/var/spool/lpd/lpnamespool/", #Spool directory
- IF => "/var/spool/lpd/lpnamespool/filter", #input filter
-
- # commentaire inserer dans le printcap pour que printtool retrouve ses petits
- DBENTRY => "DeskJet670", #entry in printer database for this printer
- RESOLUTION => "NAxNA", #ghostscript resolution to use
- PAPERSIZE => "letter", #Papersize
- BITSPERPIXEL => "necp2x6", #ghostscript color option
- CRLF => 1 , #Whether or not to do CR/LF xlation
+#-#####################################################################################
+
+=head2 pixel imports
+
+=cut
+
+#-#####################################################################################
+
+#-#####################################################################################
+
+=head2 Examples and types
+
+=over 4
+
+=item *
+
+an entry in the 'printerdb' file, which describes each type of
+supported printer:
+
+ StartEntry: DeskJet550
+ GSDriver: cdj550
+ Description: {HP DeskJet 550C/560C/6xxC series}
+ About: { \
+ This driver supports the HP inkjet printers which have \
+ color capability using both black and color cartridges \
+ simultaneously. Known to work with the 682C and the 694C. \
+ Other 600 and 800 series printers may work \
+ if they have this feature. \
+ If your printer seems to be saturating the paper with ink, \
+ try added an extra GS option of '-dDepletion=2'. \
+ Ghostscript supports several optional parameters for \
+ this driver: see the document 'devices.doc' \
+ in the ghostscript directory under /usr/doc. \
+ }
+ Resolution: {300} {300} {}
+ BitsPerPixel: {3} {Normal color printing with color cartridge}
+ BitsPerPixel: {8} {Floyd-Steinberg B&W printing for better greys}
+ BitsPerPixel: {24} {Floyd-Steinberg Color printing (best, but slow)}
+ BitsPerPixel: {32} {Sometimes provides better output than 24}
+ EndEntry
+
+Example of data-struct:
+
+ my %ex_printerdb_entry =
+ (
+ ENTRY => "DeskJet550", #-Human-readable name of the entry
+ GSDRIVER => "cdj550", #-gs driver used by this printer
+ DESCR => "HP DeskJet 550C/560C/6xxC series", #-Single line description of printer
+ ABOUT => "
+ This driver supports the HP inkjet printers which have
+ color capability using both black and color cartridges
+ ...", #-Lengthy description of printer
+ RESOLUTION => [ #-List of resolutions supported
+ {
+ XDPI => 300,
+ YDPI => 300,
+ DESCR => "commentaire",
+ },
+ ],
+ BITSPERPIXEL => [ #-List of color depths supported
+ {
+ DEPTH => 3,
+ DESCR => "Normal color printing with color cartridge",
+ },
+ ],
+ )
+ ;
+
+=item *
+
+A printcap entry only represents a subset of possible options available
+Sufficient for the simple configuration we are interested in
+there is also some text in the template (.in) file in the spooldir
+
+ # /etc/printcap
+ #
+ # Please don't edit this file directly unless you know what you are doing
+ # Be warned that the control-panel printtool requires a very strict forma
+ # Look at the printcap(5) man page for more info.
+ #
+ # This file can be edited with the printtool in the control-panel.
+
+ ##PRINTTOOL3## LOCAL uniprint NAxNA letter {} U_NECPrinwriter2X necp2x6 1
+ lpname:\
+ :sd=/var/spool/lpd/lpnamespool:\
+ :mx#45:\
+ :sh:\
+ :lp=/dev/device:\
+ :if=/var/spool/lpd/lpnamespool/filter:
+ ##PRINTTOOL3## REMOTE st800 360x180 a4 {} EpsonStylus800 Default 1
+ remote:\
+ :sd=/var/spool/lpd/remotespool:\
+ :mx#47:\
+ :sh:\
+ :rm=remotehost:\
+ :rp=remotequeue:\
+ :if=/var/spool/lpd/remotespool/filter:
+ ##PRINTTOOL3## SMB la75plus 180x180 letter {} DECLA75P Default {}
+ smb:\
+ :sd=/var/spool/lpd/smbspool:\
+ :mx#46:\
+ :sh:\
+ :if=/var/spool/lpd/smbspool/filter:\
+ :af=/var/spool/lpd/smbspool/acct:\
+ :lp=/dev/null:
+ ##PRINTTOOL3## NCP ap3250 180x180 letter {} EpsonAP3250 Default {}
+ ncp:\
+ :sd=/var/spool/lpd/ncpspool:\
+ :mx#46:\
+ :sh:\
+ :if=/var/spool/lpd/ncpspool/filter:\
+ :af=/var/spool/lpd/ncpspool/acct:\
+ :lp=/dev/null:
+
+Example of data-struct:
+
+ my %ex_printcap_entry =
+ (
+ QUEUE => "lpname", #-Queue name, can have multi separated by '|'
+
+ #-if you want something different from the default
+ SPOOLDIR => "/var/spool/lpd/lpnamespool/", #-Spool directory
+ IF => "/var/spool/lpd/lpnamespool/filter", #-input filter
+
+ #- commentaire inserer dans le printcap pour que printtool retrouve ses petits
+ DBENTRY => "DeskJet670", #-entry in printer database for this printer
+
+ RESOLUTION => "NAxNA", #-ghostscript resolution to use
+ PAPERSIZE => "letter", #-Papersize
+ BITSPERPIXEL => "necp2x6", #-ghostscript color option
+ CRLF => 1 , #-Whether or not to do CR/LF xlation
+
+ TYPE => "LOCAL",
+
+ #- LOCAL
+ DEVICE => "/dev/device", #-Print device
+
+ #- REMOTE (lpd) printers only
+ REMOTEHOST => "remotehost", #-Remote host (not used for all entries)
+ REMOTEQUEUE => "remotequeue", #-Queue on the remote machine
+
+
+ #-SMB (LAN Manager) only
+ #- in spooldir/.config
+ #-share='\\hostname\printername'
+ #-hostip=1.2.3.4
+ #-user='user'
+ #-password='passowrd'
+ #-workgroup='AS3'
+ SMBHOST => "hostname", #-Server name (NMB name, can have spaces)
+ SMBHOSTIP => "1.2.3.4", #-Can optional specify and IP address for host
+ SMBSHARE => "printername", #-Name of share on the SMB server
+ SMBUSER => "user", #-User to log in as on SMB server
+ SMBPASSWD => "passowrd", #-Corresponding password
+ SMBWORKGROUP => "AS3", #-SMB workgroup name
+ AF => "/var/spool/lpd/smbspool/acct", #-accounting filter (needed for smbprint)
+
+ #- NCP (NetWare) only
+ #- in spooldir/.config
+ #-server=printerservername
+ #-queue=queuename
+ #-user=user
+ #-password=pass
+ NCPHOST => "printerservername", #-Server name (NCP name)
+ NCPQUEUE => "queuename", #-Queue on server
+ NCPUSER => "user", #-User to log in as on NCP server
+ NCPPASSWD => "pass", #-Corresponding password
+
+ )
+ ;
- TYPE => "LOCAL",
+=cut
- # LOCAL
- DEVICE => "/dev/device", #Print device
-
- # REMOTE (lpd) printers only
- REMOTEHOST => "remotehost", #Remote host (not used for all entries)
- REMOTEQUEUE => "remotequeue", #Queue on the remote machine
-
-
- #SMB (LAN Manager) only
- # in spooldir/.config
- #share='\\hostname\printername'
- #hostip=1.2.3.4
- #user='user'
- #password='passowrd'
- #workgroup='AS3'
- SMBHOST => "hostname", #Server name (NMB name, can have spaces)
- SMBHOSTIP => "1.2.3.4", #Can optional specify and IP address for host
- SMBSHARE => "printername", #Name of share on the SMB server
- SMBUSER => "user", #User to log in as on SMB server
- SMBPASSWD => "passowrd", #Corresponding password
- SMBWORKGROUP => "AS3", #SMB workgroup name
- AF => "/var/spool/lpd/smbspool/acct", #accounting filter (needed for smbprint)
-
- # NCP (NetWare) only
- # in spooldir/.config
- #server=printerservername
- #queue=queuename
- #user=user
- #password=pass
- NCPHOST => "printerservername", #Server name (NCP name)
- NCPQUEUE => "queuename", #Queue on server
- NCPUSER => "user", #User to log in as on NCP server
- NCPPASSWD => "pass", #Corresponding password
-
- )
-;
-
-########################################################################################
-# INTERN CONSTANT
-########################################################################################
+#-#####################################################################################
+
+=head2 Intern constant
+
+=cut
+
+#-#####################################################################################
my $PRINTER_NONE = "NONE";
my $PRINTER_LOCAL = "LOCAL";
my $PRINTER_LPRREM = "REMOTE";
my $PRINTER_SMB = "SMB";
my $PRINTER_NCP = "NCP";
-########################################################################################
-# EXPORTED CONSTANT
-########################################################################################
+#-if we are in an panoramix config
+my $prefix = "";
+#-location of the printer database in an installed system
+my $PRINTER_DB_FILE = "/usr/lib/rhs/rhs-printfilters/printerdb";
+my $PRINTER_FILTER_DIR = "/usr/lib/rhs/rhs-printfilters/";
-%printer_type = ("local" => $PRINTER_LOCAL,
- "Remote lpd" => $PRINTER_LPRREM,
- "SMB/Windows 95/NT" => $PRINTER_SMB,
- "NetWare" => $PRINTER_NCP,
- );
-%printer_type_inv = reverse %printer_type;
-@papersize_type = qw(letter legal ledger a3 a4);
+#-#####################################################################################
+=head2 Exported constant
-########################################################################################
-# GLOBALS
-########################################################################################
+=cut
-#db of all entries in the printerdb file
+#-#####################################################################################
-#if we are in an panoramix config
-my $prefix = "";
+%printer_type = ("local" => $PRINTER_LOCAL,
+ "Remote lpd" => $PRINTER_LPRREM,
+ "SMB/Windows 95/NT" => $PRINTER_SMB,
+ "NetWare" => $PRINTER_NCP,
+ );
+%printer_type_inv = reverse %printer_type;
-# location of the printer database in an installed system
-my $PRINTER_DB_FILE = "/usr/lib/rhs/rhs-printfilters/printerdb";
-my $PRINTER_FILTER_DIR = "/usr/lib/rhs/rhs-printfilters/";
-my $SPOOLDIR = "/var/spool/lpd/";
+%fields = (
+ STANDARD => [qw(QUEUE SPOOLDIR IF )],
+ SPEC => [qw(DBENTRY RESOLUTION PAPERSIZE BITSPERPIXEL CRLF )],
+ LOCAL => [qw(DEVICE)],
+ REMOTE => [qw(REMOTEHOST REMOTEQUEUE)],
+ SMB => [qw(SMBHOST SMBHOSTIP SMBSHARE SMBUSER SMBPASSWD SMBWORKGROUP AF)],
+ NCP => [qw(NCPHOST NCPQUEUE NCPUSER NCPPASSWD)],
+ );
+@papersize_type = qw(letter legal ledger a3 a4);
+$spooldir = "/var/spool/lpd/";
+
+#-#####################################################################################
-########################################################################################
-# FUNCTIONS
-########################################################################################
+=head2 Functions
+
+=cut
+
+#-#####################################################################################
sub set_prefix($) {
$prefix = shift;
}
-#******************************************************************************
-# read function
-#******************************************************************************
+#-*****************************************************************************
+#- read function
+#-*****************************************************************************
#------------------------------------------------------------------------------
-#Read the printer database from dbpath into memory
+#- Read the printer database from dbpath into memory
#------------------------------------------------------------------------------
sub read_printer_db(;$) {
my ($dbpath) = @_;
- #$dbpath = $dbpath ? $dbpath : $DB_PRINTER_FILTER;
+ #-$dbpath = $dbpath ? $dbpath : $DB_PRINTER_FILTER;
$dbpath ||= $PRINTER_DB_FILE;
$dbpath = "${prefix}$dbpath";
-
%thedb and return;
- local *DBPATH; #don't have to do close
+ local *DBPATH; #-don't have to do close
open DBPATH, "<$dbpath" or die "An error has occurred on $dbpath : $!";
while (<DBPATH>) {
@@ -274,12 +325,12 @@ sub read_printer_db(;$) {
}
-#******************************************************************************
-# write functions
-#******************************************************************************
+#-******************************************************************************
+#- write functions
+#-******************************************************************************
#------------------------------------------------------------------------------
-# given the path queue_path, we create all the required spool directory
+#- given the path queue_path, we create all the required spool directory
#------------------------------------------------------------------------------
sub create_spool_dir($) {
my ($queue_path) = @_;
@@ -289,7 +340,7 @@ sub create_spool_dir($) {
mkdir "$complete_path", 0755
or die "An error has occurred - can't create $complete_path : $!";
- #redhat want that "drwxr-xr-x root lp"
+ #-redhat want that "drwxr-xr-x root lp"
my $gid_lp = (getpwnam("lp"))[3];
chown 0, $gid_lp, $complete_path
or die "An error has occurred - can't chgrp $complete_path to lp $!";
@@ -297,10 +348,10 @@ sub create_spool_dir($) {
}
#------------------------------------------------------------------------------
-#given the input spec file 'input', and the target output file 'output'
-#we set the fields specified by fieldname to the values in fieldval
-#nval is the number of fields to set
-#Doesnt currently catch error exec'ing sed yet
+#-given the input spec file 'input', and the target output file 'output'
+#-we set the fields specified by fieldname to the values in fieldval
+#-nval is the number of fields to set
+#-Doesnt currently catch error exec'ing sed yet
#------------------------------------------------------------------------------
sub create_config_file($$%) {
my ($inputfile, $outpufile, %toreplace) = @_;
@@ -308,7 +359,7 @@ sub create_config_file($$%) {
local *OUT;
local *IN;
- #TODO my $oldmask = umask 0755;
+ #-TODO my $oldmask = umask 0755;
open IN , "<$in" or die "Can't open $in $!";
if ($::testing) {
@@ -333,14 +384,13 @@ sub create_config_file($$%) {
#------------------------------------------------------------------------------
-#copy master filter to the spool dir
+#-copy master filter to the spool dir
#------------------------------------------------------------------------------
sub copy_master_filter($) {
my ($queue_path) = @_;
my $complete_path = "${prefix}${queue_path}filter";
my $master_filter = "${prefix}${PRINTER_FILTER_DIR}master-filter";
-
unless ($::testing) {
commands::cp($master_filter, $complete_path) or die "Can't copy $master_filter to $complete_path $!";
}
@@ -349,8 +399,8 @@ sub copy_master_filter($) {
}
#------------------------------------------------------------------------------
-# given a PrintCap Entry, create the spool dir and special
-# rhs-printfilters related config files which are required
+#- given a PrintCap Entry, create the spool dir and special
+#- rhs-printfilters related config files which are required
#------------------------------------------------------------------------------
my $intro_printcap_test="
#
@@ -368,16 +418,16 @@ my $intro_printcap_test="
sub configure_queue($) {
my ($entry) = @_;
- $entry->{SPOOLDIR} ||= "$SPOOLDIR";
- $entry->{IF} ||= "$SPOOLDIR$entry->{QUEUE}/filter";
- $entry->{AF} ||= "$SPOOLDIR$entry->{QUEUE}/acct";
+ $entry->{SPOOLDIR} ||= "$spooldir";
+ $entry->{IF} ||= "$spooldir$entry->{QUEUE}/filter";
+ $entry->{AF} ||= "$spooldir$entry->{QUEUE}/acct";
my $queue_path = "$entry->{SPOOLDIR}";
create_spool_dir($queue_path);
my $get_name_file = sub {
my ($name) = @_;
- ("${PRINTER_FILTER_DIR}$name.in)", "$entry->{SPOOLDIR}$name")
+ ("${PRINTER_FILTER_DIR}$name.in", "$entry->{SPOOLDIR}$name")
};
my ($filein, $file);
my %fieldname = ();
@@ -392,7 +442,7 @@ sub configure_queue($) {
"NO" : "YES";
create_config_file($filein,$file, %fieldname);
- # successfully created general.cfg, now do postscript.cfg
+ #- successfully created general.cfg, now do postscript.cfg
($filein, $file) = &$get_name_file("postscript.cfg");
%fieldname = ();
$fieldname{gsdevice} = $dbentry->{GSDRIVER};
@@ -415,7 +465,7 @@ sub configure_queue($) {
$fieldname{topbotmar} = "18";
create_config_file($filein, $file, %fieldname);
- # finally, make textonly.cfg
+ #- finally, make textonly.cfg
($filein, $file) = &$get_name_file("textonly.cfg");
%fieldname = ();
$fieldname{textonlyoptions} = "";
@@ -426,7 +476,7 @@ sub configure_queue($) {
unless ($::testing) {
if ($entry->{TYPE} eq $PRINTER_SMB) {
- # simple config file required if SMB printer
+ #- simple config file required if SMB printer
my $config_file = "${prefix}${queue_path}.config";
local *CONFFILE;
open CONFFILE, ">$config_file" or die "Can't create $config_file $!";
@@ -436,7 +486,7 @@ sub configure_queue($) {
print CONFFILE "password='$entry->{SMBPASSWD}'\n";
print CONFFILE "workgroup='$entry->{SMBWORKGROUP}'\n";
} elsif ($entry->{TYPE} eq $PRINTER_NCP) {
- # same for NCP printer
+ #- same for NCP printer
my $config_file = "${prefix}${queue_path}.config";
local *CONFFILE;
open CONFFILE, ">$config_file" or die "Can't create $config_file $!";
@@ -449,7 +499,7 @@ sub configure_queue($) {
copy_master_filter($queue_path);
- #now the printcap file
+ #-now the printcap file
local *PRINTCAP;
if ($::testing) {
open PRINTCAP, ">${prefix}etc/printcap" or die "Can't open printcap file $!";
@@ -479,28 +529,23 @@ sub configure_queue($) {
print PRINTCAP "\t:rm=$entry->{REMOTEHOST}:\\\n";
print PRINTCAP "\t:rp=$entry->{REMOTEQUEUE}:\\\n";
} else {
- # (pcentry->Type == (PRINTER_SMB | PRINTER_NCP))
+ #- (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!
+ #- cheating to get the input filter!
print PRINTCAP "\t:if=$entry->{SPOOLDIR}filter:\n";
}
#------------------------------------------------------------------------------
-#interface function
+#- interface function
#------------------------------------------------------------------------------
-sub
-#pixel stuff
-my ($o, $in);
-
-
#------------------------------------------------------------------------------
-#fonction de test
+#- fonction de test
#------------------------------------------------------------------------------
sub test {
$::testing = 1;
@@ -532,7 +577,13 @@ sub test {
#printer::configure_queue(\%printer::ex_printcap_entry, "/");
}
-########################################################################################
-# Wonderful perl :(
-########################################################################################
+#-######################################################################################
+#- Wonderful perl :(
+#-######################################################################################
1; #
+
+=head1 AUTHOR
+
+pad.
+
+=cut