path: root/localmarkdown2sms

#!/usr/bin/perl
#
# /usr/local/sbin/localmarkdown2sms
# Copyright 2009 Jonas Smedegaard <dr@jones.dk>
#
# Send series of messages through Kannel from simplified Markdown files

#  * Lines starting with "#" are "keywords" activating a message series
#    * write only a single word
#    * use each keyword only once across the whole system
#    * use only minuscles (not majuscles, i.e. CAPITAL LETTERS)
#  * Lines starting with "##" express pauses
#    * a pause is a number + a single letter, without spaces between
#    * a pause line can contain multiple pauses, separated by space

# Suggestion for writing style:
#
#  * Write explicitly how to activate next series
#  * pick keywords tied to nex series rather than the previous
#  * use same instruction jargon across all series in the system


use strict;
use warnings;

use Env qw[$DEBUG $DUMMY $NOSLEEP];
use File::Spec;
use File::Slurp;
use Time::Duration::Parse;
#use Proc::Daemon;
use Proc::Fork;
#use IO::Pipe;

#Proc::Daemon::Init;

my (%file, %delay, %reply);
my ($path) = shift @ARGV;

foreach my $file (read_dir( $path )) {
    my ($key, $i, $skipkey, $skipcontent);
    # suppress repeated warnings for same issue
    my ($warn_nonkey_delay, $warn_nonkey_content);
    next unless ($file =~ /\.mdwn$/);
    foreach my $line (read_file( File::Spec->catfile($path, $file))) {
    chomp $line;
    my $content;
    # headline
    if ($line =~ /^(#+)\s*(.*?)\s*$/) {
        # tidy latest reply (TODO: use sub)
        if (defined($key) and defined($reply{$key}[$i])) {
            $reply{$key}[$i] =~ s/^\s*(\w.*?)\s*$/$1/s || delete $reply{$key}[$i];
        }
        my $level = length($1);
        $content = $2;
        # key
        if ($level == 1 and $content =~ /(\w+)/) {
            $key = lc($1);
            $i = 0;
            $skipkey = undef;
            $skipcontent = undef;
            if (lc($content) ne $key) {
                print STDERR "key \"$key\" extracted from fuzzy string \"$content\" in file \"$file\"\n";
            }
            if (!defined( $delay{$key})) {
                $delay{$key}[0] = 0;
                $warn_nonkey_delay = undef;
                $warn_nonkey_content = undef;
            } else {
                print STDERR "skipping non-unique key \"$key\" in file \"$file\"\n";
                $key = undef;
                $skipkey = 1;
                $skipcontent = 1;
            }
        # delay
        } elsif ($level == 2 and $content =~ /((\d+[sm](\s+|\Z))+)/) {
            $skipcontent = undef;
            if (defined( $key)) {
                my $delay = parse_duration($1);
                if (defined($reply{$key}[$i])) {
                    $i++;
                    $delay{$key}[$i] = $delay{$key}[$i - 1];
                }
                $delay{$key}[$i] += $delay;
                if ($content ne $1) {
                    print STDERR "delay (${delay}s) resolved from fuzzy string \"$content\" in file \"$file\"\n";
                }
            } elsif ($skipkey) {
                # skipping - already warned about it...
            } else {
                print STDERR "ignoring non-key'ed delay line \"$1\" in file \"$file\"\n" unless ($warn_nonkey_delay);
                $warn_nonkey_delay = 1;
                $skipcontent = 1;
            }
        } else {
            print STDERR "ignoring non-parsable headline \"$line\" in file \"$file\"\n";
            $skipcontent = 1;
        }
    # reply
    } else {
        $content = $line . "\n";
        # ikiwiki directives - strip from content and parse for tags
        $content =~ s/(?<!\\)\[\[([^\[\]]*)(?<!\\)\]\]//gs and do {
            my $directive_string = $1;
            my ($directive, $directive_content);
            $directive_string =~ /^\s*\!(tag|taglink)\s*((\s*?\b\w+)+)/ and $file{$file}{'directive'}{'tag'} = [ split /\s+/, $2 ];
        };
        if ( defined( $key ) and not ($skipcontent)) {
            $content = $reply{$key}[$i] . $content if (defined($reply{$key}[$i]));
            $content =~ s/^\h*$//g;     # clean virtually empty lines
            $content =~ s/(\S)\h$/$1/g; # strip single trailing space
            $content =~ s/\n\n+/\n\n/g; # strip excess newlines
            $content =~ s/(\S)\n([^\n])/$1 $2/g; # convert newline to space
            $content =~ s/\h*$//g;      # strip all trailing spaces
            $reply{$key}[$i] = $content;
        } elsif ($skipkey or $skipcontent) {
            # skipping - already warned about it...
        } else {
            print STDERR "skipping non-key'ed content \"$line\" in file \"$file\"\n" unless ($warn_nonkey_content);
            $warn_nonkey_content = 1;
        }
    }
    }
    # tidy latest reply (TODO: use sub)
    if (defined($key) and defined($reply{$key}[$i])) {
    $reply{$key}[$i] =~ s/^\s*(\w.*?)\s*$/$1/s || delete $reply{$key}[$i];
    }
}

sub sendmsg {
    my ($phone, $desc, $msg) = @_;

    unless ($DUMMY) {
        print STDERR "Exec'ing \"...sendsms $phone ...\"\n" if ($DEBUG);
        system {'/usr/share/kannel/contrib/sendsms' } $phone, $msg;
        system {'/usr/share/kannel/contrib/sendsms' } $phone, $msg;
        print STDERR "Done $desc\n" if ($DEBUG);
    } else {
        print STDERR "\n --> $phone: $desc\n";
        print STDERR $msg . "\n";
    }
}

my ($phone) = shift @ARGV;
my ($key) = lc (shift @ARGV);

my $num_children = $#{ $reply{$key} } + 1;    # How many children we'll create

if (0 == $num_children) {
    &sendmsg($phone, "fallback message", "Hmmm, strange, the word \"$key\" is unknown. Perhaps you typed it wrong?\n\nPlease try again.");
    exit;
}

if (0 == $num_children) {
}

$SIG{CHLD} = 'IGNORE';   # Don't worry about reaping zombies

# Spawn off some children
if ($DEBUG) {
    print STDERR "queueing $num_children replies:";
    for my $num ( 0 .. $num_children - 1 ) {
        print STDERR " [" . $delay{$key}[$num] . "s]";
    }
    print STDERR "\n";
}
for my $num ( 0 .. $num_children - 1 ) {

    run_fork {
        child {
            sleep($delay{$key}[$num]) unless ($NOSLEEP);
            &sendmsg($phone, "reply #$num [" . $delay{$key}[$num] . "s]", $reply{$key}[$num]);
            exit;
        }
        parent {
            if ($DEBUG) {
                my $child_pid = shift;
                waitpid $child_pid, 0;
            }
        }
    }
}

1;