#!/usr/bin/perl
our $VERSION = '0.70';
# $Id: pista,v 1.5 2005/08/27 18:15:26 kissg Exp $
#
# Written by Gabor Kiss <kissg@cdata.hu>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 dated June, 1991.

require 5.6.0;
use strict;
use warnings;
no warnings qw(uninitialized);

use FindBin;
use lib "$FindBin::Bin/../lib/pista";

use Text::ParseWords;
use Getopt::Long;

use Pista::Object::Buffer;
use Pista::Object::Terminal;
use Pista::Object::Hexfile;
use Pista::Object::Pic;
use Pista::Object::Firmware;
use Pista::Programmer;

use Pista::Device;
use Pista::Util qw(CCtov);

use Dumpvalue;
my $dumper = new Dumpvalue;
my ($programmer, $deviceref, $pic, %buffers,
	$pager, $term, $prompt, $rcfile, $exiting, $exit_status);
my ($interactive, $suppress_rc, $backend, $stop_on_error);
$ENV{PAGER} = '/usr/bin/less -F -X' unless exists $ENV{PAGER};

my $GRUPID="$FindBin::Bin/../lib/pista/grupid";	
my %cmdtable = (
	quit		=>	\&cmd_exit,
	exit		=>	\&cmd_exit,
	help		=>	\&cmd_help,
	copy		=>	\&cmd_copy,
	compare		=>	\&cmd_compare,
	blankcheck	=>	\&cmd_blankcheck,
	device		=>	\&cmd_device,
	programmer	=>	\&cmd_programmer,
	erase		=>	\&cmd_erase,
	delete		=>	\&cmd_delete,
	checksum	=>	\&cmd_checksum,
	idcheck		=>	\&cmd_idcheck,
	show		=>	\&cmd_show,
	cd			=>	\&cmd_cd,
	'!'			=>	\&cmd_bang,
	'.'			=>	\&cmd_dot,
);

Getopt::Long::Configure('no_ignore_case');
$interactive = 0+(-t STDIN);
$stop_on_error = !$interactive;
GetOptions(
	"no-init"	=> \$suppress_rc,
	"init=s"	=> \$rcfile,
	"backend"	=> \$backend,
	"batch"		=> \$stop_on_error,
) or exit;
$stop_on_error = !$backend if defined $backend and !$interactive;
$rcfile = "$ENV{HOME}/.pistarc" unless defined $rcfile;
$rcfile = undef if $suppress_rc;


if ($interactive) {
	print <<'EOT';

==============================================================================

			*** Warning! ***

This is a beta release.
It may occur that your PIC won't be programmed successfully. Be careful.

Send any bug reports, hints, questions to <kissg@cdata.hu> and/or
<gnupic@linuxhacker.org>.

==============================================================================

EOT
	$ENV{PERL_RL} = " o=0";		# disable ornaments
	open(TERMOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
	$term = Term::ReadLine->new('pista', *STDIN, *TERMOUT) or die "no ReadLine";
	$term->MinLine(undef) if ($term->Features->{minline});
	$prompt = 'Pista> ';
}
else {
	$term = Pista::Util::ReadLine->new('pista', *STDIN, *STDOUT);
}

if (-r "$rcfile") {
	dotfile("$rcfile");
}

#sub complete_command_verb {
#	$dumper->dumpValue(\@_);
#	return ();
#}

# main loop
#$term->Attribs->{attempted_completion_function} = \&complete_command_verb;
my $lastline;
while ( !$exiting and defined ($_ = $term->readline($prompt)) ) {
	next unless /\S/;
	if ($term->Features->{addHistory}) {
		$term->AddHistory($_) unless $_ eq $lastline;
		$lastline = $_;
	}
	next if $exit_status = process_cmd($_);
	last if $stop_on_error;
}

if (defined $_) {
	if ($exiting) {		# 'exit' command was executed
		$exit_status = 1;
	}
	elsif ($stop_on_error) { # batch mode. consume input
		while ( defined $term->readline('consume input') ) { };
	}
}
elsif ($interactive) {
	print "\n";
}

exit !$exit_status;

sub dotfile {
	my $filename = shift;
	my $fh = IO::File->new($filename, 'r');
	if (!$ fh) {
		print "550 Cannot open file '$filename': $!\n";
		return;
	}
# TODO: Encapsulate batch commands' output
	while ($_ = $fh->getline) {
		next unless /\S/;
		next if /^#/;
		process_cmd($_) or return;
	}
	return 1;
}

sub process_cmd {
	my $command_line = shift;
	if ($command_line =~ /^\s*([!\|]+)(.*)$/) {
		$command_line = join(' ', split(//,$1),$2);
	}
	my @words = &shellwords($command_line);
	$_ = shift @words;
	if ($_ eq '|') {
		$pager = $ENV{PAGER};
		$_ = shift @words;
	}
	else {
		$pager = undef;
	}

	if (!exists $cmdtable{$_}) {
		print "501 Unknown command\n";
		return undef;
	}

	my $status;
	if ($pager) {
		no warnings 'once';
		open(OLDOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
		open(STDOUT, "| $pager") or open(STDOUT, ">&OLDOUT");
		local $SIG{PIPE} = 'IGNORE';
		$status = &{$cmdtable{$_}}(@words);
		close(STDOUT);
		open(STDOUT, ">&OLDOUT") or die "Can't dup OLDOUT: $!";
	}
	else {
		$status = &{$cmdtable{$_}}(@words);
	}
	return $status;
}

sub cmd_exit {
	print "201 Exiting\n";
	$exiting = 1;
	return 0;
}

sub cmd_bang {
	print "170-Running external command\n".
		"170 Don't forget to chop a dot from line beginning\n";
	if (!open(CMD,join(' ', @_, '|'))) {		# IS THIS SECURE???
		print "574 Cannot run external command: $!\n";
		return;
	}
	while ($_ = <CMD>) {
		$_ = '.'.$_ if ($_ =~ /^\./);
		print;
	}
	close(CMD);
	print "\n.\n272 External command execution finished\n";
}

sub cmd_dot {
	# TODO: check endless recursion
	# TODO: make empty files produce 2xx reply code
	my $file = shift;
	print "171 Processing command file $file\n";
	return dotfile($file);
}

sub cmd_cd {
	if (!chdir($_[0])) {
		print "550 Cannot chdir to '$_[0]': $!\n";
		return;
	}
	chomp(my $cwd = `pwd`);
	print "250 Current working directory is $cwd\n";
}

sub cmd_help {
	$_ = shift;
	if (!$_ or $_ eq 'help' or !exists $cmdtable{$_}) {
		print "110 Available commands:\n";
		my $cmds = join(' ',sort keys %cmdtable);
		$cmds =~ s/([\w ]{60,78}?) /$1\n/g;
		print "$cmds\n.\n";
		print "210-Commands preceded by '|' send its output to \$PAGER.\n";
		print "210 Try 'help <command>' for more specific info\n";
	}
	elsif ($_ eq '!') {
		print "210 '! command' - run external command via /bin/sh\n";
	}
	elsif ($_ eq '.') {
		print "210 '. file' - run commands from file\n";
	}
	elsif ($_ eq 'cd') {
		print "210 'cd [dir]' - change current working directory\n";
	}
	elsif (defined $cmdtable{$_}) {
		&{$cmdtable{$_}}('--help');
	}
	else {
		print "210 Enter 'quit' or 'exit' to leave this program.\n";
	}
	return 1;
}

# Set programmer type and port
sub cmd_programmer {
	my $newprogrammer = Pista::Programmer->new(@_);
	return unless ref $newprogrammer;
	$programmer = $newprogrammer;
	$deviceref = $programmer->grupid($deviceref) if $deviceref;
	return $programmer;
}

# Set PIC type
sub cmd_device {
	my $devname = shift;
	my $newdeviceref = Pista::Device->new($GRUPID, $devname,
						'interactive' => $interactive);
	return unless ref $newdeviceref;
	$deviceref = $newdeviceref;
	$deviceref = $programmer->grupid($deviceref) if $programmer;
	return $deviceref;
}

# Check device ID
sub cmd_idcheck {
	if ($_[0] eq '--help') {
		print "210 'idcheck' - verifies device ID\n";
		return;
	}
	my $range = Pista::Device::setup_range($deviceref, 'devid') or return;
	my $pic = Pista::Object::Pic->new($programmer, $deviceref) or return;
	my $buf = $pic->read('range' => $range) or return;

	my ($actual_devid, $mask, $value, $revmask);
	if ($deviceref->{devid}->{width} == 2) {
		$actual_devid	= $buf->{devid}->{content}->[0];
		$mask			= $deviceref->{devid}->{mask}->[0];
		$value			= $deviceref->{devid}->{value}->[0];
		$revmask		= $deviceref->{devid}->{revmask}->[0];
	}
	else {
		$actual_devid	= CCtov($buf->{devid}->{content})->[0];
		$mask			= CCtov($deviceref->{devid}->{mask})->[0];
		$value			= CCtov($deviceref->{devid}->{value})->[0];
		$revmask		= CCtov($deviceref->{devid}->{revmask})->[0];
	}

	if (($actual_devid & $mask) != $value) {
		print "560 Device $deviceref->{dev} not found\n";
		return;
	}
	printf "241 Device $deviceref->{dev} (revision %d) found\n",
		$actual_devid & $revmask;
}

# Copy data
sub cmd_copy {
	my ($o_suppressblank, $o_range, $o_force, $o_help, $range);
	{
		local @ARGV = @_;
		local $SIG{__WARN__} = sub { print "500 $_[0]"; };
		$o_suppressblank = $o_force = 0;
		GetOptions(
			'suppressblank|noblank'	=> \$o_suppressblank,
			'range=s'				=> \$o_range,
			'force|norestore'		=> \$o_force,
			'help'					=> \$o_help,
		) or return;
		@_ = @ARGV;
	};
	if ($o_help) {
		return print "210-'copy [--suppressblank] [--range=range] [--force] src dst'".
			" - copy selected\n".
			"210 content of src object to dst\n";
	}
	$range = Pista::Device::setup_range($deviceref, $o_range) or return;

	if ($#_ < 1) {
		return print "500 Syntax error. Try 'help copy'.\n";
	}
	my $dst = pop;
	my $src = shift;	# multiple source objects may be allowed in later program versions
	my ($srcobj, $dstobj);

	$dst = "file:$dst" while ($dst !~ /^(file|term|pic|buf|firmware):(.*)?$/);
	if ($1 eq 'file') {
		my $filename = $2;
		$dstobj = Pista::Object::Hexfile->new($2, 'w', $deviceref)
			or return;
	}
	elsif ($1 eq 'term') {
		$dstobj = Pista::Object::Terminal->new($term, $deviceref)
			or return;
	}
	elsif ($1 eq 'pic') {
		$dstobj = Pista::Object::Pic->new($programmer, $deviceref)
			or return;
	}
	elsif ($1 eq 'firmware') {
		$dstobj = Pista::Object::Firmware->new($programmer, $deviceref)
			or return;
	}
	elsif ($1 eq 'buf') {
		my $buffername = $2;
		if (exists $buffers{$buffername}) {
			$dstobj = $buffers{$buffername};
		}
		else {
			$buffers{$buffername} = $dstobj = Pista::Object::Buffer->new();
		}
	}

	$src = "file:$src" while ($src !~ /^(file|term|pic|buf):(.*)?$/);
	if ($1 eq 'file') {
		$srcobj = Pista::Object::Hexfile->new($2, 'r', $deviceref)
			or return;
	}
	elsif ($1 eq 'term') {
		$srcobj = Pista::Object::Terminal->new($term, $deviceref)
			or return;
	}
	elsif ($1 eq 'pic') {
		$srcobj = Pista::Object::Pic->new($programmer, $deviceref)
			or return;
	}
	elsif ($1 eq 'buf') {
		my $buffername = $2;
		if (exists $buffers{$buffername}) {
			$srcobj = $buffers{$buffername};
		}
		else {
			print "572 No such buffer: $buffername\n";
			return;
		}
	}

	$srcobj->copy($dstobj,
				'noblank'	=> $o_suppressblank,
				'range'		=> $range,
				'force'		=> $o_force
	) or return;
	print "230 Data copied\n";
}

sub cmd_checksum {
	my ($o_range, $range, $o_help);
	{
		local @ARGV = @_;
		local $SIG{__WARN__} = sub { print "500 $_[0]"; };
		GetOptions(
			'range=s'	=> \$o_range,
			'help'		=> \$o_help,
		) or return;
		@_ = @ARGV;
	}
	if ($o_help) {
		print "210-'checksum [--range=range] [src]' - compute checksum\n".
			"210 default source object is pic:\n";
		return;
	}
	$range = Pista::Device::setup_range($deviceref,
		$o_range || 'max_of:,prog,cal,userid,eeprom,conf')
		or return;

	my $srcobj = Pista::Object::Pic->new($programmer, $deviceref);
	return $srcobj->checksum('range' => $range);
}

sub cmd_compare {
print "502 Unimplemented command\n";
	return;
}

sub cmd_blankcheck {
	my ($o_range, $range, $o_help);
	{
		local @ARGV = @_;
		local $SIG{__WARN__} = sub { print "500 $_[0]"; };
		GetOptions(
			'range=s'	=> \$o_range,
			'help'		=> \$o_help,
		) or return;
		@_ = @ARGV;
	}
	if ($o_help) {
		return print "210-'blankcheck [--range=range] [src]' - check if selected ranges are empty\n".
			"210 default source object is pic:\n";
	}
	$range = Pista::Device::setup_range($deviceref,
		$o_range || 'max_of:,prog,cal,userid,eeprom,conf')
		or return;

	my $src = shift;
	my $srcobj;
	$src = 'pic:' unless $src;
	$src = "file:$src" while ($src !~ /^(file|term|pic|buf):(.*)?$/);
	if ($1 eq 'file') {
		$srcobj = Pista::Object::Hexfile->new($2, 'r', $deviceref) or return;
	}
	elsif ($1 eq 'term') {
		$srcobj = Pista::Object::Terminal->new($term, $deviceref) or return;
	}
	elsif ($1 eq 'pic') {
		$srcobj = Pista::Object::Pic->new($programmer, $deviceref) or return;
	}
	elsif ($1 eq 'buf') {
		my $buffername = $2;
		if (exists $buffers{$buffername}) {
			$srcobj = $buffers{$buffername};
		}
		else {
			print "572 No such buffer: $buffername\n";
			return;
		}
	}

	return $srcobj->blankcheck('range' => $range);
}

# Erase data
sub cmd_erase {
	my ($o_norestore, $o_range, $range, $o_help);
	{
		local @ARGV = @_;
		local $SIG{__WARN__} = sub { print "500 $_[0]"; };
		$o_norestore = 0;
		GetOptions(
			'range=s'	=> \$o_range,
			'norestore'	=> \$o_norestore,
			'help'		=> \$o_help,
		) or return;
		@_ = @ARGV;
	}
	if ($o_help) {
		return print "210 'erase [--range=range] [--norestore] dst' ".
			"- erase selected area of dst object\n";
	}
	if ($o_range) {
		$range = Pista::Device::setup_range($deviceref, $o_range) or return;
	}

	my ($dst) = shift;
	if (!$dst) {
		print "500 Syntax error. Try 'help erase'.\n";
		return;
	}
	my $dstobj;

	$dst = "file:$dst" while ($dst !~ /^(file|term|pic|buf):(.*)?$/);
	if ($1 eq 'file') {
		$dstobj = Pista::Object::Hexfile->new($2, 'r', $deviceref) or return;
	}
	elsif ($1 eq 'pic') {
		$dstobj = Pista::Object::Pic->new($programmer, $deviceref) or return;
	}
	elsif ($1 eq 'buf') {
		my $buffername = $2;
		if (exists $buffers{$buffername}) {
			$dstobj = $buffers{$buffername};
		}
		else {
			print "572 No such buffer: $buffername\n";
			return;
		}
	}
	elsif ($1 eq 'term') {
		print "573 No way to erase term: device\n";
		return;
	}

	$dstobj->erase('range' => $range, 'norestore' => $o_norestore);
	return print "232 Object has been modified\n";
}

# Delete object
sub cmd_delete {
	my ($o_norestore, $o_help);
	{
		local @ARGV = @_;
		local $SIG{__WARN__} = sub { print "500 $_[0]"; };
		$o_norestore = 0;
		GetOptions(
			'norestore'	=> \$o_norestore,
			'help'		=> \$o_help,
		) or return;
		@_ = @ARGV;
	}
	if ($o_help) {
		return print "210 'delete [--norestore] dst' - delete dst object\n";
	}

	my ($dst) = shift;
	if (!$dst) {
		print "500 Syntax error. Try 'help delete'.\n";
		return;
	}

	if ($dst !~ /^(file|term|pic|buf):(.*)?$/) {
		print "575 Unknown object: $dst. Use explicit file: prefix\n";
		return;
	}

	if ($1 eq 'file') {
		if (!unlink($2)) {
			print "550 Cannot unlink file $2: $!\n";
			return;
		}
		return print "272 File $2 deleted\n";
	}
	if ($1 eq 'pic') {
		my $dstobj = Pista::Object::Pic->new($programmer, $deviceref) or return;
		$dstobj->erase('norestore' => $o_norestore);
		return print "243 Chip erased\n";
	}
	if ($1 eq 'buf') {
		my $buffername = $2;
		if (!exists $buffers{$buffername}) {
			print "572 No such buffer: $buffername\n";
			return;
		}
		delete $buffers{$buffername};
		return print "271 buf:$buffername deleted\n";
	}
	if ($1 eq 'term') {
		print "573 No way to delete term: device\n";
		return;
	}
}

sub cmd_show {
	my ($what) = @_;

	if ($what eq '--help') {
		print "210-'show buffers' - list available buffers\n".
			"210-'show programmer' - show selected programmer\n".
			"210-'show version' - show program version\n".
			"210 'show device' - show selected chip\n";
	}
	elsif ($what eq 'buffers') {
		my @buflist = sort keys %buffers;
		print "112 Available buffers:\n";
		for (@buflist) {
			$_ = '.' . $_ if (/^\./);
			print "$_\n";
		}
		print ".\n" . "231 Buffer list finished\n";
	}
	elsif ($what eq 'device') {
#$dumper->dumpValue($deviceref);
		if (!$deviceref) {
			print "440 No device selected\n";
			return;
		}
		print "140 Device characteristics:\n";
		print "Chip type:\t$deviceref->{dev}\n";
		print "Addressing mode:\u$deviceref->{addressing}\n";
		printf "Program memory:\t0x%.4x-0x%.4x\n",
			$deviceref->{prog}->{addr}, $deviceref->{prog}->{end};
		printf "Calibr. area:\t0x%.4x-0x%.4x\n",
			$deviceref->{cal}->{addr}, $deviceref->{cal}->{end}
			if exists $deviceref->{cal};
		printf "User ID:\t0x%.4x-0x%.4x\n",
			$deviceref->{userid}->{addr},$deviceref->{userid}->{end}
			if exists $deviceref->{userid};
		printf "Device ID:\t0x%.4x-0x%.4x\n",
			$deviceref->{devid}->{addr}, $deviceref->{devid}->{end}
			if exists $deviceref->{devid};
		printf "Configuration:\t0x%.4x-0x%.4x\n",
			$deviceref->{conf}->{addr}, $deviceref->{conf}->{end}
			if exists $deviceref->{conf};
		printf "EEPROM:\t\t0x%.4x-0x%.4x\n",
			$deviceref->{eeprom}->{addr},$deviceref->{eeprom}->{end}
			if exists $deviceref->{eeprom};
		print "Features:\t", $deviceref->{features}->{rewritable} ?
				"Rewritable" : "OTP";
		print ", Parity" if $deviceref->{features}->{parity};
		print "\n";

		print ".\n"."244 Done\n";
	}
	elsif ($what eq 'programmer') {
		if (!$programmer) {
			print "420 No programmer selected\n";
			return;
		}
		$programmer->show if $programmer->can('show');
	}
	elsif ($what eq 'version') {
		print "211 Program version is $VERSION.\n";
	}
	else {
		print "500 Syntax error. Try 'help show'.\n";
		return;
	}
	return 1;
}

# vi: ts=4 sw=4
