blob: 51d3bf908cd65372c6161c473960798dba7f0239 (
plain)
- #!/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];
- }
- }
- my ($phone) = shift @ARGV;
- my ($key) = shift @ARGV;
- my $num_children = $#{ $reply{$key} } + 1; # How many children we'll create
- $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);
- unless ($DUMMY) {
- system {'/usr/share/kannel/contrib/sendsms' } $phone, $reply{$key}[$num];
- print STDERR "Done reply #$num [" . $delay{$key}[$num] . "s]\n" if ($DEBUG);
- } else {
- print STDERR "\n[" . $delay{$key}[$num] . "s]\n";
- print STDERR $reply{$key}[$num] . "\n";
- }
- exit;
- }
- parent {
- if ($DEBUG) {
- my $child_pid = shift;
- waitpid $child_pid, 0;
- }
- }
- }
- }
- 1;
|