Prncapt Pl
# Replacement Printcapture program for Mobil CardXpress machines
# Configuration file location:
#
my $cfgfile = "C:\\PRNCAP\\PRNCAPT.INI";
# Configuration variables that matter:
# Port = x // Com port Number
# Printer = xxxx // Printer Name
# IP = 1.2.3.4 // IP Address of Printer (Preferred)
# Name = xxx xx xxx // Site Name
# TaxLine = 'TOTAL INCLUDES GST' // Defaults to that if not supplied
# TCNTerm = ...
# TCN = ... // displays $TCNTERM : $TCN under $TAXLINE
use Win32::Printer;
use Win32::SerialPort qw( :STAT 0.19 );
use IO::Socket;
use Win32::GUI();
use Win32::Console;
# Maximum lines in the Textbox
my $maxlines = 200;
# Used if checking ticks in T_Timer
my $count = 0;
# Previous Printjob
my $prevprint="No Previous Print job";
# Startup text in Window.
my @screen=('Print Capture Monitor v1.0', '2008-05-09 - xrobau@gmail.com');
### Win32 Startup
# Create Window
my $w = Win32::GUI::Window->new(-name => 'W', -width => 210, -height => 325, -text => 'Receipt Monitor');
# Add the textbox
my $t = $w->AddTextfield( -name => 'T', -multiline => 1, -vscroll => 1, -autovscroll => 1, -readonly => 1, -pos => [10,10], -size => [180,260] );
# Status bar down the bottom...
my $sb = $w->AddStatusBar();
$sb->Text("Waiting for data.");
# 'Test Print' button
$tp = $w->AddButton( -name => 'TP', -text => 'Test Print', -pos => [10, 255], -onClick => \&doTestPrint);
# 'Reprint' button
$rp = $w->AddButton( -name => 'RP', -text => 'Reprint Invoice', -pos => [80, 255], -onClick => \&doRePrint);
# This setups a trigger to check for serial input. Basically, it runs the
# sub P_Timer every 500msec (twice a second)
my $t1 = $w->AddTimer('P', 500);
# The tooltip icon specified..
my $gicon = new Win32::GUI::Icon('green.ico');
my $ni = $w->AddNotifyIcon( -name => "ST", -icon => $gicon, -tip => "Print Capture Running");
my $input = "";
my $line = "";
# Show the window, yay.
$w->Show();
# Load Config file
open (CFG, $cfgfile) || die "Can't open config file $cfgfile: $^E\n";
@cfg = <CFG>;
close CFG;
my $sitename = "SITE NAME NOT SET";
my $siteaddr1 = "SITE ADDR NOT SET";
my $siteaddr2 = "SITE ADDR NOT SET";
my $siteaddr3 = "SITE ADDR NOT SET";
my $tcn = "TCN NOT SET";
my $tcnterm = "TCNTERM NOT SET";
my $taxline = "TOTAL INCLUDES GST";
my $prnname = undef;
my $comport = undef;
my $prnip = undef;
&Out("Loading Config file");
foreach (@cfg) {
s/
//g;
chomp;
if (/^Port.?=(.+)/i) { $comport = $1; $comport =~ s/^\s+//g; }
if (/^Printer.?=(.+)/i) { $prnname = $1; $prnname =~ s/^\s+//g; }
if (/^IP.?=(.+)/i) { $prnip = $1; $prnip =~ s/^\s+//g; }
if (/^Name.?=(.+)/i) { $sitename = $1; $sitename =~ s/^\s+//g; }
if (/^Addr1.?=(.+)/i) { $siteaddr1 = $1; $siteaddr1 =~ s/^\s+//g; }
if (/^Addr2.?=(.+)/i) { $siteaddr2 = $1; $siteaddr2 =~ s/^\s+//g; }
if (/^Addr3.?=(.+)/i) { $siteaddr3 = $1; $siteaddr3 =~ s/^\s+//g; }
if (/^TCN.?=(.+)/i) { $tcn = $1; $tcn =~ s/^\s+//g; }
if (/^TCNTerm.?=(.+)/i) { $tcnterm = $1; $tcnterm =~ s/^\s+//g; }
if (/^TaxLine.?=(.+)/i) { $taxline = $1; $taxline =~ s/^\s+//g; }
}
chomp($comport, $prnname, $prnip, $sitename, $tcn, $tcnterm, $taxline);
my $header = "$sitename\n$siteaddr1\n$siteaddr2\n$siteaddr3\n\n${tcnterm}: $tcn\n\n$taxline\n";
&Out("Configuration:");
&Out("Site Name: $sitename");
&Out("COM Port: $comport");
if ($prnname) {
&Out("Printer: $prnname");
} else {
&Out("Printer: -Undefined-");
}
if ($prnip) {
&Out("Printer IP: $prnip");
} else {
&Out("Printer IP: -Undefined-");
}
&Out("Note: PREFERRING IP") if ($prnname && $prnip);
&Out("TCN: $tcn");
&Out("TCN Term: $tcnterm");
&Out("Tax Line: $taxline");
# Set up Serial Port
my $port = new Win32::SerialPort("COM$comport") ||
die "Can't open port COM$comport: $^E\n";
$port->baudrate(9600) || die "Baudrate $^E\n";
$port->parity("none") || die "Parity $^E\n";
$port->databits(8) || die "Data Bits $^E\n";
$port->stopbits(1) || die "Stopbits $^E\n";
$port->handshake('none') || die "Handshake $^E\n";
$port->write_settings || die "Unable to write port settings $^E\n";
# Get rid of the PERL window now, that we're ready to go.
Win32::Console::Free();
# This is an endless loop. This only exits when the 'X' button is clicked on
# the window.
Win32::GUI::Dialog();
exit;
sub P_Timer { # This gets run every 500msec.
# Uncomment the next line to have a ping appear on every serial port
# poll.
# &Out("Timer Ping ($count)"); $count++;
$line = $port->input;
if ($line ne "") {
#print "Received $line\n";
$input .= $line;
}
if (length($line) > 3) {
$sb->Text("Receiving Printjob");
} else {
$sb->Text("Waiting for data.");
}
if ($line =~ /i!8/) {
&processInput();
}
}
sub processInput() {
# OK, so we have $input with a pile of crap in it. Split it into lines.
my @lines = split ( /
/, $input);
$sb->Text("Processing Receipt...");
$sb->Update;
# First thing is to see if the first line has an <esc>!1 in it..
# If so, delete it.
if ($lines[0] =~ /!1/) { shift @lines; }
# Now loop through the lines, cleaning up and looking for the end of
# the page (which is <esc>i<esc>!8)
my $printjob = $header;
foreach (@lines) {
$temp = $_;
if ($temp !~ /i!8/) {
# Don't spool the line if it's got an escape in it
if ($temp !~ //) {
$printjob .= "$temp";
}
} else { # <esc>i<esc>!8 is the magic marker for End of page.
# However, there may be more pages, so reset printjob
# and let the loop continue
&doPrint($printjob);
$printjob = $header;
}
}
if ($printjob != $header) {
# ..WTF, we've received stuff without an end-of-page marker.
# Print it out anyway. Probably debugging stuff.
&Out ("Failsafe print!");
&doPrint($printjob);
}
$input="";
}
sub doPrint($) {
my ($printjob) = @_;
$prevprint = $printjob;
&Out ("Received Printjob:");
my @lines = split(/\n/, $printjob);
my $lastlineblank = "true";
my $fixed = "";
foreach (@lines) {
$tmp = $_;
chomp($tmp);
$tmp =~ s/
//g;
$tmp =~ s/^\s//;
$tmp =~ s/\s+$//g;
$tmp =~ s/\*-//;
$tmp =~ s/-\*//;
next if ($tmp =~ /^Card/);
$tmp =~ s/======================/====================/;
if (($tmp eq "") && ($lastlineblank eq "false")) {
&Out ($tmp);
$fixed .= $tmp."\n";
$lastlineblank = "true";
} elsif ($tmp ne "") {
&Out ($tmp);
$fixed .= $tmp."\n";
$lastlineblank = "false";
}
}
# If we're printing to an IP Address...
if (defined($prnip) && ($prnip ne "")) {
&doPrintIP($fixed);
return;
}
# If we're printing to a Windows printer...
if (defined($prnname) && ($prnname ne "")) {
&doPrintName($fixed);
return;
}
# Some tard hasn't set the printer variables properly.
&Out ("Unable to print Printjob. No printers set up. Here it is:\n$printjob");
return;
}
sub doPrintIP($) {
my ($printjob) = @_;
$sb->Text("Printing Receipt (Direct)");
$sb->Update;
my $prn = IO::Socket::INET->new (Proto => 'tcp',
PeerAddr => $prnip,
PeerPort => 9100) || &Out ("Warning! Can't connect to printer: $^E");
if (open (HEADER, "<logo.prn")) {
binmode (HEADER);
my @head = <HEADER>;
print $prn "@";
print $prn @head;
print $prn "@! \n";
} else {
&Out("WARNING: Can't open logo.prn");
print $prn "\nMOBIL\n";
print $prn "@! \n";
}
my @lines = split(/\n/, $printjob);
foreach (@lines) {
$tmp = $_;
# next if ($tmp eq "");
print $prn "$tmp\n";
}
# Reset. Blank lines. Double Width. Cut.
print $prn "@\n\n\n\n! \nV1";
close $prn;
}
sub doPrintName($) {
my ($printjob) = @_;
$sb->Text("Printing Receipt (Spooler)");
$sb->Update;
my $dc = new Win32::Printer(
description => 'CardXpress Receipt',
unit => 'mm',
printer => $prnname
);
my $mobfon = $dc->Font('Mobil-Pi', 74);
my $stdfon = $dc->Font('Courier New Bold', 15);
my $smalfon = $dc->Font('Courier New Bold', 12);
$dc->Font($mobfon);
$dc->Write("zx", 4, 0);
$dc->Font($stdfon);
my @lines = split(/\n/, $printjob);
my $ypos = 30;
my $ystep = 5;
foreach (@lines) {
$tmp = $_;
# next if ($tmp eq "");
if (length($tmp) > 22) {
$dc->Font($smalfon);
$dc->Write($_, 4, $ypos);
$dc->Font($stdfon);
} else {
$dc->Write($_, 4, $ypos);
}
$ypos = $ypos + $ystep;
}
$dc->Close();
}
sub doTestPrint() {
&doPrint("
$header
TESTPRINTTESTPRINTTES
012345678901234567890
---------------------
^ 20 Characters ^
v 20 Characters v
---------------------
TEST
TEST
TEST
TEST
TEST
PRINT
PRINT
PRINT
PRINT
PRINT
---------------------
This line should be small
or should wrap around on
direct IP printing, with
the new Epson printers..".'
LONG LINE LONG LINE LONG
SHORT LINE SHORT LINE
ABN: 46 054 320 991
*-LOCAL CARD RECEIPT-*
9MAY08 11:54:35 00
Card 7046000028600003
Pump 01
159.9c/L x 101.00L
Diesel $161.50
ODOMETER 210147
TRANS CONFIRMED
ON POWER FAILURE
RECEIPT IS CORRECT
RECORD OF TRANSACTION
');
}
sub doRePrint() {
&doPrint($prevprint);
}
# Various stuff to keep Windows happy here.
sub W_Resize {
# Keep the textbox the same size relative to the window
$t->Resize($w->ScaleWidth - 20, $w->Height - 85);
# Keep the status bar in the right position..
$sb->Move( 0, ($w->ScaleHeight() - $sb->Height()) );
$sb->Resize( $w->ScaleWidth(), $sb->Height() );
# Buttons..
$tp->Move( 10, ($w->ScaleHeight() - 44));
$rp->Move( 80, ($w->ScaleHeight() - 44));
}
sub W_Terminate {
$ni->DESTROY();
-1; }
sub W_Minimize { # This doesn't work for some reason. It should hide the
# taskbar option.
$w->Disable();
$w->Hide();
return 1;
}
sub ST_Click {
$w->Enable();
$w->Show();
return 1;
}
sub Out($) {
my $line = shift;
my $contents = "";
if ($#screen > $maxlines) {
shift @screen
};
push @screen, $line;
foreach (@screen) {
$contents .= "$_\r\n";
}
$t->SelectAll;
$t->ReplaceSel($contents);
}
page_revision: 0, last_edited: 1220135451|%e %b %Y, %H:%M %Z (%O ago)





