summaryrefslogtreecommitdiffstats
path: root/perl-install/install_steps_gtk.pm
Commit message (Expand)AuthorAgeFilesLines
* no_commentPascal Rigaux2000-09-281-4/+5
* no_commentPascal Rigaux2000-09-271-1/+1
* *** empty log message ***Francois Pons2000-09-271-1/+0
* no_commentPascal Rigaux2000-09-261-0/+1
* no_commentPascal Rigaux2000-09-251-1/+1
* *** empty log message ***Francois Pons2000-09-251-2/+2
* no_commentPascal Rigaux2000-09-241-1/+3
* stcdamien2000-09-221-2/+1
* *** empty log message ***Francois Pons2000-09-221-0/+2
* no_commentPascal Rigaux2000-09-221-0/+1
* no_commentPascal Rigaux2000-09-211-1/+1
* no_commentPascal Rigaux2000-09-191-12/+7
* no_commentPascal Rigaux2000-09-181-1/+1
* no_commentPascal Rigaux2000-09-151-3/+2
* no_commentPascal Rigaux2000-09-151-1/+1
* *** empty log message ***Pascal Rigaux2000-09-141-1/+2
* no_commentPascal Rigaux2000-09-141-1/+1
* no_commentPascal Rigaux2000-09-131-1/+4
* no_commentPascal Rigaux2000-09-131-14/+6
* no_commentPascal Rigaux2000-09-131-8/+12
* no_commentPascal Rigaux2000-09-121-5/+3
* no_commentPascal Rigaux2000-09-121-6/+15
* no_commentPascal Rigaux2000-09-121-359/+14
* no_commentPascal Rigaux2000-09-121-2/+1
* no_commentPascal Rigaux2000-09-111-2/+3
* *** empty log message ***Francois Pons2000-09-111-2/+1
* no_commentPascal Rigaux2000-09-071-2/+2
* no_commentPascal Rigaux2000-09-061-1/+5
* no_commentPascal Rigaux2000-09-061-3/+3
* no_commentPascal Rigaux2000-09-051-5/+5
* no_commentPascal Rigaux2000-09-041-1/+1
* no_commentPascal Rigaux2000-09-021-0/+1
* no_commentPascal Rigaux2000-09-011-2/+2
* no_commentPascal Rigaux2000-09-011-46/+74
* no_commentPascal Rigaux2000-08-301-27/+3
* no_commentPascal Rigaux2000-08-281-2/+4
* *** empty log message ***Francois Pons2000-08-241-1/+6
* no_commentPascal Rigaux2000-08-221-5/+4
* corrected button_leave when not on the buttondamien2000-08-171-6/+7
* no_commentPascal Rigaux2000-08-111-106/+0
* no_commentPascal Rigaux2000-08-061-6/+6
* no_commentPascal Rigaux2000-08-061-1/+1
* no_commentPascal Rigaux2000-08-061-1/+3
* no_commentPascal Rigaux2000-08-051-31/+21
* improved step buttons look & feeldamien2000-08-051-19/+30
* no_commentPascal Rigaux2000-08-051-4/+2
* *** empty log message ***Francois Pons2000-08-011-1/+1
* no_commentPascal Rigaux2000-07-311-1/+7
* new icons. see Changelogdamien2000-07-261-5/+11
* improved logos, title, and steps appearences. see changelog.damien2000-07-251-8/+17
generated by cgit v1.2.1 (git 2.21.0) at 2025-03-07 13:32:01 +0000
$linetype or ($linetype eq "USB" and ($port =~ /usb/i or $vendor)) or ($linetype eq "PARPORT" and !$vendor and $port =~ /(parport|pt_drv|parallel)/i) or ($linetype eq "SCSI" and !$vendor and $port =~ m!(/sg|scsi|/scanner)!i)) { handle_configs::set_directive(\@driverconf, $line, 1); } } output("$sanedir/$a.conf", @driverconf); add2dll($a); } sub add2dll { return if member($_[0], chomp_(cat_("$sanedir/dll.conf"))); my @dllconf = cat_("$sanedir/dll.conf"); handle_configs::add_directive(\@dllconf, $_[0]); output("$sanedir/dll.conf", @dllconf); } sub configured { my @res; # Run "scanimage -L", to find the scanners which are already working local *LIST; open LIST, "LC_ALL=C scanimage -L |"; while (my $line = <LIST>) { if ($line =~ /^\s*device\s*\`([^\`\']+)\'\s+is\s+a\s+(\S.*)$/) { # Extract port and description my $port = $1; my $description = $2; # Remove duplicate scanners appearing through saned and the # "net" backend next if $port =~ /^net:(localhost|127.0.0.1):/; # Store collected data push @res, { port => $port, val => { DESCRIPTION => $description, } }; } } close LIST; return @res; } sub detect { my @configured = @_; my @res; # Run "sane-find-scanner", this also detects USB scanners which only # work with libusb. local *DETECT; open DETECT, "LC_ALL=C sane-find-scanner -q |"; while (my $line = <DETECT>) { my ($vendorid, $productid, $make, $model, $description, $port); if ($line =~ /^\s*found\s+USB\s+scanner/i) { # Found an USB scanner if ($line =~ /vendor=(0x[0-9a-f]+)[^0-9a-f\[]+[^\[]*\[([^\[\]]+)\].*prod(|uct)=(0x[0-9a-f]+)[^0-9a-f\[]+[^\[]*\[([^\[\]]+)\]/) { # Scanner connected via libusb $vendorid = $1; $make = $2; $productid = $4; $model = $5; $description = "$make|$model"; } elsif ($line =~ /vendor=(0x[0-9a-f]+)[^0-9a-f]+.*prod(|uct)=(0x[0-9a-f]+)[^0-9a-f]+/) { # Scanner connected via scanner.o kernel module $vendorid = $1; $productid = $3; } if ($vendorid and $productid) { # We have vendor and product ID, look up the scanner in # the usbtable foreach my $entry (cat_("$scannerDBdir/usbtable")) { if ($entry =~ /^\s*$vendorid\s+$productid\s+.*\"([^\"]+)\"\s*$/) { $description = $1; $description =~ s/Seiko\s+Epson/Epson/i; if ($description =~ /^([^\|]+)\|(.*)$/) { $make = $1; $model = $2; } last; } } } } elsif ($line =~ /^\s*found\s+SCSI/i) { # SCSI scanner if ($line =~ /\"([^\"\s]+)\s+([^\"]+?)\s+([^\"\s]+)\"/) { $make = $1; $model = $2; $description = "$make|$model"; } } else { # Comment line in output of "sane-find-scanner" next; } # The Alcatel Speed Touch internet scanner is not supported by # SANE next if $description =~ /Alcatel.*Speed.*Touch/i; # Extract port $line =~ /\s+(\S+)\s*$/; $port = $1; # Check for duplicate (scanner.o/libusb) if ($port =~ /^libusb/) { my $duplicate = 0; foreach (@res) { if ($_->{val}{vendor} eq $vendorid && $_->{val}{id} eq $productid && $_->{port} =~ /dev.*usb.*scanner/ && !defined($_->{port2})) { # Duplicate entry found, merge the entries $_->{port2} = $port; $_->{val}{MANUFACTURER} ||= $make; $_->{val}{MODEL} ||= $model; $_->{val}{DESCRIPTION} ||= $description; $duplicate = 1; last; } } next if $duplicate; } # Store collected data push @res, { port => $port, val => { CLASS => 'SCANNER', MODEL => $model, MANUFACTURER => $make, DESCRIPTION => $description, id => $productid, vendor => $vendorid, } }; } close DETECT; if (@configured) { # Remove scanners which are already working foreach my $d (@res) { my $searchport1 = handle_configs::searchstr($d->{port}); my $searchport2 = handle_configs::searchstr($d->{port2}); foreach my $c (@configured) { if ($c->{port} =~ /$searchport1$/ || ($searchport2 && $c->{port} =~ /$searchport2$/)) { $d->{configured} = 1; last; } } } @res = grep { ! $_->{configured} } @res; } return @res; } sub get_usb_ids_for_port { my ($port) = @_; local *DETECT; if ($port =~ /^\s*libusb:(\d+):(\d+)\s*$/) { # Use "lsusb" to find the USB IDs open DETECT, "LC_ALL=C lsusb -s $1:$2 |"; while (my $line = <DETECT>) { if ($line =~ /ID\s+([0-9a-f]+):(0x[0-9a-f]+)($|\s+)/) { # Scanner connected via scanner.o kernel module return ("0x$1", "0x$2"); last; } } } else { # Run "sane-find-scanner" on the port open DETECT, "LC_ALL=C sane-find-scanner -q $port |"; while (my $line = <DETECT>) { if ($line =~ /^\s*found\s+USB\s+scanner/i) { if ($line =~ /vendor=(0x[0-9a-f]+)[^0-9a-f]+.*prod(|uct)=(0x[0-9a-f]+)[^0-9a-f]+/) { # Scanner connected via scanner.o kernel module return ($1, $3); } } } } } sub readScannerDB { my ($file) = @_; my ($card, %cards); my $F = common::openFileMaybeCompressed($file); my ($lineno, $cmd, $val) = 0; my $fs = { LINE => sub { push @{$card->{lines}}, "LINE $val" }, SCSILINE => sub { push @{$card->{lines}}, "SCSILINE $val" }, USBLINE => sub { push @{$card->{lines}}, "USBLINE $val" }, PARPORTLINE => sub { push @{$card->{lines}}, "PARPORTLINE $val" }, NAME => sub { #$cards{$card->{type}} = $card if ($card and !$card->{flags}{unsupported}); $cards{$card->{type}} = $card if $card; $val =~ s/Seiko\s+Epson/Epson/i; $card = { type => $val }; }, SEE => sub { $val =~ s/Seiko\s+Epson/Epson/i; my $c = $cards{$val} or die "Error in database, invalid reference $val at line $lineno"; push @{$card->{lines}}, @{$c->{lines} || []}; add2hash($card->{flags}, $c->{flags}); add2hash($card, $c); }, ASK => sub { $card->{ask} = $val }, SERVER => sub { $card->{server} = $val }, DRIVER => sub { $card->{driver} = $val }, UNSUPPORTED => sub { $card->{flags}{unsupported} = 1 }, COMMENT => sub {}, }; local $_; while (<$F>) { $lineno++; s/\s+$//; /^#/ and next; /^$/ and next; /^END/ and do { $cards{$card->{type}} = $card if $card; last }; ($cmd, $val) = /(\S+)\s*(.*)/ or next; #log::l("bad line $lineno ($_)"), next; my $f = $fs->{$cmd}; $f ? $f->() : log::l("unknown line $lineno ($_)"); } \%cards; } sub updateScannerDBfromUsbtable { substInFile { s/END// } "ScannerDB"; my $to_add = "# generated from usbtable by scannerdrake\n"; foreach (cat_("$ENV{SHARE_PATH}/ldetect-lst/usbtable")) { my ($vendor_id, $product_id, $mod, $name) = chomp_(split /\s/,$_,4); next if $mod ne '"scanner"'; $name =~ s/\"(.*)\"$/$1/; if (member($name, keys %$scanner::scannerDB)) { print "#[$name] already in ScannerDB!\n"; next; } $to_add .= "NAME $name\nDRIVER USB\nCOMMENT usb $vendor_id $product_id\nUNSUPPORTED\n\n"; } $to_add .= "END\n"; append_to_file("ScannerDB", $to_add); } sub updateScannerDBfromSane { my ($sanesrcdir) = @_; substInFile { s/END// } "ScannerDB"; my $to_add = "# generated from Sane by scannerdrake\n"; # for compat with our usbtable my $sane2DB = { "Acer" => "Acer Peripherals Inc.", "AGFA" => "AGFA-Gevaert NV", "Agfa" => "AGFA-Gevaert NV", "Epson" => "Epson Corp.", "Fujitsu Computer Products of America" => "Fujitsu", "HP" => sub { $_[0] =~ s/HP\s/Hewlett-Packard|/; $_[0] =~ s/HP4200/Hewlett-Packard|ScanJet 4200C/; $_[0] }, "Hewlett-Packard" => sub { $_[0] =~ s/HP 3200 C/Hewlett-Packard|ScanJet 3200C/ or $_[0] = "Hewlett-Packard|$_[0]"; $_[0] }, "Kodak" => "Kodak Co.", "Mustek" => "Mustek Systems Inc.", "NEC" => "NEC Systems", "Nikon" => "Nikon Corp.", "Plustek" => "Plustek, Inc.", "Primax" => "Primax Electronics", "Siemens" => "Siemens Information and Communication Products", "Trust" => "Trust Technologies", "UMAX" => "Umax", "Vobis/Highscreen" => "Vobis", }; # Read templates for configuration file lines my %configlines; my $backend; foreach my $line (cat_("$scannerDBdir/scannerconfigs")) { chomp $line; if ($line =~ /^\s*SERVER\s+(\S+)\s*$/) { $backend = $1; } elsif ($backend) { push @{$configlines{$backend}}, $line; } } foreach my $f (glob_("$sanesrcdir/doc/descriptions/*.desc"), glob_("$sanesrcdir/doc/descriptions-external/*.desc")) { my $F = common::openFileMaybeCompressed($f); $to_add .= "\n# from $f"; my ($lineno, $cmd, $val) = 0; my ($name, $intf, $comment, $mfg, $backend); my $fs = { backend => sub { $backend = $val }, mfg => sub { $mfg = $val; $name = undef },#bug when a new mfg comes. should called $fs->{ $name }(); but ?? model => sub { unless ($name) { $name = $val; return } $name = member($mfg, keys %$sane2DB) ? (ref $sane2DB->{$mfg}) ? $sane2DB->{$mfg}($name) : "$sane2DB->{ $mfg }|$name" : "$mfg|$name"; if (0 && member($name, keys %$scanner::scannerDB)) { print "#[$name] already in ScannerDB!\n"; } else { # SANE bug: "snapscan" calls itself "SnapScan" $backend =~ s/SnapScan/snapscan/g; $to_add .= "\nNAME $name\nSERVER $backend\nDRIVER $intf\n"; # Go through the configuration lines of # this backend and add what is needed for the # interfaces of this scanner foreach my $line (@{$configlines{$backend}}) { $line =~ /^\s*(\S*?)LINE/; my $i = $1; if (!$i or $intf =~ /$i/i) { $to_add .= "$line\n"; } } if ($backend =~ /(unsupported|mustek_pp|gphoto2)/i) { $to_add .= "UNSUPPORTED\n"; } $to_add .= "COMMENT $comment\n" if $comment; $comment = undef; } $name = $val; }, interface => sub { $intf = $val }, comment => sub { $comment = $val }, }; local $_; while (<$F>) { $lineno++; s/\s+$//; /^\;/ and next; ($cmd, $val) = /:(\S+)\s*\"([^\;]*)\"/ or next; #log::l("bad line $lineno ($_)"), next; my $f = $fs->{$cmd}; $f ? $f->() : log::l("unknown line $lineno ($_)"); } $fs->{model}(); # the last one }