################################################################
# Casio::Xfer                                                  #
#                                                              #
# Perl-module to send data to a Casio calculator via an        #
# FA-122-Interface.                                            #
#                                                              #
# Thanks to Göran Weinholt ans sebfrance, without cafix and    #
# of course libcafix i wouldn't have the knowledge about the   #
# protocol ;-)                                                 #
#                                                              #
# Casio::Xfer is distributed under the terms of the GNU        #
# General public License version 2.                            #
#                                                              #
# "Casio" and "FA-122" are registered trademarks of the Casio  #
# Computer Corporation Ltd.                                    #
#                                                              #
# -- Sebastian 'yath' Schmidt <yathen@web.de>                  #
################################################################

package Casio::Xfer;

use warnings;
use strict;

use FileHandle;
use POSIX qw( :termios_h );
use vars qw( $VERSION $DEBUG $BUFFERING );

$DEBUG = 0;
$BUFFERING = 1;
$VERSION = "0.1";

sub debug {
	my $string;
	foreach my $thisarg (@_) {
		$string .= $thisarg . " ";
	}
	$string .= "\n";
	print STDERR $string if $DEBUG;
}

##################################################################
# new() opens the serial device and sets the terminal attributes #
##################################################################
sub new {
	my $class = shift;
	my @header;
	my $self = {
		debug		=> 0,
		device		=> "/dev/ttyS1",
		buffering	=> 1,
		timeout		=> 0, # in secs.
		callback	=> \&main::status,
		totalbytes	=> 0,
		bytesproc	=> 0,
		datatype	=> 0,
		datalen		=> 0,
		unstackable	=> 0,
		overwrite	=> 0,
		dataname	=> "",
		data		=> "",
		handle		=> 0,
		status		=> -1,
		interactive	=> 0,
		crc		=> 0,
		header		=> \@header,
		headerlen	=> 0,
		subtype		=> 0,
		@_ };

	$DEBUG = $self->{debug};
	$BUFFERING = $self->{buffering};
	my $port = $self->{device};
	
	&debug("Opening FA-122 device on port \"$port\"");
	local *CASIO;
	open (CASIO, "+<$port") || return undef;
	
	&debug("Setting attributes for serial terminal");
	my $termios = new POSIX::Termios();
	
	$termios->getattr(fileno(CASIO));
	
	my $cflag = $termios->getcflag();
	
	$termios->setcflag($cflag | CREAD | CLOCAL | CS8 | PARENB | PARODD);
	$termios->setispeed(B9600);
	$termios->setospeed(B9600);

	$termios->setattr(fileno(CASIO), TCSANOW);
	
	CASIO->autoflush();
	
	$self->{handle} = *CASIO;
	
	&debug("Everything done, returning from new()");
	return bless ($self, $class);
}

#############################################################################
# cleanstructs should be called after every receive -- else some things may #
# not work correctly ;-)                                                    #
#############################################################################
sub cleanstructs {
	my $self = shift;
	$self->{totalbytes} = 0;
	$self->{bytesproc} = 0;
	$self->{datatype} = 0;
	$self->{subtype} = 13;
	$self->{datalen} = 0;
	$self->{unstackable} = 0;
	$self->{overwrite} = 0;
	$self->{dataname} = "";
	$self->{data} = "";
	$self->{status} = 0;
	# XXX: Should we reset interactive?
	# i don't think so...
	return 1;
}

############################################
# with sendbyte, we send a byte to calc %) #
############################################
sub sendbyte {
	my ($self, $byte) = @_;
	# i _hate_ that :-/
	return 0 if (!$byte =~ /^0x[0-9a-f]{1,2}$/i);
	my $handle = $self->{handle};
#	&debug("\tSending $byte (".chr(hex($byte)).")");
	my $bytecode = chr(hex($byte));

	# our timeout-routine
	local $SIG{ALRM} = sub { die "TIMEOUT" };
	alarm $self->{timeout};
	my $foo;
	eval { #isn't there any other way?
		if ($BUFFERING) {
			# FIXME: Check, if print has sent the byte really
			# but... how to do that? :)
			print $handle $bytecode;
		} else {
			$foo = syswrite $handle, $bytecode, 1;
		}
		alarm 0;
	};
	if ($@ =~ /TIMEOUT/) {
		&debug("Timeout while writing to the socket..");
		return 0;
	}
	if (!$BUFFERING) {
		return 0 if (!defined($foo) || $foo != 1);
	}
	return 1;
}

##############################
# and now, we get a byte ;-) #
##############################
sub getbyte {
	my $self = shift;
	my $byte;
	my $handle = $self->{handle};
	local $SIG{ALRM} = sub { die "TIMEOUT" };
	alarm $self->{timeout};
	my $foo;
	eval {
		if ($BUFFERING) {
			$foo = read $handle, $byte, 1;
		} else {
			$foo = sysread $handle, $byte, 1;
		}
		alarm 0;
	};
	if ($@ =~ /TIMEOUT/) {
		&debug("Timeout while reading from the socket");
		return "ERR";
	}
	my $hex = sprintf "0x%lx", ord($byte);
#	&debug("\tReceived $hex ($byte)");
	return "ERR" if (!defined($foo) || $foo != 1);
	return $hex;
	
}

########################################################################
# iseq() takes two strings as argument and checks if the decimal-value #
# of them are equal                                                    #
########################################################################
sub iseq {
	my ($one, $two) = @_;
	return 1 if (hex($one) == hex($two));
	return 0;
}

############################
# this returns the version #
############################
sub get_version {
	return $VERSION;
}

####################################################################
# this gets the current status from $self->{status} and translates #
# it into human readable text                                      #
####################################################################
sub get_status_text {
	my $self = shift;
	my $status = $self->{status};
	my @statustext = ("Nothing to do",
			"Sending",
			"Sending header",
			"Sending data",
			"Receiving",
			"Receiving header",
			"Receiving data",
			"Communication error",
			"Calculator is not ready",
			"Header error",
			"Calculator ran out of memory",
			"Checksum error",
			"Unknown error",
			"Not implemented yet",
			"Overwrite?",
			"User aborted",
			"Everything okay");

	return $statustext[$status];
}

##################################################
# send_handshake() attemps to build a connection #
##################################################
sub handshake_send
{
	my $self = shift;

	my $code;

	# we use such an ugly way, because perl can't distinguish from
	# the number 16 and the text "16" -- in the 2nd case the ascii
	# codes of the text will be sent to the calc - ant that's
	# not that what we want ;-)

	if ($self->{interactive}) {
		$code = "0x06";
	} else {
		$code = "0x16";
	}
	&debug("Requesting Handshake from calculator");
	if ($self->sendbyte($code) == 0) {
		&debug("Error while sending $code to the calc");
		$self->{status} = 7;
		return 0;
	}
	my $byte = $self->getbyte();
	
	# getbyte returns a string. yes, == -1 or anything would be better...
	if ($byte eq "ERR") {
		&debug("Error encountered while reading from the socket");
		$self->{status} = 7;
		return 0;
	}
	# why elsif? if the above is true, we'll never get here
	if ($self->{interactive} == 1 && &iseq($byte, "0x06")) {
		&debug("Interactive handshake with code 0x06 successful");
		$self->{status} = 0;
		return 1;
	}
	if ($self->{interactive} == 0 && &iseq($byte, "0x13")) {
		&debug("Non-interactive handshake with code 0x13 successful");
		$self->{status} = 0;
		return 1;
	}
	&debug("Calculator sent $byte -- that means he isn't ready");
	$self->{status} = 8;
	return 0;
}

####################################
# here, we wait for a handshake... #
####################################
sub handshake_get {
	my $self = shift;
	my $byte = $self->getbyte();
	if ($byte eq "ERR") {
		&debug("Calc is not ready");
		$self->{status} = 8;
		return 0;
	}
	if (&iseq($byte, "0x15")) {
		&debug("Received request for interactive handshake (0x15) ".
		"-- responding with 0x13");
		$self->sendbyte("0x13");
		$self->{interactive} = 1;
		return 1;
	} elsif (&iseq($byte, "0x16")) {
		&debug("Received request for noninteractive handshake (0x16) ".
		"-- responding with 0x13");
		$self->sendbyte("0x13");
		$self->{interactive} = 0;
		return 1;
	} else {
		&debug("Received $byte - don't know what to do");
		$self->{status} = 8;
		return 0;
	}
	&debug("how did we get here!?");
	return 0;
}

###################################################################
# send_data() - here we send everything the calc wants to have $) #
###################################################################
sub send_data {
	my $self = shift;
	
	if ($self->{datatype} == 8 && $self->{subtype} == 13) {
		&debug("we want to send a variable... let us".
		"convert the data");
		$self->covert_data();
	}
	
	# we set some variables, the source is easier to read then
	my $type = $self->{datatype};
	my $name = $self->{dataname};
	my $data = $self->{data};
	my $len = length($data);
	
	# Now we should calculate the crc...
	$self->{status} = 1; # sending
	$self->send_header();
	#  we do not have to send data after the end-header
	# XXX: but perhaps we have to check, if the calc accepted the header?
	return 1 if ($self->{datatype} == 9);
	
	my $byte = $self->getbyte();
	if ($byte eq "ERR") {
		&debug("Error encountered while reading from the socket");
		$self->{status} = 12;
		 &{$self->{callback}};
		return 0;
	}
	if (&iseq($byte, "0x06")) {
		&debug("Calc accepted the header");
		$self->{status} = 3;
	} elsif (&iseq($byte, "0x24")) {
		&debug("Calc is out of memory");
		$self->{status} = 10;
		 &{$self->{callback}};
		return 0;
	} elsif (&iseq($byte, "0x2b")) {
		&debug("CRC Error");
		$self->{status} = 11;
		 &{$self->{callback}};
		return 0;
	} elsif (&iseq($byte, "0x21")) {
		&debug("File already exists in calculator");
		$self->{status} = 14;
		&{$self->{callback}};
		if ($self->{overwrite} != 1) {
			&debug("user doesn't want to overwrite -- sending ".
			"abortcode..");
			$self->sendbyte("0x15");
			my $qux = $self->getbyte();
			if (!(&iseq($qux, "0x06"))) {
				&debug("calc didn't sent me $qux :/");
				$self->{status} = 12;
				&{$self->{callback}};
				return 0;
			}
			&debug("okay, calc said aborting is okay");
			$self->{status} = 15;
			&{$self->{callback}};
			# XXX: should we return 0 or 1? 1 for success,
			# or 0 for abort? i'll take 1..
			return 1;
		} else {
			&debug("we want to abort");
			$self->{overwrite} = 0;
			$self->sendbyte("0x06");
			my $blah = $self->getbyte();
			if (!(&iseq($blah, "0x06"))) {
				&debug("hum.. i got $blah from the calc");
				$self->{status} = 12;
				&{$self->{callback}};
				return 0;
			}
			&debug("okay, sending now");
			$self->{status} = 3;
		}
		
	} elsif (&iseq($byte, "0x51")) {
		&debug("Header error");
		$self->{status} = 9;
		&{$self->{callback}};
		return 0;
	} elsif (&iseq($byte, "0x00")) {
		# FIXME: No idea, what's that :-/
		&debug("fixme: calc sent 0x00 - no idea what to do");
		# göran sets in libcafix STAT_OK (16), but i think we should
		# set STAT_ERROR_UNKNOWN (12)
		$self->{status} = 12;
		&{$self->{callback}};
		return 0;
	} else {
		&debug("Calc sent something very strange... ($byte)");
		$self->{status} = 12;
		&{$self->{callback}};
		return 0;
	}
	my $crc = 0;
	for (my $i = 0; $i < $len; $i++) {
		$crc += ord(substr($data, $i, 1));
	}
	$crc = abs(255 - ($crc % 256)) + 1;
	$crc = sprintf "0x%lx", $crc;
	&debug("Calculated data-crc to be $crc");
	$self->{crc} = $crc;
	$self->sendbyte("0x3a"); # a colon

	# we have to do this after sending the checksum, because
	# send_header resets the counter again
	$self->{totalbytes} = $len;

	&debug("Okay, sending data now");
	&{$self->{callback}};	
	for ($self->{bytesproc} = 0; $self->{bytesproc} < $self->{totalbytes};){
		my $thisbyte = substr($data, $self->{bytesproc}, 1);
		$thisbyte = sprintf "0x%lx", ord($thisbyte);
		# XXX: We should implement something like status_callback()

		# *shrug* i get confused... i should continue tomorrow ;)
		if ($self->sendbyte($thisbyte) == 0) {
			&debug("Communication error, couldn't send to the ".
				"calc");
			$self->{status} = 7;
			&{$self->{callback}};
			$self->{bytesproc} = 0;
			$self->{totalbytes} = 0;
			return 0;
		}
	
		# we don't increment the counter in the for()-loop,
		# because our counter will get confused
		$self->{bytesproc}++;
	
		&{$self->{callback}};
	}
	$self->{bytesproc} = 0;
	$self->{totalbytes} = 0;
	&debug("All data sent, let the calc verify the checksum");
	$self->sendbyte($crc);
	$byte = $self->getbyte();
	if ($byte eq "ERR") {
		&debug("Communication error while reading the checksum");
		$self->{status} = 7;
		&{$self->{callback}};
		return 0;
	}
	if (!(&iseq($byte, "0x06"))) {
		$self->{status} = 11;
		&{$self->{callback}};
		&debug("CRC Error -- maybe bad cable? (\$byte is $byte)");
		return 0;
	}
	&debug("Okay, CRC is good");
	$self->{status} = 16;
	&{$self->{callback}};
	return 1;
}

#################################################
# we receive data, i.e. a variable or a picture #
#################################################
sub get_data {
	my $self = shift;
	if ($self->get_header() == 0) {
		&debug("Could not get header");
		return 0;
	}
	$self->{status} = 4; # receiving
	$self->translate_header();

	&debug("Okay, got header, translated header, now we have to get the ".
	"data");

	if ($self->{datatype} == 7) {
		&debug("datatype is 7 (Request for data), we will handle this ".
		"later");
		$self->{status} = 16;
		&{$self->{callback}};
		return 1;
	}

	if ($self->{datalen} == 0) {
		&debug("datalen is 0 -- sending 0x00");
		$self->sendbyte("0x00");
		$self->{status} = 16;
		&{$self->{callback}};
		return 1;
	}

	if ($self->{subtype} == 6) {
		&debug("fixme, MT (matrix) is unsupported");
		$self->{status} = 13;
		&{$self->{callback}};
		return 0;
	}

	&debug("we accepted the header -- so we send 0x06 to the calc");
	$self->sendbyte("0x06");
	$self->{status} = 6;
	my $foo = $self->getbyte();
	if (!(&iseq($foo, "0x3a"))) {
		$self->{status} = 7;
		&{$self->{callback}};
		return 0;
	}
	$self->{totalbytes} = $self->{datalen};
	my $crc = 0;
	for ($self->{bytesproc} = 0; $self->{bytesproc} < $self->{totalbytes};){
		my $thisbyte = $self->getbyte();
		if ($thisbyte eq "ERR") {
			$self->{status} = 7;
			&{$self->{callback}};
			&debug("could not read data drom calc");
			return 0;
		}
		$crc += hex($thisbyte);
		if ($self->{datatype} == 3 && ($self->{bytesproc} == 1024 ||
		$self->{bytesproc} == 2048)) {
			my $quux = $self->getbyte();
			$self->sendbyte("0x06");
			$quux = $self->getbyte();
			$crc = 0;
		}
		$self->{data} .= chr(hex($thisbyte));
		$self->{bytesproc}++;
		&{$self->{callback}};
	}
	my $newcrc = $self->getbyte();
	$self->sendbyte("0x06");
	$self->{status} = 16;
	&{$self->{callback}};
	if ($self->{datatype} == 8 && $self->{subtype} == 13) {
		my $olddata = $self->{data};
		&debug("arg 1 is ".ord(substr($olddata, 4, 1)) * 10);
		&debug("arg 2 is ".ord(substr($olddata, 5, 1)) / 16);	
		my $newdata = (ord(substr($olddata, 4, 1)) * 10) + (ord(substr($olddata, 5, 1)) / 16);
		$self->{data} = $newdata;
		&debug("we received a variable, so the binary-crap in ".
		"\$self->{data} has been changed to $newdata");
	}
	return 1;
}

########################################################################
# Here, we translate a variable into a data-packet. Used to respond to #
# datatype 7 subtype 13 (request for variable)                         #
########################################################################
sub covert_data {
	my $self = shift;
	if (!($self->{datatype} == 8 && $self->{subtype} == 13)) {
		$self->{status} = 13;
		&{$self->{callback}};
		return 0;
	}
	
	my $value = $self->{data};
	$self->{data} = "";
	my @newdata;
	for (my $i = 0; $i < 14; $i++) {
		$newdata[$i] = "0x00";
	}
	$newdata[1] = "0x01";
	$newdata[3] = "0x01";
	$newdata[4] = sprintf "0x%lx", int ($value / 10);
	$value -= (int ($value / 10) * 10);
	$newdata[5] = sprintf "0x%lx", int ($value * 16);
	$newdata[12] = "0x01";
	$newdata[13] = "0x01";
	for (my $i = 0; $i < 14; $i++) {
		$self->{data} .= chr(hex($newdata[$i]));
	}
	return 1;
}

################################################
# this gets the length of the data and the crc #
################################################
sub translate_header {
	my $self = shift;
	my @hdr = @{$self->{header}};
	if ($self->{datatype} == 7) {
		$self->{datalen} = 0;
		$self->{unstackable} = 1;
	} elsif ($self->{datatype} == 1) {
		$self->{datalen} = hex($hdr[8]) * 256 + hex($hdr[9]) - 2;
		$self->{unstackable} = 1;
	} elsif ($self->{datatype} == 9) {
		$self->{datalen} = 0;
		$self->{unstackable} = 1;
	} elsif ($self->{datatype} == 8) {
		$self->{datalen} = hex($hdr[8]) * 256 + hex($hdr[9]) - 2;
		if ($self->{subtype} == 13) {
			$self->{datalen} = 14;
		} elsif ($self->{subtype} == 6) {
			$self->{datalen} = 2 * (hex($hdr[8]) + hex($hdr[9]));
		}
	} elsif ($self->{datatype} == 6) {
		$self->{datalen} = hex($hdr[8]) * 256 + hex($hdr[9]) - 2;
	} elsif ($self->{datatype} == 3) {
		$self->{datalen} = 3075;
		$self->{unstackable} = 1;
	} elsif ($self->{datatyoe} == 2) {
		$self->{datalen} = 10000;
		$self->{unstackable} = 1;
	} else {
		$self->{datalen} = hex($hdr[8]) * 256 + hex($hdr[9]) - 2;
	}
	for (my $i = 0; $i < 8; $i++) {
		if (!(&iseq($hdr[10+$i], "0xff"))) {
			&debug("we'll add \"".chr(hex($hdr[10+$i]))."to the ".
			"name");
			$self->{dataname} .= chr(hex($hdr[10+$i]));
		}
	}
	$self->{datalen} = 0 if ($self->{datalen} < 0);
}		


##############################
# here, we get the header... #
##############################
sub get_header {
	my $self = shift;
	my $byte = $self->getbyte();
	if ($byte eq "ERR") {
		&debug("could not get header");
		return 0;
	}
	if (!(&iseq($byte, "0x3a"))) { # has to begin with a colon, i think
		&debug("header begins with $byte...");
		$self->{status} = 7;
		&{$self->{callback}};
		return 0;
	}
	$self->{status} = 5;
	$self->{totalbytes} = 100;
	my @hdr;
	# XXX: Fix this ugly code :-/
	for ($self->{bytesproc} = 0; $self->{bytesproc}<$self->{totalbytes};){
		my $foo = $self->getbyte();
		if ($foo eq "ERR") {
			$self->{status} = 7;
			&{$self->{callback}};
			return 0;
		}
		$hdr[$self->{bytesproc}] = $foo;

		if ($self->{bytesproc} == 7) {
			# we need this -- else get_header_format
			# can't process anything
			@{$self->{header}} = @hdr;
			
			$self->get_header_format();
			&debug("our header is ".$self->{headerlen}.
			" bytes long, has type ".$self->{datatype}.
			" and subtype ".$self->{subtype});
			$self->{totalbytes} = $self->{headerlen};
		}
		
		$self->{bytesproc}++;
		&{$self->{callback}};
	}
	@{$self->{header}} = @hdr;
	$self->{totalbytes} = 0;
	$self->{bytesproc} = 0;
	return 1;
}

######################################
# get_header_format... used internal #
######################################
sub get_header_format {
	my $self = shift;
	my @hdr = @{$self->{header}};
	my $ott = chr(hex($hdr[0])).chr(hex($hdr[1])).chr(hex($hdr[2]));
	if ($ott eq "MEM") {
		$self->{datatype} = 1;
		$self->{headerlen} = 49;
	} elsif ($ott eq "DD@") {
		$self->{datatype} = 2;
		$self->{headerlen} = 39;
	} elsif ($ott eq "DC@") {
		$self->{datatype} = 3;
		$self->{headerlen} = 39;
	} elsif ($ott eq "FNC") {
		$self->{datatype} = 4;
		$self->{headerlen} = 49;
	} elsif ($ott eq "IMG") {
		$self->{datatype} = 5;
		$self->{headerlen} = 49;
	} elsif ($ott eq "TXT") {
		$self->{datatype} = 6;
		$self->{headerlen} = 49;
	} elsif ($ott eq "VAL") {
		$self->{datatype} = 8;
		$self->{headerlen} = 49;
	} elsif ($ott eq "REQ") {
		$self->{datatype} = 7;
		$self->{headerlen} = 49;
	} elsif ($ott eq "END") {
		$self->{datatype} = 9;
		$self->{headerlen} = 49;
	} else {
		&debug("hum, what kind of data is \"$ott\"?");
		$self->{status} = 12;
		$self->{datatype} = 0;
		return 0;
	}
	
	# hum.. i want a switch() :)
	my $foo = chr(hex($hdr[4])).chr(hex($hdr[5]));
	if ($foo eq "BU") {
		$self->{subtype} = 1;
	} elsif ($foo eq "FT") {
		$self->{subtype} = 2;
	} elsif ($foo eq "GF") {
		$self->{subtype} = 3;
	} elsif ($foo eq "GM") {
		$self->{subtype} = 4;
	} elsif ($foo eq "LT") {
		$self->{subtype} = 5;
	} elsif ($foo eq "MT") {
		$self->{subtype} = 6;
	} elsif ($foo eq "PC") {
		$self->{subtype} = 7;
	} elsif ($foo eq "PG") {
		$self->{subtype} = 8;
	} elsif ($foo eq "RF") {
		$self->{subtype} = 9;
	} elsif ($foo eq "RR") {
		$self->{subtype} = 10;
	} elsif ($foo eq "SE") {
		$self->{subtype} = 11;
	} elsif ($foo eq "TR") {
		$self->{subtype} = 12;
	} elsif ($foo eq "VM") {
		$self->{subtype} = 13;
	} elsif ($foo eq "WD") {
		$self->{subtype} = 14;
	} else {
		$self->{subtype} = 0;
	}
	return 1;
}
		
#################################
# we'll send the header here... #
#################################
sub send_header {
	my $self = shift;
	$self->build_header();
	&debug("Sending the header...");
	$self->{status} = 2;
	$self->sendbyte("0x3a"); # colon
	$self->{totalbytes} = scalar @{$self->{header}};
	$self->{bytesproc} = 0;
	&{$self->{callback}};
	# *burp*
	foreach my $thisbyte (@{$self->{header}}) {
		if ($self->sendbyte($thisbyte) == 0) {
			&debug("Communication error");
			$self->{status} = 7;
			&{$self->{callback}};
			return 0;
		}
		$self->{bytesproc}++;
		&{$self->{callback}};
	}
	$self->{totalbytes} = 0;
	$self->{bytesproc} = 0;
	&debug("Header sent");
	return 1;
}

###################################################
# build the header and save it in $self->{header} #
###################################################
sub build_header {
	my $self = shift;
	my @foo; # we save the header here, and then we'll put it
		 # to $self->{header}
	$self->{headerlen} = 49;
	my $hlen = $self->{headerlen};
	# is there something like memset() in perl!?
	&debug("Generating header (type ".$self->{datatype}.")");
	for (my $i = 0; $i < $hlen; $i++) {
		$foo[$i] = "0xff";
	}
	if ($self->{datatype} == 6) { # Program
		&debug("Datatype is 6 (program)");
		$foo[0] = "0x54"; # T
		$foo[1] = "0x58"; # X
		$foo[2] = "0x54"; # T
		$foo[3] = "0x00"; # NUL
		$foo[4] = "0x50"; # P^
		$foo[5] = "0x47"; # G
		$foo[6] = "0x00"; # NUL
		$foo[7] = "0x00"; # NUL
		my $datalen = length($self->{data});
		$foo[8] = sprintf "0x%lx", $datalen / 256;		# ?
		$foo[9] = sprintf "0x%lx", ($datalen % 256) + 2;	# ??
		# give me a strncpy!
		for (my $a = 0; $a < length($self->{dataname}); $a++) {
			last if ($a > 8);
			my $bar = sprintf "0x%lx",
			ord(substr($self->{dataname}, $a, 1));
			$foo[10+$a] = $bar;
		}
		$foo[34] = "0x4e"; # N
		$foo[35] = "0x4c"; # L
	} elsif ($self->{datatype} == 9) {
		&debug("Data type is 9 (End header)");
		$foo[0] = "0x45"; # E
		$foo[1] = "0x4e"; # N
		$foo[2] = "0x44"; # D
	} elsif ($self->{datatype} == 1) {
		&debug("Data type is 1 (Backup)");
		for (my $a = 0; $a < 48; $a++) {
			my $thisbyte = substr($self->{data}, 2048 + $a, 1);
			$foo[$a] = sprintf "0x%lx", ord($thisbyte);
		}
		$foo[33] = "0x00";
		$foo[34] = "0x10";
		$foo[35] = "0x00";
		$foo[36] = "0x00";
		$foo[37] = "0x00";
		$foo[38] = "0x00";
	} elsif ($self->{datatype} == 8) {
		&debug("Data type is 8 (Variable)");
		$foo[0] = "0x56"; # V
		$foo[1] = "0x41"; # A
		$foo[2] = "0x4c"; # L
		$foo[3] = "0x00"; # NUL
		for (my $a = 0; $a < length($self->{dataname}); $a++) {
			last if ($a > 8);
			my $bar = sprintf "0x%lx",
			ord(substr($self->{dataname}, $a, 1));
			$foo[10+$a] = $bar;
		}
		$foo[18] = "0x56"; # V
		$foo[19] = "0x61"; # a
		$foo[20] = "0x72"; # r
		$foo[21] = "0x69"; # i
		$foo[22] = "0x61"; # a
		$foo[23] = "0x62"; # b
		$foo[24] = "0x6c"; # l
		$foo[25] = "0x65"; # e
		$foo[26] = "0x52"; # R
		$foo[27] = "0x0a"; # LF
		if ($self->{subtype} == 13) {
			$foo[4] = "0x56"; # V
			$foo[5] = "0x4d"; # M
			$foo[6] = "0x00"; # NUL
			$foo[7] = "0x01"; # SOH
			$foo[8] = "0x00"; # NUL
			$foo[9] = "0x01"; # SOH
		}
	} else {
		$self->{status} = 13;
		&{$self->{callback}};
		&debug("Data type ".$self->{datatype}.
			" is not implemented yet");
		return 0;
	}
	my $header_crc = 0;
	for (my $i = 0; $i < $hlen-1 ; $i++) {
		$header_crc = ($header_crc + hex($foo[$i])) % 256;
	}
	$header_crc = (0 - $header_crc) % 256;
	&debug("Header checksum is $header_crc");
	$foo[$hlen-1] = sprintf "0x%lx", $header_crc;
	
	@{$self->{header}} = @foo;
}