XML::Handler::Pdb - Generate a Palm PDB from XML data

 use XML::SAX::Machines qw(Pipeline);
 use XML::Handler::Pdb;

 Pipeline( XML::Handler::Pdb->new( Output => $outfile )->parse_uri("pdb.xml") ); 

 use XML::SAX;
 use XML::Handler::Pdb;

 XML::SAX::ParserFactory->parser(
	Handler => XML::Handler::Pdb->new(
		Verbose => 0,
		Output => $output
		)
	)->parse_uri($source);

# $Id: Pdb.pm,v 1.4 2003/04/06 21:17:47 cvsjohan Exp $

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

our $VERSION = '0.2';

use base 'XML::Handler::Subs';

use Carp;
use Palm::PDB;
use Palm::Raw;
use File::Temp 'tempfile';

sub new {
	my ($proto, %arg) = @_;

	my $self = $proto->SUPER::new(%arg);

	$self->{_verbose} = $arg{Verbose} || 0; 

	print "Output to ", $self->{Output}, "\n" if $self->{_verbose};

	if (!defined($self->{Output})) {
		( $self->{_TempFH}, $self->{_Tempfile} ) = tempfile;
		$self->{_Output} = $self->{_Tempfile};
	} else {
		$self->{_Output} = $self->{Output};
	} 
	return $self;
}

sub s_pdb {
	my ($self, $el) = @_;

	print "start pdb\n" if $self->{_verbose};

	my $pdb = Palm::Raw->new;
	$pdb->{"name"} = $el->{Attributes}{"{}name"}{Value};
	$pdb->{"type"} = "DATA";
	$pdb->{"creator"} = $el->{Attributes}{"{}creator"}{Value};
	$self->{_pdb} = $pdb;
}

sub e_pdb {
	my ($self, $el) = @_;

	print "end pdb\n" if $self->{_verbose};

	$self->{_pdb}->Write($self->{_Output});
	if (defined $self->{_TempFH}) {
		my $fh = $self->{_TempFH};
		my $buf;
		while ($fh->read($buf, 2048)) { print $buf };
		$fh->close;	
	}
	$self->{_pdb} = undef;
}

sub s_record {
	my ($self, $el) = @_;

	print "start record\n" if $self->{_verbose};
	
	$self->{_actual_record} = $self->{_pdb}->new_Record;	
	$self->{_actual_record}->{"category"} 
		= $el->{Attributes}{"{}category"}{Value} || 0;
}

sub e_record {
	my ($self, $el) = @_;

	print "end record\n" if $self->{_verbose};

	$self->{_pdb}->append_Record($self->{_actual_record});
	$self->{actual_record} = undef;
}

sub s_field {
	my ($self, $el) = @_;

	print "start field\n" if $self->{_verbose};

	my $type = $el->{Attributes}{"{}type"}{Value};
	$self->{_field_type} = $type;

	if (exists($el->{Attributes}{"{}value"})) {
		$self->{_field_value} = $el->{Attributes}{"{}value"}{Value};
	}
}

sub e_field {
	my ($self, $element) = @_;

	my $data;
	my $type = $self->{_field_type};

	print "type := $type\n" if $self->{_verbose};
	if ($self->{_verbose} && defined $self->{_field_value}) {
		print "value := ", $self->{_field_value}, "\n";
	}
	if ($self->{_verbose} && defined $self->{_chars}) {
		print "value := ", $self->{_chars}, "\n";
	}

	# For each type, transform the type to the NSBasic equivalent ...
	#
	if 		($type eq 'text') {
		# Text does not need processing
		$data = $self->{_chars} . "\0";
	} elsif ($type eq 'int') {
		# Int is stored i/t attribute
		$data = pack("N", $self->{_field_value});
	} elsif ($type eq 'date') {
		# Date
		my $packed = pack("d", 
				$self->convert_date_to_nsbasic($self->{_field_value})); 
		$data = pack("C*", reverse unpack("C*", $packed));
	} elsif ($type eq 'time') {
		# Time
		my $packed = pack("d", 
				$self->convert_time_to_nsbasic($self->{_field_value}));
		$data = pack("C*", reverse unpack("C*", $packed));
	} elsif ($type eq 'byte') {
		# Byte
		$data = pack("C", $self->{_field_value});
	} elsif ($type eq 'float' || $type eq 'double') {
		# Float and double
		my $packed = pack("d", $self->{_field_value});
		$data = pack("C*", reverse unpack("C*", $packed));
	} elsif ($type eq 'short') {
		# 16 bit signed int
		$data = pack("n", $self->{_field_value});
	}
	$self->{_chars} = undef;	
	$self->{_field_type} = undef;
	$self->{_field_value} = undef;
	$self->{_actual_record}->{"data"} .= $data;

	print "end field\n" if $self->{_verbose};
}

sub characters {
	my ($self,$chars) = @_;

	print "characters ...\n" if $self->{_verbose};

	return unless $self->in_element('field');
	
	print "characters in field ...\n" if $self->{_verbose};

	$self->{_chars} .= $chars->{Data};
}

sub convert_date_to_nsbasic {
	my ($self, $rawdate) = @_;
	
	my ($year, $month, $day) = ( $rawdate =~ /(\d+)-(\d+)-(\d+)/ );
	return ($year-1900)*10000+$month*100+$day;
}

sub convert_time_to_nsbasic {
	my ($self, $rawdate) = @_;

	my ($hour, $minute, $second) = ( $rawdate =~ /(\d+):(\d+):(\d+)/ );
	return $hour*10000+$minute*100+$second;
}

1;

__END__