#!/usr/bin/perl

# All global variables and all subroutines start with "CALC_", to avoid collisions with user-created variables/functions.
# Exception: %OPT.  Tough shit.

my %OPT;
my @CALC_EXPLIST = ();  # commandline-given arguments
foreach my $arg ( @ARGV )
  {
    if    ( $arg =~ /^\-+(.+?)\=(.*)/ ) { $OPT{$1} = $2; }
    elsif ( $arg =~ /^\-+(.+)/        ) { $OPT{$1} = -1; }
    else  { push ( @CALC_EXPLIST, $arg ); }
  }

my $CALC_MODE    = 'perl';
my $CALC_SUBM    = 0;
my $CALC_QUIT    = 0;
my %CALC_MODULES = ();
my %CALC_GLOBAL  = ();  # global state, not specific to any mode.  very little should be here.
my %CALC_NAMES   = ();  # maps user-defined names to CALC_STACK structures.

my @CALC_STACK = ();  # The Stack.  Results get pushed here.  Array of hashrefs to structure:
   # cmd:  string    The text of the user's command, AFTER stack interpolation.
   # res:  any       The value of or reference to result of user's command.
   # hid:  integer   1=Hidden (do not display)
   # len:  integer   Only this many characters from {res} will be displayed.
   # ok :  integer   1=OK to push to stack; refrain, otherwise.
   # tm :  integer   Epoch time command was entered.
   # cpu:  arrayref  [ wallclock_tm, system_time, user_time ] consumed, in seconds.
   # type: string    The type of the result: 'expr', 'proc', 'error'
   # mode: string    The mode at the time of calculation.
   # subm: integer   The submode at the time of calculation (indexes @{$CALC_MODES{$CALC_STACK[]->{mode}}}[]).
   # tty : string    The tty of the originator of this command
   # host: string    The hostname of the originator of this command
   # pid : integer   The process id of the originator of this command

# Valid submodes, for now:  perl, c, shell, sql
my %CALC_MODES = ();  # The Modes.  Determines how user's input will be interpreted.
                      # Hashes on modename to arrayref of submode-specific structures.  Should have at least these fields:
   # name:  string   A description of this submode.  Default value is "$mode:$submode".

exit &CALC_main();

sub CALC_main {

  &CALC_init_modes();    # Initialize %CALC_MODES.
  &CALC_init_modules();  # Seek out (and install, if necessary) modules, and load them.
  &CALC_load_sources();  # Evaluate .calc.init, load .calc.history, and evaluate .calc.login, in that order.

  if ( scalar(@CALC_EXPLIST) > 0 ) {
    foreach my $ex ( @CALC_EXPLIST ) {
      my $r = &CALC_process_command ( $ex ); # returns a CALC_STACK record.
      push ( @CALC_STACK, $r ) if ( $r->{ok} == 1 );
      print ( $r->{res}."\n" ); # zzapp -- do something better if ref($r->{res}).
      }
    return 0;
    }

  &CALC_cook_terminal();  # Enter raw mode, or init Term::ReadLine, whatever we need to do to give us a UI.  ctl-C/ctl-Z hooked here.

  while ( !$CALC_QUIT ) {
    my $ex = &CALC_read_a_line();  # Wraps Term::ReadLine::Gnu or <STDIN> or whatever.
    last unless ( defined($ex) );
    next unless ( length($ex) > 0 );
    last if ( $ex eq 'quit' );
    last if ( $ex eq 'exit' );
    my $r = &CALC_process_command ( $ex ); # returns a CALC_STACK record.
    last if ( $CALC_QUIT );
    if ( $r->{ok} == 1 ) {
      push ( @CALC_STACK, $r );
      &CALC_append_to_history_file ( $r ); # zzapp
      }
    &CALC_show_stack(); # zzapp
    }
  return 0;
  }

sub CALC_append_to_history_file {
  my ( $r ) = @_;
  # zzapp -- punting for now
  }

sub CALC_show_stack {
  # zzapp -- improve on this: more display modes, detect display width, adjustable stack window, etc.
  my $ix = scalar(@CALC_STACK) - 10;
     $ix = 0 if ( $ix < 0 );
  my $kx = $ix+10;
     $kx = scalar(@CALC_STACK) if ( $kx > scalar(@CALC_STACK) );
  while ( $ix < $kx ) {
    my $reg = sprintf('a%02d',$ix);
    my $res = $CALC_STACK[$ix]->{res};
    my $pad = ' 'x(40-length($res));
    my $cmd = $CALC_STACK[$ix]->{cmd};
       $cmd = substr ( $cmd, 0, 50 );
    print ("$reg: $res$pad= $cmd\n");
    $ix++
    }
  }

sub CALC_init_modes {
  $CALC_MODES{'perl'}  = [ { name=> 'perl:1' } ];
  $CALC_MODES{'c'}     = [ { name=>    'c:1' } ];
  $CALC_MODES{'sql'}   = [ { name=>  'sql:1' } ];
  $CALC_MODES{'shell'} = [ { name=>'shell:1' } ];
  }

sub CALC_init_modules {
  foreach my $m ( ( 'Time::HiRes', 'Open::IPC', 'JSON', 'Term::ReadLine', 'Term::ReadKey', 'Data::Dumper', 'Sys::Hostname' ) ) {
    eval ( "use $m;" );
    if ( $@ ) {
      $CALC_MODULES{$m} = 0;
      }
    else {
      $CALC_MODULES{$m} = 1;
      } 
    }
  }

sub CALC_cook_terminal {  # Enter raw mode, or init Term::ReadLine, or whatever
  if ( !defined($OPT{'cli'}) && $CALC_MODULES{'Term::ReadLine'} ) { # zzapp -- handle other contingencies, you hoser
    &CALC_init_readline();
    }
  $| = 1;
  $SIG{'INT'}  = 'IGNORE' unless (defined($OPT{'allow-ctl-c'}));  # catch ctl-C
  $SIG{'TSTP'} = 'IGNORE' unless (defined($OPT{'allow-ctl-z'}));  # catch ctl-Z
  }

sub CALC_init_readline {
  $CALC_GLOBAL{'readline'} = new Term::ReadLine $0;
  }

sub CALC_load_sources {
  my $home = $ENV{'HOME'} || '.';
  &CALC_load_commands ( "$home/.calc.init" );
  &CALC_load_history  ( "$home/.calc.state" );
  &CALC_load_commands ( "$home/.calc.login" );
  }

sub CALC_load_commands {
  my ( $f ) = @_;
  return unless ( -r $f );
  my ( $fh, $x );
  return unless ( open ( $fh, "<", "$home/.calc.state" ) );
  while ( defined ( $x = <$fh> ) ) {
    # formatted one command per line, or so we hope.
    chomp ( $x );
    next if ( $x =~ /^\s*\#/ );
    my $r = &CALC_process_command ( $x ); # zzapp
    push ( @CALC_STACK, $r );
    }
  close ( $fh );
  }

sub CALC_load_history {
  my ( $f ) = @_;
  return unless ( -r $f );
  my ( $fh, $x );
  return unless ( open ( $fh, "<", "$home/.calc.state" ) );
  my $sz_limit = &CALC_history_load_limit();
  while ( defined ( $x = <$fh> ) ) {
    # formatted one json record per line
    chomp ( $x );
    next if ( $sz_limit && ( length($x) > $sz_limit ) );
    my $hr = json2struct ( $x );
    push ( @CALC_STACK, $hr );
    if ( $CALC_MODULES{'Term::ReadLine'} == 1 ) {
      $CALC_GLOBAL{'readline'}->addhistory ( $hr->{'cmd'} );
      }
    }
  close ( $fh );
  my @st = stat ( "$home/.calc.history" );
  $CALC_GLOBAL{'history_cursor'} = $st[7];  # this is where we pick up where we left off, when grabbing new history entries.
  }

# Returns limit on the size of a history object we want to incorporate into stack, or 0 for no limit.
sub CALC_history_load_limit {
  return $CALC_GLOBAL{'history_load_limit'} if ( defined ( $CALC_GLOBAL{'history_load_limit'} ) );
  return $OPT{'history-load-limit'} if ( defined ( $OPT{'history-load-limit'} ) );
  return $ENV{'history_load_limit'} if ( defined ( $ENV{'history_load_limit'} ) );
  return 0;
  }

# Wraps whatever method we are using to get input.
sub CALC_read_a_line {
  my $x;
  if ( defined ( $CALC_GLOBAL{'readline'} ) ) {
    $x = $CALC_GLOBAL{'readline'}->readline('> ');
    }
  else { # Either no ReadLine module is installed, or the user specified the --cli option.
    print (": ") unless ( defined ( $OPT{'cli'} ) );
    my $x = <STDIN>;
    return $x unless ( defined ( $x ) );
    }
  chomp ( $x );
  return ( $x );
  }

sub CALC_default_display_length_limit {
  my $lim = &CALC_first_defined (
    $CALC_GLOBAL{'default_display_length_limit'},
    $CALC_MODES{$CALC_MODE}->[$CALC_SUBMODE]->{'default_display_length_limit'},
    $OPT{'default-display-length-limit'},
    $ENV{'default_display_length_limit'} );
  $lim = 2048 unless ( defined ( $lim ) );  # pick a number
  return $lim;  
  }

sub CALC_first_defined {
  foreach my $r ( @_ ) {
    return $r if ( defined ( $r ) );
    }
  return undef;
  }

# Passes a command to the mode-specific processor, returns the CALC_STACK record.
sub CALC_process_command {
  my $hr = {};
     $hr->{cmd}   = $_[0];
     $hr->{hid}   = 0;
     $hr->{len}   = &CALC_default_display_length_limit();
     $hr->{tm}    = time();
     $hr->{tm}    = Time::HiRes::time() if ( &CALC_use_high_resolution_timestamps() );
     $hr->{cpu}   = [ times() ];  # zzapp -- if on linux, grab just our time from /proc/$$/stat, because times() includes kids.
     $hr->{mode}  = $CALC_MODE;
     $hr->{subm}  = $CALC_SUBMODE;
     $hr->{tty}   = &CALC_find_my_tty();
     $hr->{host}  = 'unk';
     $hr->{host}  = hostname() if ( defined ( $CALC_MODULES{'Sys::Hostname'} ) );
     $hr->{pid}   = $$;
  # Processors will edit or create:  res, ok, type
  if ( &CALC_modeless_processor ( $hr ) ) { # zzapp -- looks for metacommands for mode changes and the like.
    # la la la .. all of the work was done in the condition expression.
    }
  elsif    ( lc($CALC_MODE) eq 'perl' ) {
    &CALC_mode_processor_perl ( $hr ); # zzapp
    }
  elsif ( lc($CALC_MODE) eq 'c' ) {
    &CALC_mode_processor_c ( $hr ); # zzapp
    }
  elsif ( lc($CALC_MODE) eq 'sql' ) {
    &CALC_mode_processor_sql ( $hr ); # zzapp
    }
  elsif ( lc($CALC_MODE) eq 'shell' ) {
    &CALC_mode_processor_shell ( $hr ); # zzapp
    }
  else {
    my $call_mode = 'perl';
       $call_mode = 'shell' if ( $0 =~ /sh$/ );
    my $new_mode = $CALC_GLOBAL{'default_mode'} || $OPT{'default-mode'} || $ENV{'default_mode'} || $call_mode;
    $hr->{err} = "$0: ERROR -- invalid mode $CALC_MODE, switching to $new_mode";
    print ( STDERR "$hr->{err}\n" );
    $CALC_MODE = $new_mode;
    $CALC_SUBM = $CALC_GLOBAL{'default_subm'} || $OPT{'default-subm'} || $ENV{'default_subm'} || 0;
    $hr->{ok} = 0;
    $hr->{res} = undef;
    $hr->{type} = 'error';
    }
  my $new_times_ar = [ times() ];
  for ( my $i = 0; $i < 4; $i++ ) { $hr->{cpu}->[$i] = $hr->{cpu}->[$i] - $new_times_ar->[$i]; }
  return ( $hr );
  }

sub CALC_find_my_tty {
  return $CALC_GLOBAL{'tty'} if ( defined ( $CALC_GLOBAL{'tty'} ) );
  return &CALC_linux_guess_tty() if ( -r "/proc/$$/fd" );
  return '';
  }

sub CALC_use_high_resolution_timestamps {
  return 0 unless ( defined($CALC_MODULES{'Time::HiRes'}) );
  return 0 if     ( defined($CALC_GLOBAL{'no_hires_timestamps'}) );
  return 0 if     ( defined($CALC_MODES{$CALC_MODE}->[$CALC_SUBMODE]->{'no_hires_timestamps'}) );
  return 0 if     ( defined($OPT{'no-hires-timestamps'}) );
  return 0 if     ( defined($ENV{'no_hires_timestamps'}) );
  return 1;
  }

sub CALC_linux_guess_tty { # Linux-specific method
  my ( $apid ) = @_;
  $apid = $$ unless ( defined ( $apid ) );
  return $CALC_GLOBAL{'tty'} = '' unless ( -r "/proc/$apid/fd" );
  for ( my $i = 1; $i < 1024; $i++ ) {
    next unless ( -e "/proc/$apid/fd/$i" );
    my $tty = readlink ( "/proc/$apid/fd/$i" ); # zzapp -- first fd is not *always* the tty, but good enough for now.
    $CALC_GLOBAL{'tty'} = $tty;
    return $tty;
    }
  return $CALC_GLOBAL{'tty'} = '';
  }

sub CALC_linux_process_state { # Linux-specific method
  my ( $apid ) = @_;
  $apid = $$ unless ( defined ( $apid ) );
  return 0 unless ( -r "/proc/$apid/stat" );
  my ( $fh, $x );
  return 0 unless ( open ( $fh, "<", "/proc/$apid/stat" ) );
  $x = <$fh>;
  close ( $fh );
  $CALC_GLOBAL{'my_stat'} = [ split ( /\s+/, $x ) ];
  return 1;
  }

# Processors will edit or create:  res, ok, type
sub CALC_modeless_processor {
  my ( $hr ) = @_;
  if ( $hr->{cmd} =~ /^\s*mode\s*$/i ) {
    $hr->{res} = $CALC_MODES{$CALC_MODE}->[$CALC_SUBMODE]->{name};
    $hr->{ok}  = 1;
    $hr->{type} = 'meta';
    return 1;
    }
  if ( $hr->{cmd} =~ /^\s*mode\s*(.+?)\s*$/i ) {
    my $x = $1;
    my $new_mode;
    my $new_subm;
    if ( defined ( $CALC_MODES{$x} ) ) {
      $CALC_MODE = $x;
      $CALC_SUBM = $CALC_GLOBAL{'default_subm'} || $OPT{'default-subm'} || $ENV{'default_subm'} || 0;
      }
    elsif ( &CALC_named_mode_exists ( $x, \$new_mode, \$new_subm ) ) { # may create new submode if $x "perl:15" or somesuch.
      $CALC_MODE = $new_mode;
      $CALC_SUBM = $new_subm;
      }
    else {
      $hr->{res} = undef;
      $hr->{err} = "ERROR: unrecognized mode $x";
      $hr->{ok}  = 1;
      $hr->{type}= 'error';
      return 1;
      }
    $hr->{res} = $CALC_MODES{$CALC_MODE}->[$CALC_SUBMODE]->{name};
    $hr->{ok}  = 1;
    $hr->{type}= 'meta';
    return 1;
    }
  if ( $hr->{cmd} =~ /^\s*mode\s*name\s*(.+?)\s*$/i ) {
    my $old_name = $CALC_MODES{$CALC_MODE}->[$CALC_SUBM]->{name};
    $CALC_MODES{$CALC_MODE}->[$CALC_SUBM]->{name} = $1;
    $hr->{res} = "mode $old_name is $1";
    $hr->{ok}  = 1;
    $hr->{type}= 'meta';
    return 1;
    }
  if ( $hr->{cmd} =~ /^\s*set\s*$/i ) {
    $hr->{res} = [];
    foreach my $k ( sort keys ( %{$CALC_MODES{$CALC_MODE}->[$CALC_SUBM]} ) ) {
      push ( @{$hr->{res}}, [ $k, $CALC_MODES{$CALC_MODE}->[$CALC_SUBM]->{$k} ] );
      }
    $hr->{ok}  = 1;
    $hr->{type}= 'meta';
    return 1;
    }
  if ( $hr->{cmd} =~ /^\s*set\s*(.+?)\s*\=\s*(.+?)\s*$/i ) {
    my $label = $1;
    my $rval  = $2;
    $CALC_MODES{$CALC_MODE}->[$CALC_SUBM]->{$1} = $2;
    $hr->{res} = [ $1, $2 ];
    $hr->{ok}  = 1;
    $hr->{type}= 'meta';
    return 1;
    }
  # zzzappp
  if ( $hr->{cmd} =~ /^\s*setglobal\s*$/i ) {
    $hr->{res} = [];
    foreach my $k ( sort keys ( %CALC_GLOBAL ) ) {
      push ( @{$hr->{res}}, [ $k, $CALC_GLOBAL{$k} ] );
      }
    $hr->{ok}  = 1;
    $hr->{type}= 'meta';
    return 1;
    }
  if ( $hr->{cmd} =~ /^\s*setenv\s*$/i ) {
    $hr->{res} = [];
    foreach my $k ( sort keys ( %ENV ) ) {
      push ( @{$hr->{res}}, [ $k, $ENV{$k} ] );
      }
    $hr->{ok}  = 1;
    $hr->{type}= 'meta';
    return 1;
    }
  return 0; # This was not a metacommand, so the current mode's processor will handle it.
  }

sub CALC_named_mode_exists {
  my ( $x, $new_mode_sr, $new_subm_sr ) = @_;
  if ( ( $x =~ /^(\w+)\:(\d+)$/ ) && defined ( $CALC_MODES{$1} ) ) {
    if ( !defined ( $CALC_MODES{$1}->{$2} ) ) {
      $CALC_MODES{$1}->{$2} = { name=>$x };  # new blank mode created
      }
    $$new_mode_sr = $1;
    $$new_subm_sr = $2;
    return 1;
    }
  foreach my $m ( keys ( %CALC_MODES ) ) {
    for ( my $s = 0; $s < scalar ( @{$CALC_MODES{$m}} ); $s++ ) {
      next unless ( $CALC_MODES{$m}->[$s]->{name} eq $x );
      $$new_mode_sr = $m;
      $$new_subm_sr = $s;
      return 1;
      }
    }
  return 0;
  }

# Processors will edit or create:  res, ok, type
sub CALC_mode_processor_perl {
  my ( $CALC_hr ) = @_;
  my $CALC = ''; # THIS IS THE ACCUMULATOR
  my $CALC_cmd = $CALC_hr->{cmd};
     $CALC_hr->{'ok'} = 1;
  while ( ($CALC_cmd =~ /^(.*?[^\w])a0*(\d+)([^\w].*)/s) ||
          ($CALC_cmd =~ /^(\s*)a0*(\d+)([^\w].*)/s)         ) {
    my $pref  = $1;
    my $label = $2; 
    my $postf = $3;
    unless ( defined ( $CALC_STACK[$label] ) ) {
      $CALC_hr->{type} = 'error';
      $CALC_hr->{res}  = "ERROR: stack index out of bounds: a$label";
      return;
      }
    $CALC_cmd = $pref . "\$CALC_STACK[$label]->{res}" . $postf;
    }
  if ( ( $CALC_hr->{cmd} !~ /^\s*sub[\s\{]/ ) &&
       ( $CALC_hr->{cmd} !~ /^\s*for[\s\(]/ ) &&
       ( $CALC_hr->{cmd} !~ /^\s*foreach[\s\(]/ ) &&
       ( $CALC_hr->{cmd} !~ /^\s*while[\s\{]/ )  ) {
    $CALC_cmd = "\$CALC = $CALC_cmd";
    }
  my $CALC_res = eval ( $CALC_cmd );
  $CALC_hr->{type} = 'expr';
  if ( !defined ( $CALC_res ) ) {
    if ( $@ eq '' ) {
      $CALC_hr->{res}  = '<undef>';
      } else {
      $CALC_hr->{type} = 'error';
      $CALC_hr->{res}  = join ( ' ', split ( /[\r\n\s]+/s, $@ ) );
      $CALC_hr->{res}  = $1 if ( $CALC_hr->{res} =~ /^\s*(.+?)\s*$/ );
      }
    } else {
    $CALC_hr->{res}  = $CALC_res;
    $CALC_hr->{ok}   = 0 if ( $CALC_res eq 'CALC_DO_NOT_PUSH' );
    }
  # I think that's all .. !  Now, where am I pushing to stack and storing to ticker tape, again? zzzappp
  }

# Processors will edit or create:  res, ok, type
sub CALC_mode_processor_c {
  my ( $CALC_hr ) = @_;
  &CALC_mode_processor_stubby ( $CALC_hr ); # zzapp
  }

# Processors will edit or create:  res, ok, type
sub CALC_mode_processor_sql {
  my ( $CALC_hr ) = @_;
  &CALC_mode_processor_stubby ( $CALC_hr ); # zzapp
  }

# Processors will edit or create:  res, ok, type
sub CALC_mode_processor_shell {
  my ( $CALC_hr ) = @_;
  &CALC_mode_processor_stubby ( $CALC_hr ); # zzapp
  }

sub CALC_mode_processor_stubby { # placeholder, until more modes are implemented.
  my ( $hr ) = @_;
  $hr->{'res'}  = '';
  $hr->{'ok'}   = 0;
  $hr->{'err'}  = 'stub';
  $hr->{'type'} = 'error';
  }