#!/usr/bin/perl -w

package Device::Phone;

use strict;
use Device::SerialPort;
use Text::CSV_XS;
use Time::Local;
use Carp;

# should use this
#use base qw( Device::SerialPort );

sub new {
    my $class = shift;
    my %options = @_;

    my $self = bless {}, $class;

    $self->{device} = delete $options{device};
    $self->{lockfile} = "/var/tmp/LCK.." .
      substr( $self->{device}, rindex( $self->{device}, "/" ) + 1 );
    $self->{debug} = delete $options{debug};

    if ( $self->{device} !~ m@^/dev@ ) {
        $self->{device} = "/dev/" . $self->{device};
    }

    $self;
}

sub open {
    my $self = shift;

    # stat the lockfile, open it, check the process ID, check if
    # the process is still running, nuke the lockfile if it's not.
    if ( -f $self->{lockfile} ) {
        if ( open( LOCKFILE, "<" . $self->{lockfile} )) {
            my $pid = <LOCKFILE> || 0;
            if ( $pid ) {
                if ( kill 0, $pid ) {
                    # process still running
                    croak( $self->{device} . " is locked by process $pid" );
                }
            }
            close( LOCKFILE );
            unlink( $self->{lockfile} );
        } else {
            croak( "Can't open lockfile " . $self->{lockfile} . " for " .
                   $self->{device} . ": $!" );
        }
    }

    $self->{port} = new Device::SerialPort( $self->{device}, 1,
                                            $self->{lockfile} )
      or croak( "Can't create SerialPort object with " . $self->{device} .
                " and " . $self->{lockfile} . ": $!" );

    # now set up the port
    $self->{port}->baudrate( 115200 );  # actually virtual speed
    $self->{port}->parity( "none" );
    $self->{port}->databits( 8 );
    $self->{port}->stopbits( 1 );
    $self->{port}->handshake( "rts" );

    $self->{port}->alias( "phone" );

    $self->{port};
}

sub closephone {
    my $self = shift;

    if ( ref( $self->{port} )) {
        $self->{port}->close;
    }
    unlink $self->{lockfile};
    undef $self->{port};
}

# Convenience routines, which should be more robust.
sub ask {
    my $self = shift;
    my $string = shift;
    my $errorok = shift;

    $self->{debug} and print STDERR "Writing AT$string\n";
    writeport( $self, "AT" . $string . "\r" );
    my ( $ok, $reply ) = checkreply( $self, "doing $string", $errorok );
    if ( $ok ) {
        $string = quotemeta( $string );
        $self->{debug} and print STDERR "quotemeta: $string\n";
        #$string =~ s/(\\\=?)\\\?/($1\\?)?/; # a little wizardry ;)
        $self->{debug} and print STDERR "raw reply: $reply\n";
        # Unecho the thing
        $reply =~ s/^AT${string}\s*\n//s;
        $self->{debug} and print STDERR "unechoed: $reply\n";
        # some commands present the answer as "+FOO: answer", and there can be a
        # few of them over multiple lines.
        $string =~ s/(\\[=?])+.*$//;
        $reply =~ s/\s*${string}:\s*/ /sg; # leave a space, though
        $reply =~ s/\s*\+CCFC:\s*/ /sg; # special case, cos I'm lazy.
        $self->{debug} and print STDERR "removing matching $string: $reply\n";
        # nuke trailing OK
        $reply =~ s/(\r\n)*OK(\r\n)+//s;
        $reply =~ s/^\s+//s;

        $self->{debug} and print STDERR "Returning>>$reply\n";
    } else {
        $reply = undef;
    }

    $reply;
}

sub writeport {
    my $self = shift;
    my $p = $self->{port};
    my $str = shift;
    my $len = length( $str );   # not used

    $p->write( $str );
    while ( !($p->write_drain)[0] ) {
    }
    1 while( chomp( $str ));
    print STDERR ">>> $str\n" if $self->{debug};
}

sub checkreply {
    my $self = shift;
    my $p = $self->{port};
    my $context = shift;
    my $errorok = shift;
    my $reply = "";
    my $ok;
    my $now = time;

    while ( 1 ) {
        my $s = $p->input;
        print STDERR join( "\n<<< ", "", split( /[\r\n]+/, $s )) . "\n"
                                    if $self->{debug} && $s;
        $reply .= $s;
        last if ( $reply =~ m/^(OK|ERROR)\r?$/m ); # wait for answer
        if ( time > ( $now + 60)) { # don't wait more than 1 minute
            $^W and warn "Timed out in checkreply ($context)\n";
            last
        }
    }

    $ok = ( $reply =~ m/^OK\r?$/m ) ? 1 : 0;
    if ( $errorok ) {
        $ok = 1;
    }

    if ( wantarray ) {
        return ( $ok, $reply );
    } else {
        return $ok;
    }
}

sub reset {
    my $self = shift;
    my ( $reply, $ok );
    writeport( $self->{port}, "ATZ\r" );
    ( $ok, $reply ) = checkreply( $self->{port}, "resetting phone" );
    $reply ||= "unknown error";
    if ( !$ok ) {
        closephone;             # make sure to at least clean up.
        die "Failed to reset phone ($reply)\nStopped";
    }
}

sub mynum {
    my $self = shift;
    $self->{mynum} = shift;
}

sub getsms {
    my $self = shift;
    my $num = shift;
    my $loc = shift;

    if ( !$self->{mynum} ) {
        croak( "you need to set up your own number for this device" );
    }

    if ( $loc ) {
        $self->ask( "+CPMS=\"$loc\"" ) or return;
    }

    my $reply = $self->ask( "+MMGR=$num" );
    return unless $reply;

    my %msg = ( idx => $num, reply => $reply );
    ( $msg{header}, $msg{message} ) = split( /[\r\n]+/, $reply, 2 );

    my $csv = new Text::CSV_XS;
    if ( $csv->parse( $msg{header} )) {
        ( $msg{type}, $msg{number}, $msg{timestamp} ) =
            $csv->fields;
    } else {
        # XXX
        return;
    }

    if ( !defined( $msg{message} )) {
        # XXX
        return;
    }

    $msg{message} =~ s/\r\n//gs;

    if ( $msg{type} =~ /READ/ ) {
        $msg{from} = $msg{number};
        $msg{to} = $self->{mynum};
    } elsif ( $msg{type} =~ /SENT/ ) {
        $msg{from} = $self->{mynum};
        $msg{to} = $msg{number};
        $msg{to} =~ s/ /, /g;
        $msg{timestamp} = 0; # XXX
    }

    if ( $msg{timestamp} ) {
        my ( $y, $mt, $d, $h, $m, $s ) =
            $msg{timestamp} =~
            m|(\d+)/(\d+)/(\d+),(\d+):(\d+):(\d+)|;
        if ( defined( $s )) {
            $msg{timestamp} =
                timelocal( $s, $m, $h, $d, $mt - 1, $y ); # XXX
        } else {
            # XXX
            warn "Unable to parse $msg{timestamp}\n";
        }
    }

    \%msg;
}

1;