File Coverage

blib/lib/Palm/MaTirelire/AccountsV1.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

#
# Author          : Maxime Soulé
# Created On      : Mon Aug 30 00:36:38 2004
# Last Modified By: Maxime Soule
# Last Modified On: Mon May  3 15:00:42 2010
# Update Count    : 2
#
# Copyright (C) 2005, Maxime Soulé
# You may distribute this file under the terms of the Artistic
# License, as specified in the README file.
#

package Palm::MaTirelire::AccountsV1;

use strict;

use Palm::BlockPack;

use Palm::MaTirelire;
use Palm::StdAppInfo();

use base qw(Palm::MaTirelire Palm::StdAppInfo);

our $VERSION = '1.0';


use constant UNKNOWN_MODE	=> ((1 << 5) - 1);
use constant UNKNOWN_TYPE	=> ((1 << 6) - 1);

my $TRANS_BLOCK = Palm::BlockPack->new
    ('DateType'	=> [ 'date_' => 'now' ],
     'TimeType'	=> [ 'time_' => 'now' ],

     '-N'	=> [ 'amount' => 0 ],

     UInt32	=> [
		    [ 'checked:1'	=> 0 ],
		    'repeat:1',
		    [ 'mode:5' 		=> UNKNOWN_MODE ],
		    [ 'type:6' 		=> UNKNOWN_TYPE ],
		    'check_num:1',
		    'xfer:1',
		    [ 'marked:1'	=> 0 ],
		    [ 'alarm:1'		=> 0 ],
		    'xfer_cat:1',
		    'value_date:1',
		    [ 'reserved:*'	=> 0 ],
		    ],
     );

my $TRANS_CHECKNUM_BLOCK = Palm::BlockPack->new(N => 'check_num');

my $TRANS_VALUEDATE_BLOCK = Palm::BlockPack->new(DateType => '');

my $TRANS_REPEAT_BLOCK = Palm::BlockPack->new
    (UInt16	=> [
		    'repeat_type:2',
		    'repeat_freq:6',
		    'reserved:*',
		    ],
     skip	=> [ 2 => "\xff" ], # End date is not used in M1 and must be -1
     );

my $TRANS_XFER_BLOCK = Palm::BlockPack->new(N => 'xfer');

my $TRANS_DESCRIPTION_BLOCK = Palm::BlockPack->new
    ('Z*' => [ 'description' => '' ]);


sub import
{
    &Palm::PDB::RegisterPDBHandlers(__PACKAGE__, [ "MaTi", 'Data' ]);
}


sub new
{
    my $classname   = shift;
    my $self        = $classname->SUPER::new(@_);
    # Create a generic PDB. No need to rebless it,
    # though.

    # Creator for V1 is not the same
    $self->{creator} = "MaTi";

    $self->{name} = "MaTirelire Data"; # Default
    $self->{type} = "Data";

    # Add the standard AppInfo block stuff
    &Palm::StdAppInfo::seed_StdAppInfo($self->{appinfo});

    return $self;
}


sub ParseAppInfoBlock
{
    my $self = shift;
    my $data = shift;
    my $appinfo = {};
    my $std_len;

    # Get the standard parts of the AppInfo block
    $std_len = &Palm::StdAppInfo::parse_StdAppInfo($appinfo, $data);

    return $appinfo;
}


sub PackAppInfoBlock
{
    my $self = shift;
    my $retval;

    # Pack the AppInfo block
    $retval = &Palm::StdAppInfo::pack_StdAppInfo($self->{appinfo});

    return $retval;
}


sub new_Record
{
    my $classname = shift;
    my $retval = $classname->SUPER::new_Record(@_);

    $TRANS_BLOCK->init_block($retval);
    $TRANS_DESCRIPTION_BLOCK->init_block($retval);

    return $retval;
}


sub ParseRecord
{
    my $self = shift;
    my %record = @_;

    delete $record{offset};	# This is useless
    my $data = delete $record{data};

    $record{size} = length $data; # Used in validRecords method

    $TRANS_BLOCK->unpack_block(\$data, \%record, 1);

    # Cheque number
    if (delete $record{check_num})
    {
	$TRANS_CHECKNUM_BLOCK->unpack_block(\$data, \%record, 1);
    }

    # Value date
    if (delete $record{value_date})
    {
	$record{value_date} = {};
	$TRANS_VALUEDATE_BLOCK->unpack_block(\$data, $record{value_date}, 1);
    }

    # Repetition
    if (delete $record{repeat})
    {
	$record{repeat} = {};
	$TRANS_REPEAT_BLOCK->unpack_block(\$data, $record{repeat}, 1);
    }

    # Transfer
    if (delete $record{xfer})
    {
	$TRANS_XFER_BLOCK->unpack_block(\$data, \%record, 1);
    }
    else
    {
	delete $record{xfer_cat};
    }

    $TRANS_DESCRIPTION_BLOCK->unpack_block(\$data, \%record);

    #if (length($data) > 0)
    #{
    #	use Data::Dumper;
    #
    #	print Dumper(\%record);
    #	print Dumper($data);
    #}

    return \%record;
}


sub PackRecord
{
    my $self = shift;
    my $record = shift;
    my $pack;

    # Small check...
    if ($record->{xfer_cat})
    {
	if (not defined $record->{xfer} or $record->{xfer} >= 16)
	{ delete $record->{xfer_cat} }
    }

    $pack = $TRANS_BLOCK->pack_block($record);

    # Cheque number
    if ($record->{check_num})
    {
	$pack .= $TRANS_CHECKNUM_BLOCK->pack_block($record);
    }

    # Value date
    if ($record->{value_date})
    {
	$pack .= $TRANS_VALUEDATE_BLOCK->pack_block($record->{value_date});
    }

    # Repetition
    if ($record->{repeat})
    {
	$pack .= $TRANS_REPEAT_BLOCK->pack_block($record->{repeat});
    }

    # Transfer
    if ($record->{xfer})
    {
	$pack .= $TRANS_XFER_BLOCK->pack_block($record);
    }

    $pack .= $TRANS_DESCRIPTION_BLOCK->pack_block($record);

    return $pack;
}


sub sortRecords
{
    my $self = shift;

    @{$self->{records}} = sort
    {
	# Pack date and time on an 31 bits width integer...

	# 11 bits: 30 .. 20
	(($a->{date_year} << 20)
	 #  4 bits: 19 .. 16
	 | ($a->{date_month} << 16)
	 #  5 bits: 15 .. 11
	 | ($a->{date_day} << 11)
	 #  5 bits: 10 .. 6
	 | ($a->{time_hour} << 6)
	 #  6 bits: 5 .. 0	 11 bits: 30 .. 20
	 | $a->{time_min}) <=> (($b->{date_year} << 20)
				#  4 bits: 19 .. 16
				| ($b->{date_month} << 16)
				#  5 bits: 15 .. 11
				| ($b->{date_day} << 11)
				#  5 bits: 10 .. 6
				| ($b->{time_hour} << 6)
				#  6 bits: 5 .. 0
				| $b->{time_min})
    }
    @{$self->{records}};
}


#
# Returns a list (number of deleted records, number of errors corrected)
sub validRecords ($;$)
{
    my($self, $verbose) = @_;

    # $verbose can be a reference on a filehandle
    $verbose = \*STDOUT if $verbose && not ref $verbose;

    my $deleted_records = 0;
    my $errors_found = 0;

    my @to_del;
    my %ids;
    my $index = 0;

    foreach my $rec (@{$self->{records}})
    {
	if ($rec->{size} == 0)
	{
	    print $verbose ("Record #$index (cat=$rec->{category}) "
			    . "UniqueID $rec->{id}\n"
			    . "**** empty => deleted\n")
		if $verbose;

	    push(@to_del, $index);
	}
	else
	{
	    $ids{$rec->{id}} = 1;
	}
	$index++;
    }

    if (@to_del)
    {
	$deleted_records = @to_del;

	foreach my $idx (reverse @to_del)
	{
	    splice @{$self->{records}}, $idx, 1;
	}
    }

    my %links;
    $index = 0;

    foreach my $rec (@{$self->{records}})
    {
	my @err_msg;

	# Repeat
	if ($rec->{repeat})
	{
	    if ($rec->{repeat}{repeat_freq} == 0
		or $rec->{repeat}{repeat_type} > 2
		or $rec->{repeat}{reserved} != 0)
	    {
		push(@err_msg, "deleted repeat option");
		delete $rec->{repeat};
	    }
	}

	# Xfer
	if (exists $rec->{xfer})
	{
	    my $error = 0;

	    if ($rec->{xfer_cat})
	    {
		if ($rec->{xfer} >= 16)
		{
		    push(@err_msg, "invalid account (xfer) link");

		    $error = 1;
		}
	    }
	    else
	    {
		if (exists $ids{$rec->{xfer}})
		{
		    $links{$rec->{id}} = $rec->{xfer};
		}
		else
		{
		    push(@err_msg, "invalid transaction (xfer) link");

		    $error = 1;
		}
	    }

	    if ($error)
	    {
		delete @$rec{qw(xfer xfer_cat)};
		push(@err_msg, "deleted transfer option");
	    }
	}

	# No account (not possible ?)
	if ($rec->{category} eq '')
	{
	    $rec->{attributes} = { dirty => 1 };
	    push(@err_msg, "not associated to an account");
	}

	if (@err_msg)
	{
	    if ($verbose)
	    {
		print $verbose
		    ("Record #$index (account=$rec->{category}) "
		     . "UniqueID $rec->{id}\n"
		     . "$rec->{date_year}/$rec->{date_month}/$rec->{date_day} "
		     . "$rec->{time_min}:$rec->{time_hour} "
		     . "amount = ", $rec->{amount} / 100, "\n",
		     "  ");

		print $verbose join("\n  ", @err_msg), "\n";
	    }

	    $rec->{attributes}{Dirty} = 1;

	    $errors_found++;
	}
    }

    while (my($id, $link) = each %links)
    {
	if (not exists $links{$link})
	{
	    print $verbose ("**** Xfer: $id => $link but $link is not linked,",
			    " corrected.\n")
		if $verbose;

	    my $rec = $self->findRecordByID($link);
	    $rec->{xfer} = $id;
	    delete $rec->{xfer_cat};

	    $rec->{attributes}{Dirty} = 1;
	}
	elsif ($links{$link} != $id)
	{
	    print $verbose
		"**** Xfer: $id => $link but $link => $links{$link}\n"
		if $verbose;
	}
    }

    return ($deleted_records, $errors_found);
}

1;
__END__