view release on metacpan or  search on metacpan

lib/Hex/Record.pm  view on Meta::CPAN

package Hex::Record;

use strict;
use warnings;
use Carp;

our $VERSION = '0.09';

sub new {
    my ($class, %args) = @_;

    $args{parts} = [] unless exists $args{parts};

    return bless \%args, $class;
}

sub import_intel_hex {
    my ($self, $hex_string) = @_;

    my $addr_high_dec = 0;
    my $create_part = 0;
    for my $line (split m{\n\r?}, $hex_string) {
        my ($addr, $type, $bytes_str) = $line =~ m{
		  : # intel hex start
		   [[:xdigit:]]{2}  # bytecount
		  ([[:xdigit:]]{4}) # addr
		  ([[:xdigit:]]{2}) # type
		  ([[:xdigit:]] * ) # databytes
	       	   [[:xdigit:]]{2}  # checksum
	      }ix or next;

        my @bytes = unpack('(A2)*', $bytes_str);

        # data line?
        if ($type == 0) {
            $self->write($addr_high_dec + hex $addr, \@bytes, $create_part);
            $create_part = 0;
        }
        # extended linear address type?
        elsif ($type == 4) {
            $addr_high_dec = hex( join '', @bytes ) << 16;
            $create_part = 1;
        }
        # extended segment address type?
        elsif ($type == 2) {
            $addr_high_dec = hex( join '', @bytes ) << 4;
            $create_part = 1;
        }
    }

    return;
}

sub import_srec_hex {
    my ($self, $hex_string) = @_;

    my %address_length_of_srec_type = (
        0 => 4,
        1 => 4,
        2 => 6,
        3 => 8,
        4 => undef,
        5 => 4,
        6 => 6,
        7 => 8,
        8 => 6,
        9 => 4,
    );

    my @parts;
    for my $line (split m{\n\r?}, $hex_string) {
        next unless substr( $line, 0, 1 ) =~ m{s}i;

        my $type = substr $line, 1, 1;

        my $addr_length = $address_length_of_srec_type{$type} || next;

        my ($addr, $bytes_str) = $line =~ m{
		      s #srec hex start
		   [[:xdigit:]]{1}             #type
		   [[:xdigit:]]{2}              #bytecount
		  ([[:xdigit:]]{$addr_length})  #addr
		  ([[:xdigit:]] * )             #databytes
		   [[:xdigit:]]{2}              #checksum
	      }ix or next;

        # data line?
        if ($type == 1 || $type == 2 || $type == 3) {
            $self->write(hex $addr, [ unpack '(A2)*', $bytes_str ]);
        }
    }

    return;
}

sub write {
    my ($self, $from, $bytes_hex_ref, $create_part) = @_;
    $create_part ||= 0;

    $self->remove($from, scalar @$bytes_hex_ref);

    my $to = $from + @$bytes_hex_ref;

    for (my $part_i = 0; $part_i < @{ $self->{parts} }; $part_i++) {
        my $part = $self->{parts}->[$part_i];

        my $start_addr = $part->{start};
        my $end_addr   = $part->{start} + $#{ $part->{bytes} };

        # merge with this part
        if ($create_part == 0 && $to == $start_addr) {
            $part->{start} = $from;
            unshift @{ $part->{bytes} }, @$bytes_hex_ref;
            return;
        }
        elsif ($create_part == 0 && $from == $end_addr + 1) {
            push @{ $part->{bytes} }, @$bytes_hex_ref;

            return if $part_i+1 == @{ $self->{parts} };

            my $next_part = $self->{parts}->[$part_i+1];
            # merge with next part
            if ($to == $next_part->{start}) {
                push @{ $part->{bytes} }, @{ $next_part->{bytes} };
                splice @{ $self->{parts} }, $part_i+1, 1;
            }
            return;
        }
        elsif ($from < $start_addr) {
            splice @{ $self->{parts} }, $part_i, 0, {
                start => $from,