move whatPrinter(), whatUsbport() and whatPrinterPort() out of detect_devices to printer::detect

(it cleans up detect_devices, and won't hurt eyes anymore :)

this change, together with .perl_checker skipping printer::* marks the style disagreement
    between printer/* and the rest of install

1 files changed, 105 insertions, 2 deletions

diff --git a/perl-install/printer/detect.pm b/perl-install/printer/detect.pm
index 4645d94de..5c3a4fe1e 100644
--- a/perl-install/printer/detect.pm
+++ b/perl-install/printer/detect.pm
@@ -2,7 +2,6 @@ package printer::detect;
 
 use strict;
 use common;
-use detect_devices;
 use modules;
 
 sub local_detect {
@@ -10,7 +9,7 @@ sub local_detect {
     eval { modules::unload(qw(lp parport_pc parport_probe parport)) }; #- on kernel 2.4 parport has to be unloaded to probe again
     eval { modules::load(qw(parport_pc lp parport_probe)) }; #- take care as not available on 2.4 kernel (silent error).
     my $_b = before_leaving { eval { modules::unload("parport_probe") } };
-    detect_devices::whatPrinter();
+    whatPrinter();
 }
 
 sub net_detect { whatNetPrinter(1, 0) }
@@ -21,6 +20,110 @@ sub detect {
     local_detect(), whatNetPrinter(1, 1);
 }
 
+
+#-CLASS:PRINTER;
+#-MODEL:HP LaserJet 1100;
+#-MANUFACTURER:Hewlett-Packard;
+#-DESCRIPTION:HP LaserJet 1100 Printer;
+#-COMMAND SET:MLC,PCL,PJL;
+sub whatPrinter {
+    my @res = (whatParport(), whatUsbport());
+    grep { $_->{val}{CLASS} eq "PRINTER" } @res;
+}
+
+sub whatPrinterPort() {
+    grep { tryWrite($_) } qw(/dev/lp0 /dev/lp1 /dev/lp2 /dev/usb/lp0 /dev/usb/lp1 /dev/usb/lp2 /dev/usb/lp3 /dev/usb/lp4 /dev/usb/lp5 /dev/usb/lp6 /dev/usb/lp7 /dev/usb/lp8 /dev/usb/lp9);
+}
+
+sub whatUsbport() {
+    # The printer manufacturer and model names obtained with the usb_probe()
+    # function were very messy, once there was a lot of noise around the
+    # manufacturers name ("Inc.", "SA", "International", ...) and second,
+    # all Epson inkjets answered with the name "Epson Stylus Color 760" which
+    # lead many newbies to install their Epson Stylus Photo XXX as an Epson
+    # Stylus Color 760 ...
+    #
+    # This routine based on an ioctl request gives very clean and correct
+    # manufacturer and model names, so that they are easily matched to the
+    # printer entries in the Foomatic database
+    my @res;
+    foreach my $i (0..15) {
+	my $port = "/dev/usb/lp$i";
+	my $realport = devices::make($port);
+	next if !$realport;
+	next if ! -r $realport;
+	open(my $PORT, $realport) or next;
+	my $idstr = "";
+	# Calculation of IOCTL function 0x84005001 (to get device ID
+	# string):
+	# len = 1024
+	# IOCNR_GET_DEVICE_ID = 1
+	# LPIOC_GET_DEVICE_ID(len) =
+	#     _IOC(_IOC_READ, 'P', IOCNR_GET_DEVICE_ID, len)
+	# _IOC(), _IOC_READ as defined in /usr/include/asm/ioctl.h
+	# Use "eval" so that program does not stop when IOCTL fails
+	eval { 
+	    my $output = "\0" x 1024; 
+	    ioctl($PORT, 0x84005001, $output);
+	    $idstr = $output;
+        } or do {
+	    close $PORT;
+	    next;
+	};
+	close $PORT;
+	# Remove non-printable characters
+	$idstr =~ tr/[\x00-\x1f]/\./;
+	# Extract the printer data from the ID string
+	my ($manufacturer, $model, $serialnumber, $description, 
+	    $commandset, $sku) =
+	    ("", "", "", "", "");
+	if ($idstr =~ /MFG:([^;]+);/ || $idstr =~ /MANUFACTURER:([^;]+);/) {
+	    $manufacturer = $1;
+	    $manufacturer =~ s/Hewlett[-\s_]Packard/HP/;
+	    $manufacturer =~ s/HEWLETT[-\s_]PACKARD/HP/;
+	}
+	# For HP's multi-function devices the real model name is in the "SKU"
+	# field. So use this field with priority for $model when it exists.
+	if ($idstr =~ /MDL:([^;]+);/ || $idstr =~ /MODEL:([^;]+);/) {
+	    $model ||= $1;
+	}
+	if ($idstr =~ /SKU:([^;]+);/) {
+	    $sku = $1;
+	}
+	if ($idstr =~ /DES:([^;]+);/ || $idstr =~ /DESCRIPTION:([^;]+);/) {
+	    $description = $1;
+	    $description =~ s/Hewlett[-\s_]Packard/HP/;
+	    $description =~ s/HEWLETT[-\s_]PACKARD/HP/;
+	}
+	if ($idstr =~ /SE*R*N:([^;]+);/) {
+	    $serialnumber = $1;
+	}
+	if ($idstr =~ /CMD:([^;]+);/ || 
+	    $idstr =~ /COMMAND\s*SET:([^;]+);/) {
+	    $commandset ||= $1;
+	}
+	# Was there a manufacturer and a model in the string?
+	if ($manufacturer eq "" || $model eq "") {
+	    next;
+	}
+	# No description field? Make one out of manufacturer and model.
+	if ($description eq "") {
+	    $description = "$manufacturer $model";
+	}
+	# Store this auto-detection result in the data structure
+	push @res, { port => $port, val => 
+		     { CLASS => 'PRINTER',
+		       MODEL => $model,
+		       MANUFACTURER => $manufacturer,
+		       DESCRIPTION => $description,
+		       SERIALNUMBER => $serialnumber,
+		       'COMMAND SET' => $commandset,
+		       SKU => $sku
+		   } };
+    }
+    @res;
+}
+
 sub whatNetPrinter {
     my ($network, $smb) = @_;