path: root/src/mum

#!/usr/bin/perl

use 5.010;
use strict;
use warnings;

use Data::Dumper;

# 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: $!";

# Run main loop

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

	print $tty "$MBOX:$MESSAGE& ";

	# Read next command from user

	my $cmd = <$tty>;
	$cmd = '' if not $cmd;
	chomp $cmd;
	$cmd =~ s/^\s+|\s+$//g;

	# Parse user-given command

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

		# 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;
		}

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

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

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

		# p
		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 get($a, $b);
		}

		# l
		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 die "failed to open pager: $!";
			print $pager "$_\n" for get($a, $b);
			close $pager;
		}

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

		# !
		elsif (/^!/) {
			$cmd =~ s/!//;
			system $cmd;
			print "!\n";
		}

		# r[a]
		elsif (/^ra? \s+ (?<index> .*)/x) {
			my $idx = $+{index};
			$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$//;
			local $/ = '';
			@MESSAGES = () if not $cmd =~ /^ra/; # overwrite
			my $offset = 0;
			while (<$h>) {
				s/^From .*\n/$&M-Index-Offset: $offset\n/;
				push @MESSAGES, $_;
				$offset += length $_;
			}
			close $h;
			print scalar @MESSAGES, " messages\n";
		}

		# 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;
}

# Read messages from mbox
sub get {
	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;
}