upscope wrote:
> I have written the following little test program for the printer module.
> When I replace MSWIN32 with LPT1. It prints to the printer on that post. My
> main printer on on the usb bus. I've tryed DOT4 which is what shows up in
> the my computer device mgr. and to DOT4_001 which shows up in control panel
> printer. Neither work. Does anyone know if Printer will work with USB.
>
> #!c:\perl\bin\perl
> print "Content-type:text/html\n\n";
>
> use Win32;
> use printer;
>
> $printer = new Printer('osname' => 'printer port');
> $prn = new Printer('MSWin32'=>'DOT4_001');
> %available_printers = $prn->list_printers;
>
>
> $data = members.txt;
> $prn->use_default;
> $prn->print($data);
> exit;
This module appears to be real buggy. I've found at least 3 or 4 errors
in it so far. It's better to print a doc using an app that has a print
function (eg: word, wordpad, etc). My printer is postscript, so I had
to create a PS file to test.
use strict;
use Win32;
use Printer;
my $prn = new Printer;
$prn->use_default; # using default printer PS on LPT1:
# I added logic for type => file
$prn->print_command('MSWin32' => {'type' => 'file'} );
my $data = "spoolfile.prn\n"; # created a Postscript file with notepad
$prn->print($data);
exit;
__END__
First I got rid of the warnings in Printer.pm:
*** Printer.pm Fri Dec 13 00:31:14 2002
--- E:/perl/site/lib/Printer.pm Mon Sep 15 17:30:10 2003
***************
*** 38,43 ****
--- 38,44 ----
# frob the system value to use linux routines below for the
# various unices
# see perldoc perlport for system names
+ BEGIN { # $Bill 09/15/03
if (grep { /^$OSNAME$/ } qw(aix bsdos dgux dynixptx
freebsd hpux irix rhapsody
machten next openbsd dec_osf
***************
*** 58,71 ****
$self->{'program'} = \%progs;
# load the unix printer module
! BEGIN {
require Printer::Unix;
}
! }
# load system specific modules for win32
! BEGIN {
if ($OSNAME eq "MSWin32") {
# win32 specific modules
require Win32::Registry; # to list printers
--- 59,72 ----
$self->{'program'} = \%progs;
# load the unix printer module
! # BEGIN { # $Bill 09/15/03
require Printer::Unix;
}
! # }
# load system specific modules for win32
! # BEGIN { # $Bill 09/15/03
if ($OSNAME eq "MSWin32") {
# win32 specific modules
require Win32::Registry; # to list printers
Fixed some bugs (bad or's on REs etc) and added logic for 'file' type using
'print' command and added pipe logic (untested) - still needs work:
*** Win32.pm Fri Dec 13 00:31:26 2002
--- E:/perl/site/lib/Printer/Win32.pm Mon Sep 15 16:44:56 2003
***************
*** 32,38 ****
# default name is the human readable printer name (not port)
# look in the registry to find it
! if ($self->{winver} eq ('Win95' or 'Win98' or 'WinNT4')) {
# the old routines, win95/nt4 tested
my $register = 'Config\0001\SYSTEM\CurrentControlSet\Control\Print\Printers';
my $HKLM = $main::HKEY_LOCAL_MACHINE;
--- 32,40 ----
# default name is the human readable printer name (not port)
# look in the registry to find it
! # if ($self->{winver} eq ('Win95' or 'Win98' or 'WinNT4')) { # $Bill 09/15/03
! if ($self->{winver} eq 'Win95' or $self->{winver} eq 'Win98' or
! $self->{winver} eq 'WinNT4') { # $Bill 09/15/03
# the old routines, win95/nt4 tested
my $register = 'Config\0001\SYSTEM\CurrentControlSet\Control\Print\Printers';
my $HKLM = $main::HKEY_LOCAL_MACHINE;
***************
*** 49,55 ****
. $EXTENDED_OS_ERROR;
$hkey->GetValues(\%values);
$self->{'printer'}{$OSNAME} = $values{Port}[2];
! } elsif ($self->{winver} eq ('Win2000' or 'WinXP/.Net')) {
# different registry paths for win2k
my $register = 'Software\Microsoft\Windows NT\CurrentVersion\Windows';
my $HKCU = $main::HKEY_CURRENT_USER;
--- 51,59 ----
. $EXTENDED_OS_ERROR;
$hkey->GetValues(\%values);
$self->{'printer'}{$OSNAME} = $values{Port}[2];
! # } elsif ($self->{winver} eq ('Win2000' or 'WinXP/.Net')) { # $Bill
09/15/03
! } elsif ($self->{winver} eq 'Win2000' or
! $self->{winver} eq 'WinXP/.Net') { # $Bill 09/15/03
# different registry paths for win2k
my $register = 'Software\Microsoft\Windows NT\CurrentVersion\Windows';
my $HKCU = $main::HKEY_CURRENT_USER;
***************
*** 59,70 ****
my $default = $values{Device}[2];
$default =~ s/,.*//;
# find the port for this printer
! my $register = "SOFTWARE\\Microsoft\\Windows
NT\\CurrentVersion\\Print\\Printers\\$default";
my $HKLM = $main::HKEY_LOCAL_MACHINE;
$HKLM->Open($register, $hkey) or
Carp::croak "Can't open registry key $register in use_default():
$EXTENDED_OS_ERROR\n";
$hkey->GetValues(\%values);
- print $values{Port}[2];
$self->{'printer'}{$OSNAME} = $values{Port}[2];
}
--- 63,73 ----
my $default = $values{Device}[2];
$default =~ s/,.*//;
# find the port for this printer
! $register = "SOFTWARE\\Microsoft\\Windows
NT\\CurrentVersion\\Print\\Printers\\$default";
my $HKLM = $main::HKEY_LOCAL_MACHINE;
$HKLM->Open($register, $hkey) or
Carp::croak "Can't open registry key $register in use_default():
$EXTENDED_OS_ERROR\n";
$hkey->GetValues(\%values);
$self->{'printer'}{$OSNAME} = $values{Port}[2];
}
***************
*** 111,121 ****
print "Spool: ", $spoolfile, "\n";
print SPOOL $data;
close SPOOL;
! system($cmd) || die $OS_ERROR;
unlink $spoolfile;
} else {
# pipe accepting command
# can't use this - windows perl doesn't support pipes.
}
}
}
--- 114,134 ----
print "Spool: ", $spoolfile, "\n";
print SPOOL $data;
close SPOOL;
! # system($cmd) or die $OS_ERROR; # $Bill 09/15/03
! system($cmd) and die $OS_ERROR; # $Bill 09/15/03
unlink $spoolfile;
+ # next 3 - $Bill 09/15/03
+ } elsif ($self->{print_command}->{$OSNAME}->{type} eq 'file') {
+ my $cmd = "print /d:$self->{printer}{$OSNAME} $data";
+ system ($cmd) and warn "system $cmd: $!";
} else {
# pipe accepting command
# can't use this - windows perl doesn't support pipes.
+ # next 4 - $Bill 09/15/03
+ my $pipe = $self->{print_command}->{$OSNAME}->{pipe};
+ open PIPE, "|$pipe" or warn "open pipe $pipe: $!";
+ print PIPE $data;
+ close PIPE;
}
}
--
,-/- __ _ _ $Bill Luebkert Mailto:[EMAIL PROTECTED]
(_/ / ) // // DBE Collectibles Mailto:[EMAIL PROTECTED]
/ ) /--< o // // Castle of Medieval Myth & Magic http://www.todbe.com/
-/-' /___/_<_</_</_ http://dbecoll.tripod.com/ (My Perl/Lakers stuff)
_______________________________________________
Perl-Win32-Users mailing list
[EMAIL PROTECTED]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
