File Coverage

blib/lib/Mac/PropertyList.pm
Criterion Covered Total %
statement 316 375 84.2
branch 64 104 61.5
condition 5 9 55.5
subroutine 86 99 86.8
pod 21 21 100.0
total 492 608 80.9


line stmt bran cond sub pod time code
1 24     24   6912328 use v5.10;
  24         103  
2              
3             package Mac::PropertyList;
4 24     24   154 use strict;
  24         48  
  24         877  
5              
6 24     24   164 use warnings;
  24         98  
  24         1861  
7 24     24   138 no warnings;
  24         61  
  24         1488  
8              
9 24     24   144 use vars qw($ERROR);
  24         51  
  24         1677  
10 24     24   139 use Carp qw(croak carp);
  24         47  
  24         2142  
11 24     24   14536 use Data::Dumper;
  24         195386  
  24         2187  
12 24     24   14833 use HTML::Entities;
  24         170737  
  24         2709  
13 24     24   12481 use XML::Entities;
  24         276655  
  24         1875  
14              
15             BEGIN {
16             %HTML::Entities::char2entity = %{
17             # XML::Entities::Data::char2entity('all');
18             # We explicitly do not want *all* here. 'all' in the XML::Entities module
19             # is JUST PLAIN WRONG, as these are HTML entities that are NOT part of XML.
20              
21 24     24   77 {
22 24         5079 '&' => '&',
23             '<' => '<',
24             '>' => '>',
25             "'" => "'",
26             '"' => '"',
27             }
28             };
29             }
30              
31 24     24   259 use Exporter qw(import);
  24         55  
  24         78738  
32              
33             our @EXPORT_OK = qw(
34             parse_plist
35             parse_plist_fh
36             parse_plist_file
37             plist_as_string
38             create_from_hash
39             create_from_array
40             create_from_string
41             );
42              
43             our %EXPORT_TAGS = (
44             'all' => \@EXPORT_OK,
45             );
46              
47             our $VERSION = '1.606';
48              
49             =encoding utf8
50              
51             =head1 NAME
52              
53             Mac::PropertyList - work with Mac plists at a low level
54              
55             =head1 SYNOPSIS
56              
57             use Mac::PropertyList qw(:all);
58              
59             my $data = parse_plist( $text );
60             my $perl = $data->as_perl;
61              
62             # == OR ==
63             my $data = parse_plist_file( $filename );
64              
65             # == OR ==
66             open my( $fh ), $filename or die "...";
67             my $data = parse_plist_fh( $fh );
68              
69              
70             my $text = plist_as_string( $data );
71              
72             my $plist = create_from_hash( \%hash );
73             my $plist = create_from_array( \@array );
74              
75             my $plist = Mac::PropertyList::dict->new( \%hash );
76              
77             my $perl = $plist->as_perl;
78              
79             =head1 DESCRIPTION
80              
81             This module is a low-level interface to the Mac OS X Property List
82             (plist) format in either XML or binary. You probably shouldn't use
83             this in applications–build interfaces on top of this so you don't have
84             to put all the heinous multi-level object stuff where people have to
85             look at it.
86              
87             You can parse a plist file and get back a data structure. You can take
88             that data structure and get back the plist as XML. If you want to
89             change the structure inbetween that's your business. :)
90              
91             You don't need to be on Mac OS X to use this. It simply parses and
92             manipulates a text format that Mac OS X uses.
93              
94             If you need to work with the old ASCII or newer JSON formet, you can
95             use the B tool that comes with MacOS X:
96              
97             % plutil -convert xml1 -o ExampleBinary.xml.plist ExampleBinary.plist
98              
99             Or, you can extend this module to handle those formats (and send a pull
100             request).
101              
102             =head2 The Property List format
103              
104             The MacOS X Property List format is simple XML. You can read the DTD
105             to get the details.
106              
107             http://www.apple.com/DTDs/PropertyList-1.0.dtd
108              
109             One big problem exists—its dict type uses a flat structure to list
110             keys and values so that values are only associated with their keys by
111             their position in the file rather than by the structure of the DTD.
112             This problem is the major design hinderance in this module. A smart
113             XML format would have made things much easier.
114              
115             If the parse_plist encounters an empty key tag in a dict structure
116             (i.e. C<< >> ) the function croaks.
117              
118             =head2 The Mac::PropertyList classes
119              
120             A plist can have one or more of any of the plist objects, and we have
121             to remember the type of thing so we can go back to the XML format.
122             Perl treats numbers and strings the same, but the plist format
123             doesn't.
124              
125             Therefore, everything C creates is an object of some
126             sort. Container objects like C and
127             C hold other objects.
128              
129             There are several types of objects:
130              
131             Mac::PropertyList::string
132             Mac::PropertyList::data
133             Mac::PropertyList::real
134             Mac::PropertyList::integer
135             Mac::PropertyList::uid
136             Mac::PropertyList::date
137             Mac::PropertyList::array
138             Mac::PropertyList::dict
139             Mac::PropertyList::true
140             Mac::PropertyList::false
141              
142             Note that the Xcode property list editor abstracts the C and
143             C objects as just C. They are separate tags in the
144             plist format though.
145              
146             =over 4
147              
148             =item new( VALUE )
149              
150             Create the object.
151              
152             =item value
153              
154             Access the value of the object. At the moment you cannot change the
155             value
156              
157             =item type
158              
159             Access the type of the object (string, data, etc)
160              
161             =item write
162              
163             Create a string version of the object, recursively if necessary.
164              
165             =item as_perl
166              
167             Turn the plist data structure, which is decorated with extra
168             information, into a lean Perl data structure without the value type
169             information or blessed objects.
170              
171             =back
172              
173             =cut
174              
175             my $Debug = $ENV{PLIST_DEBUG} || 0;
176              
177             my %Readers = (
178             "dict" => \&read_dict,
179             "string" => \&read_string,
180             "date" => \&read_date,
181             "real" => \&read_real,
182             "integer" => \&read_integer,
183             "array" => \&read_array,
184             "data" => \&read_data,
185             "true" => \&read_true,
186             "false" => \&read_false,
187             );
188              
189             my $Options = {ignore => ['', '']};
190              
191             =head1 FUNCTIONS
192              
193             These functions are available for individual or group import. Nothing
194             will be imported unless you ask for it.
195              
196             use Mac::PropertyList qw( parse_plist );
197              
198             use Mac::PropertyList qw( :all );
199              
200             =head2 Things that parse
201              
202             =over 4
203              
204             =item parse_plist( TEXT )
205              
206             Parse the XML plist in TEXT and return the C
207             object.
208              
209             =cut
210              
211             # This will change to parse_plist_ref when we create the dispatcher
212              
213             sub parse_plist {
214 49     49 1 91946 my $text = shift;
215              
216 49         105 my $plist = do {
217 49 100       361 if( $text =~ /\A<\?xml/ ) { # XML plists
    100          
218 38         144 $text =~ s///g;
219             # we can handle either 0.9 or 1.0
220 38         449 $text =~ s|^<\?xml.*?>\s*\s*\s*||;
221 38         1803 $text =~ s|\s*\s*$||;
222              
223 38         312 my $text_source = Mac::PropertyList::TextSource->new( $text );
224 38         132 read_next( $text_source );
225             }
226             elsif( $text =~ /\Abplist/ ) { # binary plist
227 6         1478 require Mac::PropertyList::ReadBinary;
228 6         64 my $parser = Mac::PropertyList::ReadBinary->new( \$text );
229 6         27 $parser->plist;
230             }
231             else {
232 5         842 croak( "This doesn't look like a valid plist format!" );
233             }
234             };
235             }
236              
237             =item parse_plist_fh( FILEHANDLE )
238              
239             Parse the XML plist from FILEHANDLE and return the C
240             data structure. Returns false if the arguments is not a reference.
241              
242             You can do this in a couple of ways. You can open the file with a
243             lexical filehandle (since Perl 5.6).
244              
245             open my( $fh ), $file or die "...";
246             parse_plist_fh( $fh );
247              
248             Or, you can use a bareword filehandle and pass a reference to its
249             typeglob. I don't recommmend this unless you are using an older
250             Perl.
251              
252             open FILE, $file or die "...";
253             parse_plist_fh( \*FILE );
254              
255             =cut
256              
257             sub parse_plist_fh {
258 2     2 1 4377 my $fh = shift;
259              
260 2         4 my $text = do { local $/; <$fh> };
  2         7  
  2         67  
261              
262 2         22 parse_plist( $text );
263             }
264              
265             =item parse_plist_file( FILE_PATH )
266              
267             Parse the XML plist in FILE_PATH and return the C
268             data structure. Returns false if the file does not exist.
269              
270             Alternately, you can pass a filehandle reference, but that just
271             calls C for you.
272              
273             =cut
274              
275             sub parse_plist_file {
276 12     12 1 41393 my $file = shift;
277              
278 12 50       57 if( ref $file ) { return parse_plist_fh( $file ) }
  0         0  
279              
280 12 100       351 unless( -e $file ) {
281 1         158 croak( "parse_plist_file: file [$file] does not exist!" );
282 0         0 return;
283             }
284              
285 11         27 my $text = do { local $/; open my($fh), '<:raw', $file; <$fh> };
  11         58  
  11         587  
  11         782  
286              
287 11         66 parse_plist( $text );
288             }
289              
290             =item create_from_hash( HASH_REF )
291              
292             Create a plist dictionary from the hash reference.
293              
294             The values of the hash can only be simple scalars–not references.
295             Reference values are silently ignored.
296              
297             Returns a string representing the hash in the plist format.
298              
299             =cut
300              
301             sub create_from_hash {
302 0     0 1 0 my $hash = shift;
303              
304 0 0       0 unless( ref $hash eq ref {} ) {
305 0         0 carp "create_from_hash did not get an hash reference";
306 0         0 return;
307             }
308              
309 0         0 my $string = XML_head() . Mac::PropertyList::dict->write_open . "\n";
310              
311 0         0 foreach my $key ( keys %$hash ) {
312 0 0       0 next if ref $hash->{$key};
313              
314 0         0 my $bit = Mac::PropertyList::dict->write_key( $key ) . "\n";
315 0         0 my $value = Mac::PropertyList::string->new( $hash->{$key} );
316              
317 0         0 $bit .= $value->write . "\n";
318              
319 0         0 $bit =~ s/^/\t/gm;
320              
321 0         0 $string .= $bit;
322             }
323              
324 0         0 $string .= Mac::PropertyList::dict->write_close . "\n" . XML_foot();
325              
326 0         0 return $string;
327             }
328              
329             =item create_from_array( ARRAY_REF )
330              
331             Create a plist array from the array reference.
332              
333             The values of the array can only be simple scalars–not references.
334             Reference values are silently ignored.
335              
336             Returns a string representing the array in the plist format.
337              
338             =cut
339              
340             sub create_from_array {
341 0     0 1 0 my $array = shift;
342              
343 0 0       0 unless( ref $array eq ref [] ) {
344 0         0 carp "create_from_array did not get an array reference";
345 0         0 return;
346             }
347              
348 0         0 my $string = XML_head() . Mac::PropertyList::array->write_open . "\n";
349              
350 0         0 foreach my $element ( @$array ) {
351 0         0 my $value = Mac::PropertyList::string->new( $element );
352              
353 0         0 my $bit .= $value->write . "\n";
354 0         0 $bit =~ s/^/\t/gm;
355              
356 0         0 $string .= $bit;
357             }
358              
359 0         0 $string .= Mac::PropertyList::array->write_close . "\n" . XML_foot();
360              
361 0         0 return $string;
362             }
363              
364             =item create_from_string( STRING )
365              
366             Returns a string representing the string in the plist format.
367              
368             =cut
369              
370             sub create_from_string {
371 1     1 1 3662 my $string = shift;
372              
373 1 50       5 unless( ! ref $string ) {
374 0         0 carp "create_from_string did not get a string";
375 0         0 return;
376             }
377              
378             return
379 1         5 XML_head() .
380             Mac::PropertyList::string->new( $string )->write .
381             "\n" . XML_foot();
382             }
383              
384             =item create_from
385              
386             Dispatches to either C, C, or
387             C based on the argument. If none of those fit,
388             this Cs.
389              
390             =cut
391              
392             sub create_from {
393 0     0 1 0 my $thingy = shift;
394              
395 0         0 return do {
396 0 0       0 if( ref $thingy eq ref [] ) { &create_from_array }
  0 0       0  
    0          
397 0         0 elsif( ref $thingy eq ref {} ) { &create_from_hash }
398 0         0 elsif( ! ref $thingy eq ref {} ) { &create_from_string }
399             else {
400 0         0 croak "Did not recognize argument! Must be a string, or reference to a hash or array";
401             }
402             };
403             }
404              
405             =item read_string
406              
407             =item read_data
408              
409             =item read_integer
410              
411             =item read_date
412              
413             =item read_real
414              
415             =item read_true
416              
417             =item read_false
418              
419             Reads a certain sort of property list data
420              
421             =cut
422              
423 73     73 1 376 sub read_string { Mac::PropertyList::string ->new( XML::Entities::decode( 'all', $_[0] ) ) }
424 24     24 1 109 sub read_integer { Mac::PropertyList::integer->new( $_[0] ) }
425 2     2 1 13 sub read_date { Mac::PropertyList::date ->new( $_[0] ) }
426 3     3 1 19 sub read_real { Mac::PropertyList::real ->new( $_[0] ) }
427 3     3 1 23 sub read_true { Mac::PropertyList::true ->new }
428 0     0 1 0 sub read_false { Mac::PropertyList::false ->new }
429              
430             =item read_next
431              
432             Read the next data item
433              
434             =cut
435              
436             sub read_next {
437 161     161 1 293 my $source = shift;
438              
439 161         338 local $_ = '';
440 161         244 my $value;
441              
442 161         395 while( not defined $value ) {
443 680 50       1531 croak "Couldn't read anything!" if $source->eof;
444 680         1546 $_ .= $source->get_line;
445 680 100       13445 if( s[^\s* < (string|date|real|integer|data) > \s*(.*?)\s* ][]sx ) {
    100          
    100          
    50          
    50          
    100          
446 118         539 $value = $Readers{$1}->( $2 );
447             }
448             elsif( s[^\s* < string / > ][]x ){
449 2         37 $value = $Readers{'string'}->( '' );
450             }
451             elsif( s[^\s* < (dict|array) > ][]x ) {
452             # We need to put back the unprocessed text if
453             # any because the and readers
454             # need to see it.
455 38 50 33     1038 $source->put_line( $_ ) if defined $_ && '' ne $_;
456 38         70 $_ = '';
457 38         170 $value = $Readers{$1}->( $source );
458             }
459             # these next two are some wierd cases i found in the iPhoto Prefs
460             elsif( s[^\s* < dict / > ][]x ) {
461 0         0 $value = Mac::PropertyList::dict->new();
462             }
463             elsif( s[^\s* < array / > ][]x ) {
464 0         0 $value = Mac::PropertyList::array->new();
465             }
466             elsif( s[^\s* < (true|false) /> ][]x ) {
467 3         35 $value = $Readers{$1}->();
468             }
469             }
470 161         493 $source->put_line($_);
471 161         795 return $value;
472             }
473              
474             =item read_dict
475              
476             Read a dictionary
477              
478             =cut
479              
480             sub read_dict {
481 24     24 1 47 my $source = shift;
482              
483 24         45 my %hash;
484 24         74 local $_ = $source->get_line;
485 24         109 while( not s|^\s*|| ) {
486 77         121 my $key;
487 77         197 while (not defined $key) {
488 77 50       426 if (s[^\s*(.*?)][]s) {
489 77         623 $key = HTML::Entities::decode($1);
490             # Bring this back if you want this behavior:
491             # croak "Key is empty string!" if $key eq '';
492             }
493             else {
494 0 0       0 croak "Could not read key!" if $source->eof;
495 0         0 $_ .= $source->get_line;
496             }
497             }
498              
499 77         289 $source->put_line( $_ );
500 77         296 $hash{ $key } = read_next( $source );
501 77         206 $_ = $source->get_line;
502             }
503              
504 24         93 $source->put_line( $_ );
505 24 50 66     131 if ( 1 == keys %hash && exists $hash{'CF$UID'} ) {
506             # This is how plutil represents a UID in XML.
507 0         0 return Mac::PropertyList::uid->integer( $hash{'CF$UID'}->value );
508             }
509             else {
510 24         128 return Mac::PropertyList::dict->new( \%hash );
511             }
512             }
513              
514             =item read_array
515              
516             Read an array
517              
518             =cut
519              
520             sub read_array {
521 14     14 1 28 my $source = shift;
522              
523 14         40 my @array = ();
524              
525 14         69 local $_ = $source->get_line;
526 14         85 while( not s|^\s*|| ) {
527 46         119 $source->put_line( $_ );
528 46         126 push @array, read_next( $source );
529 46         139 $_ = $source->get_line;
530             }
531              
532 14         62 $source->put_line( $_ );
533 14         93 return Mac::PropertyList::array->new( \@array );
534             }
535              
536             sub read_data {
537 18     18 1 70 my $string = shift;
538              
539 18         1600 require MIME::Base64;
540              
541 18         2372 $string = MIME::Base64::decode_base64($string);
542              
543 18         98 return Mac::PropertyList::data->new( $string );
544             }
545              
546             =back
547              
548             =head2 Things that write
549              
550             =over 4
551              
552             =item XML_head
553              
554             Returns a string that represents the start of the PList XML.
555              
556             =cut
557              
558             sub XML_head () {
559 8     8 1 98 <<"XML";
560            
561            
562            
563             XML
564             }
565              
566             =item XML_foot
567              
568             Returns a string that represents the end of the PList XML.
569              
570             =cut
571              
572             sub XML_foot () {
573 8     8 1 19 <<"XML";
574            
575             XML
576             }
577              
578             =item plist_as_string
579              
580             Return the plist data structure as XML in the Mac Property List format.
581              
582             =cut
583              
584             sub plist_as_string {
585 7     7 1 846 my $object = CORE::shift;
586              
587 7         25 my $string = XML_head();
588              
589 7         31 $string .= $object->write . "\n";
590              
591 7         21 $string .= XML_foot();
592              
593 7         38 return $string;
594             }
595              
596             =item plist_as_perl
597              
598             Return the plist data structure as an unblessed Perl data structure.
599             There won't be any C objects in the results. This
600             is really just C.
601              
602             =cut
603              
604 0     0 1 0 sub plist_as_perl { $_[0]->as_perl }
605              
606             =back
607              
608             =cut
609              
610             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
611             package Mac::PropertyList::Source;
612             sub new {
613 38     38   305 my $self = bless { buffer => [], source => $_[1] }, $_[0];
614 38         102 return $self;
615             }
616              
617 680 100   680   1078 sub eof { (not @{$_[0]->{buffer}}) and $_[0]->source_eof }
  680         2484  
618              
619             sub get_line {
620 841     841   1432 my $self = CORE::shift;
621              
622             # I'm not particularly happy with what I wrote here, but that's why
623             # you shouldn't write your own buffering code! I might have left over
624             # text in the buffer. This could be stuff a higher level looked at and
625             # put back with put_line. If there's text there, grab that.
626             #
627             # But here's the tricky part. If that next part of the text looks like
628             # a "blank" line, grab the next next thing and append that.
629             #
630             # And, if there's nothing in the buffer, ask for more text from
631             # get_source_line. Follow the same rules. IF you get back something that
632             # looks like a blank line, ask for another and append it.
633             #
634             # This means that a returned line might have come partially from the
635             # buffer and partially from a fresh read.
636             #
637             # At some point you should have something that doesn't look like a
638             # blank line and the while() will break out. Return what you do.
639             #
640             # Previously, I wasn't appending to $_ so newlines were disappearing
641             # as each next read replaced the value in $_. Yuck.
642              
643 841         2302 local $_ = '';
644 841   66     4456 while (defined $_ && /^[\r\n\s]*$/) {
645 1078 100       1703 if( @{$self->{buffer}} ) {
  1078         2422  
646 293         447 $_ .= shift @{$self->{buffer}};
  293         1663  
647             }
648             else {
649 785         1617 $_ .= $self->get_source_line;
650             }
651             }
652              
653 841         2345 return $_;
654             }
655              
656 360     360   549 sub put_line { unshift @{$_[0]->{buffer}}, $_[1] }
  360         1061  
657              
658             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
659             package Mac::PropertyList::LineListSource;
660 24     24   266 use base qw(Mac::PropertyList::Source);
  24         51  
  24         13691  
661              
662 0 0   0   0 sub get_source_line { return shift @{$_->{source}} if @{$_->{source}} }
  0         0  
  0         0  
663              
664 0     0   0 sub source_eof { not @{$_[0]->{source}} }
  0         0  
665              
666             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
667             package Mac::PropertyList::TextSource;
668 24     24   219 use base qw(Mac::PropertyList::Source);
  24         56  
  24         19452  
669              
670             sub get_source_line {
671 785     785   1283 my $self = CORE::shift;
672 785         5646 $self->{source} =~ s/(.*(\r|\n|$))//;
673 785         5284 $1;
674             }
675              
676 557     557   2010 sub source_eof { not $_[0]->{source} }
677              
678             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
679             package Mac::PropertyList::Item;
680 0     0   0 sub type_value { ( $_[0]->type, $_[0]->value ) }
681              
682             sub value {
683 732     732   84375 my $ref = $_[0]->type;
684              
685 732         1123 do {
686 732 100       1879 if( $ref eq 'array' ) { wantarray ? @{ $_[0] } : $_[0] }
  44 100       165  
  5 100       26  
687 137 50       652 elsif( $ref eq 'dict' ) { wantarray ? %{ $_[0] } : $_[0] }
  0         0  
688 551         836 else { ${ $_[0] } }
  551         2072  
689             };
690             }
691              
692 825 50   825   13415 sub type { my $r = ref $_[0] ? ref $_[0] : $_[0]; $r =~ s/.*:://; $r; }
  825         4112  
  825         2000  
693              
694             sub new {
695 724     724   2909 bless $_[1], $_[0]
696             }
697              
698 34     34   332 sub write_open { $_[0]->write_either(); }
699 34     34   696 sub write_close { $_[0]->write_either('/'); }
700              
701             sub write_either {
702 68 100   68   162 my $slash = defined $_[1] ? '/' : '';
703              
704 68         135 my $type = $_[0]->type;
705              
706 68         231 "<$slash$type>";
707             }
708              
709 3     3   16 sub write_empty { my $type = $_[0]->type; "<$type/>"; }
  3         16  
710              
711             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
712             package Mac::PropertyList::Container;
713 24     24   233 use base qw(Mac::PropertyList::Item);
  24         49  
  24         12285  
714              
715             sub new {
716 117     117   3143 my $class = CORE::shift;
717 117         210 my $item = CORE::shift;
718              
719 117 100       370 if( ref $item ) {
720 113         526 return bless $item, $class;
721             }
722              
723 4         10 my $empty = do {
724 4 100       34 if( $class =~ m/array$/ ) { [] }
  2 50       5  
725 2         8 elsif( $class =~ m/dict$/ ) { {} }
726             };
727              
728 4         26 $class->SUPER::new( $empty );
729             }
730              
731             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
732             package Mac::PropertyList::array;
733 24     24   311 use base qw(Mac::PropertyList::Container);
  24         106  
  24         20732  
734              
735 0     0   0 sub shift { CORE::shift @{ $_[0]->value } }
  0         0  
736       0     sub unshift { }
737 0     0   0 sub pop { CORE::pop @{ $_[0]->value } }
  0         0  
738       0     sub push { }
739       0     sub splice { }
740 3     3   2366 sub count { return scalar @{ $_[0]->value } }
  3         35  
741 17     17   26 sub _elements { @{ $_[0]->value } } # the raw, unprocessed elements
  17         41  
742             sub values {
743 2     2   8 my @v = map { $_->value } $_[0]->_elements;
  7         23  
744 2 50       16 wantarray ? @v : \@v
745             }
746              
747             sub as_basic_data {
748 3     3   6 my $self = CORE::shift;
749             return
750             [ map
751             {
752 3 50       11 eval { $_->can('as_basic_data') } ? $_->as_basic_data : $_
  7         14  
  7         42  
753             } @$self
754             ];
755             }
756              
757             sub write {
758 3     3   5 my $self = CORE::shift;
759              
760 3         15 my $string = $self->write_open . "\n";
761              
762 3         11 foreach my $element ( @$self ) {
763 11         52 my $bit = $element->write;
764              
765 11         44 $bit =~ s/^/\t/gm;
766              
767 11         25 $string .= $bit . "\n";
768             }
769              
770 3         13 $string .= $self->write_close;
771              
772 3         19 return $string;
773             }
774              
775             sub as_perl {
776 15     15   24 my $self = CORE::shift;
777              
778 15         43 my @array = map { $_->as_perl } $self->_elements;
  21         60  
779              
780 15         35 return \@array;
781             }
782              
783             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
784             package Mac::PropertyList::dict;
785 24     24   279 use base qw(Mac::PropertyList::Container);
  24         64  
  24         26597  
786              
787             sub new {
788 59     59   2572 $_[0]->SUPER::new( $_[1] );
789             }
790              
791 1     1   3 sub delete { delete ${ $_[0]->value }{$_[1]} }
  1         4  
792 6 100   6   1240 sub exists { exists ${ $_[0]->value }{$_[1]} ? 1 : 0 }
  6         18  
793 5     5   1846 sub count { scalar CORE::keys %{ $_[0]->value } }
  5         21  
794              
795             sub value {
796 137     137   5008 my $self = shift;
797 137         259 my $key = shift;
798              
799             do
800 137         245 {
801 137 100       316 if( defined $key ) {
802 78         171 my $hash = $self->SUPER::value;
803              
804 78 50       210 if( exists $hash->{$key} ) { $hash->{$key}->value }
  78         261  
805 0         0 else { return }
806             }
807 59         227 else { $self->SUPER::value }
808             };
809              
810             }
811              
812 18 50   18   1303 sub keys { my @k = CORE::keys %{ $_[0]->value }; wantarray ? @k : \@k; }
  18         55  
  18         142  
813             sub values {
814 2     2   1372 my @v = map { $_->value } CORE::values %{ $_[0]->value };
  5         19  
  2         7  
815 2 50       20 wantarray ? @v : \@v;
816             }
817              
818             sub as_basic_data {
819 3     3   6 my $self = shift;
820              
821             my %dict = map {
822 3         14 my ($k, $v) = ($_, $self->{$_});
  9         52  
823 9 50       18 $k => eval { $v->can('as_basic_data') } ? $v->as_basic_data : $v
  9         57  
824             } CORE::keys %$self;
825              
826 3         28 return \%dict;
827             }
828              
829             sub write_key {
830 12     12   40 '' . HTML::Entities::encode_entities($_[1]) . ''
831             }
832              
833             sub write {
834 6     6   15 my $self = shift;
835              
836 6         73 my $string = $self->write_open . "\n";
837              
838 6         26 foreach my $key ( sort { $a cmp $b } $self->keys ) {
  11         22  
839 12         25 my $element = $self->{$key};
840              
841 12         34 my $bit = __PACKAGE__->write_key( $key ) . "\n";
842 12         305 $bit .= $element->write . "\n";
843              
844 12         67 $bit =~ s/^/\t/gm;
845              
846 12         33 $string .= $bit;
847             }
848              
849 6         31 $string .= $self->write_close;
850              
851 6         59 return $string;
852             }
853              
854             sub as_perl {
855 8     8   1163 my $self = CORE::shift;
856              
857             my %dict = map {
858 8         24 my $v = $self->value($_);
  69         142  
859 69 100       122 $v = $v->as_perl if eval { $v->can( 'as_perl' ) };
  69         387  
860 69         238 $_, $v
861             } $self->keys;
862              
863 8         47 return \%dict;
864             }
865              
866              
867             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
868             package Mac::PropertyList::Scalar;
869 24     24   221 use base qw(Mac::PropertyList::Item);
  24         217  
  24         12215  
870              
871 720     720   393136 sub new { my $copy = $_[1]; $_[0]->SUPER::new( \$copy ) }
  720         2289  
872              
873 16     16   51 sub as_basic_data { $_[0]->value }
874              
875 23     23   1273 sub write { $_[0]->write_open . HTML::Entities::encode_entities($_[0]->value) . $_[0]->write_close }
876              
877 20     20   39 sub as_perl { $_[0]->value }
878              
879             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
880             package Mac::PropertyList::date;
881 24     24   245 use base qw(Mac::PropertyList::Scalar);
  24         43  
  24         8525  
882              
883             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
884             package Mac::PropertyList::real;
885 24     24   189 use base qw(Mac::PropertyList::Scalar);
  24         43  
  24         6617  
886              
887             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
888             package Mac::PropertyList::integer;
889 24     24   215 use base qw(Mac::PropertyList::Scalar);
  24         46  
  24         6263  
890              
891             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
892             package Mac::PropertyList::uid;
893 24     24   213 use base qw(Mac::PropertyList::Scalar);
  24         48  
  24         9662  
894              
895             # The following is conservative, since the actual largest unsigned
896             # integer is ~0, which is 0xFFFFFFFFFFFFFFFF on many (most?) modern
897             # Perls; but it is consistent with Mac::PropertyList::ReadBinary.
898             # This is really just future-proofing though, since it appears from
899             # CFBinaryPList.c that a UID is carried as a hard-coded uint32_t.
900 24     24   234 use constant LONGEST_HEX_REPRESENTABLE_AS_NATIVE => 8; # 4 bytes
  24         49  
  24         13726  
901              
902             # Instantiate with hex string. The string will be padded on the left
903             # with zero if its length is odd. It is this string which will be
904             # returned by value(). Presence of a non-hex character causes an
905             # exception. We default the argument to '00'.
906             sub new {
907 10     10   3570 my ( $class, $value ) = @_;
908 10 100       32 $value = '00' unless defined $value;
909 10 50       42 Carp::croak( 'uid->new() argument must be hexadecimal' )
910             if $value =~ m/ [[:^xdigit:]] /smx;
911 10 100       29 substr $value, 0, 0, '0'
912             if length( $value ) % 2;
913 10         41 return $class->SUPER::new( $value );
914             }
915              
916             # Without argument, this is an accessor returning the value as an unsigned
917             # integer, either a native Perl value or a Math::BigInt as needed.
918             # With argument, this is a mutator setting the value to the hex
919             # representation of the argument, which must be an unsigned integer,
920             # either native Perl of Math::BigInt object. If called as static method
921             # instantiates a new object.
922             sub integer {
923 2     2   2170 my ( $self, $integer ) = @_;
924 2 100       9 if ( @_ < 2 ) {
925 1         4 my $value = $self->value();
926 1 50       9 return length( $value ) > LONGEST_HEX_REPRESENTABLE_AS_NATIVE ?
927             Math::BigInt->from_hex( $value ) :
928             hex $value;
929             }
930             else {
931 1 50       5 Carp::croak( 'uid->integer() argument must be unsigned' )
932             if $integer < 0;
933 1 50       8 my $value = ref $integer ?
934             $integer->to_hex() :
935             sprintf '%x', $integer;
936 1 50       4 if ( ref $self ) {
937 0 0       0 substr $value, 0, 0, '0'
938             if length( $value ) % 2;
939 0         0 ${ $self } = $value;
  0         0  
940             }
941             else {
942 1         4 $self = $self->new( $value );
943             }
944 1         4 return $self;
945             }
946             }
947              
948             # This is how plutil represents a UID in XML.
949             sub write {
950 1     1   3 my $self = shift;
951 1         5 my $dict = Mac::PropertyList::dict->new( {
952             'CF$UID' => Mac::PropertyList::integer->new(
953             $self->integer ),
954             }
955             );
956 1         6 return $dict->write();
957             }
958              
959             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
960             package Mac::PropertyList::string;
961 24     24   201 use base qw(Mac::PropertyList::Scalar);
  24         61  
  24         6663  
962              
963             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
964             package Mac::PropertyList::ustring;
965 24     24   181 use base qw(Mac::PropertyList::Scalar);
  24         58  
  24         6418  
966              
967             # XXX need to do some fancy unicode checking here
968              
969             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
970             package Mac::PropertyList::data;
971 24     24   193 use base qw(Mac::PropertyList::Scalar);
  24         44  
  24         9238  
972              
973             sub write {
974 2     2   5 my $self = shift;
975              
976 2         6 my $type = $self->type;
977 2         6 my $value = $self->value;
978              
979 2         13 require MIME::Base64;
980              
981 2         9 my $string = MIME::Base64::encode_base64($value);
982              
983 2         10 $self->write_open . $string . $self->write_close;
984             }
985              
986             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
987             package Mac::PropertyList::Boolean;
988 24     24   208 use base qw(Mac::PropertyList::Item);
  24         58  
  24         11338  
989              
990             sub new {
991 20     20   2911 my $class = shift;
992              
993 20         140 my( $type ) = $class =~ m/.*::(.*)/g;
994              
995 20         120 $class->either( $type );
996             }
997              
998 20     20   47 sub either { my $copy = $_[1]; bless \$copy, $_[0] }
  20         265  
999              
1000 3     3   22 sub write { $_[0]->write_empty }
1001              
1002             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1003             package Mac::PropertyList::true;
1004 24     24   218 use base qw(Mac::PropertyList::Boolean);
  24         58  
  24         30814  
1005              
1006             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1007             package Mac::PropertyList::false;
1008 24     24   187 use base qw(Mac::PropertyList::Boolean);
  24         51  
  24         8104  
1009              
1010              
1011             =head1 SOURCE AVAILABILITY
1012              
1013             This project is in Github:
1014              
1015             https://github.com/briandfoy/mac-propertylist.git
1016              
1017             =head1 CREDITS
1018              
1019             Thanks to Chris Nandor for general Mac kung fu and Chad Walker for
1020             help figuring out the recursion for nested structures.
1021              
1022             Mike Ciul provided some classes for the different input modes, and
1023             these allow us to optimize the parsing code for each of those.
1024              
1025             Ricardo Signes added the C methods so you can dump
1026             all the plist junk and just play with the data.
1027              
1028             =head1 TO DO
1029              
1030             * change the value of an object
1031              
1032             * validate the values of objects (date, integer)
1033              
1034             * methods to add to containers (dict, array)
1035              
1036             * do this from a filehandle or a scalar reference instead of a scalar
1037             + generate closures to handle the work.
1038              
1039             =head1 AUTHOR
1040              
1041             brian d foy, C<< >>
1042              
1043             Tom Wyant added support for UID types.
1044              
1045             =head1 COPYRIGHT AND LICENSE
1046              
1047             Copyright © 2004-2026, brian d foy . All rights reserved.
1048              
1049             This program is free software; you can redistribute it and/or modify
1050             it under the terms of the Artistic License 2.0.
1051              
1052             =head1 SEE ALSO
1053              
1054             http://www.apple.com/DTDs/PropertyList-1.0.dtd
1055              
1056             =cut
1057              
1058             "See why 1984 won't be like 1984";