path: root/src/mum

#!/usr/bin/perl

use 5.010;
use strict;
use warnings;

use Data::Dumper;
use Getopt::Std;
use POSIX qw/sigaction SIGINT/;
use Term::ReadLine;
use Term::ReadLine::Gnu ();

our $VERSION = '0.01';

# Define range syntax

my @RANGE; # range (one/two references)
our %REF; # current reference

my $d = qr{
 (?(DEFINE)
  (?<range>                                                   (?{ @RANGE = () })
            ( (?&ref)
	    | (?&ref),(?&ref)
	    | (?&grep)
	    )
                                                       (?{ push @RANGE, \%REF })
  )
  (?<ref> ( (\d+)                              (?{ local %REF = (line => $^N) })
          | (\.|\$)                            (?{ local %REF = (spec => $^N) })
          | ' ([a-z])                          (?{ local %REF = (mark => $^N) })
          | (?&next)                           (?{ local %REF = (next => $^R) })
          | (?&prev)                           (?{ local %REF = (prev => $^R) })
          )
          ( ([+-] \d+)                 (?{ local %REF = (%REF, plus => 0+$^N) })
          )?
  )
  (?<grep> g((?&next))                         (?{ local %REF = (grep => $^R) })
  )
  (?<next> /(([^/\\]++ | \\.)*+)/                                     (?{ $^N })
  )
  (?<prev> \?(([^?\\]++ | \\.)*+)\?                                   (?{ $^N })
  )
 )
}x;

# Define program state

my $MESSAGE = 0;  # selected message
my $INDEX = '';   # loaded mbox index
my $MBOX = '';    # associated mbox
my @MESSAGES;     # loaded messages
my %MARKS;        # saved marks
my $SEARCH;       # last search regex

# Open TTY for reading and writing

open my $tty, '+<:unix', '/dev/tty' or die "Could not open /dev/tty: $!";

# Parse arguments

my %opt;
$Getopt::Std::STANDARD_HELP_VERSION = 1;
getopts('r:', \%opt);

sub HELP_MESSAGE {
	print STDERR <<USAGE;
usage: $0 [-r mbox.i]
USAGE
}

if ($opt{r}) {
	load($opt{r});
}

# Run main loop

my $term = Term::ReadLine->new('repl', $tty, $tty);
$term->ornaments(0);

sigaction SIGINT, new POSIX::SigAction sub {
	print $tty "\n";
	$term->on_new_line();
	$term->replace_line('');
	$term->redisplay();
};

while () {
	$MESSAGE = 1 if $MESSAGE < 1;
	$MESSAGE = @MESSAGES if $MESSAGE > @MESSAGES;

	# Read next command from user

	my $cmd = $term->readline("$MBOX:$MESSAGE& ");
	last if not defined $cmd;

	chomp $cmd;
	$cmd =~ s/^\s+|\s+$//g;
	$term->addhistory($cmd) if $cmd =~ /\S/;

	# Parse user-given command

	for ($cmd) {
		# q -- quit
		if (/^q$/) {
			exit;
		}

		# +/- -- next/previous message
		elsif (/^(?<num> \d*) (?<dir> [+-]) \Z/x) {
			my $num = $+{num} || 1;
			for ($+{dir}) {
				$MESSAGE += $num if /\+/;
				$MESSAGE -= $num if /-/;
				goto h if length($_) > 1;
			}
		}

		# c -- change working directory
		elsif (/^c\s+(.*)/) {
			chdir $1;
		}

		# h -- print summary of headers
		elsif (/^ (?&range)? h \Z $d/x) {
h:
			print "h\n";
		}

		# i -- print headers verbatim
		elsif (/^ (&range)? i \Z $d/x) {
			my ($a, $b);
			$a = toloc(0, shift @RANGE) or next if @RANGE > 1;
			$b = toloc($a, shift @RANGE) or next if @RANGE;
			$b = $MESSAGE if not $b;
			$a = $b if not $a;

			print "$_" for @MESSAGES[$a-1..$b-1];
		}

		# p -- print message(s)
		elsif (/^ (?&range)? p \Z $d/x) {
			my ($a, $b);
			$a = toloc(0, shift @RANGE) or next if @RANGE > 1;
			$b = toloc($a, shift @RANGE) or next if @RANGE;
			$b = $MESSAGE if not $b;
			$a = $b if not $a;

			print "$_\n" for mbox($a, $b);
		}

		# l -- view message(s) in pager
		elsif (/^ (?&range)? l \Z $d/x) {
			my ($a, $b);
			$a = toloc(0, shift @RANGE) or next if @RANGE > 1;
			$b = toloc($a, shift @RANGE) or next if @RANGE;
			$b = $MESSAGE if not $b;
			$a = $b if not $a;

			open my $pager, '|-', $ENV{PAGER} || 'less' or do {
				warn "failed to open pager: $!\n";
				next;
			};
			local $SIG{PIPE} = sub {};
			print $pager "$_\n" for mbox($a, $b);
			close $pager;
		}

		# | -- pipe message(s)
		elsif (/^ (?&range)? \| (?<rest>.+) $d/x) {
			print "|\n";
		}

		# ! -- run shell command
		elsif (/^!/) {
			$cmd =~ s/!//;
			system $cmd;
		}

		# r -- read message headers from mbox index
		elsif (/^r (\s+ (?<index> .+))? \Z/x) {
			load($+{index} || $INDEX);
		}

		# s -- sync and read messages
		elsif (/^s\Z/x) {
			chomp($ENV{PASSWORD} = `getpw`) if not $ENV{PASSWORD};
			system 'm-sync';
			load($INDEX) if $INDEX;
		}

		# range without command
		elsif (/^(?&range) \Z $d/x) {
			# select last message in range
			my ($a, $b);
			$a = toloc(0, shift @RANGE) or next if @RANGE > 1;
			$b = toloc($a, shift @RANGE) or next;
			$MESSAGE = $b;
		}

		# empty command
		elsif (/^$/) {
			$MESSAGE++;
		}

		# unrecognized command
		else {
			warn "unrecognized command syntax\n";
			next;
		}
	}
}

# Subroutines

# Parse ref/grep and return corresponding location in index
sub toloc {
	my $start = shift;     # starting position for searches (optional)
	my %ref = %{(shift)};  # reference to parse
	my $loc;               # location to return

	if ($ref{line}) {
		$loc = $ref{line};
	}

	elsif ($ref{mark}) {
		if ($MARKS{$ref{mark}}) {
			$loc = $MARKS{$ref{mark}};
		} else {
			warn "mark '$ref{mark} not set\n";
			return;
		}
	}

	elsif ($ref{spec}) {
		$loc = $MESSAGE if $ref{spec} eq '.';
		$loc = scalar @MESSAGES if $ref{spec} eq '$';
	}

	elsif (exists $ref{next}) {
		$ref{next} = $SEARCH if not $ref{next};
		$SEARCH = $ref{next};
		if (not $ref{next}) {
			warn "missing pattern\n";
			return;
		}

		$start = $MESSAGE if not $start;
		$start++;
		$loc = $start-1;

		for (@MESSAGES[$start-1..$#MESSAGES]) {
			$loc++;
			goto found if /$ref{next}/;
		}

		warn "pattern /$ref{next}/ not found\n";
		return;
	}

	elsif (exists $ref{prev}) {
		$ref{prev} = $SEARCH if not $ref{prev};
		$SEARCH = $ref{prev};
		if (not $ref{prev}) {
			warn "missing pattern\n";
			return;
		}

		$start = $MESSAGE if not $start;
		$start--;
		$loc = $start+1;

		for (reverse @MESSAGES[0..$start-1]) {
			$loc--;
			goto found if /$ref{prev}/;
		}

		warn "pattern ?$ref{prev}? not found\n";
		return;
	}

	elsif ($ref{grep}) {
		# to be implemented
		return;
	}

found:
	$loc += $ref{plus} if $ref{plus};
	$loc = 1 if $loc < 1;
	$loc = @MESSAGES if $loc > @MESSAGES;
	return $loc;
}

# Load message headers from index
sub load {
	my $idx = shift; # index file to read

	$idx =~ s/\.i$//;
	$idx .= '.i'; # be sure to open index and not mbox
	open my $h, '<', $idx or do {
		warn "failed to open $idx: $!\n";
		next;
	};

	$INDEX = $idx;
	($MBOX = $INDEX) =~ s/\.i$//;

	@MESSAGES = ();
	local $/ = '';
	my $offset = 0;
	while (<$h>) {
		s/^From .*\n/$&M-Index-Offset: $offset\n/;
		push @MESSAGES, $_;
		$offset += length $_;
	}
	close $h;
	print scalar @MESSAGES, " messages\n";
}

# Read full messages from mbox
sub mbox {
	my ($a, $b) = @_;  # range to read
	my @messages;      # messages to return

	open my $mbox, '<', $MBOX or do {
		warn "failed to open $MBOX: $!\n";
		next;
	};

	for my $i ($a .. $b) {
		$MESSAGES[$i-1] =~ /^M-Offset: (.*)$/m;
		my $offset = $1;
		$MESSAGES[$i-1] =~ /^M-Length: (.*)$/m;
		my $length = $1;

		unless (defined $offset and defined $length) {
			warn "ill-formatted message $i\n";
			next;
		}

		seek $mbox, $offset, 0 or do {
			warn "failed to retrieve message $i\n";
			next;
		};

		local $/ = \$length;
		push @messages, scalar <$mbox>;
	}

	close $mbox;

	return @messages;
}

print $tty "\n";