#!/usr/bin/perl

#
# Convertor MAMPro 2.4 PDB database to CSV format.
#
# Copyright (C) 2001 by Konstantin Voschanov
#

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

# Load handler for the MAM Pro
use Palm::MAMPro;

use vars qw( $VERSION %PDBHandlers %PRCHandlers $hexdump );

*PDBHandlers = *Palm::PDB::PDBHandlers;
*PRCHandlers = *Palm::PDB::PRCHandlers;

&Palm::PDB::RegisterPRCHandlers("Palm::Raw",
	[ "", "" ],
	);


my $hexdump = 0;	# By default, no print hex dumps of everything
my $palm_home;
my $prefix;
my $arg;

# Parse command-line arguments

while ( $arg = $ARGV[0] )
	{
	$arg = shift;

	if ($arg =~ /^-palm_home=(.+)/)
		{ $palm_home = $1; } 
	elsif ($arg eq "-hex")
		{ $hexdump = 1; } 
	else 
		{
		$0 =~ /(\w+)$/;
		my $script = $1; 

		print <<EOT;
Usage: $script [options] 
Options:
	-h, -help		This message.
	-hex			Print hex dumps. You probaly never need this.
	-palm_home=<dir>	Path to the MAM Pro PDB files MAM_W_*.pdb
				Default is \$HOME/.jpilot/backup

EOT
#'
		exit 0;
		}
	}


if( defined $ENV{MAMPRO_DATA_HOME} )
	{ $prefix = $ENV{MAMPRO_DATA_HOME} }
if( $palm_home )
	{ $prefix = $palm_home }
else
	{ $prefix = "$ENV{HOME}/.jpilot/backup"; }


my (%cats, %accs, %curr, %trip, %proj);

&mampro_dbs_read( "$prefix/MAM_W_Category.pdb",\&parse_category_record,\%cats);
&mampro_dbs_read( "$prefix/MAM_W_Account.pdb", \&parse_account_record, \%accs);
&mampro_dbs_read( "$prefix/MAM_W_Currency.pdb",\&parse_currency_record,\%curr);
&mampro_dbs_read( "$prefix/MAM_W_Trip.pdb",    \&parse_category_record,\%trip);
&mampro_dbs_read( "$prefix/MAM_W_Project.pdb", \&parse_category_record,\%proj);



&mampro_read( "$prefix/MAM_W_DB.pdb", \%cats,\%accs,\%curr,\%trip,\%proj);



sub mampro_read
{
	my $self = new Palm::Raw;
	my $fname = shift;		# Filename to read from
	my $cats = shift;
	my $accs = shift;
	my $curr = shift;
	my $trip = shift;
	my $proj = shift;

	my $buf;			# Buffer into which to read stuff

	my $HeaderLen = 32+2+2+(9*4);		# Size of database header
	my $RecIndexHeaderLen = 6;		# Size of record index header

	# Open database file
	open PDB, "< $fname" or die "Can't open \"$fname\": $!\n";
	binmode PDB;			# Parse as binary file under MS-DOS

	# Get the size of the file. It'll be useful later
	seek PDB, 0, 2;		# 2 == SEEK_END. Seek to the end.
	$self->{_size} = tell PDB;
	seek PDB, 0, 0;		# 0 == SEEK_START. Rewind to the beginning.

	# Read header

	read PDB, $buf, $HeaderLen;	# Read the PDB header

	# Split header into its component fields
	my ($name, $attributes, $version, $ctime, $mtime, $baktime,
	$modnum, $appinfo_offset, $sort_offset, $type, $creator,
	$uniqueIDseed) =
		unpack "a32 n n N N N N N N a4 a4 N", $buf;

	# _appinfo_offset and _sort_offset are private fields
	$self->{_appinfo_offset} = $appinfo_offset;
	$self->{_sort_offset} = $sort_offset;
	$self->{type} = $type;
	$self->{creator} = $creator;

	unless( $creator eq 'MAM2' )
		{ die "\"$fname\" is not a MAM Pro 2.4 data file\n"; }

	# Rebless this PDB object, depending on its type and/or
	# creator. This allows us to magically invoke the proper
	# &Parse*() function on the various parts of the database.

	# Look for most specific handlers first, least specific ones
	# last. That is, first look for a handler that deals
	# specifically with this database's creator and type, then for
	# one that deals with this database's creator and any type,
	# and finally for one that deals with anything.

	my $handler;
	if ($self->{attributes}{resource})
	{
		# Look among resource handlers
		$handler = $PRCHandlers{$self->{creator}}{$self->{type}} ||
			$PRCHandlers{undef}{$self->{type}} ||
			$PRCHandlers{$self->{creator}}{""} ||
			$PRCHandlers{""}{""};
	} else {
		# Look among record handlers
		$handler = $PDBHandlers{$self->{creator}}{$self->{type}} ||
			$PDBHandlers{""}{$self->{type}} ||
			$PDBHandlers{$self->{creator}}{""} ||
			$PDBHandlers{""}{""};
	}

	if (defined($handler))
	{
		bless $self, $handler;
	} else {
		# XXX - This should probably return 'undef' or something,
		# rather than die.
		die "No handler defined for creator \"$creator\", type \"$type\"\n";
	}

	## Read record/resource index
	# Read index header
	read PDB, $buf, $RecIndexHeaderLen;

	my $next_index;
	my $numrecs;

	($next_index, $numrecs) = unpack "N n", $buf;
	$self->{_numrecs} = $numrecs;

	# Read the index itself
	if ($self->{attributes}{resource})
	{
		die "Here must be _load_rsrc_index function";
	} else {
		&skip_rec_index($self, \*PDB);
	}

	# Ignore the two NUL bytes that are usually here. We'll seek()
	# around them later.

	# Read AppInfo block, if it exists
	if ($self->{_appinfo_offset} != 0)
	{
		&skip_appinfo_block($self, \*PDB);
	}


	# Read record/resource list
	if ($self->{attributes}{resource})
	{
		die "Here must be _load_resources function";
	} else {
		&load_mam_records($self, \*PDB, $cats,$accs,$curr,$trip,$proj);
	}

	# These keys were needed for parsing the file, but are not
	# needed any longer. Delete them.
	delete $self->{_index};
	delete $self->{_numrecs};
	delete $self->{_appinfo_offset};
	delete $self->{_sort_offset};
	delete $self->{_size};

	close PDB;
}










# 
#  Load the actual MAMPro data records
#

sub load_mam_records
{
	my $pdb = shift;
	my $fh = shift;		# Input file handle
	my $cats = shift;
	my $accs = shift;
	my $curr = shift;
	my $trip = shift;
	my $proj = shift;
	my $i;


	print <<EOB;
"Date","Who","Amount","Currency","Rate","Category","Account","Transfer","Trip","Project","Cleared","Receipt","Billable",
EOB

	# Read each record in turn
	for ($i = 0; $i < $pdb->{_numrecs}; $i++)
	{
		my $len;	# Length of record
		my $buf;	# Input buffer

		# Sanity check: make sure we're where we think we
		# should be.
		if (tell($fh) > $pdb->{_index}[$i]{offset})
		{
			die "Bad offset for record $i: expected ",
				sprintf("0x%08x",
					$pdb->{_index}[$i]{offset}),
				" but it's at ",
				sprintf("[0x%08x]", tell($fh)), "\n";
		}

		# Seek to the right place, if necessary
		if (tell($fh) != $pdb->{_index}[$i]{offset})
		{
			seek PDB, $pdb->{_index}[$i]{offset}, 0;
		}

		# Compute the length of the record: the last record
		# extends to the end of the file. The others extend to
		# the beginning of the next record.
		if ($i == $pdb->{_numrecs} - 1)
		{
			# This is the last record
			$len = $pdb->{_size} -
				$pdb->{_index}[$i]{offset};
		} else {
			# This is not the last record
			$len = $pdb->{_index}[$i+1]{offset} -
				$pdb->{_index}[$i]{offset};
		}

		# Read the record
		read $fh, $buf, $len;
		if ($hexdump)
		{
			&hexdump("   ", $buf);
			print "\n";
		}

		# Tell the real class to parse the record data. Pass
		# &ParseRecord all of the information from the index,
		# plus a "data" field with the raw record data.
		my $record;

		$record = $pdb->ParseRecord(
			%{$pdb->{_index}[$i]},
			"data"	=> $buf,
			);
		push @{$pdb->{records}}, $record;

		&print_mam_record( $record, $cats,$accs,$curr,$trip,$proj);
		print "\n";
	}
}



sub hexdump
{
	my $prefix = shift;	# What to print in front of each line
	my $data = shift;	# The data to dump
	my $maxlines = shift;	# Max # of lines to dump
	my $offset;		# Offset of current chunk

	for ($offset = 0; $offset < length($data); $offset += 16)
	{
		my $hex;		# Hex values of the data
		my $ascii;		# ASCII values of the data
		my $chunk;		# Current chunk of data

		last if defined($maxlines) && ($offset >= ($maxlines * 16));

		$chunk = substr($data, $offset, 16);

		($hex = $chunk) =~ s/./sprintf "%02x ", ord($&)/ges;

		($ascii = $chunk) =~ y/\040-\176/./c;

		printf "%s %-48s|%-16s|\n", $prefix, $hex, $ascii;
	}
}




sub print_mam_record
{
my $hash = shift;
my $cats = shift;
my $accs = shift;
my $curr = shift;
my $trip = shift;
my $proj = shift;


printf "\"%d.%02d.%4d\",", $hash->{'mday'}, $hash->{'mon'}, $hash->{'year'};
printf "\"%s\",", $hash->{'who'};
printf "\"%d\",", $hash->{'amount'};
printf "\"%s\",", $curr->{ $hash->{'currency'} };
printf "\"%.8f\",", $hash->{'rate'};
printf "\"%s\",", $cats->{ $hash->{'category'} };
printf "\"%s\",", $accs->{ $hash->{'account'} };
printf "\"%s\",", $accs->{ $hash->{'transfer'} };

printf "\"%s\",", $trip->{ $hash->{'trip'}};
printf "\"%s\",", $proj->{ $hash->{'project'}};

printf "\"%1d\",", $hash->{'cleared'};
printf "\"%1d\",", $hash->{'receipt'};
printf "\"%1d\",", $hash->{'billable'};
}






sub mampro_dbs_read
{
	my $self = new Palm::Raw;
	my $fname = shift;		# Filename to read from
	my $func = shift;
	my $ref = shift;
	my $buf;			# Buffer into which to read stuff

	my $HeaderLen = 32+2+2+(9*4);		# Size of database header
	my $RecIndexHeaderLen = 6;		# Size of record index header

	$ref->{0} = "None";

	# Open database file

	unless( open PDB, "< $fname")
		{ print STDERR "Can't open \"$fname\": $!\n"; return; }

	binmode PDB;			# Parse as binary file under MS-DOS

	# Get the size of the file. It'll be useful later
	seek PDB, 0, 2;		# 2 == SEEK_END. Seek to the end.
	$self->{_size} = tell PDB;
	seek PDB, 0, 0;		# 0 == SEEK_START. Rewind to the beginning.

	# Read header

	read PDB, $buf, $HeaderLen;	# Read the PDB header

	# Split header into its component fields
	my ($name, $attributes, $version, $ctime, $mtime, $baktime,
	$modnum, $appinfo_offset, $sort_offset, $type, $creator,
	$uniqueIDseed) =
		unpack "a32 n n N N N N N N a4 a4 N", $buf;

	# _appinfo_offset and _sort_offset are private fields
	$self->{_appinfo_offset} = $appinfo_offset;
	$self->{_sort_offset} = $sort_offset;
	$self->{type} = $type;
	$self->{creator} = $creator;


	# Rebless this PDB object, depending on its type and/or
	# creator. This allows us to magically invoke the proper
	# &Parse*() function on the various parts of the database.

	# Look for most specific handlers first, least specific ones
	# last. That is, first look for a handler that deals
	# specifically with this database's creator and type, then for
	# one that deals with this database's creator and any type,
	# and finally for one that deals with anything.

	my $handler;
	if ($self->{attributes}{resource})
	{
		# Look among resource handlers
		$handler = $PRCHandlers{$self->{creator}}{$self->{type}} ||
			$PRCHandlers{undef}{$self->{type}} ||
			$PRCHandlers{$self->{creator}}{""} ||
			$PRCHandlers{""}{""};
	} else {
		# Look among record handlers
		$handler = $PDBHandlers{$self->{creator}}{$self->{type}} ||
			$PDBHandlers{""}{$self->{type}} ||
			$PDBHandlers{$self->{creator}}{""} ||
			$PDBHandlers{""}{""};
	}

	if (defined($handler))
	{
		bless $self, $handler;
	} else {
		# XXX - This should probably return 'undef' or something,
		# rather than die.
		die "No handler defined for creator \"$creator\", type \"$type\"\n";
	}

	## Read record/resource index
	# Read index header

	read PDB, $buf, $RecIndexHeaderLen;

	my $next_index;
	my $numrecs;

	($next_index, $numrecs) = unpack "N n", $buf;
	$self->{_numrecs} = $numrecs;

	# Read the index itself
	if ($self->{attributes}{resource})
	{
		die "Here must be _load_rsrc_index function";
	} else {
		&skip_rec_index($self, \*PDB);
	}

	# Ignore the two NUL bytes that are usually here. We'll seek()
	# around them later.

	# Read AppInfo block, if it exists
	if ($self->{_appinfo_offset} != 0)
	{
		&skip_appinfo_block($self, \*PDB);
	}


	# Read record/resource list
	if ($self->{attributes}{resource})
	{
		die "Here must be _load_resources function";
	} else {
		&load_mampro_records($self, \*PDB, $ref, $func);
	}

	# These keys were needed for parsing the file, but are not
	# needed any longer. Delete them.
	delete $self->{_numrecs};
	delete $self->{_appinfo_offset};
	delete $self->{_sort_offset};
	delete $self->{_size};

	close PDB;
}













# skip_rec_index
# Private function. skip the record index, for a record database
sub skip_rec_index
{
	my $pdb = shift;
	my $fh = shift;		# Input file handle
	my $i;
	my $lastoffset = 0;
	my $IndexRecLen = 8;			# Length of record index entry

	# Read each record index entry in turn
	for ($i = 0; $i < $pdb->{_numrecs}; $i++)
	{
		my $buf;		# Input buffer

		# Read the next record index entry
		my $offset;
		my $attributes;
		my @id;			# Raw ID
		my $id;			# Numerical ID
		my $entry = {};		# Parsed index entry

		read $fh, $buf, $IndexRecLen;

		# The ID field is a bit weird: it's represented as 3
		# bytes, but it's really a double word (long) value.

		($offset, $attributes, @id) = unpack "N C C3", $buf;
if ($offset == $lastoffset)
{
print STDERR "Record $i has same offset as previous one: $offset\n";
}
$lastoffset = $offset;

		$entry->{offset} = $offset;
		$entry->{attributes}{expunged} = 1 if $attributes & 0x80;
		$entry->{attributes}{dirty} = 1 if $attributes & 0x40;
		$entry->{attributes}{deleted} = 1 if $attributes & 0x20;
		$entry->{attributes}{private} = 1 if $attributes & 0x10;
		$entry->{id} = ($id[0] << 16) |
				($id[1] << 8) |
				$id[2];

		# The lower 4 bits of the attributes field are
		# overloaded: If the record has been deleted and/or
		# expunged, then bit 0x08 indicates whether the record
		# should be archived. Otherwise (if it's an ordinary,
		# non-deleted record), the lower 4 bits specify the
		# category that the record belongs in.
		if (($attributes & 0xa0) == 0)
		{
			$entry->{category} = $attributes & 0x0f;
		} else {
			$entry->{attributes}{archive} = 1
				if $attributes & 0x08;
		}

		# Put this information on a temporary array
		push @{$pdb->{_index}}, $entry;
	}
}


# skip_appinfo_block
# Private function. Skip the AppInfo block
sub skip_appinfo_block
{
	my $pdb = shift;
	my $fh = shift;		# Input file handle
	my $len;		# Length of AppInfo block
	my $buf;		# Input buffer

	# Sanity check: make sure we're positioned at the beginning of
	# the AppInfo block
	if (tell($fh) > $pdb->{_appinfo_offset})
	{
		die "Bad AppInfo offset: expected ",
			sprintf("0x%08x", $pdb->{_appinfo_offset}),
			", but I'm at ",
			tell($fh), "\n";
	}

	# Seek to the right place, if necessary
	if (tell($fh) != $pdb->{_appinfo_offset})
	{
		seek PDB, $pdb->{_appinfo_offset}, 0;
	}

	# There's nothing that explicitly gives the size of the
	# AppInfo block. Rather, it has to be inferred from the offset
	# of the AppInfo block (previously recorded in
	# $pdb->{_appinfo_offset}) and whatever's next in the file.
	# That's either the sort block, the first data record, or the
	# end of the file.

	if ($pdb->{_sort_offset})
	{
		# The next thing in the file is the sort block
		$len = $pdb->{_sort_offset} - $pdb->{_appinfo_offset};
	} elsif ((defined $pdb->{_index}) && @{$pdb->{_index}})
	{
		# There's no sort block; the next thing in the file is
		# the first data record
		$len = $pdb->{_index}[0]{offset} -
			$pdb->{_appinfo_offset};
	} else {
		# There's no sort block and there are no records. The
		# AppInfo block goes to the end of the file.
		$len = $pdb->{_size} - $pdb->{_appinfo_offset};
	}

	# Read the AppInfo block
	read $fh, $buf, $len;

	# Tell the real class to parse the AppInfo block
	$pdb->{appinfo} = $pdb->ParseAppInfoBlock($buf);

}


#
# load_mampro_records function.
# Load varios MAMPro DBs.
# 

sub load_mampro_records
{
	my $pdb = shift;
	my $fh = shift;		# Input file handle
	my $ref = shift;
	my $func = shift;
	my $i;

	# Read each record in turn
	for ($i = 0; $i < $pdb->{_numrecs}; $i++)
	{
		my $len;	# Length of record
		my $buf;	# Input buffer


		# Sanity check: make sure we're where we think we
		# should be.
		if (tell($fh) > $pdb->{_index}[$i]{offset})
		{
			die "Bad offset for record $i: expected ",
				sprintf("0x%08x",
					$pdb->{_index}[$i]{offset}),
				" but it's at ",
				sprintf("[0x%08x]", tell($fh)), "\n";
		}

		# Seek to the right place, if necessary
		if (tell($fh) != $pdb->{_index}[$i]{offset})
		{
			seek PDB, $pdb->{_index}[$i]{offset}, 0;
		}

		# Compute the length of the record: the last record
		# extends to the end of the file. The others extend to
		# the beginning of the next record.
		if ($i == $pdb->{_numrecs} - 1)
		{
			# This is the last record
			$len = $pdb->{_size} -
				$pdb->{_index}[$i]{offset};
		} else {
			# This is not the last record
			$len = $pdb->{_index}[$i+1]{offset} -
				$pdb->{_index}[$i]{offset};
		}

		# Read the record
		read $fh, $buf, $len;

		# Tell the real class to parse the record data. Pass
		# &ParseRecord all of the information from the index,
		# plus a "data" field with the raw record data.
		my $record;

		$record = $pdb->ParseRecord(
			%{$pdb->{_index}[$i]},
			"data"	=> $buf,
			);

		&{$func}( $record, $ref );

		push @{$pdb->{records}}, $record;
	}
}







#
# MAMPro DB parse functions
# 



sub parse_category_record
{
my $record = shift;
my $ref = shift;

$record->{data} =~ s/\0$//;	# Trim trailing NUL
$record->{data} =~ s/^\0//;	# Trim heading NUL
$ref->{ $record->{id} } = $record->{data};
}



sub parse_account_record
{
my $record = shift;
my $ref = shift;

my $acc_name = substr( $record->{data}, 26);
$acc_name =~ s/\0$//;	# Trim trailing NUL
$ref->{ $record->{id} } = $acc_name;
}






sub parse_currency_record
{
my $record = shift;
my $ref = shift;

my $curr_name = substr( $record->{data}, 10);
$curr_name =~ s/\0$//;	# Trim trailing NUL
$ref->{ $record->{id} } = $curr_name;
}


1;


