%{
# PlistParse.yp - Apple PLIST XML grammer parser, used by 'plistparse'
# compile using yapp script from Parse::Yapp PERL module

# Copyright 2009 Lou Arminio (lou <dot> arminio <at> gmail <dot> com)

#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.

# Globals
my $indent = 0;
my $XML;
my @regexp;
my $showtags;

my @lastkey;
my @lasttag;
my $lasttag_len = 0;
my $lastkey_len = 0;

%}
%%
plist:		PLIST_ plist_object PLIST
		| tags PLIST_ plist_object PLIST
		;

tags:		tag
		| tags tag
		;

tag:		TAG__ 
		| TAG_ 
		| TAG_ TAG
		| TAG_ PCDATA TAG
		;

plist_object:	array
		| data
		| date
		| dict
		| real
		| integer
		| string
		| true
		| false
		;

array: 		array_s array_body array_e
		;
array_s:	ARRAY_	{
                         $indent++; 
                         print "  "x$indent, "Array:\n" if ($showtags);
			 if (!$showtags and (key_match() or block_match())) {
			     print "  Array_\n";
			     lasttag_push("Block");
			 }
                        }
		;
array_body:	plist_object
		| array_body plist_object
		;
array_e:	ARRAY	{
                         print "  "x$indent, "EndArray:\n" if ($showtags); 
                         $indent--;
			 if (!$showtags and block_match()) {
			     print "  _Array\n";
			     lasttag_pop();
			 }
                        }
		;

dict:		dict_s dict_e	/* <dict> can be empty! */
		| dict_s dict_objects dict_e
		;
dict_s:		DICT_	{
			 if ($showtags) {
                             $indent++; 
                             print "  "x$indent, "Dict:\n";
			 }
			 elsif (key_match() or block_match()) {
			     lasttag_push("Block");
			     print "  Dict_\n";
			 }
                        }
		;
dict_objects:	dict_objects dict_object
		| dict_object
		;
dict_object:	key plist_object	{
					 lastkey_pop(); # key value
					 if (key_match()) {
					     lasttag_pop(); # key tag
					 }
					}
		;
dict_e:		DICT	{
			 if ($showtags) {
                             print "  "x$indent, "EndDict:\n";
                             $indent--;
			 }
			 elsif (block_match()) {
			     print "  _Dict\n";
			     lasttag_pop(); # key tag
                         }
                        }
		;

key:		KEY_ PCDATA KEY	{
                                 lastkey_push ($_[2]);
                                 if (re_match ($_[2]) or key_match() or 
				                            block_match()) {
                                     lasttag_push ("Key"); 
                                     print "  "x$indent if ($showtags);
				     print "  Key: $_[2]\n";
				 }
                                }
		;

string:		STRING_ STRING	{
				  process_pcdata ("String", "<empty>");
				}
		| STRING_ PCDATA STRING	{
				  process_pcdata ("String", $_[2]);
				}
		;

data:		DATA_ DATA	{
				  process_pcdata ("Data", "<empty>");
				}
		| DATA_ PCDATA DATA	{
				  process_pcdata ("Data", $_[2]);
				}
		;

date:		DATE_ DATE	{ 
				  process_pcdata ("Date", "<empty>");
				}
		| DATE_ PCDATA DATE	{
					  process_pcdata ("Date", $_[2]);
					}
		;

integer:	INTEGER_ INTEGER	{
					  process_pcdata ("Integer", "<empty>");
					}
		| INTEGER_ PCDATA INTEGER	{
					  process_pcdata ("Integer", $_[2]);
					}
		;

real:	REAL_ REAL	{
			  process_pcdata ("Integer", "<empty>");
			}
	| REAL_ PCDATA REAL	{
				  process_pcdata ("Integer", $_[2]);
				}
		;

true:		TRUE	{
			  process_pcdata ("Boolean", "TRUE");
			}
		;

false:		FALSE	{
			  process_pcdata ("Boolean", "FALSE");
			}
		;
%%

sub _yyerror {
        exists $_[0]->YYData->{ERRMSG}
    and do {
        print $_[0]->YYData->{ERRMSG};
        delete $_[0]->YYData->{ERRMSG};
        return;
    };
    print "Syntax error.\n";
}

sub _yylex {
    my($parser)=shift;

    while (! $parser->YYData->{INPUT}) {
        $parser->YYData->{INPUT} = <$XML> or return('',undef);

        chomp $parser->YYData->{INPUT};
        $parser->YYData->{INPUT} =~ s/^\s*//; # strip leading spaces
    }

    # <plist>
    $parser->YYData->{INPUT} =~ s/^(<plist(\s+version="[0-9\.]+")?>)// and 
        return("PLIST_", $1);
    $parser->YYData->{INPUT} =~ s/^(<\/plist>)// and 
        return("PLIST", $1);

    # <dict>
    $parser->YYData->{INPUT} =~ s/^(<dict>)// and 
        return("DICT_", $1);
    $parser->YYData->{INPUT} =~ s/^(<\/dict>)// and 
        return("DICT", $1);
    
    # <array>
    $parser->YYData->{INPUT} =~ s/^(<array>)// and
        return("ARRAY_", $1);
    $parser->YYData->{INPUT} =~ s/^(<\/array>)// and
        return("ARRAY", $1);

    # <data>
    $parser->YYData->{INPUT} =~ s/^(<data>)// and 
        return("DATA_", $1);
    $parser->YYData->{INPUT} =~ s/^(<\/data>)// and 
        return("DATA", $1);

    # <key>
    $parser->YYData->{INPUT} =~ s/^(<key>)// and 
        return("KEY_", $1);
    $parser->YYData->{INPUT} =~ s/^(<\/key>)// and
        return("KEY", $1);

    # <date>
    $parser->YYData->{INPUT} =~ s/^(<date>)// and 
        return("DATE_", $1);
    $parser->YYData->{INPUT} =~ s/^(<\/date>)// and 
        return("DATE", $1);

    # <real>
    $parser->YYData->{INPUT} =~ s/^(<real>)// and 
        return("REAL_", $1);
    $parser->YYData->{INPUT} =~ s/^(<\/real>)// and 
        return("REAL", $1);

    # <integer>
    $parser->YYData->{INPUT} =~ s/^(<integer>)// and 
        return("INTEGER_", $1);
    $parser->YYData->{INPUT} =~ s/^(<\/integer>)// and 
        return("INTEGER", $1);

    # <string>
    $parser->YYData->{INPUT} =~ s/^(<string>)// and 
        return("STRING_", $1);
    $parser->YYData->{INPUT} =~ s/^(<\/string>)// and 
        return("STRING", $1);

    # <true>
    $parser->YYData->{INPUT} =~ s/^(<true\s*\/>)// and 
        return("TRUE", $1);
    # <false>
    $parser->YYData->{INPUT} =~ s/^(<false\s*\/>)// and 
        return("FALSE", $1);

    # Any other XML tag 
    $parser->YYData->{INPUT} =~ s/^(<[^>]*>)// and 
        return("TAG_", $1);
    $parser->YYData->{INPUT} =~ s/^(<\/[^>]*>)// and 
        return("TAG", $1);
    $parser->YYData->{INPUT} =~ s/^(<[^\/]*\/>)// and
        return("TAG__", $1);

    # PCDATA
    $parser->YYData->{INPUT} =~ s/^([^<]*)// and 
        return("PCDATA", $1);

    # Catch-all
    # Just passing the char back to the parser to keep the process moving
    # Error should be caught (and possibly ignored) by the parser.
    $parser->YYData->{INPUT} =~ s/(.)// and 
        return("UNEXPECTED_CHAR", $1);
}

sub re_match {
    my ($str) = @_;
    my $ismatch = 0;
    my $rex;

    foreach $rex (@regexp) {
        # use eval to catch issues with passed in regular expression
        eval {
            if ($str =~ /$rex/) { 
               $ismatch = 1;
               return;  # from eval
            }
        };
        warn $@ if $@;
    }
    return ($ismatch);
}

sub key_match {
    return ( (lasttag_val() eq "Key") ? 1 : 0 );
}

sub block_match {
    return ( (lasttag_val() eq "Block") ? 1 : 0 );
}

sub lastkey_push {
    my ($key) = @_;

    $lastkey_len = unshift (@lastkey, $key);
    return ($lastkey_len);
}

sub lastkey_pop {
    my $key = shift (@lastkey);

    $lastkey_len--;
    return($key);
}

sub lastkey_val {
    return ($lastkey[0] or "<undef>");
}

sub lasttag_push {
    my ($tag) = @_;

    $lasttag_len = unshift (@lasttag, $tag);
    return ($lasttag_len);
}

sub lasttag_pop {
    my $tag = shift (@lasttag);

    $lasttag_len--;
    return($tag);
}

sub lasttag_val {
    return ($lasttag[0] or "<undef>");
}

sub process_pcdata {
    my ($label, $value) = @_;

    if (key_match() or block_match()) {
        print "  "x$indent if ($showtags);
        print "  $label: $value\n";
    }
     elsif (re_match ($value)) {
        print "  "x$indent if ($showtags);
        print "  Key: ", lastkey_val(), "\n";
        print "  $label: $value\n";
    }
}

sub Run {
    my($self)=shift;

    # Move static input parameters to more efficient storage
    $XML = $self->YYData->{XML};
    @regexp = @{ $self->YYData->{REX} };
    $showtags = $self->YYData->{TAGS};

    $self->YYParse( yylex => \&_yylex, yyerror => \&_yyerror );
}