File Coverage

lib/Device/ParallelPort/drv.pm

Criterion	Covered	Total	%
statement	36	72	50.0
branch	11	26	42.3
condition	1	3	33.3
subroutine	7	21	33.3
pod	5	19	26.3
total	60	141	42.5

package Device::ParallelPort::drv;
use Carp;

=head1 NAME

Device::ParallelPort::drv - Standard pacakge to be imported by all drivers

=head1 SYNOPSIS

(Not Applicable) - do not use this directly, use another driver

	* Device::ParallelPort::drv::auto
	* Device::ParallelPort::drv::linux
	* Device::ParallelPort::drv::parport
	* Device::ParallelPort::drv::win32

=head1 DESCRIPTION

This driver is the base class recommended for all Parallel Port Drivers.
It is not useful in itself. Although against proper OO
design, this particular module does not work by itself.

=head1 METHODS

=head2 new

=head2 get_bit

=head2 get_byte

=head2 set_bit

=head2 set_byte

=head1 NOTES

=head2 Device Names

A special system of device names has been deviced.
Basically we are trying to be compatible with most systems, and not force
people to learn something new.

You can enter parallel port device in a number of ways

	- N	Unix style, where 0 is the first port
	- lptN	Windows style, where 1 is the first port
	- 0xNNN	Direct hardware location

This is totally dependent on the driver being used.
For example the script driver would not use these but the auto driver does.

Now these are not necessarily supported in all operating systems. By default
this base driver converts lpt notation into lp notation, it then optionally
converts all lp notation into a hardware location. However what would not work
for parport control, which is generally done as parport device, mapping the
same number as the lp above (check that?), in that case passing the direct
hardware location is pointless.

=head1 COPYRIGHT

Copyright (c) 2002,2004 Scott Penrose. All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Scott Penrose L, L

=head1 SEE ALSO

L

=cut

# Some constants that are useful
sub BASE_0 { 0x378; }		# Intel x86 Base Port
sub OFFSET_DATA { 0; }
sub OFFSET_STATUS { 1; }
sub OFFSET_CONTROL { 2; }

sub new {
	my ($class, $str, @params) = @_;
	my $this = bless {}, ref($class) || $class;
	$this->init($str, @params) if ($this->can('init'));
	return $this;
}

# ------------------------------------------------------------------------------
# BIT -> BYTE and BYTE -> BIT Autoamtic Support
# ------------------------------------------------------------------------------
# This seciton basically provides
sub get_bit {
	my ($this, $bit) = @_;
	unless ($this->INFO->{type} eq "byte") { croak "Unsupported in this driver"; }
	# Find the byte
	my $byte = int($bit / 8);
	$bit = $bit - ($byte * 8);
	return _bit_from_byte($this->get_byte($byte), $bit);
}

sub _bit_from_byte {
	my ($byte, $bit) = @_;
	return ((ord($byte) & (1 << $bit)) == (1 << $bit)) ? 1 : 0;
}

sub get_byte {
	my ($this, $byte) = @_;
	unless ($this->INFO->{type} eq "bit") { croak "Unsupported in this driver"; }
	my $ret = 0;
	my $first_bit = ($byte * 8);
	for (my $bit = $first_bit; $bit < ($first_bit + 8); $bit++) {
		if ($this->get_bit($bit)) {
			$ret = $ret + (1 << ($bit - ($byte * 8)));
		}
	}
	return chr($ret);
}

sub get_byte_uninvert {
	my ($this, $byte) = @_;
	return $this->uninvert($byte, $this->get_byte($byte));
}

sub set_byte_uninvert {
	my ($this, $byte, $val) = @_;
	return $this->set_byte($byte, $this->uninvert($byte, $val));
}

sub set_bit {
	my ($this, $bit, $val) = @_;
	unless ($this->INFO->{type} eq "byte") { croak "Unsupported in this driver"; }
	my $byte = int($bit / 8);
	$bit = $bit - ($byte * 8);
	my $current = $this->get_byte($byte);
	if (defined($current)) {
		$current = ord($current);
	} else {
		$current = 0;
	}
	if ($val) {
		$current = $current | (1 << $bit);
	} else {
		$current = $current & (~ (1 << $bit));
	}
	$this->set_byte($byte, chr($current));
}

sub set_byte {
	my ($this, $byte, $val) = @_;
	unless ($this->INFO->{type} eq "bit") { croak "Unsupported in this driver"; }
	for(my $i = 0; $i < 8; $i++) {
		$this->set_bit(
			$i + ($byte * 8),
			_bit_from_byte($val, $i),
		);
	}
}

# Shortcuts for those who want data, control and status for standard parallel
# ports seprarately.

sub get_data {
	my ($this) = @_;
	return $this->get_byte($this->OFFSET_DATA);
}

sub get_control {
	my ($this) = @_;
	return $this->get_byte($this->OFFSET_CONTROL);
}

sub get_status {
	my ($this) = @_;
	return $this->get_byte($this->OFFSET_STATUS);
}

sub set_data {
	my ($this, $val) = @_;
	return $this->set_byte($this->OFFSET_DATA, $val);
}

sub set_control {
	my ($this, $val) = @_;
	return $this->set_byte($this->OFFSET_CONTROL, $val);
}

sub set_status {
	my ($this, $val) = @_;
	return $this->set_byte($this->OFFSET_STATUS, $val);
}

# HELPER METHODS

# TODO - Real byte converter - CHAR from Number
# Convert an integer to a real byte - just in case someone has passed in a
# number instead of a byte.
#sub real_byte {
#	my ($this, $val) = @_;
#	return $val;
#}

# TODO - Invert / Uninverter - Just swaps bits
# Convert all inverted bits back to normal
#sub uninvert {
#	my ($this, $byte, $val, $bits) = @_;
#	if ($byte == 0) {	# BYTE
#		$bits ||= [];
#	} elsif ($byte == 1) {	# STATUS
#		$bits ||= [qw/7/];
#	} elsif ($byte == 2) {	# STATUS
#		$bits ||= [qw/0 1 3/];
#	}
#	my $ret = $val;
#	foreach my $bit (@$bits) {
#		# XXX XOR Bit here
#	}
#}

# ADDRESS METHODS

sub address_to_num {
	my ($this, $address) = @_;
	if (($address * 1) == $address) {
		return $address;
	} elsif ($address =~/^lpt(\d)$/) {
		return $1 - 1;
	} else {
		croak "Unable to convert $address to something meaninful to Device::ParallelPort - try 0..9 or lpt1..lpt9";
	}
}

sub num_to_hardware {
	my ($this, $num) = @_;
	if ($num == 0) {
		return 0x378;
	} elsif ($num == 1) {
		return 0x278;
	} else {
		croak "No known lookup for hardware address $num to Device::ParallelPort - Try 0..1";
	}
}

1;