File Coverage

blib/lib/Mac/Tie/PList.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

#==============================================================================a#

package Mac::Tie::PList;
our $VERSION = '0.03';

#==============================================================================a#

=head1 NAME

Mac::Tie::PList - Parse Apple NSDictionary objects (e.g. Preference Lists)


=head1 SYNOPSIS

use Mac::Tie::PList;

    my $plist = Mac::Tie::PList->new_from_file("/Library/Preferences/.GlobalPreferences.plist");

    while ((my $key,$val) = each %$plist) {
    	print "$key => $val\n";
    }


=head1 DESCRIPTION

This module allows you to parse NSDictionary objects, as used in PList files, as tied perl
objects. It uses the L perl/objective-c bridge and so both xml1 and binary1
formats are currently supported.

The objects are mapped as follows:

	NSNumber NSBoolean NSString => perl tied scalar
	NSArray => perl tied array
	NSDictionary => perl tied hash
	NSDate => perl tied string - returns seconds since 1970
	NSData => *WARNING* The returned sting format is not decided yet

NOTE: Currently the module only provided read access to the data. Write access is
planned in the future.

=over 4

=cut

#==============================================================================a#

use strict;
use warnings;
use Carp;
use Foundation;
use File::Temp qw(tempfile);

=item my $hash_ref = Mac::Tie::PList->new($data)

Parses data and creates a new tied hash based on the data provided as a string.

=cut

sub new {
	my ($obj,$xml) = @_;
	my ($tmp_fh,$tmp_file) = tempfile();
	$tmp_fh->print($xml);
	$tmp_fh->close();
	my $plist = $obj->new_from_file($tmp_file);
	unlink($tmp_file);
	return $plist;
}


=item my $hash_ref = Mac::Tie::PList->new_from_file($filename)

Parses data and creates a new tied hash based on the contents of a file.

=cut


sub new_from_file {
	my ($obj,$file) = @_;
	my $plist_obj = NSDictionary->dictionaryWithContentsOfFile_($file);
	if ($plist_obj && $$plist_obj)  {
		tie my %plist, 'Mac::Tie::PList::Hash', $plist_obj;
		return \%plist;
	} else {
		return;
	}
}


sub _tie_plist {
	my ($plist_obj) = @_;
	if ($plist_obj->isKindOfClass_(NSArray->class) ) {
		tie my @plist, 'Mac::Tie::PList::Array', $plist_obj;
		return \@plist;
	} elsif (
		($plist_obj->isKindOfClass_(NSCFNumber->class)) ||
		($plist_obj->isKindOfClass_(NSCFBoolean->class)) ||
		($plist_obj->isKindOfClass_(NSCFData->class)) ||
		($plist_obj->isKindOfClass_(NSDate->class)) ||
		($plist_obj->isKindOfClass_(NSCFString->class))
	) {
		tie my $plist, 'Mac::Tie::PList::Scalar', $plist_obj;
		return $plist;
	} elsif ($plist_obj->isKindOfClass_(NSDictionary->class) ) {
		tie my %plist, 'Mac::Tie::PList::Hash', $plist_obj;
		return \%plist;
	} else {
		carp "Unknown type: $plist_obj\n";
		return;
	}
}


#==============================================================================a#

package Mac::Tie::PList::Hash;

use strict;
use warnings;
use Carp;
use Foundation;
use Tie::Hash;
use base qw(Tie::Hash);

sub TIEHASH {
        my ($class,$plist_obj)  = @_;
        return bless {plist_obj=>$plist_obj, hash=>{} }, $class;
}

sub FETCH {
        my ($obj,$key)  = @_;
	if ($obj->{hash}->{$key}) {
		return $obj->{hash}->{$key};
	} else {
		if ($obj->{plist_obj} && ${$obj->{plist_obj}})  {
        		my $sub_obj  = $obj->{plist_obj}->objectForKey_($key);
        		if ($sub_obj && $$sub_obj ) {
                		return $obj->{hash}->{$key} = Mac::Tie::PList::_tie_plist($sub_obj);
        		} else {
                		return;
        		}
		}
	}
}

sub FIRSTKEY {
        my ($obj)  = @_;
        my @keys;
	if ($obj->{plist_obj} && ${$obj->{plist_obj}})  {
        	my $keys_array = $obj->{plist_obj}->allKeys;
        	for (my $i=0; $i<$keys_array->count; $i++) {
                	my $key_obj = $keys_array->objectAtIndex_($i);
                	if ($key_obj && $$key_obj) {
                        	push @keys,$key_obj->description->UTF8String;
                	}
        	}
	}

        $obj->{keys} = \@keys;
        return $obj->NEXTKEY;
}

sub NEXTKEY {
        my ($obj)  = @_;
        return shift @{$obj->{keys}};
}


#==============================================================================#

package Mac::Tie::PList::Scalar;

use strict;
use warnings;
use Carp;
use Foundation;
use Tie::Scalar;
use base qw(Tie::Scalar);

sub TIESCALAR {
        my ($class,$plist_obj)  = @_;
        return bless {plist_obj => $plist_obj}, $class;
}

sub FETCH {
        my ($obj)  = @_;

	if ($obj->{plist_obj} && ${$obj->{plist_obj}})  {
		if ($obj->{plist_obj}->isKindOfClass_(NSDate->class) ) {
			return $obj->{plist_obj}->timeIntervalSince1970;
		# TODO Data is in what format? Perl should return a packed string
		#} elsif ($obj->{plist_obj}->isKindOfClass_(NSData->class) ) {
		#	return pack "c*", $obj->{plist_obj}->bytes;
		} else {
			return $obj->{plist_obj}->description->UTF8String;
		}
	} else {
		return;
	}
}


#==============================================================================#

package Mac::Tie::PList::Array;

use strict;
use warnings;
use Carp;
use Foundation;
use Tie::Array;
use base qw(Tie::Array);

sub TIEARRAY {
        my ($class,$plist_obj)  = @_;
        return bless {plist_obj=>$plist_obj, array=>[]}, $class;
}

sub FETCH {
        my ($obj,$n)  = @_;

	if ($obj->{array}->[$n]) {
		return $obj->{array}->[$n];
	} else {
        	my $sub_obj  = $obj->{plist_obj}->objectAtIndex_($n);
        	if ($sub_obj && $$sub_obj ) {
                	return $obj->{array}->[$n] = Mac::Tie::PList::_tie_plist($sub_obj);
        	} else {
                	return;
        	}
	}
}

sub FETCHSIZE {
	my ($obj) = @_;

	if ($obj->{plist_obj} && ${$obj->{plist_obj}})  {
		return $obj->{plist_obj}->count;
        } else {
               	return;
	}
}


#==============================================================================#

=back

=head1 SEE ALSO

This module is based on code from the following O'Reilly article:

	http://www.macdevcenter.com/pub/a/mac/2005/07/29/plist.html

The Objective C Bridge is descibed at:

	http://developer.apple.com/documentation/Darwin/Reference/ManPages/man3/PerlObjCBridge.3pm.html

Further details of NSDictionary's is available here:

	http://developer.apple.com/documentation/Cocoa/Reference/Foundation/ObjC_cla
ssic/Classes/NSDictionary.html

=head1 AUTHOR

Gavin Brock, [e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Gavin Brock

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.0 or,
at your option, any later version of Perl 5 you may have available.

=cut


#
# That's all folks..
#==============================================================================#

1;