#! perl -w
# ---------------------------------------------------------------------------------------------
# Mac::Serial.pm, by Joseph A. DiVerdi
# Copyright (c) 1999-2000 by La Famiglia DiVerdi. All rights reserved.
# This library is free software.
# It can be redistributed and/or modified under the same terms as Perl itself.
#
# Revision History:
# created  1 Nov 1999 JAD
# ---------------------------------------------------------------------------------------------
# Package definitions
	package Mac::Serial;
# ---------------------------------------------------------------------------------------------
# Includes and other external modules
	require 5.001;
	use strict;
	MacPerl::LoadExternals("::Mac::Serial.pm");
# ---------------------------------------------------------------------------------------------
# initialization executable

	# define the version information
	$Mac::Serial::VERSION ='1.006';
	$Mac::Serial::revision = '$Id: Mac::Serial.pm, v1.006 2000/03/19 00:00:00 jadv Exp $';

	# the names of all of the configuration parameters
	my @param_names = qw(	state buffer 
							baudrate parity stopbits datasize 
							XOnIn XOnOut DTR CTS XOnChar XOffChar
							frameErr breakErr parityErr overrunErr);
	
	# create the XCMD data structures
	_initialize_globals();
# ---------------------------------------------------------------------------------------------
sub END {
	# destroy the XCMD data structures
	#_destroy_globals();
}
# ---------------------------------------------------------------------------------------------
# create a new object
sub new {
	my $class = shift || 'Serial';

	# create the object here and bless it into the class
	my $port = {};
	bless $port, $class;
	
	# clear the error field
	$port->{'error'} = '';

	# initialize the main pointer to a port
	$port->{'portIndex'} = 0;

	# check for the # of arguments and open the port as necessary
	# if there are no args then no port name was supplied so just stuff a null portIndex in return
	# if there is only one then it must be in the form 'some port name', call _open
	# if there are more than one then they must be in the form 'name => some_port_name', etc.
	#    process the arg and call _open with it 
	my ($port_name, $return);
	if (@_ == 0) {
		$return = 0;
	} elsif (@_ == 1) {
		$port_name = shift;
		$return = _open($port_name);
	} elsif (@_ > 1) {
		my %args = @_;
		$port_name = $args{'name'} if exists $args{'name'} and defined $args{'name'};
		$return = _open($port_name);
	}
	
	# check for an error response, put the return value in the appropriate field
	if ($return =~ /^Can't/i) {
		$port->{'error'} = $return;
	} else {
		$port->{'portIndex'} = $return;
	}
	
	# return a reference to the new object in either case
	return $port;
}
# ---------------------------------------------------------------------------------------------
sub version {
	
	# no supplied argument, no checking, just return the following string
	return $Mac::Serial::VERSION;
}
# ---------------------------------------------------------------------------------------------
# get last error which occurred using the supplied object
sub error {
	my $port = shift;
	
	# check for a valid portIndex, if found return the error field, if not return empty
	return $port ? $port->{'error'} : '';
}
# ---------------------------------------------------------------------------------------------
sub ports {
	my $port = shift;
	
	# clear the error field
	$port->{'error'} = '';
	
	# the return value from _get_port_names is either a comma-delimited list of names 
	#   or an error message
	my $return = _get_port_names();

	if ($return =~ /^Can't/i) {
		$port->{'error'} = $return;
		return '';
	} else {
		# split the list and return it as an array
		return (split /,/, $return);	#/
	}
}
# ---------------------------------------------------------------------------------------------
sub params {
	
	# no supplied argument, no checking, just return the following array of definitions
	return @param_names;
}
# ---------------------------------------------------------------------------------------------
sub open {
	my $port = shift;
	my $port_name = shift || '';
	
	# clear the error field
	$port->{'error'} = '';

	# report an error if no port name was specified
	# the return value from _open is either a scalar number or an error message
	my $return = $port_name ? _open($port_name) : 
									"Can't open port - a port name must be specified.";
	
	# check for an error response, if found return without changing portIndex
	if ($return =~ /^Can't/i) {
		$port->{'error'} = $return;
		return;
	}
	
	# no error was found, the return string contains a valid portIndex
	$port->{'portIndex'} = $return;
	
	# return an empty string
	return '';
}
# ---------------------------------------------------------------------------------------------
sub close {
	my $port = shift;
	
	# clear the error field
	$port->{'error'} = '';

	# no arguments, just do it
	my $return = _close($port->{'portIndex'});

	# check for an error response
	$port->{'error'} = $return if ($return =~ /^Can't/i);
	
	# return an empty string
	return '';
}
# ---------------------------------------------------------------------------------------------
sub purge {
	my $port = shift;
	
	# clear the error field
	$port->{'error'} = '';

	# no arguments, just do it
	my $return = _purge($port->{'portIndex'});
	
	# check for an error response
	$port->{'error'} = $return if ($return =~ /^Can't/i);
	
	# return an empty string
	return '';
}
# ---------------------------------------------------------------------------------------------
sub break {
	my $port = shift;
	
	# clear the error field
	$port->{'error'} = '';

	# set up default values for the arguments
	my $state = 'clear';
	my $duration = 0;
	
	# check for the # of arguments
	# if there is only one then it must be in the form 'set' or 'clear' and refer to the state
	# if there are more than one then they must be in the form 'state => clear', etc.
	if (@_ == 1) {
		$state = shift;
	} elsif (@_ > 1) {
		my %args = @_;
		$state    = $args{'state'}    if exists $args{'state'}    and defined $args{'state'};
		$duration = $args{'duration'} if exists $args{'duration'} and defined $args{'duration'};
	}
	
	# send the arguments to the port
	my $return = _break($port->{'portIndex'}, $state, $duration);

	# check for an error response
	$port->{'error'} = $return if ($return =~ /^Can't/i);
	
	# return an empty string
	return '';
}
# ---------------------------------------------------------------------------------------------
sub config {
	my $port = shift;
	
	# routing selector depending on # of arguments, any and all argument checking occurs in 
	#    the particular routines
	if (@_ == 0) {
		# return param_names and param_values for all parameters to a hash
		return (_get_all_config_params($port));
	} elsif (@_ == 1) {
		# return just one param_value for the param_name supplied
		return _get_one_config_param($port, @_);
	} else {
		# accept a hash containing one or more pairs of param_names and param_values to be set 
		#   and return an empty string
		return _set_config_params($port, @_);
	}
}
# ---------------------------------------------------------------------------------------------
sub _get_all_config_params {
	my $port = shift;
	
	# clear the error field
	$port->{'error'} = '';

	# get the parameter values as a string or a failure response
	my $return = _get_config($port->{'portIndex'});
	
	# move a failure response over to the object and return an empty hash
	if ($return =~ /^Can't/i) {
		$port->{'error'} = $return;
		return '';
	}
	
	# split the parameter values into an array
	my @param_values = split /,/, $return; #/
	
	# combine the parameter names and values into one array
	# single quote any value which has embedded spaces
	my @return_array;
	foreach my $param_name (@param_names) {
		my $param_value = shift @param_values;
		my $quote = $param_value =~ / / ? "'" : "";
		push @return_array, $param_name, "$quote$param_value$quote";
	}
	
	return @return_array;
}
# ---------------------------------------------------------------------------------------------
sub _get_one_config_param {
	my $port = shift;
	my $param_name = shift;
	
	# clear the error field
	$port->{'error'} = '';

	# check to see if the supplied parameter is in the valid array
	my $point = -1;
	for (my $p = 0; $p < scalar @param_names; $p++) { 
		$point = $p if $param_names[$p] eq $param_name; 
	}
	
	# return an error message and an empty string
	unless ($point >= 0) {
		$port->{'error'} = "Can't get configuration - invalid parameter name.";
		return '';
	}

	# get all of the parameter values, return is a failure response or comma-delimited string
	my $return = _get_config($port->{'portIndex'});
	
	# move a failure response over to the object and return an empty string
	if ($return =~ /^Can't/i) {
		$port->{'error'} = $return;
		return '';
	}
	
	# split the parameter values into an array
	my @param_values = split /,/, $return; #/
	
	# point to the parameter value corresponding to the parameter name
	return $param_values[$point];
}
# ---------------------------------------------------------------------------------------------
sub _set_config_params {
	my $port = shift;

	# clear the error field
	$port->{'error'} = '';

	# accept a hash consisting of parameter name-value pairs to be set
	# convert the input array into a hash
	my %args = @_;
	
	# pass through the hash using the standard parameter names
	foreach my $key (@param_names) {
		# make sure the value of every valid parameter is defined empty
		$args{$key} = '' unless exists $args{$key} and defined $args{$key};
	}
	
	# call the _set_config routine to make the changes
	# send a '' to indicate 'no change' for a particular argument
	# portIndex must be specified and the order of the arguments is significant
	# 'portIndex' and 'buffer' are numeric arguments
	# 'XOnChar' and 'XOffChar' are single character arguments
	# 'baudrate', 'parity', 'stopbits', and 'datasize' are string arguments
	# 'frameErr', 'breakErr', 'parityErr', and 'overrunErr' are "boolean" string arguments
	my $return = _set_config($port->{'portIndex'}, $args{'buffer'}, 
				$args{'baudrate'}, $args{'parity'}, $args{'stopbits'}, $args{'datasize'}, 
				$args{'XOnIn'}, $args{'XOnOut'}, $args{'CTS'}, $args{'DTR'}, 
				$args{'XOnChar'}, $args{'XOffChar'}, 
				$args{'frameErr'}, $args{'breakErr'}, $args{'parityErr'}, $args{'overrunErr'});
	
	# check for an error
	$port->{'error'} = $return if $return =~ /^Can't/i;
	
	# return an empty string
	return '';
}
# ---------------------------------------------------------------------------------------------
sub send {
	my $port = shift;
	
	# clear the error field
	$port->{'error'} = '';

	# set up default value for the argument
	my $string = '';
	
	# check for the # of arguments
	# if there is only one then it must be a single string which will be sent out the port
	# if there are more than one then they must be in the form 'string => 'my message'', etc.
	if (@_ == 1) {
		$string = shift;
	} elsif (@_ > 1) {
		my %args = @_;
		$string = $args{'string'} if exists $args{'string'} and defined $args{'string'};
	}
	
	# the arguments look OK so send them to the port
	my $return = _send($port->{'portIndex'}, $string);

	# check for an error response
	$port->{'error'} = $return if ($return =~ /^Can't/i);
	
	# return an empty string
	return '';
}
# ---------------------------------------------------------------------------------------------
sub receive {
	my $port = shift;
	
	# clear the error field
	$port->{'error'} = '';

	# set up default value for the arguments
	my $term = '';
	my $timeout = 0;
	my $size = 0;
	
	# check for the # of arguments
	# if there is only one then it must be a single string which will be sent out the port
	# if there are more than one then they must be in the form 'string => 'my message'', etc.
	if (@_ == 1) {
		$timeout = shift;
	} elsif (@_ > 1) {
		my %args = @_;
		$term    = $args{'term'}    if exists $args{'term'}    and defined $args{'term'};
		$timeout = $args{'timeout'} if exists $args{'timeout'} and defined $args{'timeout'};
		$size    = $args{'size'}    if exists $args{'size'}    and defined $args{'size'};
	}
	
	# send the arguments over to the port
	my $return = _receive($port->{'portIndex'}, $term, $timeout, $size);

	# check for an error response
	# if found, move the error message and return an empty string
	if ($return =~ /^Can't/i) {
		$port->{'error'} = $return;
		return '';
	}
	
	# return the received string
	return $return;
}
# ---------------------------------------------------------------------------------------------
sub status {
	my $port = shift;
	
	# clear the error field
	$port->{'error'} = '';

	# the only argument is the portIndex so just get the status
	my $return = _get_status($port->{'portIndex'});

	# check for an error response
	# if found, move the error message and return an empty string
	if ($return =~ /^Can't/i) {
		$port->{'error'} = $return;
		return '';
	}
	
	# return the received status
	return $return;
}
# ---------------------------------------------------------------------------------------------
1;	# all good packages return the success code
# ---------------------------------------------------------------------------------------------
__END__

=head1 NAME

Mac::Serial.pm - Serial interface library for I<MacPerl5>

=head1 SYNOPSIS

=over 4

 use Mac::Serial;
 my $modem = new Mac::Serial();
 $modem->open('Modem Port');
 $modem->config(baudrate => 9600, parity => no, data => 8, stop => 1, buffer => 4000, 
        XOnIn => 'on', XOnIn => 'off', 
        XOnChar => chr(17), XOffChar => chr(19));
 $modem->send('Hello world!');
 $modem->close();
 exit;

=head1 ABSTRACT

This I<MacPerl> library uses a simple object-oriented programming style to provide a set of tools to control the serial ports of the Macintosh and communicate through them. This library defines Mac::Serial objects, entities which contain the values for serial port configuration parameters. Using a Mac::Serial object's methods ports can be opened and closed and data can be sent out of those ports or received through them. In addition, various configuration settings are under program control including data transmission protocols (baud rate, data size, etc.), hardware and software flow control methods, and the size of the buffer allocated to the input driver.

=head1 DESCRIPTION

B<Mac::Serial.pm> is a I<Perl5> module to interface I<MacPerl> and the Macintosh serial ports using the Serial Driver.

=head2 PROGRAMMING STYLE

In an object-oriented style, the programmer creates one or more Mac::Serial objects (the maximum number is limited by hardware) and uses object methods to interact with the port(s). Each Mac::Serial object is independent of the others and can be manipulated independently. Ports can be repeatedly opened and closed, several can be open simultaneously, configuration parameters can be changed at any time, and data sends and receives are independent of each other. 

The following example creates a Mac::Serial object and reports which ports are available on the executing machine. It then opens the port named "Modem Port", sets a few configuration parameters including the input buffer size to (an arbitrary) 4,000 bytes, sends a few characters out the serial port, and closes the port. At every step, error checking is performed and the script dies if any error response is received.

=over 4

 #! perl -w
 use Mac::Serial;
 
 my $error;
 my $modem = new Mac::Serial();
 $error = $modem->error;
 die $error if $error;
 
 my @port_names = $modem->ports();
 print "Available port Names: ", join("'", @port_names), "\n";
 
 $modem->('Modem Port');
 $error = $modem->error;
 die $error if $error;
 
 $modem->config(baudrate => 19200, parity => 'even', datasize => 7, 
      stopbits => 1.5, buffer => 4000, XOnOut => "off");
 $error = $modem->error;
 die $error if $error;
 
 $modem->send('Hello world!');
 $error = $modem->error;
 die $error if $error;
 
 $modem->close();
 $error = $modem->error;
 die $error if $error;
 
 exit;

=back


=head1 USAGE


=head2 ARGUMENTS IN MAC::SERIAL.PM METHODS

While some methods use no arguments, most accept one or more and those are designed to use a streamlined format when accepting a single argument. As an example, the following lines are all legitimate ways to diddle with a B<break> signal out of the modem port:

=over 4

 $modem->break();                      # no arguments, use defaults "clear" and "forever"
 $modem->break("set");                 # one argument format, the default parameter name for one 
                                       # argument with this method is the "state" of the output. 
                                       # The port transmit line is aserted to a "space" state and 
                                       # it stays there until changed with another statement.
 $modem->break(state => "set");        # alternate format for one parameter, same effect as above
 $modem->break(duration => 0);         # alternate format for one parameter, the effect of this 
                                       # statement is "clear" and "forever", the transmit line is 
                                       # deasserted to a "mark" state.
 $modem->break(state => "set", duration => 60);	
                                       # multiple arguments format, the port transmit line is asserted 
                                       # to "space" for sixty I<ticks> (sixtieths of a second) or 
                                       # one second then is deasserted to "mark".
  
=back

The details of valid arguments and defaults for each method are documented below. More information on the B<break> signal can be found in documents on serial communication, I<e.g.,> B<Introduction to Serial Communication> in B<Inside Macintosh>.


=head2 CREATING A NEW MAC::SERIAL OBJECT

=over 4

 $port = new Mac::Serial;

=back

This creates an empty, I<i.e.>, not pointing at any port, object named B<$port>. It may be a useful convention to name objects after their intended ports, I<e.g.>, $modem, $printer, I<etc.>


=head2 OPENING A PORT

=over 4

 $port->open('Printer Port');

=back

This associates the B<$port> object with the port named "Printer Port" and opens that port for input and output. I<n.b.> ports cannot be opened for input only or output only, they are always opened for both. The port is configured with some default values, I<i.e.>, 9600 baud, no parity, 1 stop bit, 8 data bits, all flow control off, and a default 64 byte input buffer. If this configuration is adequate then data can be sent and received immediately.


=head2 CREATING A NEW MAC::SERIAL OBJECT I<AND> OPENING A PORT

=over 4

 $modem = new Mac::Serial("Modem Port");

=back

If a valid port name is supplied to the new method, it will create the requested object and open the port in one step.


=head2 CHECKING FOR ERRORS

=over 4

 my $error = $port->error;

=back

After a method is completed on an object, an error is associated with that object. If the method is successful then the error is empty, otherwise it contains a reference to the attempted method and the reported error in the following format:

=over 4

 "Can't open port - an invalid port name was specified."

=back


=head2 CLOSING A PORT

=over 4

 $modem->close();

=back

Simple, isn't it? It is B<EXTREMELY IMPORTANT> that any and all opened serial port(s) be closed before quitting the calling script. Otherwise, buffer space allocated for the serial port may still be used by the serial driver, which may cause obscure and extremely difficult to debug errors to arise in subsequently invoked applications. The use of the B<END> subroutine in the main script can be very helpful in ensuring that open ports are closed as shown in the following example:

=over 4

 #! perl -w
 use Mac::Serial;
  
 my $modem = new Mac::Serial('Modem Port');
 while (1) {
   $modem->send("Hello world!\n");
 }

 exit;
 
 sub END {
   $modem->close() if defined $modem;
 }

=back

In this example, a string is repeatedly sent out the Modem Port until the user halts the script's execution (by hitting "cmd-." or with the pull down menu). At that time the END subroutine is executed and the the port is closed properly. However an END subroutine is actually executed at compile time and the execution of the B<close> method at that time would trow an error. To prevent this from occurring an "if defined..." conditional is included in the code.


=head1 METHODS


=item my $port = new Mac::Serial(["valid port name"])

=over 4

Create a new object. Optionally open the serial port of the specified name and associate it with the newly created object. Once created, a Mac::Serial object can only be destroyed by going out of scope; no explicit B<destroy> method is supplied. It is a B<very bad idea> to let an object with an open port go out of existence. See B<close>.

=back


=item $port->open("valid port name")

=over 4

Open the serial port of the specified name and associate it with the object. Serial ports are always opened for read and write; they cannot be opened for read-only or write-only. No more than one object can be associated with a given port at any time. Once associated with a particular port an object cannot be reassociated with any other port.

=back


=item $version = $port->version()

=over 4

Returns a string containing the library's version number.
 
=back


=item @port_names = $port->ports()

=over 4

Returns an array containing the names of the serial ports in the executing machine. These can be used as arguments for the B<choose> command to allow for interactive selection of the port to use. The object B<$port> must have been created to apply this method but no ports need be open. Legal port names are Macintosh model dependent. 

 Example port names:
 "Modem Port", "Printer Port", "Printer-Modem Port", "PowerPort PC Card"
 
B<n.b.> The above example assumes the use of the Mac OS English version. Mac::Serial.pm will report the port names in the the appropriate language when used with other OS language versions and those port names should be used with the other methods. In non-English OS versions parameter names and all other fields are unchanged from the English version.

=back


=item %config = $port->config()

=item $param_value = $port->config(param_name)

=item $port->config(param_name1 => param_value1, param_name2 => param_value2, ... )

=over 4

This method has several forms but all deal with the configuration of serial ports. One form, with no arguments supplied, returns a hash containing all parameter names and their current values. A second form, with exactly one parameter name supplied as an argument returns a scalar containing the value corresponding to that name. The third form, with any number of parameter name-value pairs sets configures the object's port with those values. Parameter names which I<are not> supplied I<are not> changed. Valid names and values follow:

 Parameter Name      Type        Valid Values        Notes
 --------------    --------   ------------------    ------------------------------------------------------
 buffer            numeric    >= 0, <= 32,767       Input buffer size in bytes, 0 indicates default buffer
 baudrate          numeric    300, 600, 1200,       Actual values are hardware dependent
                              1800, 2400, 3600, 
                              4800, 7200, 9600, 
                              14400, 19200, 28800, 
                              38400, 57600
 parity            string     'none', even', 'odd'
 datasize          numeric    5, 6, 7, 8
 stopbits          numeric    1, 1.5, 2
 XOnIn             string     'on', 'off'            Software flow control on input
 XOnOut            string     'on', 'off'            Software flow control on output
 DTR               string     'on', 'off'            Hardware flow control on input
 CTS               string     'on', 'off'            Hardware flow control on output
 XOffChar          numeric    >= 0, <= 255           Ordinal value of character to halt I/O
 XOnChar           numeric    >= 0, <= 255           Ordinal value of character to resume I/O
 frameErr          string     'on', 'off'            Enable detection of framing errors on input
 parityErr         string     'on', 'off'            Enable detection of parity errors on input
 breakErr          string     'on', 'off'            Enable detection of break errors on input
 overrunErr        string     'on', 'off'            Enable detection of overrun errors on input
 
=back


=item @names = $port->params()

=over 4

Returns an array containing the names of the valid parameters. This elements of this array can be used as keys to a hash for setting a port's configuration.

=back


=item $port->break([args])

=over 4

Control transmission of a I<break> signal. Two arguments are supported: B<state> and B<duration>, with default values of 'clear' and '0', respectively. If the single argument format is used the supplied argument is used to set the value of B<state>.

With a B<duration> of zero, the value of B<state> is used to drive the output port transmit line directly. For non-zero values of B<duration>, the output port transmit line is driven by the value of B<state> for B<duration> ticks (sixtieths of a second) after which it is driven to the opposite state.

The B<break> signal is used by some computers and data switches as an attention signal.

=back


=item $port->send("string to be sent")

=over 4

Send a string of characters out the serial port. This process is performed synchronously, I<i.e.>, control is not returned to the calling script until the transmission is completed. A maximum of 255 characters can be sent in any one string. If a message of greater than 255 characters must be sent then it must be broken up into separate strings and sends.

=back


=item $characters_available = $port->status()

=over 4

Return the number of characters waiting to be read from the input driver serial port. If no characters are available, zero is returned. 

The waiting characters are held in the input buffer which, by default, is set to 64 bytes. In many applications, a larger buffer is needed to prevent over run errors in which the calling application is unable to keep up with the incoming data stream.

=back


=item $port->purge()

=over 4

Empty the input buffer of any characters held in it. All purged characters are irrevocably lost.

=back


=item $string = $port->receive([args])

=over 4

Wait for and receive characters from input driver of the serial port. Three arguments are supported: B<term>, B<size>, and B<timeout>, with default values of '', '0', and '0', respectively. If the single argument format is used the supplied argument is used to set the value of B<timeout>.

B<term> is the ordinal value of a single ASCII termination character. If a termination character is specified then the receive operation is halted when that character is encountered in the input stream. The characters up to but not including the termination character are returned.

B<size> is the number of characters to receive after which the receive operation is halted. If a termination character is specified then the receive operation is halted when that character is encountered in the input stream. The received characters are returned.

B<timeout> is a period of time in ticks (sixtieth of a second) after which the receive operation is halted. The characters received prior to timeout are returned. If size, timeout, and/or a termination character are specified then the receive operation is terminated by which ever event occurs first. If a timeout is not specified then execution will "hang" until the termination character has or the specified number of characters have been received.


=back


=head1 AUTHOR INFORMATION

=over 4

Joseph DiVerdi <diverdi@XTRsystems.com>

Copyright (C) 1999 La Famiglia DiVerdi. All rights reserved. 

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Address bug reports and comments to: diverdi@XTRsystems.com. When sending bug reports, please include the Macintosh model, and the versions of Mac::Serial.pm, MacPerl, and the Mac OS.

=back


=head1 ACKNOWLEDGEMENTS AND CREDITS

Many thanks to: 

=over 4

=item Lincoln D. Stein <lstein@cshl.org> 

=item Martien Verbruggen <mgjv@comdyn.com.au> 

=over 4 

For creating CGI.pm and GIFGraph.pm, respectively, which (through no fault or knowledge of their own) taught me much about writing great libraries.

=back


=item Chris Nandor <pudge@pobox.com>

=item Jean-Pierre Szikora <szikora@icp.ucl.ac.be>

=item Darryl Holder <dholder@hiwaay.net>

=item Derrik Walker <firebug@apk.net>

=over 4 

For comments and suggestions.

=back


=head1 KNOWN BUGS

=item config

=over 4

Although the B<config> method is supports the setting of parity, framing, break, and over run errors on the input driver, no method of reporting or examining those errors has been provided.

=cut