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   1021326 use v5.10;
  20         207  
2              
3             package Mac::PropertyList;
4 20     20   128 use strict;
  20         43  
  20         563  
5              
6 20     20   110 use warnings;
  20         34  
  20         664  
7 20     20   136 no warnings;
  20         46  
  20         876  
8              
9 20     20   149 use vars qw($ERROR);
  20         91  
  20         1411  
10 20     20   136 use Carp qw(croak carp);
  20         44  
  20         1178  
11 20     20   12448 use Data::Dumper;
  20         128699  
  20         1278  
12 20     20   9700 use XML::Entities;
  20         334576  
  20         973  
13              
14 20     20   158 use Exporter qw(import);
  20         43  
  20         51028  
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.502';
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 25415 my $text = shift;
198              
199 46         90 my $plist = do {
200 46 100       288 if( $text =~ /\A<\?xml/ ) { # XML plists
    100          
201 33         129 $text =~ s///g;
202             # we can handle either 0.9 or 1.0
203 33         383 $text =~ s|^<\?xml.*?>\s*\s*\s*||;
204 33         982 $text =~ s|\s*\s*$||;
205              
206 33         247 my $text_source = Mac::PropertyList::TextSource->new( $text );
207 33         100 read_next( $text_source );
208             }
209             elsif( $text =~ /\Abplist/ ) { # binary plist
210 8         1082 require Mac::PropertyList::ReadBinary;
211 8         70 my $parser = Mac::PropertyList::ReadBinary->new( \$text );
212 8         26 $parser->plist;
213             }
214             else {
215 5         556 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 2331 my $fh = shift;
242              
243 2         4 my $text = do { local $/; <$fh> };
  2         12  
  2         79  
244              
245 2         11 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 6885 my $file = shift;
260              
261 8 50       31 if( ref $file ) { return parse_plist_fh( $file ) }
  0         0  
262              
263 8 100       188 unless( -e $file ) {
264 1         103 croak( "parse_plist_file: file [$file] does not exist!" );
265 0         0 return;
266             }
267              
268 7         23 my $text = do { local $/; open my($fh), $file; <$fh> };
  7         36  
  7         292  
  7         309  
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 2750 my $string = shift;
355              
356 1 50       8 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 324 sub read_string { Mac::PropertyList::string ->new( XML::Entities::decode( 'all', $_[0] ) ) }
407 24     24 1 99 sub read_integer { Mac::PropertyList::integer->new( $_[0] ) }
408 2     2 1 12 sub read_date { Mac::PropertyList::date ->new( $_[0] ) }
409 4     4 1 21 sub read_real { Mac::PropertyList::real ->new( $_[0] ) }
410 8     8 1 42 sub read_true { Mac::PropertyList::true ->new }
411 7     7 1 18 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 328 my $source = shift;
421              
422 213         347 local $_ = '';
423 213         309 my $value;
424              
425 213         446 while( not defined $value ) {
426 1258 50       2528 croak "Couldn't read anything!" if $source->eof;
427 1258         2430 $_ .= $source->get_line;
428 1258 100       13423 if( s[^\s* < (string|date|real|integer|data) > \s*(.*?)\s* ][]sx ) {
    100          
    100          
    50          
    100          
    100          
429 155         494 $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     287 $source->put_line( $_ ) if defined $_ && '' ne $_;
439 41         86 $_ = '';
440 41         155 $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         4 $value = Mac::PropertyList::array->new();
448             }
449             elsif( s[^\s* < (true|false) /> ][]x ) {
450 15         50 $value = $Readers{$1}->();
451             }
452             }
453 213         778 $source->put_line($_);
454 213         877 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 49 my $source = shift;
465              
466 26         45 my %hash;
467 26         110 local $_ = $source->get_line;
468 26         94 while( not s|^\s*|| ) {
469 129         196 my $key;
470 129         255 while (not defined $key) {
471 129 50       580 if (s[^\s*(.*?)][]s) {
472 129         407 $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         415 $source->put_line( $_ );
483 129         319 $hash{ $key } = read_next( $source );
484 129         260 $_ = $source->get_line;
485             }
486              
487 26         99 $source->put_line( $_ );
488 26 50 66     139 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         179 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 27 my $source = shift;
505              
506 15         36 my @array = ();
507              
508 15         37 local $_ = $source->get_line;
509 15         98 while( not s|^\s*|| ) {
510 51         137 $source->put_line( $_ );
511 51         137 push @array, read_next( $source );
512 51         117 $_ = $source->get_line;
513             }
514              
515 15         66 $source->put_line( $_ );
516 15         102 return Mac::PropertyList::array->new( \@array );
517             }
518              
519             sub read_data {
520 36     36 1 113 my $string = shift;
521              
522 36         1196 require MIME::Base64;
523              
524 36         1575 $string = MIME::Base64::decode_base64($string);
525              
526 36         120 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 11 <<"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 13 <<"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 17 my $object = CORE::shift;
569              
570 4         10 my $string = XML_head();
571              
572 4         13 $string .= $object->write . "\n";
573              
574 4         11 $string .= XML_foot();
575              
576 4         9 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   262 my $self = bless { buffer => [], source => $_[1] }, $_[0];
597 33         82 return $self;
598             }
599              
600 1258 100   1258   1599 sub eof { (not @{$_[0]->{buffer}}) and $_[0]->source_eof }
  1258         3580  
601              
602             sub get_line {
603 1479     1479   2124 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         2168 local $_ = '';
627 1479   66     5945 while (defined $_ && /^[\r\n\s]*$/) {
628 1835 100       2589 if( @{$self->{buffer}} ) {
  1835         3494  
629 415         572 $_ .= shift @{$self->{buffer}};
  415         2061  
630             }
631             else {
632 1420         2446 $_ .= $self->get_source_line;
633             }
634             }
635              
636 1479         3954 return $_;
637             }
638              
639 475     475   627 sub put_line { unshift @{$_[0]->{buffer}}, $_[1] }
  475         1225  
640              
641             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
642             package Mac::PropertyList::LineListSource;
643 20     20   230 use base qw(Mac::PropertyList::Source);
  20         72  
  20         10803  
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   176 use base qw(Mac::PropertyList::Source);
  20         40  
  20         14977  
652              
653             sub get_source_line {
654 1420     1420   1939 my $self = CORE::shift;
655 1420         10742 $self->{source} =~ s/(.*(\r|\n|$))//;
656 1420         8961 $1;
657             }
658              
659 1078     1078   3386 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   15299 my $ref = $_[0]->type;
667              
668 626         955 do {
669 626 100       1332 if( $ref eq 'array' ) { wantarray ? @{ $_[0] } : $_[0] }
  41 100       132  
  4 100       18  
670 126 50       471 elsif( $ref eq 'dict' ) { wantarray ? %{ $_[0] } : $_[0] }
  0         0  
671 459         579 else { ${ $_[0] } }
  459         1406  
672             };
673             }
674              
675 680 50   680   6087 sub type { my $r = ref $_[0] ? ref $_[0] : $_[0]; $r =~ s/.*:://; $r; }
  680         2630  
  680         1510  
676              
677             sub new {
678 698     698   2299 bless $_[1], $_[0]
679             }
680              
681 18     18   95 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   81 my $slash = defined $_[1] ? '/' : '';
686              
687 36         78 my $type = $_[0]->type;
688              
689 36         140 "<$slash$type>";
690             }
691              
692 3     3   11 sub write_empty { my $type = $_[0]->type; "<$type/>"; }
  3         15  
693              
694             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
695             package Mac::PropertyList::Container;
696 20     20   191 use base qw(Mac::PropertyList::Item);
  20         49  
  20         9031  
697              
698             sub new {
699 116     116   1590 my $class = CORE::shift;
700 116         178 my $item = CORE::shift;
701              
702 116 100       352 if( ref $item ) {
703 111         443 return bless $item, $class;
704             }
705              
706 5         11 my $empty = do {
707 5 100       39 if( $class =~ m/array$/ ) { [] }
  3 50       11  
708 2         11 elsif( $class =~ m/dict$/ ) { {} }
709             };
710              
711 5         37 $class->SUPER::new( $empty );
712             }
713              
714             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
715             package Mac::PropertyList::array;
716 20     20   229 use base qw(Mac::PropertyList::Container);
  20         177  
  20         16197  
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   1510 sub count { return scalar @{ $_[0]->value } }
  3         18  
724 17     17   29 sub _elements { @{ $_[0]->value } } # the raw, unprocessed elements
  17         31  
725             sub values {
726 2     2   7 my @v = map { $_->value } $_[0]->_elements;
  7         18  
727 2 50       12 wantarray ? @v : \@v
728             }
729              
730             sub as_basic_data {
731 3     3   7 my $self = CORE::shift;
732             return
733             [ map
734             {
735 3 50       11 eval { $_->can('as_basic_data') } ? $_->as_basic_data : $_
  7         11  
  7         42  
736             } @$self
737             ];
738             }
739              
740             sub write {
741 2     2   3 my $self = CORE::shift;
742              
743 2         9 my $string = $self->write_open . "\n";
744              
745 2         9 foreach my $element ( @$self ) {
746 5         18 my $bit = $element->write;
747              
748 5         20 $bit =~ s/^/\t/gm;
749              
750 5         67 $string .= $bit . "\n";
751             }
752              
753 2         8 $string .= $self->write_close;
754              
755 2         7 return $string;
756             }
757              
758             sub as_perl {
759 15     15   25 my $self = CORE::shift;
760              
761 15         55 my @array = map { $_->as_perl } $self->_elements;
  21         53  
762              
763 15         33 return \@array;
764             }
765              
766             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
767             package Mac::PropertyList::dict;
768 20     20   168 use base qw(Mac::PropertyList::Container);
  20         40  
  20         19010  
769              
770             sub new {
771 56     56   1029 $_[0]->SUPER::new( $_[1] );
772             }
773              
774 1     1   3 sub delete { delete ${ $_[0]->value }{$_[1]} }
  1         4  
775 6 100   6   978 sub exists { exists ${ $_[0]->value }{$_[1]} ? 1 : 0 }
  6         15  
776 5     5   1516 sub count { scalar CORE::keys %{ $_[0]->value } }
  5         13  
777              
778             sub value {
779 126     126   3750 my $self = shift;
780 126         182 my $key = shift;
781              
782             do
783 126         176 {
784 126 100       238 if( defined $key ) {
785 78         137 my $hash = $self->SUPER::value;
786              
787 78 50       172 if( exists $hash->{$key} ) { $hash->{$key}->value }
  78         200  
788 0         0 else { return }
789             }
790 48         147 else { $self->SUPER::value }
791             };
792              
793             }
794              
795 16 50   16   910 sub keys { my @k = CORE::keys %{ $_[0]->value }; wantarray ? @k : \@k; }
  16         44  
  16         95  
796             sub values {
797 2     2   1050 my @v = map { $_->value } CORE::values %{ $_[0]->value };
  5         13  
  2         5  
798 2 50       22 wantarray ? @v : \@v;
799             }
800              
801             sub as_basic_data {
802 3     3   6 my $self = shift;
803              
804             my %dict = map {
805 3         14 my ($k, $v) = ($_, $self->{$_});
  9         19  
806 9 50       14 $k => eval { $v->can('as_basic_data') } ? $v->as_basic_data : $v
  9         49  
807             } CORE::keys %$self;
808              
809 3         25 return \%dict;
810             }
811              
812 5     5   16 sub write_key { "$_[1]" }
813              
814             sub write {
815 4     4   7 my $self = shift;
816              
817 4         16 my $string = $self->write_open . "\n";
818              
819 4         16 foreach my $key ( $self->keys ) {
820 5         11 my $element = $self->{$key};
821              
822 5         13 my $bit = __PACKAGE__->write_key( $key ) . "\n";
823 5         19 $bit .= $element->write . "\n";
824              
825 5         27 $bit =~ s/^/\t/gm;
826              
827 5         15 $string .= $bit;
828             }
829              
830 4         14 $string .= $self->write_close;
831              
832 4         18 return $string;
833             }
834              
835             sub as_perl {
836 8     8   983 my $self = CORE::shift;
837              
838             my %dict = map {
839 8         23 my $v = $self->value($_);
  69         120  
840 69 100       114 $v = $v->as_perl if eval { $v->can( 'as_perl' ) };
  69         313  
841 69         190 $_, $v
842             } $self->keys;
843              
844 8         40 return \%dict;
845             }
846              
847              
848             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
849             package Mac::PropertyList::Scalar;
850 20     20   201 use base qw(Mac::PropertyList::Item);
  20         50  
  20         9223  
851              
852 693     693   139420 sub new { my $copy = $_[1]; $_[0]->SUPER::new( \$copy ) }
  693         1790  
853              
854 16     16   42 sub as_basic_data { $_[0]->value }
855              
856 10     10   43 sub write { $_[0]->write_open . $_[0]->value . $_[0]->write_close }
857              
858 20     20   33 sub as_perl { $_[0]->value }
859              
860             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
861             package Mac::PropertyList::date;
862 20     20   174 use base qw(Mac::PropertyList::Scalar);
  20         50  
  20         6903  
863              
864             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
865             package Mac::PropertyList::real;
866 20     20   160 use base qw(Mac::PropertyList::Scalar);
  20         67  
  20         5884  
867              
868             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
869             package Mac::PropertyList::integer;
870 20     20   162 use base qw(Mac::PropertyList::Scalar);
  20         59  
  20         5662  
871              
872             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
873             package Mac::PropertyList::uid;
874 20     20   150 use base qw(Mac::PropertyList::Scalar);
  20         41  
  20         5805  
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   227 use constant LONGEST_HEX_REPRESENTABLE_AS_NATIVE => 8; # 4 bytes
  20         46  
  20         8516  
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   2885 my ( $class, $value ) = @_;
889 14 100       54 $value = '00' unless defined $value;
890 14 50       58 Carp::croak( 'uid->new() argument must be hexadecimal' )
891             if $value =~ m/ [[:^xdigit:]] /smx;
892 14 100       48 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   356 my ( $self, $integer ) = @_;
905 2 100       8 if ( @_ < 2 ) {
906 1         3 my $value = $self->value();
907 1 50       9 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       7 my $value = ref $integer ?
915             $integer->to_hex() :
916             sprintf '%x', $integer;
917 1 50       3 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         3 $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   3 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         5 return $dict->write();
938             }
939              
940             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
941             package Mac::PropertyList::string;
942 20     20   173 use base qw(Mac::PropertyList::Scalar);
  20         75  
  20         6055  
943              
944             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
945             package Mac::PropertyList::ustring;
946 20     20   158 use base qw(Mac::PropertyList::Scalar);
  20         40  
  20         6052  
947              
948             # XXX need to do some fancy unicode checking here
949              
950             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
951             package Mac::PropertyList::data;
952 20     20   171 use base qw(Mac::PropertyList::Scalar);
  20         39  
  20         7124  
953              
954             sub write {
955 2     2   4 my $self = shift;
956              
957 2         17 my $type = $self->type;
958 2         5 my $value = $self->value;
959              
960 2         10 require MIME::Base64;
961              
962 2         8 my $string = MIME::Base64::encode_base64($value);
963              
964 2         9 $self->write_open . $string . $self->write_close;
965             }
966              
967             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
968             package Mac::PropertyList::Boolean;
969 20     20   197 use base qw(Mac::PropertyList::Item);
  20         85  
  20         8883  
970              
971             sub new {
972 30     30   1571 my $class = shift;
973              
974 30         171 my( $type ) = $class =~ m/.*::(.*)/g;
975              
976 30         135 $class->either( $type );
977             }
978              
979 30     30   65 sub either { my $copy = $_[1]; bless \$copy, $_[0] }
  30         150  
980              
981 3     3   19 sub write { $_[0]->write_empty }
982              
983             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
984             package Mac::PropertyList::true;
985 20     20   183 use base qw(Mac::PropertyList::Boolean);
  20         66  
  20         7012  
986              
987             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
988             package Mac::PropertyList::false;
989 20     20   154 use base qw(Mac::PropertyList::Boolean);
  20         41  
  20         6220  
990              
991              
992             =head1 SOURCE AVAILABILITY
993              
994             This project is in Github:
995              
996             git://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";