Printing a file in M$ Windows

[slloyd]

For what it is worth, I have written the following subroutines to make it easy to print pretty much any file to any printer on Windows. Also to get a list of available printers, get the default printer, etc... Thanks to node 193470 for the inspiration to do this.
Enjoy :)

########################################################
### subs_win32printer.pl - requires the following modules
#use Win32::GUI();
#use Win32::GUI::AxWindow;
#use Win32::API;
#use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>0 );
########################################################
### References
###        http://www.perlmonks.org/?node_id=193470
###        http://support.microsoft.com/kb/267240
########################################################
##############
sub printText
{
    my $text=shift;
    my $printer=shift || getDefaultPrinter();
    if(-e $text){$text=getFileContents($text);}
    #initialize Win32 API calls
    my $OpenPrinter = new Win32::API('winspool.drv', 'OpenPrinter',['P
+','P','P'], 'N');
    my $StartDocPrinter = new Win32::API('winspool.drv','StartDocPrint
+er', ['N','N','P'], 'N');
    my $StartPagePrinter = new Win32::API('winspool.drv','StartPagePri
+nter', ['N'], 'N');
    my $WritePrinter =     new Win32::API('winspool.drv','WritePrinter
+',  ['N','P','N','P'], 'N');
    my $EndPagePrinter =   new Win32::API('winspool.drv','EndPagePrint
+er',  ['N'], 'N');
    my $EndDocPrinter =    new Win32::API('winspool.drv', 'EndDocPrint
+er', ['N'],  'N');
    my $ClosePrinter =     new Win32::API('winspool.drv', 'ClosePrinte
+r', ['N'],  'N');
    #Setup devicename
    $printer .= "\0";
    my $hprinter = pack('x4');
    # RAW mode
    my $datatype = "RAW\0";
    # devmode not passed in pdefaults
    # user selected paper/orientation/duplex have no effect in RAW mod
+e
    # defaults set at printer will be used
    my $pdefaults = pack('px4L', $datatype, 0x8); # PRINTER_ACCESS_USE
    $OpenPrinter->Call($printer, $hprinter, $pdefaults) || return $^E;
    $hprinter = unpack('L', $hprinter);
    # name of document in print manager display
    # this won't be there very long unless the printer is off or busy 
+with another job
    my $docname = "Win32::API print test\0";
    my $docinfo = pack("px12", $docname);
    $StartDocPrinter->Call($hprinter, 1, $docinfo) || return $^E;
    $StartPagePrinter->Call($hprinter) || return $^E;
    my $written = pack('x4');
    $text .= "\f";
    my $len = length $text;
    $WritePrinter->Call($hprinter, $text, $len, $written) || return $^
+E;
    # one canvas per sheet, next postscript would start new sheet
    $EndPagePrinter->Call($hprinter) || return $^E;
    $EndDocPrinter->Call($hprinter) || return $^E;
    $ClosePrinter->Call($hprinter);
    return 1;
}
##############
sub printHtml{
    my $file=shift || return "No file passed to printHtml";
    my $printer=shift || getDefaultPrinter();
    my $navigate='';
    if($file=~/^http/is){$navigate=$file;}
    else{
        if($file !~/[\\\/]/s && -e "$progpath\\$file"){$navigate="file
+://$progpath\\$file";}
        elsif(-e $file){$navigate="file://$file";}
        }
    if(!length($navigate)){return("No such file: $file");}
    if(length($printer) && !changeDefaultPrinter($printer)){return "Un
+able to change printer to $printer";}
    # Create a window to host the axWindow in
    my $Window = new Win32::GUI::Window(
        -name  => "Window",
          -title => "Win32::GUI::AxWindow test",
          -pos   => [100, 100],
          -size  => [400, 400],
          );
    # Add a WebBrowser AxtiveX
    my $Control = new Win32::GUI::AxWindow (
        -parent   => $Window,
        -name     => "Control",
        -control  => "Shell.Explorer",
        -pos      => [0, 0],
        -size     => [400, 400],
      );
    our $loaded=0;
    # Register some event
    $Control->RegisterEvent("StatusTextChange",
        sub {
            my $self    = shift;
            my $eventid = shift;
            my $event = shift;
            print "Event : [$eventid][$event]\n" if length($event) && 
+$debug;
            if($eventid==102 && $event=~/^done$/is){$loaded=1;}
            } );
    # Call Method Navigate to load the page
    print "printing $navigate\n" if $debug;
    $Control->CallMethod("Navigate", $navigate);
    #loop until the page has loaded
    while(!$loaded){
        Win32::GUI::DoEvents();
        select(undef,undef,undef,.1);
        }
    #Print the URL, page, or image
    my $PRINT = 6;
    my $DONTPROMPTUSER = 2;
    print "Printing $file to $printer\n" if $debug;
    #Setting custom header and footer - does not work yet
    #http://support.microsoft.com/kb/267240
    #my $array = Win32::OLE::Variant->new(VT_ARRAY | VT_BSTR, 2);
    #$array->Put(0, 'Custom Header');
    #$array->Put(1, 'Custom Footer');

    #Call print without prompting user
    my $ok=$Control->CallMethod("ExecWB",$PRINT,$DONTPROMPTUSER);
    print "Done printing [$ok]...\n" if $debug;
    # Event loop
    $Window->Hide();
    $Window->AddTimer('Shutdown', 1500);
    Win32::GUI::Dialog();
    exit(0);
    sub Shutdown_Timer{
        print "shutting down\n" if $debug;
        changeDefaultPrinter('',1);
        return -1;
        }
    }
################
sub changeDefaultPrinter
{
    my $printer=shift;
    my $reset=shift;
    #Get current Default Printer
    my $default = $Registry->{"CUser/Software/Microsoft/Windows NT/Cur
+rentVersion/Windows/Device"};
    if($reset && length($Registry->{"CUser/Software/Microsoft/Windows 
+NT/CurrentVersion/Windows/PreDevice"}))
    {
        #Reset default printer back
        my $previous = $Registry->{"CUser/Software/Microsoft/Windows N
+T/CurrentVersion/Windows/PreDevice"};
        $Registry->{"CUser/Software/Microsoft/Windows NT/CurrentVersio
+n/"}={
            "Windows/"    => {"/Device"=>$previous}
            };
        #remove previous key
        $Registry->{"CUser/Software/Microsoft/Windows NT/CurrentVersio
+n/"}={
            "Windows/"    => {"/PreDevice"=>''}
            };
        return 1;
    }
    if(!length($printer)){return 0;}
    #if the printer is already set, return true
    if($default=~/^\Q$printer\E\,/is){return 1;}
    #Does the printer exist?
    if(!defined $Registry->{"CUser/Software/Microsoft/Windows NT/Curre
+ntVersion/Devices/$printer"}){return 0;}
    #Set PreDevice to current default printer
    $Registry->{"CUser/Software/Microsoft/Windows NT/CurrentVersion/"}
+={
            "Windows/"    => {"/PreDevice"=>$default}
            };
    my $newval=$Registry->{"CUser/Software/Microsoft/Windows NT/Curren
+tVersion/Devices/$printer"};
    $Registry->{"CUser/Software/Microsoft/Windows NT/CurrentVersion/"}
+={
        "Windows/"    => {"/Device"=>"$printer\,$newval"}
        };
    return 1;
}
################
sub getDefaultPrinter
{
my ($printer,$drv,$port)=split(/\,/,$Registry->{"CUser/Software/Micros
+oft/Windows NT/CurrentVersion/Windows/Device"},3);
return $printer;
}
################
sub getPrinters
{
    my $printers=$Registry->{"CUser/Software/Microsoft/Windows NT/Curr
+entVersion/Devices/"};
    my @printers=();
    foreach my $printer (keys(%{$printers}))
    {
        $printer=~s/^\/+//sg;
        push(@printers,$printer);
        #print "Printer: $printer\n";
    }
    if(wantarray){return @printers};
    return join(',',@printers);
}
return 1;

[ww]

Moved the last "}" at 176; placed it below the "return 1;"
because, oddly,

F:\_wo\pl_test>perl -c prettyprinter.pl
prettyprinter.pl syntax OK

but

F:\_wo\pl_test>perl prettyprinter.pl
Can't return outside a subroutine at prettyprinter.pl line 180.

WTF?

Also, think you need to UNcomment the "use" statements at the top... and maybe use warnings and strict?

...and having done all those, I've run out of time to psych out this:

Useless use of a constant in void context at prettyprinter.pl line 6, <DATA> line 164.

Still, I'm impressed. ++