package LinuxIsdn;
# A working set
# S00=00 S01=00 S02=043 S03=013 S04=010 S05=008 S06=003 S07=60 S08=02 S09=06
# S10=07 S11=70 S12=069 S13=220 S14=000 S15=000 S16=064 S17=08 S18=01 S19=00
# S20=01 S21=33 S22=131 S23=001
# EAZ/MSN: 703814673

use strict;
use warnings;
use Fcntl;
use Carp;
use Event;
use WeakRef;
use Time::HiRes qw(gettimeofday);

BEGIN {
    require "sys/ioctl.ph";
}

BEGIN {
    require fields::accessor;
    $fields::accessor::print = 1;
}
# $Event::DIED = \&Event::verbose_exception_handler;
$Event::DIED = sub { my $line = join("", @_);
                     $line =~ s/\r/\\r/g;
                     print STDERR "------------$_[1]"; };

use base   qw(Exporter);
use fields qw(user fh dev debug deep_debug reader writer out match collect
              binary ostate answer on_ring call queue recover_count started
              queued qsec qusec speed timer high_buffer low_buffer);
use fields::accessor qw(debug      $
                        on_ring    $
                        queued	   $
                        high_buffer $
                        low_buffer $
                        );

our $early = 0;	# Commands must be queued at the front(true) or end(false)
our $VERSION = "0.1";
our @EXPORT = qw();
our @EXPORT_OK = qw(wait delay $early);

# Possible TTY mirror states

# Output states. Never use these to regulate input
# (except that some states, like audio, are both an input and an output state)
use constant COMMAND    => 0;	# Waiting for a command
use constant OUTPUT     => 1;	# Waiting for output from a pending command
use constant ATA        => 2;	# Waiting for pickup

use constant VRX        => 3;	# Waiting for recording CONNECT
use constant POST_VRX   => 4;	# Waiting for \n after recording CONNECT
use constant RECORDING  => 5;	# application sees audio
use constant RDLE       => 6;	# application sees audio, DLE read
use constant ETX        => 7;	# application saw audio, DLE/ETX read

use constant VTX        => 8;	# Waiting for transmitting CONNECT
use constant POST_VTX   => 9;	# Waiting for \n after transmitting CONNECT
use constant TRANSMITTING=>10;	# application sends audio
use constant TDLE	=> 11;	# application sends audio, DLE read
use constant DC4        => 12;	# application sent audio, DLE/DC4 read

use constant VRTX       => 13;	# Waiting for recording/transmitting CONNECT
use constant POST_VRTX  => 14;	# Waiting for \n after recording/transmitting CONNECT
use constant POST_POST_VRTX  => 15;	# Waiting for \n after recording/transmitting CONNECT
use constant RECORDING_TRANSMITTING=>16; # application receives/sends audio
use constant RTDLE	=> 17;	# application receives/sends audio, DLE read
use constant TETX       => 18;	# application saw/sends audio, DLE/ETX read
use constant RDC4       => 19;	# application receives/sent audio, DLE/DC4 read

use constant PRE_RECOVER=> 20;	# Waiting to push recover command

# Input states. Never use these to regulate output
use constant ACCEPT	=> 0;	# Queing will try to access dev (if not yet)
use constant WAIT	=> 1;	# Queue is (temporarily) denied access to dev
# use constant BINARY	=> 2;		# audio mode, cleanup phase
use constant BINARY_RECORD	=> 3;		# audio mode
use constant BINARY_TRANSMIT	=> 4;		# audio mode
use constant BINARY_RECORD_TRANSMIT => 5;	# audio mode
use constant RECOVER	=> 6;	# Eliminate bullshit buffer after remote hangup

use LinuxIsdn::Call qw(@audio_speed);

sub nop {
}

sub new {
    my ($class, $dev, $debug) = @_;

    $debug ||= 0;
    unless ($dev) {
        for (qw(/dev/ttyI0 /dev/ttyI/0 /dev/ttyI)) {
            if (-w $_ && -r _) {
                $dev = $_;
                goto DEV;
            }
        }
        croak "Could not find a isdn tty device";
    }
  DEV:
    sysopen(my $fh, $dev, O_RDWR | O_NDELAY| O_NOCTTY) ||
        croak "Could not open $dev: $!";
    select((select($fh), $| = 1)[0]);
    print STDERR "Opened $dev\n" if $debug;

    my LinuxIsdn $self = $class->anew();
    $self->{dev} = $dev;
    $self->{fh}  = $fh;
    stty($fh);
    $self->{debug}   = $debug;
    $self->{out}     = [];
    $self->{binary}  = [];
    $self->{match}   = [];
    $self->{collect} = "";
    $self->{high_buffer}= 2.0;
    $self->{low_buffer} = 1.0;
    $self->{on_ring} = sub {
        my $call = shift;
        $call->ignore();
    } ;

    weaken($self->{reader} = Event->io(fd => $fh, poll => "r",
                                       cb => [$self, 'collect']));
    weaken($self->{writer} = Event->io(fd => $fh, poll => "w",
                                       parked => 1,
                                       cb => [$self, 'do_out']));

    $self->{ostate}  = COMMAND;
    $self->{queue}   = ACCEPT;
    $self->{started} = 0;
    # First get these through in one fell swoop so the parser will work at all
    # Load default profile
    # Echo on
    # Enable result codes
    # English response codes
    # Send packet size 4000 bits
    $self->command("ATZE1Q0V1&B4000");
    # Auto answer off
    $self->set_register(0, 0);
    # Accept no calls
    $self->set_register(18, 0);
    # $self->set_register_bits(12, 0x10, 0x00);
    # 0x80: Show display messages from net
    # 0x40: RUNG messages
    # 0x10: Caller number before first RING
    # 0x08: Extended response messages (old method)
    $self->set_register_bits(13, 0xD8, 0xD8);
    # Extended response messages (new method)
    $self->set_register_bits(23, 3, 3);
    # Final initial command
    $self->query("ATI", sub {
        my LinuxIsdn $isdn = shift;
        $isdn->{started} = shift;
    });
    return $self;
}

sub error {
    my LinuxIsdn $self = shift;
    printf STDERR "Fatal Error\n" if $self->{debug};
    $self->DESTROY(1);
    die @_;
}

# Args:
# $self:     LinuxIsdn object
# $command:  AT command
# $fun:      optional function to call when command response has been seen
# $test_fun: optional call $test_fun($self). command is executed if returns
#            true
sub _queue {
    my LinuxIsdn $self = shift;
    my @args = @_;	# Make a private copy of the arguments
    my $n = @{$self->{out}};
    if ($early) {
        unshift(@{$self->{out}}, \@args);
    } else {
        push(@{$self->{out}}, \@args);
    }
    $self->{writer}->again() if
        @{$self->{out}} && $n == 0 && $self->{queue} == ACCEPT;
    return $self;
}

# It's explicitely allowed to queue binary before input is in binary
# mode so input can start flowing from the moment binary input is accepted
# Notice that this method does NOT copy it's arguments !!!
# Since the arguments get sliced and diced, the CALLER must copy them
# This to avoid copying in the typical case of big buffers being transferred
# after reading from a filedescriptor
sub _queue_binary {
    my LinuxIsdn $self = shift;
    if ($early) {
        unshift(@{$self->{binary}}, \@_);
        if ($self->{timer} && $_[1] != TRANSMITTING) {
            $self->{timer}->cancel();
            $self->{timer} = undef;
            $self->{writer}->again();
        }
    } else {
        push(@{$self->{binary}}, \@_);
    }
    $self->{writer}->again() if
        @{$self->{binary}} == 1 &&
            ($self->{queue} == BINARY_RECORD ||
             $self->{queue} == BINARY_TRANSMIT ||
             $self->{queue} == BINARY_RECORD_TRANSMIT);
    return $self;
}

sub command {
    my LinuxIsdn $self = shift;
    $self->_queue(shift, COMMAND, shift) while @_;
    return $self;
}

sub query {
    my LinuxIsdn $self = shift;
    $self->_queue(shift, OUTPUT, shift() || ($self->{debug} ? sub {
        print STDERR "Output of $_[2]:\n", @{$_[1]}
    } : undef)) while @_;
    return $self;
}

sub get_register {
    my LinuxIsdn $self = shift;
    my ($reg, $fun) = @_;
    $fun = sub {
        printf STDERR "Register %d = %d (0x%02x)\n", $reg, $_[1], $_[1];
    } if !$fun && $self->{debug};
    @_ = ($self, "ATS$reg?", $fun ? sub {
        join("", @{$_[1]}) =~ /^\s*(\d+)\s*\z/ or
            die "Returned lines @{$_[1]} are not purely numeric";
        my $val = $1;
        @_ = ($_[0], $val, $reg);
        goto $fun;
    } : undef);
    goto &query;
}

sub set_register {
    @_ = ($_[0], "ATS$_[1]=$_[2]");
    goto &command;
}

sub set_register_bits {
    my ($self, $reg, $and, $or) = @_;

    $or ||= 0;
    $and ||= 0;
    $and = ~$and & 0xff;
    $self->query("ATS$reg?", sub {
        my ($self, $val) = @_;
        join("", @{$val}) =~ /^\s*(\d+)\s*\z/ or
            die "Returned lines $val are not purely numeric";
        # printf STDERR ("New val will be 0x%02x & 0x%02x | 0x%02x\n", $1, $and, $or);
        my $nval = $1 & $and | $or;
        unless ($1 == $nval) {
            local $early = 1;
            $self->command("ATS$reg=$nval");
        }
    });
}

sub telephone {
    @_ = ($_[0], "AT&E$_[1]");
    goto &command;
}

sub audio_mode {
    my ($self, $mode) = @_;
    my $val;
    if (!defined($mode) || $mode) {
        # Enable audio mode.
        $self->get_register(18, sub { $val = $_[1] });
        $self->command("AT+FCLASS=8" => sub {
            local $early = 1;
            $self->set_register(18, $val & ~0x01 | 0x01);
        });
    } else {
        # Disable audio mode.
        $self->get_register(18, sub { $val = $_[1] });
        $self->command("AT+FCLASS=0&B4000" => sub {
            local $early = 1;
            $self->set_register_bits(18, $val & ~0x01);
        });
    }
}

sub ata {
    my LinuxIsdn $self = shift;
    my LinuxIsdn::Call $call = shift;
    $self->get_register(18, sub {
        # there's a race between RUNG and ATA, and if this is still the same
        # call.
        # This fixes it (yes, RUNG and ATA can still pass each other on
        # the line, but in fact then RUNG will be done, and the ATA
        # will cause a NO CARRIER while there is no call record anymore, so
        # it will be ignored
        return unless $call->{controller};
        my ($self, $val) = @_;
        local $early = 1;
        if ($val & 0x04) {	# already has data
            $self->_queue("ATS1?A", ATA);
        } else {
            my $nval = $val | 0x04;	# Add in data
            $self->_queue("ATS18=${nval}S1?A", ATA, sub {
                local $early = 1;
                $self->set_register(18, $val);
            });
        }
    });
}

sub vrx {
    my $self = shift;
    my LinuxIsdn::Call $call = shift;
    my $fun = shift;
    my $speed = $audio_speed[$call->{audio_mode}];
    my $generation = $call->{generation};
    $self->_queue("AT+VSM=$call->{audio_mode}+VSD=$call->{silence_sensitivity},$call->{silence_interval}+VDD=$call->{dtmf_sensitivity},$call->{dtmf_duration}+VRX", VRX, sub {
        my LinuxIsdn $self = $_[0];
        $self->{speed} = $speed;
        goto $fun if $fun;
    }, sub {
        my LinuxIsdn $self = shift;
        my LinuxIsdn::Call $new_call = $self->{call};
        return defined($new_call) &&
            $new_call == $call && $new_call->{connected} &&
                $generation == $new_call->{generation};
    });
}

sub vrtx {
    my $self = shift;
    my LinuxIsdn::Call $call = shift;
    my $fun = shift;
    my $speed = $audio_speed[$call->{audio_mode}];
    my $generation = $call->{generation};
    $self->_queue("AT+VSM=$call->{audio_mode}+VSD=$call->{silence_sensitivity},$call->{silence_interval}+VDD=$call->{dtmf_sensitivity},$call->{dtmf_duration}+VRX+VTX", VRTX, sub {
        my LinuxIsdn $self = $_[0];
        $self->{speed} = $speed;
        goto $fun if $fun;
    }, sub {
        my LinuxIsdn $self = shift;
        my LinuxIsdn::Call $new_call = $self->{call};
        return defined($new_call) &&
            $new_call == $call && $new_call->{connected} &&
                $generation == $new_call->{generation};
    });
}

sub vtx {
    my $self = shift;
    my LinuxIsdn::Call $call = shift;
    my $generation = $call->{generation};
    $self->_queue("AT+VSM=$call->{audio_mode}+VDD=$call->{dtmf_sensitivity},$call->{dtmf_duration}+VTX", VTX, shift, sub {
        my LinuxIsdn $self = shift;
        my LinuxIsdn::Call $new_call = $self->{call};
        return defined($new_call) &&
            $new_call == $call && $new_call->{connected} &&
                $generation == $new_call->{generation};
    });
}

sub _abort_recording {
    my LinuxIsdn $self = shift;
    # DLE DC4
    # Any binary stuff written in the same write after this sequence will
    # disappear into the black hole
    # In fact, ANY character (even a lonely DLE) written in pure receive mode
    # stops recording !
    my $a = "\020\024";	# _queue_binary needs a modifiable copy !
    $self->_queue_binary($a, DC4, shift);
}

sub _abort_transmitting {
    my LinuxIsdn $self = shift;
    # DLE ETX
    my $a = "\020\003";	# _queue_binary needs a modifiable copy !
    $self->_queue_binary($a, ETX, shift);
}

sub transmit_unencoded_audio {
    my LinuxIsdn $isdn = shift;
    # we must make a copy for queue binary anyways
    my $line = shift;
    # Escape DLE
    $line =~ s/\020/\020\020/g;
    $isdn->_queue_binary($line, TRANSMITTING, shift);
}

sub kick_queue {
    my LinuxIsdn $self = shift;
    print STDERR "Kicking queue\n";
    $self->{timer}->cancel();
    $self->{timer} = undef;
    $self->{writer}->again();
}

sub do_out {
    my LinuxIsdn $self = shift;
    my $fh = $self->{fh};
    if ($self->{queue} == BINARY_RECORD ||
        $self->{queue} == BINARY_TRANSMIT ||
        $self->{queue} == BINARY_RECORD_TRANSMIT) {
        #print STDERR "do_out has ", scalar @{$self->{binary}}, " entries\n";
        #if (@{$self->{binary}}) {
        #    print STDERR length($self->{binary}[0][0]), " bytes, $self->{binary}[0][1], ", ($self->{binary}[0][2] ? $self->{binary}[0][2] : "undef"), "\n";
        #}
        if ($self->{binary}[0][1] == TRANSMITTING) {
            if ($self->{queue} != BINARY_TRANSMIT &&
                $self->{queue} != BINARY_RECORD_TRANSMIT) {
                my $rc = shift(@{$self->{binary}});
                print STDERR "Ignored pending transmit entry while not in transmit mode\n" if $self->{debug};
                $rc->[2]->($self, $rc, "ignore") if $rc->[2];
                return;
            }
            if ($self->{qsec}) {
                my ($s, $u) = gettimeofday();
                my $eta = $self->{queued}-($s-$self->{qsec})-($u-$self->{qusec})/1000000;
                if ($eta < 0) {
                    # queue could very well be empty
                    $self->{qsec} = 0 if $self->tty_empty();
                } elsif ($eta > $self->{high_buffer}) {
                    # Queued enough
                    print STDERR "Queue Full: $eta seconds pending\n";
                    $self->error("Already a pending eta timer ???") if
                        $self->{timer};
                    weaken($self->{timer} = Event->timer
                           (after => $eta-$self->{low_buffer},
                            #at => $self->{queued}-1+$self->{qfrom},
                            cb => [$self, 'kick_queue']));
                    $self->{writer}->stop();
                    return;
                }
            }
        }
        print STDERR "Sending ", length($self->{binary}[0][0]), " bytes\n";
        my $rc = syswrite($self->{fh}, $self->{binary}[0][0]);
        unless ($rc) {
            $self->error("Unexpected EOF while writing binary") if
                defined($rc);
            $self->error("Unecpted error while writing binary: $!");
        }
        if ($self->{binary}[0][1] == TRANSMITTING) {
            unless ($self->{qsec}) {
                ($self->{qsec}, $self->{qusec}) = gettimeofday();
                $self->{queued} = 0;
            }
            $self->{queued} += $rc/$self->{speed};
        }
        substr($self->{binary}[0][0], 0, $rc, "");
        return if $self->{binary}[0][0] ne "";
        $rc = shift(@{$self->{binary}});
        $rc->[2]->($self, $rc, "") if $rc->[2];
        if ($rc->[1] == ETX) {
            print STDERR ("Draining transmit queue at ", scalar localtime(),
                          "\n") if $self->{debug};
            # Abort transmit command, drain queue of TRANSMITTING entries
            my $type;
            my $i=0;
            my $queue = $self->{binary};
            my @drained;
            while ($i < @{$queue}) {
                if ($queue->[$i][1] == TRANSMITTING) {
                    push(@drained, splice(@{$queue}, $i, 1));
                } else {
                    $i++;
                }
            }
            if ($self->{queue} == BINARY_TRANSMIT) {
                $self->{queue} = WAIT;
            } elsif ($self->{queue} == BINARY_RECORD_TRANSMIT) {
                $self->{queue} = BINARY_RECORD;
            }
            # Only execute callbacks now since they could queue again
            for $rc (@drained) {
                $rc->[2]->($self, $rc, "abort") if $rc->[2];
            }
        }
        # Queue emptied
        $self->{writer}->stop() unless @{$self->{binary}};
        return;
    }
    unless ($self->{queue} == ACCEPT) {
        if ($self->{queue} == RECOVER) {
            die "Completely unrecovered" if $self->{recover_count} > 255;
            print $fh "ATS1=$self->{recover_count}\015\012";
            $self->{queue}  = WAIT;
            $self->{writer}->stop();
            push(@{$self->{match}},
                 ["ATS1=$self->{recover_count}", OUTPUT, \&nop]);
            return;
        }
        $self->error("do_out should never be called in non accepting state $self->{queue}/$self->{ostate}\n");
    }
    my $line = shift(@{$self->{out}});
    if (!$line->[3] || $line->[3]->($self)) {
        substr($line->[0], 0, 2) eq "AT" or
            $self->error("Command $line->[0] is not an AT command\n");
        # We shouldn't block if we can't get rid of whole command !
        $self->modem_flags("Plain before");
        print $fh $line->[0], "\015\012";
        $self->modem_flags("Plain after");
        # Add some error handling here --Ton
        push(@{$self->{match}}, $line);
        $self->{queue} = WAIT if
            # pause queue if there's a handler function
            # (in case the handler wants to preque a followup)
            $line->[2] ||
                # pause queue since ATA gets confused early input
                $line->[1] == ATA ||
                    # pause queue since audio_modes do not accept input
                    $line->[1] == VRX || $line->[1] == VTX;
    }
    $self->{writer}->stop() if
        @{$self->{out}} == 0 || $self->{queue} != ACCEPT;
    print STDERR "$line->[0] is setting state to $self->{queue}/$self->{ostate}\n" if $self->{debug} & 0x02;
}

sub finish {
    my LinuxIsdn $self = shift;
    my ($command, $omode, $imode) = @_;
    my $rc;
    defined($rc = shift(@{$self->{match}})) or
        $self->error("$command without causing command\n");

    $self->{ostate} = defined($omode) ? $omode : COMMAND;
    # If $imode != undef/ACCEPT/BINARY,
    # it's your responsibility to restart the queue
    my $iold = $self->{queue};
    $self->{queue} = $imode if defined($imode);

    my $error = $command eq "ERROR";
    print STDERR "ERROR\n" if $error && $self->{debug};
    if ($rc->[2]) {
        $rc->[2]->($self, $self->{answer}, $rc->[0], $error);
        # The case where the queue was suspended because there was a
        # handler function. The other cases should take care of themselves
        if ($self->{queue} == WAIT) {
            $self->{queue} = ACCEPT;
            $self->{writer}->again() if @{$self->{out}};
        }
    }

    $self->{answer} = undef;	# Cause errors on incorrect access
    $self->{writer}->again() if
        ($self->{queue} == BINARY_RECORD ||
         $self->{queue} == BINARY_TRANSMIT ||
         $self->{queue} == BINARY_RECORD_TRANSMIT) &&
            $self->{queue} != $iold && @{$self->{binary}};
}

sub command_mode {
    my LinuxIsdn $self = shift;
    $self->{ostate} = COMMAND;
    $self->{queue}  = ACCEPT;
    if ($self->{timer}) {
        $self->{timer}->cancel();
        $self->{timer} = undef;
    }
    $self->{writer}->again() if @{$self->{out}};
}

my %state_dispatch =
    (COMMAND()		=> \&d_line,
     OUTPUT()		=> \&d_line,
     ATA()		=> \&d_line,

     VRX()		=> \&d_line,
     POST_VRX()		=> \&d_line,
     RECORDING()	=> \&d_recording,
     RDLE()		=> \&d_rdle,
     ETX()		=> \&d_etx,

     VTX()		=> \&d_line,
     POST_VTX()		=> \&d_line,
     TRANSMITTING()	=> \&d_transmitting,
     TDLE()		=> \&d_tdle,
     DC4()		=> \&d_dc4,

     VRTX()		=> \&d_line,
     POST_VRTX()	=> \&d_line,
     POST_POST_VRTX()	=> \&d_line,
     RECORDING_TRANSMITTING() => \&d_recording_transmitting,
     RTDLE()		=> \&d_rtdle,
     #TETX()		=> \&d_tetx,
     #RDC4()		=> \&d_rdc4,

     PRE_RECOVER()	=> \&d_line,
     );
my @state_dispatch;
@state_dispatch[keys %state_dispatch] = values %state_dispatch;

sub d_line {
    my LinuxIsdn $self = shift;
    my $length = index($self->{collect}, "\012", shift);
    return 1 if $length < 0;
    $length++;

    my $command = substr($self->{collect}, 0, $length, "");
    $command =~ s/\015*\012\z//;
    # mm, getting enough fun that a sub dispatch table makes sense --Ton
    if ($command =~ /^CALLER NUMBER:\s*(\d+)$/) {
        print STDERR "Incoming phonecall from $1, state is $self->{queue}/$self->{ostate}\n" if $self->{debug};
        my LinuxIsdn::Call $call = $self->{call};
        $call ||
            $self->error("Got CALLER NUMBER without pending call\n");
        $call->{remote_number} = $1;
        local $early = 1;
        $self->get_register(22, sub {
            $call->{octet3a} = $_[1];
            # Call can be gone in the mean time
            $self->{on_ring}->($call) if $call->{controller};
        });
        $self->get_register(21, sub { $call->{octet3} = $_[1] });
        $self->get_register(20, sub { $call->{service} = $_[1] });
    } elsif ($command =~ /^RING(?:\/\s*(\d+))?$/) {
        print STDERR "Incoming phonecall for $1\n" if $self->{debug};
        my LinuxIsdn::Call $call = $self->{call};
        unless ($call) {
            $self->{call} = $call =
              LinuxIsdn::Call->new($self, 0, 0, $self->{debug});
        }
        $call->{local_number} = $1 if defined($1);
        $call->{recorder} = undef;
    } elsif ($command =~ /^NO CARRIER(?:\/([\da-fA-F]+))?$/) {
        print STDERR "$command\n" if $self->{debug};
        my LinuxIsdn::Call $call = $self->{call};
        $call || !$self->{started} ||
            $self->error("Got NO CARRIER without pending call\n");
        $self->recover_hack(0);
        $call->do_hangup($self, defined($1) ? $1 : "") if $call;
    } elsif ($command eq "RUNG") {
        print STDERR "$command\n" if $self->{debug};
        my LinuxIsdn::Call $call = $self->{call};
        $call || $self->error("Got RUNG without pending call\n");
        $call->do_rung($self);
    } elsif ($self->{ostate} == ATA) {
        if ($command eq "VCON") {
            my $rings = join("", @{$self->{answer}});
            $self->finish("OK");
            print STDERR "VCON\n" if $self->{debug};
            my LinuxIsdn::Call $call = $self->{call};
            $call || $self->error("Got VCON without pending call\n");
            $rings =~ /^\s*(\d+)\s*\z/ or
                $self->error("Number of rings $rings does not look like a number\n");
            $call->{rings} = $1;
            $call->do_pickup();
            # local $early =1;
            # $self->get_register(1, sub { $call->{rings} = $_[1] });
        } elsif ($command =~ /^(\d+)$/) {
            push(@{$self->{answer}}, $1);
        } elsif ($command =~ /^NO ANSWER(?:\/([\da-fA-F]+))?$/) {
            $self->finish("OK");
            print STDERR "NO ANSWER: $1\n" if $self->{debug};
            $self->{call} && $self->error("Got NO ANSWER on ATA($self->{match}[0][0]) while call pending (no RUNG seen)\n");
        } elsif ($command eq "") {
        } else {
            goto ERROR;
        }
    } elsif ($self->{ostate} == VRX) {
        # State is WAIT/VRX at this point
        if ($command eq "CONNECT") {
            $self->{ostate} = POST_VRX;
        } elsif ($command =~ /^NO ANSWER(?:\/([\da-fA-F]+))?$/) {
            # Call is gone. The hangup message should already
            # have cleaned up all data structures
            $self->finish("OK");
            print STDERR "NO ANSWER: $1\n" if $self->{debug};
            # Sanity checking
            my LinuxIsdn::Call $call = $self->{call};
            $call && $call->{connected} and $self->error("Got NO ANSWER on AT+VRX($self->{match}[0][0]) on connected call (no RUNG seen)\n");
        } elsif ($command eq "") {
        } else {
            goto ERROR;
        }
    } elsif ($self->{ostate} == POST_VRX) {
        $command eq "" or
            $self->error("Missing empty line after VRX CONNECT");
        print STDERR "audio recording CONNECT\n" if $self->{debug};
        # The vrx callback should now store the recording object
        $self->finish("OK", RECORDING, BINARY_RECORD);
        # Sanity checking
        my LinuxIsdn::Call $call = $self->{call};
        $call && $call->{connected} or $self->error("Got audio recording CONNECT without (connected) call\n");
    } elsif ($self->{ostate} == VTX) {
        # State is WAIT/VTX at this point
        if ($command eq "CONNECT") {
            $self->{ostate} = POST_VTX;
        } elsif ($command =~ /^NO ANSWER(?:\/([\da-fA-F]+))?$/) {
            # Call is gone. The hangup message should already
            # have cleaned up all data structures
            $self->finish("OK");
            print STDERR "NO ANSWER: $1\n" if $self->{debug};
            # Sanity checking
            my LinuxIsdn::Call $call = $self->{call};
            $call && $call->{connected} and $self->error("Got NO ANSWER on AT+VTX($self->{match}[0][0]) on connected call (no RUNG seen)\n");
        } elsif ($command eq "") {
        } else {
            goto ERROR;
        }
    } elsif ($self->{ostate} == POST_VTX) {
        $command eq "" or $self->error("Missing empty line after VTX CONNECT");
        print STDERR "audio transmitting CONNECT\n" if $self->{debug};
        # The vtx callback should now store the recording object
        $self->finish("OK", TRANSMITTING, BINARY_TRANSMIT);
        # Sanity checking
        my LinuxIsdn::Call $call = $self->{call};
        $call && $call->{connected} or $self->error("Got audio transmitting CONNECT without (connected) call\n");
    } elsif ($self->{ostate} == VRTX) {
        # State is WAIT/VRTX at this point
        if ($command eq "CONNECT") {
            $self->{ostate} = POST_VRTX;
        } elsif ($command =~ /^NO ANSWER(?:\/([\da-fA-F]+))?$/) {
            # Call is gone. The hangup message should already
            # have cleaned up all data structures
            $self->finish("OK");
            print STDERR "NO ANSWER: $1\n" if $self->{debug};
            # Sanity checking
            my LinuxIsdn::Call $call = $self->{call};
            $call && $call->{connected} and $self->error("Got NO ANSWER on AT+VRX+VTX($self->{match}[0][0]) on connected call (no RUNG seen)\n");
        } elsif ($command eq "") {
        } else {
            goto ERROR;
        }
    } elsif ($self->{ostate} == POST_VRTX) {
        # State is WAIT/VRTX at this point
        if ($command eq "CONNECT") {
            $self->{ostate} = POST_POST_VRTX;
        } elsif ($command =~ /^NO ANSWER(?:\/([\da-fA-F]+))?$/) {
            # Call is gone. The hangup message should already
            # have cleaned up all data structures
            $self->finish("OK");
            print STDERR "NO ANSWER: $1\n" if $self->{debug};
            # Sanity checking
            my LinuxIsdn::Call $call = $self->{call};
            $call && $call->{connected} and $self->error("Got NO ANSWER on AT+VRX+VTX($self->{match}[0][0]) on connected call (no RUNG but one CONNECT seen)\n");
        } elsif ($command eq "") {
        } else {
            goto ERROR;
        }
    } elsif ($self->{ostate} == POST_POST_VRTX) {
        $command eq "" or
            $self->error("Missing empty line after VRX+VTX CONNECT");
        print STDERR "audio recording/transmitting CONNECT\n" if
            $self->{debug};
        # The vrtx callback should now store the recording object
        $self->finish("OK", RECORDING_TRANSMITTING, BINARY_RECORD_TRANSMIT);
        # Sanity checking
        my LinuxIsdn::Call $call = $self->{call};
        $call && $call->{connected} or $self->error("Got audio recording/transmitting CONNECT without (connected) call\n");
    } elsif ($command eq "OK" || $command eq "ERROR") {
        # print STDERR "$command\n" if $self->{debug};
        $self->finish($command);
    } elsif ($self->{ostate} == OUTPUT) {
        push(@{$self->{answer}}, "$command\n");
    } elsif ($self->{ostate} == PRE_RECOVER) {
        if ($command =~ m/^ATS1=\d+$/) {
            my $match;
            while (1) {
                $match = shift(@{$self->{match}}) or
                    die "Confused during recovery";
                last if $match->[0] eq $command;
            }
            $self->{answer} = [];
            $self->{ostate} = $match->[1];
            unshift(@{$self->{match}}, $match);
            print STDERR "Recovered on '$command' to $self->{queue}/$self->{ostate}\n" if $self->{debug};
        } else {
            print STDERR "Eating bytes\n" if $self->{debug};
            $self->{collect} = "";
            # Queue yet another ATS1=
            $self->recover_hack($self->{recover_count}+1);
        }
    } elsif (@{$self->{match}} && $command eq $self->{match}[0][0]) {
        $self->{answer} = [];
        $self->{ostate} = $self->{match}[0][1];
        print STDERR "Echo '$command'\n" if $self->{debug};
    } elsif ($command ne "") {
      ERROR:
        $self->error("Unknown command response '$command' (caused by ",
                     (@{$self->{match}} ? $self->{match}[0][0] :
                      "umatched input"),
                     " in state $self->{queue}/$self->{ostate})\n");
    }
    return;
}

sub d_recording {
    my LinuxIsdn $self = shift;
    my LinuxIsdn::Call $call = $self->{call};
    $call or $self->error("Recording without call\n");
    my LinuxIsdn::Call::Recorder $record = $call->{recorder};
    $record or $self->error("Recording without record object");
    # \020 is <DLE>, Data Link Escape
    my $length = index($self->{collect}, "\020", shift);
    if ($length < 0) {
        # No more special stuff
        $record->out($self->{collect});
        $self->{collect} = "";
        return 1;
    }
    $record->out(substr($self->{collect}, 0, $length)) if $length;
    $length++;                  # Also eat DLE
    substr($self->{collect}, 0, $length) = "";
    $self->{ostate} = RDLE;
    return;
}

sub d_recording_transmitting {
    my LinuxIsdn $self = shift;
    my LinuxIsdn::Call $call = $self->{call};
    $call or $self->error("Recording/transmitting without call\n");
    my LinuxIsdn::Call::Recorder $record = $call->{recorder};
    $record or $self->error("Recording without record object");
    # \020 is <DLE>, Data Link Escape
    my $length = index($self->{collect}, "\020", shift);
    if ($length < 0) {
        # No more special stuff
        $record->out($self->{collect});
        $self->{collect} = "";
        return 1;
    }
    $record->out(substr($self->{collect}, 0, $length)) if $length;
    $length++;                  # Also eat DLE
    substr($self->{collect}, 0, $length) = "";
    $self->{ostate} = RTDLE;
    return;
}

sub d_rdle {
    # We can only get here with $offset = 0;
    my LinuxIsdn $self = shift;
    my $char = substr($self->{collect}, 0, 1, "");
    $self->{ostate} = RECORDING;
    my LinuxIsdn::Call $call = $self->{call};
    $call or $self->error("Recording without call\n");
    my LinuxIsdn::Call::Recorder $record = $call->{recorder};
    $record or $self->error("Recording without record object");
    if ($char eq "\020") {	# DLE
        $record->out($char);
    } elsif ($char eq "\3") {	# ETX
        $self->{ostate} = ETX;
        $self->{queue}  = WAIT;
        $call->do_end_recording($record);
    } elsif ("0" le $char && $char le "9" ||
             "A" le $char && $char le "D" ||
             $char eq "#" || $char eq "*") {
        $record->dtmf($char);
    } elsif ($char eq "q") {
        $record->quiet();
    } elsif ($char eq "s") {
        $record->silence();
    } elsif ($char eq "c") {
        $record->fax();
    } elsif ($char eq "b") {
        $record->busy();
    } else {
        printf STDERR ("Unknown DLE escape code %02x ignored\n", ord($char));
    }
    return;
}

sub d_rtdle {
    # We can only get here with $offset = 0;
    my LinuxIsdn $self = shift;
    my $char = substr($self->{collect}, 0, 1, "");
    $self->{ostate} = RECORDING_TRANSMITTING;
    my LinuxIsdn::Call $call = $self->{call};
    $call or $self->error("Recording/Transmitting without call\n");

    my LinuxIsdn::Call::Recorder $record = $call->{recorder};
    $record or
        $self->error("Recording/Transmitting without record object");

    my LinuxIsdn::Call::Recorder $transmit = $call->{transmitter};
    $transmit or
        $self->error("Recording/Transmitting without transmit object");

    if ($char eq "\020") {	# DLE
        $record->out($char);
    } elsif ($char eq "\3") {	# ETX
        $self->{ostate} = TRANSMITTING;
        $self->{queue}  = BINARY_TRANSMIT;
        $call->do_end_recording($record);
    } elsif ($char eq "\024") {	# DC4
        $self->{ostate} = RECORDING;
        $self->{queue}  = BINARY_RECORD;
        $call->do_end_transmitting($transmit);
    } elsif ("0" le $char && $char le "9" ||
             "A" le $char && $char le "D" ||
             $char eq "#" || $char eq "*") {
        $record->dtmf($char);
        $transmit->dtmf($char);
    } elsif ($char eq "q") {
        $record->quiet();
    } elsif ($char eq "s") {
        $record->silence();
    } elsif ($char eq "c") {
        $record->fax();
        $transmit->fax();
    } elsif ($char eq "b") {
        $record->busy();
        $transmit->busy();
    } else {
        printf STDERR ("Unknown DLE escape code %02x ignored\n", ord($char));
    }
    return;
}

sub d_etx {
    my LinuxIsdn $self = shift;
    my $length = index($self->{collect}, "\012", shift);
    return 1 if $length < 0;
    $length++;

    my $command = substr($self->{collect}, 0, $length);
    substr($self->{collect}, 0, $length) = "";
    $command =~ s/\015*\012\z//;
    # We should share some of this code with normal case above
    if ($command eq "VCON") {
        print STDERR "$command\n" if $self->{debug};
        my LinuxIsdn::Call $call = $self->{call};
        $call || $self->error("Returning to VCON without pending call\n");
        $self->command_mode();
    } elsif ($command =~ /^NO CARRIER(?:\/([\da-fA-F]+))?$/) {
        print STDERR "$command\n" if $self->{debug};
        my LinuxIsdn::Call $call = $self->{call};
        $call || $self->error("Got NO CARRIER without pending call\n");
        $self->recover_hack(0);
        $call->do_hangup($self, defined($1) ? $1 : "");
    } elsif ($command eq "") {
    } else {
        $self->error("Unknown response '$command' after leaving record mode\n");
    }
    return;
}

sub d_tdle {
    # We can only get here with $offset = 0;
    my LinuxIsdn $self = shift;
    my $char = substr($self->{collect}, 0, 1);
    substr($self->{collect}, 0, 1) = "";
    $self->{ostate} = TRANSMITTING;
    my LinuxIsdn::Call $call = $self->{call};
    $call or $self->error("Transmitting without call\n");
    my LinuxIsdn::Call::Transmitter $transmit = $call->{transmitter};
    $transmit or $self->error("Transmitting without transmit object");
    if ($char eq "\3") {	# ETX
        # Means a DLE DC4 (stop record) was given in a pure transmit
        # Weird, but in fact valid
        print STDERR "Stop record on transmit state\n" if $call->{debug};
    } elsif ($char eq "\024") {	# DC4
        $self->{ostate} = DC4;
        $self->{queue}  = WAIT;
        $call->do_end_transmitting($transmit);
    } elsif ("0" le $char && $char le "9" ||
             "A" le $char && $char le "D" ||
             $char eq "#" || $char eq "*") {
        $transmit->dtmf($char);
    } elsif ($char eq "c") {
        $transmit->fax();
    } elsif ($char eq "b") {
        $transmit->busy();
    } else {
        printf STDERR ("Unknown DLE escape code %02x ignored\n", ord($char));
    }
    return;
}

sub d_transmitting {
    my LinuxIsdn $self = $_[0];
    my $offset = $_[1];
    my LinuxIsdn::Call $call = $self->{call};
    $call or $self->error("Transmitting without call\n");
    my LinuxIsdn::Call::Transmitter $transmit = $call->{transmitter};
    $transmit or $self->error("Transmitting without transmit object");
    # \020 is <DLE>, Data Link Escape
    my $length = index($self->{collect}, "\020", $offset);
    if ($length == 0) {
        substr($self->{collect}, 0, 1, "");
        $self->{ostate} = TDLE;
    } else {
        # mm, possibly preparation for hangup
        $self->{ostate} = DC4;
        $self->{queue}  = WAIT;
        $call->do_end_transmitting($transmit);
        goto &d_dc4;
    }
    return;
}

sub d_dc4 {
    my LinuxIsdn $self = shift;
    my $length = index($self->{collect}, "\012", shift);
    return 1 if $length < 0;
    $length++;

    my $command = substr($self->{collect}, 0, $length);
    substr($self->{collect}, 0, $length) = "";
    $command =~ s/\015*\012\z//;
    # We should share some of this code with normal case above
    if ($command eq "VCON") {
        print STDERR "$command\n" if $self->{debug};
        my LinuxIsdn::Call $call = $self->{call};
        $call ||
            $self->error("Returning to VCON without pending call\n");
        $self->command_mode();
    } elsif ($command =~ /^NO CARRIER(?:\/([\da-fA-F]+))?$/) {
        print STDERR "$command\n" if $self->{debug};
        my LinuxIsdn::Call $call = $self->{call};
        $call || $self->error("Got NO CARRIER without pending call\n");
        $self->recover_hack(0);
        $call->do_hangup($self, defined($1) ? $1 : "");
    } elsif ($command eq "") {
    } else {
        $self->error("Unknown response '$command' after leaving transmit mode\n");
    }
    return;
}

sub collect {
    my LinuxIsdn $self = shift;
    my ($rc, $fun);
    my $offset = length($self->{collect});
    unless ($rc = sysread($self->{fh}, $self->{collect}, 4096, $offset)) {
        print STDERR "Sysread ?\n" if $self->{debug};
        defined($rc) || $self->error("Error reading $self->{dev}: $!\n");
        $self->error("Unexpected EOF reading $self->{dev}");
    }
    do {
        # print STDERR "'", substr($self->{collect}, $offset), "'", unpack("H*", substr($self->{collect}, $offset)), "\n";
        $fun = $state_dispatch[$self->{ostate}] or
            $self->error("Unknown state $self->{queue}/$self->{ostate}\n");
        return if $fun->($self, $offset);
        $offset = 0;
    } until $self->{collect} eq "";
}

# Hangup during audio transmit can cause output of nonsense buffers
sub recover_hack {
    my LinuxIsdn $self = shift;
    $self->{ostate} = PRE_RECOVER;
    $self->{queue}  = RECOVER;
    if ($self->{timer}) {
        $self->{timer}->cancel();
        $self->{timer} = undef;
    }
    $self->{writer}->again();
    $self->{recover_count} = shift;
}

sub stty {
    local (*SAVE);
    open(SAVE, "<&STDIN") || croak "Could not save STDIN: $!";
    eval {
        close(STDIN);
        my $fd = fileno($_[0]);
        open(STDIN, "<&$fd") || croak "Could not dup isdn tty into STDIN: $!";
        my @command = ("stty", "sane");
        CORE::system(@command) and croak "Unexpected return $? from @command";

        # Experiments
        @command = ("stty", "ignpar", "-cstopb", "-parity");
        CORE::system(@command) and croak "Unexpected return $? from @command";
        #system("stty", "ignbrk", "-brkint", "-icrnl", "-ixon", "-imaxbel", "-opost");
        # system("stty", "-iexten", "-echoe", "-echok");
        # system("stty", "time", "5"); #if anything, 0 seems to make more sense

        # Never seen evidence these do anything useful, but they sound right
        @command = ("stty", "hup", "crtscts", "clocal", "-ixon", "pass8");
        CORE::system(@command) and croak "Unexpected return $? from @command";
        # The REALLY important ones
        @command = ("stty", "-onlcr", "-echo", "-icanon", "-isig");
        CORE::system(@command) and croak "Unexpected return $? from @command";
    };
    close(STDIN);
    if (open(STDIN, "<&SAVE")) {
        die $@ if $@;
    } else {
        die "Could not restore STDIN ($!) after $@" if $@;
        croak "Could not restore STDIN: $!"
    }
}

my %modem_flags =
    ("RTS"	=> TIOCM_RTS,
     "DTR"	=> TIOCM_DTR,
     "CAR"	=> TIOCM_CAR,
     "RNG"	=> TIOCM_RNG,
     "DSR"	=> TIOCM_DSR,
     "CTS "	=> TIOCM_CTS);

sub tty_empty {
    my LinuxIsdn $self = shift;
    ioctl($self->{fh}, TIOCSERGETLSR, my $val="") ||
        $self->error("ioctl(TIOCSERGETLSR) failed: $!");
    return unpack("I", $val)+0;
}

sub modem_flags {
    my LinuxIsdn $self = shift;
    ioctl($self->{fh}, TIOCMGET, my $val="") ||
        $self->error("ioctl(TIOCMGET) failed: $!");
    $val = unpack("I", $val)+0;
    #my $result = $val & TIOCM_CTS;
    if (0) {
        my ($name, $flags);
        my $out = "";
        my $work = $val;
        while (($name, $flags) = each %modem_flags) {
            $out .= " ";
            $out .= "~" unless $work & $flags;
            $work &= ~ $flags;
            $out .= $name;
        }
        die "Unprocessed bits in $work\n" if $work;
        printf STDERR "Modemflags are:$out\n";
    }
    return $val;
}

sub cancel {
    my LinuxIsdn $self = shift;
    printf STDERR "Cancel\n" if $self->{debug};
    $self->DESTROY(1);
    return $self;
}

sub delay {
    shift if @_ == 3;
    my ($time, $f) = @_;
    return Event->timer(at => time()+$time, cb => $f);
}

sub DESTROY {
    my LinuxIsdn $self = shift;

    print STDERR ((shift() ? "Faked" : "Real"), " cleanup $self\n") if
        $self->{debug} & 0x08;
    $self->{collect} = "";
    $self->{out} = [];
    $self->{binary} = [];
    $self->{match} = [];

    if ($self->{call}) {
        my LinuxIsdn::Call $call = $self->{call};
        $call->{controller} = undef;
        $self->{call} = undef;
    }
    if ($self->{reader}) {
        $self->{reader}->cancel();
        $self->{reader} = undef;
    }
    if ($self->{writer}) {
        $self->{writer}->cancel();
        $self->{writer} = undef;
    }
    if ($self->{timer}) {
        $self->{timer}->cancel();
        $self->{timer} = undef;
    }
    if ($self->{fh}) {
        close $self->{fh};
        $self->{fh} = undef;
    }
}

sub wait {
    shift if $_[0] && UNIVERSAL::isa($_[0], "LinuxIsdn");
    return Event::loop(@_);
}

sub unwait {
    my $isdn;
    $isdn = shift if $_[0] && UNIVERSAL::isa($_[0], "LinuxIsdn");
    @_ = 0 unless @_;
    &Event::unloop(@_);
    return $isdn;
}

1;

__END__

=head1 DESCRIPTION

Methods for manipulating linux isdn tty devices (call controll)

=head1 SYNOPSIS

 use LinuxIsdn;

 $dev = "/dev/ttyI0";
 $isdn = LinuxIsdn->new($dev, $debug);

 $debug   = $isdn->debug(?$new_debug?);
 $self    = $isdn->command($command => $fun, ...);
 $self    = $isdn->query($command => $fun, ...);
 $self    = $isdn->set_register($reg => $val);
 $self    = $isdn->get_register($reg => $fun);
 $self    = $isdn->set_register_bits($reg, ?$nand, ?$or??);
 $self    = $isdn->telephone($phone);
 $self    = $isdn->audio_mode(?$audio?)
 $self	  = $isdn->ata();
 $self    = $isdn->cancel();
 $old_fun = $isdn->on_ring(?$new_fun?);
 $result  = $isdn->wait(?$timeout?);
 $result  = LinuxIsdn->wait(?$timeout?);
 $result  = LinuxIsdn::wait(?$timeout?);
 $self    = $isdn->unwait($result);
 $class   = LinuxIsdn->unwait($result);
 LinuxIsdn::unwait($result);

=head1 METHODS

=over 4

Notice that all methods that cause a tty command to be executed, do this
by queing the command, which will later be processed in the event loop.
That means that if you e.g. give a L<hangup|LinuxIsdn/"hangup"> command,
your following statement will not be executed with the phone hung up.

=item $isdn = LinuxIsdn->X<new>($dev, $debug)

Opens $dev (defaults to /dev/ttyI0) for r/w, and take over management of
this device, beginning with bringing it to a default state:

    # Load default profile
    # Echo on
    # Enable result codes
    # English response codes
    # Send packet size 4000 bits
    # Auto answer off
    # Accept no calls
    # Show display messages from net
    # RUNG messages
    # Caller number before first RING
    # Extended response messages

After this, the device should only be manipulated through the returned
$isdn object.

A true value for debug will cause the program te be rather verbose.

=item $debug   = $isdn->X<debug>(?$new_debug?)

Returns true if and only if debugging is set for this object. If given,
first sets debugging to true or false depending on the thruth of $new_debug.

=item $self = $isdn->X<command>($command => $fun, ...)

Queues a number of commands (waits until $isdn is in command mode and is
writable). $fun is called just after the corresponding command got executed
(Nothing gets called if $fun is undef, leaving out the last argument is the
same as specifying undef),
as S<$fun-E<gt>($isdn, $answer, $command, $rc)> where $rc is the response code
(typically "OK", but maybe e.g. "ERROR"). $answer will be undef on failure
and [] on success.

This method is meant for commands that just respond with success or failure.
If the command has any output, use L<query|"query">, even if you are not
interested in the output.

Returns $isdn.

Example:

    $isdn->command("ATZ");

=item $self = $isdn->X<query>($command => $fun, ...)

Queues a number of commands (waits until $isdn is in command mode and is
writable). When the command gets executed, all output upto and excluding
the final OK is collected. Then the callback $fun is called as
S<$fun-E<gt>($self, [@lines], $command)>. (nothing is called if $fun is undef,
leaving out the last argument is the same as specifying undef).
Returns $isdn.

Example (the example callback is in fact default callback):

    $self->query("AT+FCLASS=?", sub {
        print STDERR "Output of $_[2]:\n", @{$_[1]}});

Which might output:

    Output of AT+FCLASS=?:
    0,2,8

=item $self = $isdn->X<set_register>($reg => $val)

Convenience function to set register $reg to $val (does some preparation
and then really calls L<command|"command">). Return $isdn.

Example:

    $isdn->set_register(3, "\r");

=item $self = $isdn->X<get_register>($reg => $fun);

Convenience function to query the value of register $reg (does some preparation
and then really calls L<query|"query">). When the value is known, will call
$fun->($isdn, $reg, $val). If no $fun is given, will use a default callback
which prints a message to STDERR if $isdn has L<debugging|"debug"> set, and
hdo nothing otherwise. Return $isdn.

Example (the example callback is in fact default callback):

    $isdn->get_register(11, sub {
        printf STDERR "Register $reg = %d (0x%02x)\n", $_[1], $_[1]});

Which might output:

    Register 11 = 70 (0x46)

=item $self = $isdn->X<set_register_bits>($reg, ?$nand, ?$or??)

Convenience function to set some bits in register $reg (does some preparation
and then really calls L<query|"query"> and later L<command|"command">).
$nand should have a 1 bit for each bit in register $reg that has to get a
fixed value. $or should be 1 for the bits that have to end up
as 1. Basically think of this funtion as doing:

    val($reg) = val($reg) & ~$nand | $or;

$nand and $or default to 0. Returns $isdn.

Example (the example callback is in fact default callback):

    $isdn->set_register_bits(11, 0x41, 0x01);

If register 11 contained 0x46, it will contain 0x07 afterward.

=item $self = $isdn->X<telephone>($phone)

Set MSN (Euro-ISDN, EDSS1) or EAZ (German 1TR6) to $phone. For MSNs, $phone is
a string of digits representing the local phone number, while for EAZs $phone
should be only the last digit of the number.

e.g.:

    $isdn->telephone("123456789");

(Notice, no leading 0, but including area code)

=item $self = $isdn->X<audio_mode>(?$audio?)

Turns on audio_mode if $audio is true, off otherwise. $audio defaults to true.
If audio is turned on, the send packet size is set to 384 bits, if audio is
turned off to 4000 bits.

=item $self = $isdn->X<ata>($call)

Internal function to correctly give a pickup command. B<Never> give a
a raw "AT" command containing a non trivial "ATA" yourself since it will
confuse the system. $call represents the call that's giving this ATA. If
by the time the pickup command is given this call is gone, nothing will be
done.

=item $self = $isdn->X<cancel>()

Releases control over the tty device. Closes all filedescriptors, drops all
eventhandlers (so forgets about any commands that are still queued), and
forgets about any pending call.

=item $old_fun = $isdn->X<on_ring>(?$new_fun?)

Returns the function reference that will be executed when an incoming call
is detected (RING message). If given an argument, will replace the current
function. The function will be called as S<new_fun-E<gt>($call)> where $call is
a freshly created L<LinuxIsdn::Call|LinuxIsdn::Call> object with all known
fields filled in. The default value is basically
L<LinuxIsdn::Call::ignore|LinuxIsdn::Call/"ignore">. This callback should
typically either call L<LinuxIsdn::Call::ignore|LinuxIsdn::Call/"ignore">
(to ignore the call and free up the tty again) or
L<LinuxIsdn::Call::pickup|LinuxIsdn::Call/"pickup"> in an attempt to pick up
the call.

=item $result = $isdn->X<wait>(?$timeout?)

=item $result = LinuxIsdn->wait(?$timeout?)

=item $result = LinuxIsdn::wait(?$timeout?)

A wrapper around L<Event::loop|Event/"loop">. Will start giving commands to
the active isdn tty device and react to events until the L<Event|Event> loop
gets stopped (e.g. by calling L<unwait|"unwait">. The returncode is that of
the L<Event::unloop|Event/"unloop"> that stopped the event loop.

=item $self = $isdn->X<unwait>($result)

=item $class = LinuxIsdn->unwait($result)

=item LinuxIsdn::unwait($result)

A wrapper around L<Event::loop|Event/"loop">. $result is the value that will
be returned to L<Event::loop|Event/"loop">.

=back

=head1 EXAMPLE

Here's a typical example. It will accept a voice call, print the remote number
and then hang up the phone.

 use LinuxIsdn;

 use strict;
 use LinuxIsdn;

 sub rung {
     my $call = shift;
     printf STDERR "Attempted call by %s!\n", $call->remote_number();
     $call->active()->unwait(0);
 }

 sub connected {
     my $call = shift;
     printf STDERR "Connected by %s!\n", $call->remote_number();
     $call->hangup();
 }

 sub hangup {
     my $call = shift;
     $call->active()->unwait(0);
 }

 my $mytel = "601234567";
 my $isdn = LinuxIsdn->new();
 $isdn->telephone($mytel) if $mytel;
 $isdn->audio_mode(1);
 $isdn->on_ring(sub {
     my $call = shift;
     print STDERR $call->string();
     # $call->ignore(\&rung);
     $call->pickup(\&connected, \&rung, \&hangup);
 });
 $isdn->wait();

=head1 BUGS

None known

=head1 AUTHOR

Ton Hospel (LinuxIsdn@ton.iguana.be)

=head1 SEE ALSO

L<LinuxIsdn::Call::Transmitter>,
L<LinuxIsdn::Call::Recorder>,
L<LinuxIsdn::Call>,
L<IsdnDaemon>,
L<Event>

=cut
