File Coverage

blib/lib/XML/Generator/Pdb.pm

Criterion	Covered	Total	%
statement	12	78	15.3
branch	0	24	0.0
condition	0	6	0.0
subroutine	4	9	44.4
pod	0	5	0.0
total	16	122	13.1

# $Id: Pdb.pm,v 1.1.1.1 2003/04/06 21:20:57 cvsjohan Exp $

package XML::Generator::Pdb;
use strict;
use warnings;

our $VERSION = '0.1';

use Palm::Raw;
use Palm::PDB;

sub new {
	my ($proto, %arg) = @_;
	my $class = ref($proto) || $proto;
	my $self = { %arg };
	bless $self, $class;

	$self->{PDBFile} || die "Please provide a 'PDBFile'";
	$self->{Layout} || die "I need a 'Layout'";

	return $self;
}

sub parse {
	my $self = shift;

	# Open PDB
	my $pdb = Palm::PDB->new;
	$pdb->Load( $self->{PDBFile} ) || croak( "Couldn't open PDB: $!" );
	my @records = @{$pdb->{"records"}};

	# Produce header and pdb start tag
	$self->{Handler}->start_document();
	$self->{Handler}->start_element(
				{
					Name => 'pdb',
					Attributes =>
						{
							type => $pdb->{"type"},
							name => $pdb->{"name"},
							creator => $pdb->{"creator"}
						}
				});

	# For each element, try to parse and generate
	for my $record (@records) {
		$self->{Handler}->start_element(
					{
						Name => 'record',
						Attributes =>
							{
								category => $record->{"category"}
							}
					});

		my $data = $record->{"data"};
		my $offset = 0;
		for my $field (@{$self->{Layout}}) {
			if 		($field eq 'int') {
				my $value = unpack("N", substr($data, $offset, 4));
				$offset += 4;
				$self->field($field, $value, undef);
			} elsif	($field eq 'date') {
				my $raw = pack("C*",reverse unpack("C*",substr($data,$offset,8)));
				my $unpacked = unpack("d", $raw);
				my $value = $self->convert_date_from_nsbasic( $unpacked );
				$offset += 8;
				$self->field($field, $value, undef);
			} elsif ($field eq 'time') {
				my $raw = pack("C*",reverse unpack("C*",substr($data,$offset,8)));
				my $unpacked = unpack("d", $raw);
				my $value = $self->convert_time_from_nsbasic( $unpacked );
				$offset += 8;
				$self->field($field, $value, undef);
			} elsif ($field eq 'byte') {
				my $value = unpack("C", substr($data, $offset, 1));
				$offset += 1;
				$self->field($field, $value, undef);
			} elsif ($field eq 'float' || $field eq 'double') {
				my $raw = pack("C*",reverse unpack("C*",substr($data,$offset,8)));
				my $value = unpack("d", $raw);
				$offset += 8;
			} elsif ($field eq 'short') {
				my $value = unpack("n", substr($data, $offset, 2));
				$offset += 2;
				$self->field($field, $value, undef);
			} elsif ($field eq 'text') {
				my ($content) = ( substr($data, $offset) =~ /^(.+?)\0/ );
				$offset += length($content) + 1;
				$self->field($field, undef, $content);
			} else {
				warn "Unsupported field type: $field";
			}
		}

		$self->{Handler}->end_element(
					{
						Name => 'record'
					});
	}

	$self->{Handler}->end_element(
			{
				Name => 'pdb'
			});
	$self->{Handler}->end_document();
}

sub field {
	my ($self, $field, $value, $content) = @_;

	my $el = {
				Name => 'field',
				Attributes =>
					{
						type => $field
					}
			 };
	$el->{Attributes}->{value} = $value if $value;
	$self->{Handler}->start_element( $el );

	$self->{Handler}->characters({ Data => $content }) if $content;

	$self->{Handler}->end_element(
				{
					Name => 'field'
				});
}

sub convert_date_from_nsbasic {
	my ($self, $raw) = @_;

	my $year = int($raw / 10000) + 1900;
	my $month = int(($raw - ($year-1900)*10000) / 100);
	my $day = $raw - ($year-1900)*10000 - $month*100;

	return sprintf("%04d-%02d-%02d", $year, $month, $day);
}

sub convert_time_from_nsbasic {
	my ($self, $raw) = @_;

	my $hour = int($raw / 10000);
	my $minute = int(($raw - $hour*10000) / 100);
	my $second = $raw - $hour*10000 - $minute*100;

	return sprintf("%02d:%02d:%02d", $hour, $minute, $second);
}

1;

__END__