summaryrefslogtreecommitdiff
path: root/localmarkdown2sms
blob: 96ed0ac4642473b6d1a9378f87080731af197cd0 (plain)
  1. #!/usr/bin/perl
  2. #
  3. # /usr/local/sbin/localmarkdown2sms
  4. # Copyright 2009 Jonas Smedegaard <dr@jones.dk>
  5. #
  6. # Send series of messages through Kannel from simplified Markdown files
  7. # * Lines starting with "#" are "keywords" activating a message series
  8. # * write only a single word
  9. # * use each keyword only once across the whole system
  10. # * use only minuscles (not majuscles, i.e. CAPITAL LETTERS)
  11. # * Lines starting with "##" express pauses
  12. # * a pause is a number + a single letter, without spaces between
  13. # * a pause line can contain multiple pauses, separated by space
  14. # Suggestion for writing style:
  15. #
  16. # * Write explicitly how to activate next series
  17. # * pick keywords tied to nex series rather than the previous
  18. # * use same instruction jargon across all series in the system
  19. use strict;
  20. use warnings;
  21. use Env qw[$debug $info $warn $dummy $nosleep];
  22. use Log::Log4perl qw(:easy);
  23. use File::Spec;
  24. use File::Slurp;
  25. use Time::Duration::Parse;
  26. #use Proc::Daemon;
  27. use Proc::Fork;
  28. #use IO::Pipe;
  29. #Proc::Daemon::Init;
  30. use LWP::UserAgent;
  31. use URI::Escape;
  32. my $sms_url = "http://localhost:13013/cgi-bin/sendsms";
  33. my $sms_user = "tester";
  34. my $sms_pw = "foobar";
  35. my (%file, %delay, %reply);
  36. my ($path) = shift @ARGV;
  37. my ($phone) = shift @ARGV;
  38. my ($key) = lc (shift @ARGV);
  39. if ($debug) {
  40. Log::Log4perl->easy_init($DEBUG);
  41. } elsif ($INFO) {
  42. Log::Log4perl->easy_init($INFO);
  43. } elsif ($WARN) {
  44. Log::Log4perl->easy_init($WARN);
  45. } elsif ($ERROR) {
  46. Log::Log4perl->easy_init($ERROR);
  47. }
  48. foreach my $file (read_dir( $path )) {
  49. my ($key, $i, $skipkey, $skipcontent);
  50. # suppress repeated warnings for same issue
  51. my ($warn_nonkey_delay, $warn_nonkey_content);
  52. next unless ($file =~ /\.mdwn$/);
  53. foreach my $line (read_file( File::Spec->catfile($path, $file))) {
  54. chomp $line;
  55. my $content;
  56. # headline
  57. if ($line =~ /^(#+)\s*(.*?)\s*$/) {
  58. # tidy latest reply (TODO: use sub)
  59. if (defined($key) and defined($reply{$key}[$i])) {
  60. $reply{$key}[$i] =~ s/^\s*(\w.*?)\s*$/$1/s || delete $reply{$key}[$i];
  61. }
  62. my $level = length($1);
  63. $content = $2;
  64. # key
  65. if ($level == 1 and $content =~ /(\w+)/) {
  66. $key = lc($1);
  67. $i = 0;
  68. $skipkey = undef;
  69. $skipcontent = undef;
  70. if (lc($content) ne $key) {
  71. WARN "key \"$key\" extracted from fuzzy string \"$content\" in file \"$file\"";
  72. }
  73. if (!defined( $delay{$key})) {
  74. $delay{$key}[0] = 0;
  75. $warn_nonkey_delay = undef;
  76. $warn_nonkey_content = undef;
  77. } else {
  78. WARN "skipping non-unique key \"$key\" in file \"$file\"";
  79. $key = undef;
  80. $skipkey = 1;
  81. $skipcontent = 1;
  82. }
  83. # delay
  84. } elsif ($level == 2 and $content =~ /((\d+[sm](\s+|\Z))+)/) {
  85. $skipcontent = undef;
  86. if (defined( $key)) {
  87. my $delay = parse_duration($1);
  88. if (defined($reply{$key}[$i])) {
  89. $i++;
  90. $delay{$key}[$i] = $delay{$key}[$i - 1];
  91. }
  92. $delay{$key}[$i] += $delay;
  93. if ($content ne $1) {
  94. WARN "delay (${delay}s) resolved from fuzzy string \"$content\" in file \"$file\"";
  95. }
  96. } elsif ($skipkey) {
  97. # skipping - already warned about it...
  98. } else {
  99. WARN "ignoring non-key'ed delay line \"$1\" in file \"$file\"" unless ($warn_nonkey_delay);
  100. $warn_nonkey_delay = 1;
  101. $skipcontent = 1;
  102. }
  103. } else {
  104. WARN "ignoring non-parsable headline \"$line\" in file \"$file\"";
  105. $skipcontent = 1;
  106. }
  107. # reply
  108. } else {
  109. $content = $line . "\n";
  110. # ikiwiki directives - strip from content and parse for tags
  111. $content =~ s/(?<!\\)\[\[([^\[\]]*)(?<!\\)\]\]//gs and do {
  112. my $directive_string = $1;
  113. my ($directive, $directive_content);
  114. $directive_string =~ /^\s*\!(tag|taglink)\s*((\s*?\b\w+)+)/ and $file{$file}{'directive'}{'tag'} = [ split /\s+/, $2 ];
  115. };
  116. if ( defined( $key ) and not ($skipcontent)) {
  117. $content = $reply{$key}[$i] . $content if (defined($reply{$key}[$i]));
  118. $content =~ s/^\h*$//g; # clean virtually empty lines
  119. $content =~ s/(\S)\h$/$1/g; # strip single trailing space
  120. $content =~ s/\n\n+/\n\n/g; # strip excess newlines
  121. # $content =~ s/(\S)\n([^\n])/$1 $2/g; # convert newline to space
  122. $content =~ s/\h*$//g; # strip all trailing spaces
  123. $reply{$key}[$i] = $content;
  124. } elsif ($skipkey or $skipcontent) {
  125. # skipping - already warned about it...
  126. } else {
  127. WARN "skipping non-key'ed content \"$line\" in file \"$file\"" unless ($warn_nonkey_content);
  128. $warn_nonkey_content = 1;
  129. }
  130. }
  131. }
  132. # tidy latest reply (TODO: use sub)
  133. if (defined($key) and defined($reply{$key}[$i])) {
  134. $reply{$key}[$i] =~ s/^\s*(\w.*?)\s*$/$1/s || delete $reply{$key}[$i];
  135. }
  136. }
  137. sub sendmsg {
  138. my ($phone, $desc, $msg) = @_;
  139. unless ($dummy) {
  140. my $ua = LWP::UserAgent->new(agent => "localmarkdown2sms");
  141. $ua->timeout(10);
  142. $ua->request(HTTP::Request->new('GET', $sms_url
  143. . '?username=' . uri_escape($sms_user)
  144. . '&password=' . uri_escape($sms_pw)
  145. . '&to=' . uri_escape($phone)
  146. . '&text=' . uri_escape(encode("cp1252", $msg))
  147. ));
  148. DEBUG "Done $desc";
  149. } else {
  150. print STDERR "\n --> $phone: $desc\n";
  151. print STDERR $msg . "\n";
  152. }
  153. }
  154. my $num_children = $#{ $reply{$key} } + 1; # How many children we'll create
  155. if (0 == $num_children) {
  156. &sendmsg($phone, "fallback message", "Hmmm, strange, the word \"$key\" is unknown. Perhaps you typed it wrong?\n\nPlease try again.");
  157. exit;
  158. }
  159. if (0 == $num_children) {
  160. }
  161. $SIG{CHLD} = 'IGNORE'; # Don't worry about reaping zombies
  162. # Spawn off some children
  163. if ($debug) {
  164. DEBUG "queueing $num_children replies:";
  165. for my $num ( 0 .. $num_children - 1 ) {
  166. DEBUG " [" . $delay{$key}[$num] . "s]";
  167. }
  168. # DEBUG "\n";
  169. }
  170. for my $num ( 0 .. $num_children - 1 ) {
  171. run_fork {
  172. child {
  173. sleep($delay{$key}[$num]) unless ($nosleep);
  174. &sendmsg($phone, "reply #$num [" . $delay{$key}[$num] . "s]", $reply{$key}[$num]);
  175. exit;
  176. }
  177. parent {
  178. if ($debug) {
  179. my $child_pid = shift;
  180. waitpid $child_pid, 0;
  181. }
  182. }
  183. }
  184. }
  185. 1;