# -*- mode: text; tab-stop-list: (2 4 40 42); indent-tabs-mode: t -*-
# $Id$
# Simple TAP client with modem dialer.

# Typographical conventions.  As far as l2poe is concerned, hyphens
# are equivalent to underscores in symbol names.

# The general structure and format for his is shamelessly nicked from
# Libero, which lives at <http://www.imatix.com/>.

#------------------------------------------------------------------------------
# The <macros> section defines simple macros.  Macros may be defined
# two ways: assigned and unassigned.
#
# Assigned macros simply assign some text to a macro name.  When the
# macro is invoked, it's replaced with the text that was assigned to
# it.  For example:
#
#   MacroName = "Some Text Here"
#
# Unassigned macros are assumed to be runstate variables.  The
# following assigned and unassigned macros are equivalent:
#
#   MacroName = $_[RUNSTATE]->{MacroName}
#   MacroName
#
# Unassigned macros exist as a convenience.

# <macros>

Port
Pager_ID
Message
Device_Name

Sys  = $_[KERNEL]
Arg0 = $_[ARG0]
Arg1 = $_[ARG1]
Arg2 = $_[ARG2]

#------------------------------------------------------------------------------
# The <subs> section defines code that will be used in event handlers.
# Subs which are only used once could be inlined into the state
# machine definition, but that would make the definition beholden to a
# single language.  It should be possible to rip the Perl bits out of
# l2poe and replace them with a schema like Libero does.

# <subs>

# Multi-line subs look like regular Perl subs, but their names can
# contain hyphens.  Hyphens are translated to underscores when it's
# time to generate code.

sub open-port {
  Port =
    POE::Wheel::ReadWrite->new
      ( Handle       => Async->new( Device => Device_Name,
                                    Speed  => 38400,
                                    Size   => 7,
                                    Parity => 'e',
                                    Stop   => 1,
                                    Vmin   => 1,
                                  ),
        InputFilter  => POE::Filter::Line->new( Literal => "\x0D\x0A" ),
        OutputFilter => POE::Filter::Stream->new(),
        Driver       => POE::Driver::SysRW->new( BlockSize => 1 ),
        InputState   => 'input',
      );
}

# It turns out that a lot of subs are single lines.  The single-line
# sub syntax is relatively new.

sub close-port				delete Port;
sub set-close-settle-delay		Sys->delay( port_settled => 1 );
sub send-first-init-string		&put( Port, 'ATZ' . CR );
sub send-second-init-string		&put( Port, 'ATE0M0' . CR );
sub set-init-timeout			Sys->delay( init_timeout => 5 );
sub clear-init-timeout			Sys->delay( 'init_timeout' );
sub set-redial-timeout			Sys->delay( redial_timeout => 4 );
sub clear-redial-timeout		Sys->delay( 'redial_timeout' );

sub send-dial-command {
  &put( Port, 'ATDT ' . substr(Pager_ID, 3, 3) . '-6683' . CR );
}

sub set-dial-timeout			Sys->delay( dial_timeout => 90 );
sub clear-dial-timeout			Sys->delay( 'dial_timeout' );
sub set-id-timeout			Sys->delay( id_timeout => 2 );
sub clear-id-timeout			Sys->delay( 'id_timeout' );
sub set-state-timeout			Sys->delay( state_timeout => 15 );
sub clear-state-timeout			Sys->delay( 'state_timeout' );
sub send-cr				&put( Port, CR );

sub send-esc-pg1-cr {
  Port->set_input_filter( POE::Filter::Line->new( Literal => CR ) );
  &put( Port, ESC . 'PG1' . CR );
}

sub send-packet {
  &put( Port, &make_packet( Pager_ID, Message ) );
}

sub send-eot-cr				&put( Port, EOT . CR );
sub exit				# does nothing

sub trace-input {
  print STDERR "<<< ", &show($_[ARG0]), "\n";
}

sub store-page-info {
  Device_Name = Arg0;
  Pager_ID    = Arg1;
  Message     = Arg2;
}

#------------------------------------------------------------------------------
# Each <states> section defines a state machine.  The <states>
# directive includes the name of the machine being defined, so you can
# define more than one machine in the same file.  This example defines
# a state machine named "tap-machine".
#
# States follow the format:
#
# state-name:
#   event-name   -> optional-default-transition
#     action     -> optional-transition-if-action-is-true
#     action     -> optional-transition-if-action-is-true
#     action     -> optional-transition-if-action-is-true
#     ...
#
# The first outbound transition is followed; subsequent actions are
# ignored.

# <states tap-machine>

start:
  enter					-> open-modem
    &store-page-info

open-modem:
  enter
    &open-port
    &set-close-settle-delay
  port-settled				-> init-1

close-modem:
  (template open-modem)
  enter
    &close-port
    &set-close-settle-delay
  port-settled				-> open-modem

init-1:
  enter
    &send-first-init-string
    &set-init-timeout
  init-timeout				-> close-modem
  input
    &trace-input
    /^OK$/				-> init-2
  leave
    &clear-init-timeout

init-2:
  enter
    &send-second-init-string
    &set-init-timeout
  init-timeout				-> close-modem
  input
    &trace-input
    /^OK$/				-> dial
  leave
    &clear-init-timeout

redial:
  enter
    &set-redial-timeout
  redial-timeout			-> dial

dial:
  enter
    &send-dial-command
    &set-dial-timeout
  input
    &trace-input
    /^CONNECT (\d+)/			-> tap-await-id
    /^NO CARRIER$/			-> redial
  dial-timeout				-> close-modem
  leave
    &clear-dial-timeout

tap-await-id:
  enter
    &set-id-timeout
    &set-state-timeout
  id-timeout
    &send-cr
    &set-id-timeout
  state-timeout				-> close-modem
  input
    &trace-input
    /^ID=$/				-> tap-send-page-type
    /^NO CARRIER$/			-> close-modem
  leave
    &clear-id-timeout
    &clear-state-timeout

tap-send-page-type:
  enter
    &set-state-timeout
    &send-esc-pg1-cr
  state-timeout				-> close-modem
  input
    &trace-input
    /^\e\[p$/				-> tap-send-page-packet
    /^NO CARRIER$/			-> close-modem
  leave
    &clear-state-timeout

tap-send-page-packet:
  enter
    &set-state-timeout
    &send-packet
  state-timeout				-> close-modem
  input
    &trace-input
    /^\006$/				-> tap-wait-disconnect
    /^NO CARRIER$/			-> close-modem
  leave
    &clear-state-timeout

tap-wait-disconnect:
  enter
    &set-state-timeout
    &send-eot-cr
  state-timeout				-> done
  input
    &trace-input
    /^\e\004$/				-> done
    /^NO CARRIER$/			-> done
  leave
    &clear-state-timeout

done:
  (inherits close-modem with exit)
  enter
    &close-port
    &set-close-settle-delay
  port-settled				-> exit

# Make a separate state for exiting to test inheritance with done.
exit:
  enter
    &exit

#------------------------------------------------------------------------------
# The <template> section is like the Force.  It surrounds and
# permeates the state machine(s), and gives them life.  Or something.
#
# The <generate ...> directive is only valid within a template.  It
# generates the Perl code for a previously defined state machine.
# This comment would be near <generate ...> in the template, but then
# it would be mysteriously included in the generated code.

# <template>

#!/usr/bin/perl -w

use strict;
use lib '/home/troc/perl/poe';
use lib '/home/troc/perl/Async';

# Import POE-y things we'll need.  Async is a helper to open serial
# ports.

use POE::Kernel;
use POE::Wheel::ReadWrite;
use POE::Filter::Line;
use POE::Filter::Stream;
use POE::Driver::SysRW;
use POE::NFA;
use Async;

# ASCII constants.

sub STX   () { "\002" }
sub ETX   () { "\003" }
sub EOT   () { "\004" }
sub ENQ   () { "\005" }
sub ACK   () { "\006" }
sub LF    () { "\012" }
sub CR    () { "\015" }
sub NAK   () { "\025" }
sub ESC   () { "\033" }
sub RS    () { "\036" }
sub READY () { ESC . '[p' }
sub DISC  () { ESC . EOT  }

# Generate a showable representation of some data which may not
# necessarily display properly.

sub show {
  my @stuff =
    ( map { ( ($_ lt ' ' or $_ gt '~')
              ? ('<' . unpack('H*', $_) . '>')
              : $_
            )
          }
      split //, shift
    );
  join '', @stuff;
}

# Send some data, but first show it.

sub put {
  my ($port, $stuff) = @_;
  print STDERR ">>> ", &show($stuff), "\n";
  $port->put( $stuff );
}

# Build a TAP packet.  This wraps the pager ID and short message in a
# VISA protocol packet, with a funky sort of checksum.

sub make_packet {
  my ($pager_id, $message) = @_;
  my $packet = STX . $pager_id . CR . $message . CR . ETX;
  my $checksum = substr(unpack('H*', pack('N', unpack('%32C*', $packet))), -3);
  $checksum =~ tr[a-f][:-?];
  $packet .= $checksum . CR;
  return $packet;
}

# Get the pager ID and short message from the command line.

my $pager_id = shift @ARGV;
my $message = "@ARGV";
die "usage: $0 pager-number message"
  unless ( defined $pager_id and length $pager_id
           and defined $message and length $message
         );

# The TAP machine itself, plus some inline code to spawn it.

# <generate tap-machine>

# <spawn-function tap-machine>

# Spawn a TAP machine with a pager ID and a message to send it.  Run
# POE until the message is sent, and then exit.  Takes a device
# name... it's possible to spawn several of these at once, each on a
# different port, to page people in parallel.

&spawn_tap_machine( '/dev/com2', $pager_id, $message );
$poe_kernel->run();

exit 0;