Years ago I had to make a call to a Parallel Port using perl
This is the code that I used. This was used to check if a radio station was broadcasting or not.. Hope this helps
use strict;
my $settings;
while (1 > 0 ) {
$settings->{ports}->{status} = &CheckPort($settings);
&SetStatus($settings);
}
sub CheckPort {
my $parport = Device::ParallelPort->new('win32');
$parport->set_control(32);
#Grab values from DATA port
my $data = $parport->get_bit(0);
$data = $data . $parport->get_bit(1);
$data = $data . $parport->get_bit(2);
$data = $data . $parport->get_bit(3);
$data = $data . $parport->get_bit(4);
$data = $data . $parport->get_bit(5);
$data = $data . $parport->get_bit(6);
$data = $data . $parport->get_bit(7);
return unpack("N", pack("B32", substr("0" x 32 . $data, -32)));
}
###########################################################
# Set the status of each port
###########################################################
sub SetStatus {
my $settings = shift(@_);
my $sendMail;
my $station;
my $stationNumber;
my $writeStatus;
my $number = $settings->{ports}->{status};
my $checkFor = $settings->{checkFor};
# the port has 8 data registers. if port 8 is low then we have 011
+11111 as a binary value.
print "--[ If the port is not " . $checkFor . " then we have a prob
+lem\n";
$bin = sprintf("%08b", $number);
print "--[ sprintf result " . $bin . "\n";
@chars = unpack("A1" x length($bin), $bin);
for( $i=0; $i <= $#chars; $i++) {
# convert
$status = sprintf("%d", $chars[$i]);
# $i + 1 is equivelent to the position on the port
$stationNumber = ($i+1);
# may not have a station for all ports
unless (exists($settings->{ports}->{$stationNumber})) {next;}
# station id
$station = $settings->{ports}->{$stationNumber}->{id};
if ($status != $checkFor) {
print "--[ houston we have a problem\n";
$writeStatus = $settings->{statusBad};
$color = $settings->{colorBad};
$sendMail = 1;
}else{
print "--[ all ok \n";
$writeStatus = $settings->{statusGood};
$color = $settings->{colorGood};
$sendMail = 0;
}
$settings->{ports}->{$stationNumber}->{status} = $writeStatus;
$settings->{ports}->{$stationNumber}->{sendMail} = $sendMail;
$settings->{ports}->{$stationNumber}->{color} = $color;
print "--[ " . $station . " on port " . $stationNumber . " is
+" . $writeStatus . "\n";
}
return;
}