File Coverage

blib/lib/Mac/PropertyList.pm
Criterion Covered Total %
statement 312 369 84.5
branch 65 104 62.5
condition 5 9 55.5
subroutine 85 97 87.6
pod 21 21 100.0
total 488 600 81.3


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