Hardware::iButton::Device - object to represent iButtons

  use Hardware::iButton::Connection;
  $c = new Hardware::iButton::Connection "/dev/ttyS0";
  @b = $c->scan();
  foreach $b (@b) {
      print "id: ", $b->id(), ", reg0: ",$b->readreg(0),"\n";
  }

 $family = $b->family();  # "01" for DS1990A/DS2401 "id only" buttons
 $serial = $b->serial();  # "000001F1F1F3", as stamped on button
 $crc = $b->crc();        # "E5" error check byte
 $id = $b->id();   # the previous three joined together: "01000001F1F1F3E5"

  $b->select();

 $button->is_present();

 $model = $b->model();    # "DS1992"
 $bytes = $b->memsize(); # 128 bytes
 $type = $b->memtype();   # "NVRAM"
 $special = $b->specialfuncs();   # "thermometer", "clock", "java", "crypto"

 $data = $b->read_memory($start, $length);

 $b->write_memory($start, $data);

 $temp = $b->read_temperature();
 $temp = $b->read_temperature_hires();

package Hardware::iButton::Device;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;
#require AutoLoader;
use Time::HiRes qw(usleep);

@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
	
);

( $VERSION ) = '$Revision: 1.2 $ ' =~ /\$Revision:\s+([^\s]+)/;

# Preloaded methods go here.

use vars qw(%models);
%models = (
	   "01" => {
		    'model' => 'DS1990A',
		    'memsize' => 0,
		    'memtype' => "none",
		    'specialfuncs' => "",
		   },
	   "02" => {
		    'model' => 'DS1991',
		    'memsize' => 512/8,
		    'memtype' => "NVRAM",
		    'specialfuncs' => "protected nvram 3*384bits",
		   },
	   "08" => {
		    'model' => 'DS1992',
		    'memsize' => 1024/8,
		    'memtype' => "NVRAM",
		    'specialfuncs' => "",
		   },
	   "06" => {
		    'model' => 'DS1993',
		    'memsize' => 4096/8,
		    'memtype' => "NVRAM",
		    'specialfuncs' => "",
		   },
	   "05" => {
		    'model' => 'DS2405',
		    'memsize' => 0,
		    'memtype' => "none",
		    'specialfuncs' => "switch",
		    'class' => 'Hardware::iButton::Device::switch',
		   },
	   "04" => {
		    'model' => 'DS1994',
		    'memsize' => 4096/8,
		    'memtype' => "NVRAM",
		    'specialfuncs' => "clock/counter",
		   },
	   "0a" => {
		    'model' => 'DS1995',
		    'memsize' => 16*1024/8,
		    'memtype' => "NVRAM",
		    'specialfuncs' => "",
		   },
	   "0c" => {
		    'model' => 'DS1996',
		    'memsize' => 64*1024/8,
		    'memtype' => "NVRAM",
		    'specialfuncs' => "",
		   },
	   "09" => {
		    'model' => 'DS1982',
		    'memsize' => 1024/8,
		    'memtype' => "EPROM",
		    'specialfuncs' => "",
		   },
	   "0b" => {
		    'model' => 'DS1985',
		    'memsize' => 16*1024/8,
		    'memtype' => "EPROM",
		    'specialfuncs' => "",
		   },
	   "0f" => {
		    'model' => 'DS1986',
		    'memsize' => 64*1024/8,
		    'memtype' => "EPROM",
		    'specialfuncs' => "",
		   },
	   "10" => {
		    'model' => 'DS1920',
		    'memsize' => 16/8, # yes, really. two bytes.
		    'memtype' => "EEPROM",
		    'specialfuncs' => "thermometer",
		    'class' => 'Hardware::iButton::Device::DS1920',
		   },
	   
	   "14" => {
		    'model' => 'DS1971',
		    'memsize' => 256/8,
		    'memtype' => "EPROM",
		    'specialfuncs' => "??",
		   },
	   "16" => {
		    'model' => 'javabutton',
		    'memsize' => 0,
		    'memtype' => "??",
		    'specialfuncs' => "Java processor",
		    'class' => 'Hardware::iButton::Device::JavaButton',
		   },
	  );


# new is the constructor, called by Hardware::iButton::Connection::scan() to
# create the new Hardware::iButton::Device instance to return to the user
sub new {
    my($class, $connection, $raw_id) = @_;
    my $self = bless {}, $class;
    # we'll rebless ourselves into a device-specific class once we set up some
    # basic stuff
    $self->{'connection'} = $connection;
    $self->{'raw_id'} = $raw_id;

    # things the user can query about, all derived from the raw_id
    $self->{'family'} = unpack("H2",pack("b8",substr($raw_id,0,8)));
    $self->{'serial'} = unpack("H12",
			       pack("B48",
				    scalar(reverse(substr($raw_id,8,48)))));
    $self->{'crc'} = unpack("H2",pack("b8",substr($raw_id,56,8)));
    $self->{'id'} = join("",
			 $self->{'family'},$self->{'serial'},$self->{'crc'});

    # check CRC
    my $crc = Hardware::iButton::Connection::crc(0, split(//, pack("b*", 
								   $raw_id)));
    if ($crc != 0) {
	warn("crc didn't match");
    }

    # model-specific stuff
    if (defined($models{$self->{'family'}})) {
	my $m = $models{$self->{'family'}};
	foreach (keys(%$m)) {
	    #print "  $_ -> ",$m->{$_},"\n";
	    $self->{$_} = $m->{$_};
	}
	if ($m->{'class'}) {
	    bless $self, $m->{'class'};
	}
    } else {
	warn "unknown model, family code $self->{'family'}";
    }

    return $self;
}

sub family {
    return $_[0]->{'family'};
}

sub serial {
    return $_[0]->{'serial'};
}

sub crc {
    return $_[0]->{'crc'};
}

sub id {
    return $_[0]->{'id'};
}

sub select {
    my($self) = @_;
    return $self->{'connection'}->select($self->{'raw_id'});
}

sub verify {
    my($self) = @_;
    return $self->{'connection'}->verify($self->{'raw_id'});
}

sub reset {
    return $_[0]->{'connection'}->reset();
}

sub is_present {
    my($self) = @_;
    return 1 
      # XXX pointless code if return 1 above ?
      if $self->{'connection'}->scan($self->{'family'}, $self->{'serial'});
    return 0;
}

sub model {
    return $_[0]->{'model'};
}
sub memsize {
    return $_[0]->{'memsize'};
}
sub memtype {
    return $_[0]->{'memtype'};
}
sub specialfuncs {
    return $_[0]->{'specialfuncs'};
}


# common actions that all buttons can do

sub read_memory {
    my($self, $addr, $length) = @_;
    my $c = $self->{'connection'};
    $self->select();
    my $str = &Hardware::iButton::Connection::READ_MEMORY . pack("v",$addr)
      . "\xff" x $length;
    $c->send($str);
    $c->read(1+2);
    my $buf;
    $buf = $c->read($length);
    $self->reset();
    return $buf;
}

sub write_memory_page {
    my($self, $pageaddr, $chunk) = @_;
    # the data does not span a page, 
    #  i.e. ($pageaddr % 32) == (($pageaddr+length($chunk)) % 32)
    # length($chunk) <= 32
    
    my $c = $self->{'connection'};
    
    $c->reset();
    $self->select();
    my $str = &Hardware::iButton::Connection::WRITE_SCRATCHPAD . pack("v",$pageaddr);
    $str .= $chunk;
    $c->send($str);
    $c->read(length($str));
    $c->reset();

    # verify the scratchpad
    $self->select();
    $str = &Hardware::iButton::Connection::READ_SCRATCHPAD . "\xff" x 3;
    $c->send($str); $c->read(1);
    my $buf;
    $buf = $c->read(3);
    # check it! 
    #   ("right foot red.. yellow foot blue.. left right yellow blue green!")
    # the first two bytes are the address we wrote. The third is a status byte.
    my $readback_addr = unpack("v", substr($buf, 0, 2));
    if ($readback_addr != $pageaddr) {
	# address got garbled in transit
	print "address not correct: $readback_addr instead of $pageaddr\n";
	$c->reset();
	return 0; # try again
    }
    my $status = unpack("C", substr($buf, 2, 1));
    # $status byte is (AA OF PF E4 E3 E2 E1 E0)
    # AA: authorization accepted: set once COPY_SCRATCHPAD happens
    # OF: overflow flag, if data ran beyond a page
    # PF: partial flag, if we didn't send a full byte
    # E: end address, should be ($pageaddr+$length-1)%32
    if ($status & 0x80) {
	# AA flag still set, so the WRITE_SCRATCHPAD hasn't happened since
	# the last COPY_SCRATCHPAD
	print "AA flag set\n";
	$c->reset();
	return 0;
    }
    if ($status & 0x40) {
	# OF flag set, maybe we sent too many bytes, or the pageaddr got
	# garbled to make it look closer to the end of the page
	print "OF flag set\n";
	$c->reset();
	return 0;
    }
    if ($status & 0x20) {
	# PF set, some bits got dropped
	print "PF flag set\n";
	$c->reset();
	return 0;
    }
    if (($status & 0x1f) != ($pageaddr+length($chunk)-1)%32) {
	# addr isn't right
	print "addr is ",($status & 0x1f),", should be ",
	($pageaddr+length($chunk)-1)%32,"\n";
	$c->reset();
	return 0;
    }
    
    # read data out and check it
    $c->send("\xff" x length($chunk));
    $buf = $c->read(length($chunk));
    if ($buf ne $chunk) {
	# data got corrupted
	print "data readback was wrong\n";
	$c->reset();
	return 0;
    }
    $c->reset();

    # looks good
    
    # copy from scratchpad to NVRAM
    $self->select();
    $str = &Hardware::iButton::Connection::COPY_SCRATCHPAD
      . pack("v",$pageaddr) . pack("C", $status);
    $c->send($str);
    $c->read(1+2+1);
    
    # wait for it to program.. data book says 30us typ.
    # the device will respond with 1's if it's still programming
    usleep(50);
    while(1) {
	$c->send("\xff");
	$buf = $c->read(1);
	last if $buf eq "\x00";
	usleep(50*1000); # 50ms
    }
    
    # read back and verify
    
    $c->reset();
}

sub write_memory_page_loop {
    my($self, $pageaddr, $chunk) = @_;
    # try a couple of times to write
    my $times = 3;
    my $nwritten;
    while ($times) {
	print "write(times=$times,pageaddr=$pageaddr,length=",length($chunk),")\n";
	$nwritten = $self->write_memory_page($pageaddr, $chunk);
	last if $nwritten == length($chunk);
	$times--;
    }
    return $nwritten;
}

sub write_memory {
    my($self, $addr, $data) = @_;
    my $nwritten = 0;
    
    # find the first chunk boundaries: the scratchpad is like a direct-mapped
    # cache, so we can only copy to a single "page" (32-bytes) at a time.
    
    # do we need to write a partial chunk first
    if ($addr % 32) {
	# yup
	my $chunklen = 32 - ($addr % 32);
	print "chunklen is $chunklen\n";
	$nwritten += 
	  $self->write_memory_page_loop($addr, substr($data, 0, $chunklen));
	$addr += $chunklen;
	substr($data, 0, $chunklen) = '';
    }
    
    # write chunks
    while(length($data)) {
	my $chunklen = (length($data) > 32) ? 32 : length($data); # max 32
	print "chunklen is $chunklen\n";
	$nwritten += 
	  $self->write_memory_page_loop($addr, substr($data, 0, $chunklen));
	$addr += $chunklen;
	substr($data, 0, $chunklen) = '';
    }

    # done!
    return $nwritten;
}

package Hardware::iButton::Device::eeprom;
# this is a class that implements read-eeprom and write-eeprom commands.
# other device classes can inherit from this one
use strict;
use vars qw(@ISA);

# read one byte
sub read_eeprom {
    my($self, $addr) = @_;
}

# write one byte
sub write_eeprom {
    my($self, $addr, $data) = @_;
}


package Hardware::iButton::Device::switch;
use strict;
use vars qw(@ISA);
@ISA = qw(Hardware::iButton::Device);

#sub on {
#	my ($this) = @_;
#	print $this->verify() . "\n";
#	$this->select();
#}

#sub off {
#	my ($this) = @_;
#	print $this->verify() . "\n";
#	$this->select();
#}

#sub is_on {
#}

sub toggle {
	my ($this) = @_;
	$this->select();
}


package Hardware::iButton::Device::DS1920;

use Hardware::iButton::Connection;
use Time::HiRes qw(usleep);

# this is the thermometer button.
use strict;
use vars qw(@ISA);

@ISA = qw(Hardware::iButton::Device);

sub read_temperature_scratchpad {
    my($self) = @_;
    my $c = $self->{'connection'};

    $c->reset();
    $c->mode(&Hardware::iButton::Connection::SET_COMMAND_MODE);
    $c->write("\x39"); # set a 524ms pullup
    $c->read(1); # response to config command
    $c->reset();
    $self->select();
    $c->mode(&Hardware::iButton::Connection::SET_COMMAND_MODE);
    $c->write("\xef"); # arm the pullup
    $c->write("\xf1"); # terminate pulse (??)
    $c->read(1); # response to 0xf1
    $c->mode(&Hardware::iButton::Connection::SET_DATA_MODE);
    $c->send("\x44"); # start conversion. need to do a 0.5s strong pullup.
    $c->read(1); # read back 0x44
    # wait
    usleep(600*1000); # wait .6s
    $c->mode(&Hardware::iButton::Connection::SET_COMMAND_MODE);
    $c->write("\xed"); # disarm pullup
    $c->write("\xf1"); # terminate pulse
    $c->read(1); # response??

    $c->reset();
    $self->select();

    # read scratchpad, bytes 0 and 1 (LSB and MSB)
    $c->send("\xbe"); $c->read(1);
    $c->send("\xff" x 9);
    my $scratchpad = $c->read(9);
    $c->reset();
    # check CRC in last byte.
    if (Hardware::iButton::Connection::crc(0, split(//,$scratchpad))) {
	warn("scratchpadcrc was wrong");
    }
    return $scratchpad;
}

sub read_temperature {
    my($self) = @_;
    my $scratchpad = $self->read_temperature_scratchpad($self);
    my $tempnumber = unpack("v",substr($scratchpad, 0, 2));
    # now, that's really supposed to be a signed 16-bit little-endian
    # quantity, but there isn't a pack() code for such things.
    #printf("tempnumber as read is 0x%04x\n",$tempnumber);
    $tempnumber -= 0x10000 if $tempnumber > 0x8000;
    my $temp = $tempnumber / 2;
    return $temp;
}

sub read_temperature_hires {
    my($self) = @_;
    my $scratchpad = $self->read_temperature_scratchpad($self);
    my $tempnumber = unpack("v",substr($scratchpad, 0, 2));
    # now, that's really supposed to be a signed 16-bit little-endian
    # quantity, but there isn't a pack() code for such things.
    my $count_per_c = ord(substr($scratchpad, 7, 1));
    my $count_remaining = ord(substr($scratchpad, 6, 1));
    #printf("tempnumber as read is 0x%04x\n",$tempnumber);
    $tempnumber &= 0xfffe; # truncate LSB
    $tempnumber -= 0x10000 if $tempnumber > 0x8000;
    my $temp = ($tempnumber / 2) - 0.25 + 
      ($count_per_c - $count_remaining) / $count_per_c;
    return $temp;
}

package Hardware::iButton::Device::JavaButton;
use strict;
use vars qw(@ISA);

use Hardware::iButton::Connection;
use Time::HiRes qw(usleep);

# this is the Java button.
@ISA = qw(Hardware::iButton::Device);

sub send_apdu {
}

# an APDU is just a specially formatted buffer. a Command APDU is sent to the
# button, which responds with a Response APDU.
#  Command APDU:
#   byte header[4];  // CLA, INS, P1, P2
#   byte Lc;
#   byte *Data;
#   byte Le;
#  Response APDU
#   word Len;
#   byte *Data;
#   word SW;  // status word

# wrappers for those APDUs
#  Command Packet
#   byte len;
#   byte cmdbyte;
#   byte groupid;
#   byte cmddata[max=255]
#  Return Packet
#   byte CSB
#   byte groupid
#   byte datalen
#   byte cmddata[max=2048]

sub get_firmware_version_string {
    # apdu: class 0xd0, instruction 0x95, parm1 0x01, parm2 0x00
    # header = "\xd0\x95\x01\x00"
    # Lc = "\x00", data is uninitialized
    # Le = "\x00"

    # cmdbyte = 137, groupid = 0, len = 3+4 (3+apdu header) + 1 + lc + 1
    # data = header . lc . [lc bytes of data] . le

    # SendAPDU()
    # so arg to sendcibmessage is:
    #  len . cmdbyte(137) . groupid(0) . 
    #    [header(4bytes) . lc . data(lc bytes) . le]
    # sendcibmessage(data, len+1)
    # recvcibmessage

#an apdu has a 4-byte header: class, instruction, parm1, parm2. then lots
#of random data. class >= 0xd0 is for the ring itself, otherwise it is passed
#to the applet (which one?)

}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__