File Coverage

blib/lib/Palm/ListDB.pm

Criterion	Covered	Total	%
statement	16	96	16.6
branch	0	30	0.0
condition	0	6	0.0
subroutine	6	12	50.0
pod	6	6	100.0
total	28	150	18.6

# -*- perl -*-
#
# $Id: ListDB.pm Mon Aug  5 19:57:50 2002 $
#
# DESCRIPTION	Sub class of Palm::PDB
#               specialized for listDB by Andrew Low
#
# COPYRIGHT (c)	2002 by Rudiger Peusquens
#		All rights reserved.
#               This program is free software; you can redistribute it
#	        and/or modify it under the same terms as Perl itself.
#
# AUTHOR	Rudiger Peusquens
#
# HISTORY
# $Log$
#
use strict;

package Palm::ListDB;

use Palm::StdAppInfo();
use Palm::Raw();
use Carp qw(carp);

use vars qw( $VERSION @ISA );

@ISA = qw( Palm::StdAppInfo Palm::Raw );
$VERSION = '0.25';

sub import {
    &Palm::PDB::RegisterPDBHandlers( __PACKAGE__,
				     [ "LSdb", "DATA" ],
				     [ "LSdb", "" ] );
}

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

	$self->{name} = 'ListDB';	# give it a default name
	$self->{creator} = 'LSdb';
	$self->{type} = 'DATA';
	$self->{attributes}{resource} = 0;

	# Initialize the AppInfo block
	$self->{appinfo} = {
	    writeProtect => 0,		# *ListDb's* write protection
	    lastCategory => 0xff,	# default: All
	    field1 => '',
	    field2 => '',
	};

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

	# Give the PDB a blank sort block
	$self->{sort} = undef;

	# Give the PDB an empty list of records
	$self->{records} = [];

	return $self;
}

sub ParseAppInfoBlock {
    my ($self, $data) = @_;
    my $appinfo = {};

    &Palm::StdAppInfo::parse_StdAppInfo( $appinfo, $data );

    # don't know what first 2 bytes are for
    my ($C1, $C2, $field1, $field2) = unpack 'C2a16a16', $appinfo->{other};

    $appinfo->{ writeProtect } = $C1;
    $appinfo->{ lastCategory } = $C2;

    # trim after first NUL (renaming might have left "Foo\0bar")
    $field1 =~ s/\0.*$//;
    $field2 =~ s/\0.*$//;

    $appinfo->{field1} = $field1;
    $appinfo->{field2} = $field2;

    return $appinfo;
}

sub PackAppInfoBlock {
    my $self = shift;

    my %data = ( writeProtect => 0,
		 lastCategory => 0xff ); # default 0xff : "All"

    foreach my $attr (qw(field1 field2)) {
	if ( defined $self->{appinfo}{$attr} ) {
	    $data{$attr} = $self->{appinfo}{$attr};
	} else {
	    $data{$attr} = '';
	}
    }
    if ( $self->{appinfo}{writeProtect} ) {
	$data{writeProtect} = 1;
    }
    if ( defined $self->{appinfo}{lastCategory} ) {
	$data{lastCategory} = $self->{appinfo}{lastCategory};
    }

    # Pack the non-category part of the AppInfo block
    # We need to pad the last 202 bytes.
    $self->{appinfo}{other} = pack 'C2a16a16x202',
                                   @data{qw(writeProtect lastCategory
					    field1 field2)};

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


sub ParseRecord {
    my ($self, %record) = @_;

    delete $record{offset};		# This is useless

    # split into fields
    # ignore first 3 chars; they are offsets
    my ($field1, $field2, $note) = split /\0/, substr( $record{ data }, 3 );

    $record{ field1 } = $field1 unless $field1 eq '';
    $record{ field2 } = $field2 unless $field2 eq '';
    unless ( $note eq '' ) {
	# make sure we have our local newlines
	( $record{ note } = $note ) =~ s/\012/\n/g;
    }

    delete $record{ data };

    return \%record;
}

sub PackRecord {
    my ($self, $record) = @_;

    my %data = ();
    foreach my $attr (qw(field1 field2 note)) {
	if ( defined $record->{$attr} ) {
	    $data{$attr} = $record->{$attr};
	} else {
	    $data{$attr} = '';
	}
    }

    # fix note if it's a array ref
    $data{note} = join "\012", @{ $data{note} }
        if ref $data{note} eq 'ARRAY';

    $data{note} =~ s/\r?\n\r?/\012/g;	# fix PalmOS newlines

    my $data = pack('CCC',
                    3,
                    4 + length( $data{field1} ),
                    5 + length( $data{field1} )
		      + length( $data{field2} ) );
    $data .= $data{field1} . "\0";
    $data .= $data{field2} . "\0";
    $data .= $data{note} . "\0";

    return $data ;
}

sub new_Record {
    my ($self, %args) = @_;
    my $record = $self->SUPER::new_Record();

    # maybe set category
    if ( defined( my $category = $args{category} ) ) {
	my @categories = @{ $self->{appinfo}{categories} };
	my $catIndex = undef;

	if ( $category eq '' ) {
	    # empty string silently mapped to Unfiled
	    $catIndex = 0;
	} elsif ( $category =~ /\D/ ) {
	    # category by name
	    foreach my $i ( 0 .. $#categories ) {
		my $cat = $categories[$i];
		if ( defined $cat->{name} and $cat->{name} eq $category ) {
		    $catIndex = $i;
		    last;
		}
	    }
	} elsif ( $category >= 0 and $category <= $#categories ) {
	    # category by index
	    $catIndex = $category;
	}

	# fall back to "Unfiled"
	unless ( defined $catIndex ) {
	    carp "Bad category `$category'. Using `Unfiled' (0)";
	    $catIndex = 0;
	}
	$record->{category} = $catIndex;
    }

    # set field1, field2 and note
    foreach my $field (qw(field1 field2 note)) {
	if ( defined $args{$field} ) {
	    $record->{$field} = $args{$field};
	} else {
	    $record->{$field} = undef;
	}
    }

    return $record;
}

1;	# module must return success

__END__