# PropertyList.pm
#
#    Copyright (c) 1995  Markus Felten <markus@arlac.rhein-main.de>
#
#    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 2 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, write to the Free Software
#    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# Author: Markus Felten <markus@arlac.rhein-main.de>
#
# $Id: PropertyList.pm,v 1.8 1995/10/28 17:53:58 markus Exp $

package PropertyList;

sub version { '1.3.2'; }

sub quote {
	local($string)=@_;
	local($s);

	return '""'	if $string eq '';
	return 0	if $string eq 0;

	$s	= $string;
	$s	=~ s/[A-Za-z_0-9.\/\:]*//;

	return $string if $s eq '';

	$string	=~ s/\\/\\\\/g;
	$string	=~ s/\"/\\\"/g;
	$string =~ s/\r/\\r/g;
	$string =~ s/\n/\\n/g;
	$string =~ s/\t/\\t/g;
	$string =~ s/\f/\\f/g;

	return "\"$string\"";
}

sub print {
	local($object,$indent)=@_;
	local($string,$t,$key,$value,$prefix);

	if(ref($object) eq 'ARRAY') {
	  $t		= '';
	  $string	.= '( ';
	  foreach $value (@$object) { $string .= $t . PropertyList::print($value,$indent + 1); $t = ','; }
	  $string	.= " )";
         }
	elsif(ref($object) eq 'HASH') {
	  if($indent) {
	    $prefix	= "\t" x ($indent / 2) . '    ' x ($indent % 4);
	    $string	.= $prefix . "{\n "; }
	  else { $string = ''; }
	  while(($key,$value) = each %$object)
	    { $string .= $prefix . quote($key);
	      $string .= ' = ' . PropertyList::print($value,$indent + 1) if defined $value;
	      $string .= ";\n"; }
	  $string	.= "$prefix}" if $indent;
         }
	else {
	  return quote($object,$indent + 1);
	 }

	return $string;
}

sub _parseString {
	local($str)=@_;

	$str	=~ s/\\n/\n/g;
	$str	=~ s/\\r/\r/g;
	$str	=~ s/\\t/\t/g;
	$str	=~ s/\\f/\f/g;
	$str	=~ s/\\([0-7]{3})/chr(oct($+))/ge;
	$str	=~ s/\\(.)/$1/g;

	return $str;
}

sub _parseDictionaryContents {
	local($str)=@_;
	local($name,$value,%dictionary);

	while($$str =~ /^[\s]*(([A-Za-z_0-9\.\/\:]+)|("(([^"\n]|\\["'0-7nrft])*)"))/) {
	  $$str		= $';
	  $name		= defined $4 ? _parseString($4) : $1;
	  if($$str  =~ /^[\s]*=/) {
	    $$str	= $';
	    $value	= _parseValue($str); }
	  else {
	    $value	= undef; }

	  if($$str =~ /^[\s]*;/) {
	    $$str		= $';
	    $dictionary{$name}	= $value; }
	  else { printf(STDERR "missing ; %20s\n",$$str); }
	 }

	return \%dictionary;
}

sub _parseArrayContents {
	local($str)=@_;
	local($value,@array);

	return \@array if $$str =~ /^[\s]*[\)]/;

	push(@array,_parseValue($str));

	while($$str =~ /^[\s]*[\,]/) {
	  $$str		= $';
	  push(@array,_parseValue($str)); }

	return \@array;
}

sub _parseValue {
	local($str)=@_;
	local($value);

	if($$str =~ /^[\s]*\(/) {
	  $$str		= $';
	  $value	= _parseArrayContents($str);
	  $$str		= $' if $$str	=~ /^[\s]*[\)]/;
	  return $value; }

	if($$str =~ /^[\s]*\{/) {
	  $$str		= $';
	  $value	= _parseDictionaryContents($str);
	  $$str		= $' if $$str	=~ /^[\s]*[\}]/;
	  return $value; }

	if($$str =~ /^[\s]*(([A-Za-z_0-9\.\/\:]+)|("(([^"\n]|\\["'0-7nrft])*)"))/) {
	  $$str		= $';
	  return defined $4 ? _parseString($4) : $1;
	 }

	return undef;
}

sub parse {
	local($str)=@_;
	local($dict);
	$str	=~ s/\/\*([^\*]*)\*\// /g;

	$dict	= _parseDictionaryContents(\$str);

	return $dict if %$dict;
	return _parseValue(\$str);
}

sub readFromFileNamed {
	local($fname)=@_;
	open(FILE,"<$fname");
	read(FILE,$str,1048576);
	close(FILE);
	return parse($str);
}

sub writeToFileNamed {
	local($fname,$v)=@_;
	open(FILE,">$fname");
	print FILE PropertyList::print($v);
	close(FILE);
}

1;

__END__

=head1 NAME

PropertyList

=head1 SYNOPSIS

C<use PropertyList;>

C<parse \@I<string>;>

C<print \@I<reference>;>

C<readFromFileNamed \@I<fileName>;>

C<writeToFileNamed \@I<fileName>;>

=head1 DESCRIPTION

Handles NeXT's foundation property list format.
converts perl values (hash,scalar,array) into a string that is formatted in the
property list format (and back).

The C<parse> subroutine parses the contents of C<@I<string>> and returns the contents as a structure of arrays,dictionaries and scalar values.

The C<print> subrutine returns a string with the contents of C<@I<propertyList>>.

=head1 EXAMPLE

    use PropertyList;

    $value	= {
		'a'	=> (1,2,3),
		'b'	=> { 'a b c' => 1 }
		};

    $string	= PropertyList::print($value);

=head1 AUTHOR

Copyright (C) 1995  Markus Felten <markus@arlac.rhein-main.de>

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 2 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, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

=head1 BUGS
Strings with escape sequences (\t,\",\007) are not handeled correctly.
