#package hashparser;
#############################################################################################################################################################
#
#	This is a very simple DTD-free XML parser/unparser package. Release date 15.12.2004
#	The package consists of two functions: PARSER and UNPARSER. 
#	PARSER converts XML file into a hash structure, UNPARSER does the opposite
#	
#				P A R S E R
#
#	To call PARSER you use the following line: 
#	                                   $hashpars=PARSER($name);													(1)
# where $name is the XML file to process and the line $hashpars, after the command
#										eval($hashpars);																		(2)
#	produces the %object hash containing the XML-defined data structure and the data file name in the form $object{object_file}. Elements that appear multiple times in
# the XML file are transformed into arrays of hashes, attribute-value pairs are simple hashes. The non-tagged content is put into hash under the {content} keyword.
#
#		EXAMPLE:
#
#		a file "test.xml" 
#
#		<xmlfile name="test" id="1">
#		This is the test XML file to check how the parser works 
#			<tag1 name="first_tag"/>
#			<tag1 name="second_tag"/>
#			<tag1 name="third_tag"/>
#			<tag2 name="yet another tag">
#					This shows the embedding properties
#					<embedded name="here it is">
#							Embedded tag
#					</embedded>
#			</tag2>
#		</xmlfile>																													(3)
#
#	After the line (1) is executed, the $hashpars variable contains the following (the line is broken into several for convenience):
#	%object=
#		(
#			xmlfile=>
#				{
#					name=>"test", 
#					id=>"1", 
#					tag1=>
#					[
#						{
#							name=>"first_tag"
#						},
#						{
#							name=>"second_tag"
#						},
#						{
#							name=>"third_tag"
#						}
#					], 
#					tag2=>
#						{
#							name=>"yet another tag", 
#							embedded=>
#								{
#									name=>"here it is", 
#									content=>"Embedded tag"
#								}, 
#							content=>"This shows the embedding properties"
#						}, 
#					content=>"This is the test XML file to check how the parser works "
#				},
#			object_file=>"test.xml"
#		)
#																																				(4)
# The access to data is accomplished via usual rules for hashes of hashes and hashes of arrays. For example, 
#
# $object{xmlfile}{tag1}[1]{name} equals "third_tag"																(5)
#							and
#
#$object{xmlfile}{tag2}{embedded}{content} equals "Embedded tag"										(6)
#
#					U N P A R S E R
#
#	UNPARSER is called as follows: 
#			$q=&UNPARSER(\%object);																						(7)
#	and returns the data file name. For the object (4) we will have the output as follows: 
#
#	<xmlfile name="test" id="1">
#		This is the test XML file to check how the parser works 
#		<tag2 name="yet another tag">
#			This shows the embedding properties
#			<embedded name="here it is">
#				Embedded tag
#			</embedded>
#		</tag2>
#		<tag1 name="first_tag"/>
#		<tag1 name="second_tag"/>
#		<tag1 name="third_tag"/>
#	</xmlfile>
#																																					(8)
#	This output will be written to the file with the name stored in $object{object_file}, which initially contains the file from which the XML was originally written (See4). Before unarsing 
# this name can be modified by assignment, for example.
#
#		$object{$object_file}="test_mod.xml";		
#
#WARNINGS:
#		 All comments are lost in PARSER
#		 Letter "å" should not be used in xml as it is reserved for parsing purposes
#		 ABSOLUTELY FOOL UNPROOF!!!!!
#		 The input/output file name is DATA, so do not open such file elsewhere!!!
#
#############################################################################################################################################################
#
#
#
#
#
#
############################## PARSING XML INTO OBJECT MODEL ###############################
#
#

sub PARSER
{
#
#	READ THE DATA IN FILE
#
my $data_file=shift; 
 open (DATA, "$data_file");
 my @data=<DATA>;
close(DATA);
 my $length=@data-1; my $i;
#
#	ELIMINATE ALL THE LINE BREAKS AND MULTIPLE SPACES
#
 my $alldata="";
 for ($i=0;$i<=$length;$i++)
 {
   chop $data[$i];
   $data[$i]=~s/\n//g;
   $alldata=$alldata . $data[$i];
 }
#
#	SPLIT BY >
#
 $alldata=~s/<\//\¤/g;				# </ to ¤ 
 $alldata=~s/\/>/\ö\ö\ö\ö/g;				# /> to ö
 $alldata=~s/\//åååå/g;                            # / to å
 $alldata=~s/\¤/<\//g;                          # ¤ to </
 $alldata=~s/\ö\ö\ö\ö/\/>/g;                          # ö to />
#
 $alldata=~s/[ ]+/ /g;                          # spaces singlize
 $alldata=~s/</\¤</g;                            # < to ¤<
 $alldata=~s/>/>\¤/g;                            # > to >¤
 $alldata=~s/\¤\¤/\¤/g;                            # ¤¤ to ¤
 $alldata=~s/\¤ \¤/\¤/g;                           # ¤ ¤ to ¤
 $alldata=~s/\¤  \¤/\¤/g;                           # ¤ ¤ to ¤
 $alldata=~s/\¤[ ]+\¤/\¤/g;                           # ¤ ¤ to ¤
 $alldata=~s/\¤\t\¤/\¤/g;                           # ¤ ¤ to ¤
 $alldata=~s/\t//g;
 my @elements=split/¤/,$alldata;
 my $elements_length=@elements-1;
#
#	SEPARATE ELEMENTS
#
#
# 
#	TAKE OUT ALL COMMENTS
#
# my $count;
 $count=0;
 # my @new_elements;
 for ($i=0;$i<=$elements_length;$i++)
 {
   if (($elements[$i]!~/<!--/)&&($elements[$i] ne "")&&($elements[$i] ne " "))
   {
    $count++;
    $new_elements[$count]=$elements[$i];
	$new_elements[$count]=~s/\t//g;
	$new_elements[$count]=~s/[ ]+/ /g;
	$new_elements[$count]=~s/>[ ]+/>/g;
   } 
 }
 $counter=1;
 $depth=0;
 @har=Builder(); 
 $ll=$har[0] ."=>{" . $har[1] . "},  object_file=>\"" . $data_file . "\""; 
 $ll="\%object=(" . $ll . ")";
 $ll=~s/ =>\{\}\,//g;
 $ll=~s/\{ /\{/g;
 $ll=~s/åååå/\//g;
 $ll=~s/, content=>\"\"//g;

sub Builder
{
 my $i;
	my @har; 
	my @harr; 
	my $line;
    my $names;
	my %namehash; 
	my %namecount;
	$namecount=0;
	$depth++;
	if ($counter>$count) 
	{
		return;
	}
	my $content="";
	$line=$new_elements[$counter];
	@har=Hasher($line); 
	$counter++; 
	if ($line=~/\/>/) 
	{
		$depth--;
		return @har;
	}
	$line=$new_elements[$counter];
	while ($line!~/<\//) 
	{
		if ($line!~/</) 
		{
			$line=~s/\"/\'/g;
			$content=$content . $line; 
			$counter++;
	        $line=$new_elements[$counter];
		}
		else
		{
			@harr=Builder();
			$names=$harr[0]; 
			$namecount{$names}++;
			$namehash{$names}[$namecount{$names}]=$harr[1];
			if ($harr[2]==0) {$counter++}
	        $line=$new_elements[$counter];
		}
	}
	my $cn=0;
	for (%namecount) 
	{
		$cn=1-$cn; 
		if ($cn==1) 
		{   
			if ($namecount{$_}>1) 
			{
				$har[1]=$har[1] . "\, " . $_ . "\=>\[";
				for ($i=1;$i<=$namecount{$_};$i++) 
				{
					$har[1]=$har[1]  .  "\,{" . $namehash{$_}[$i] . "}"; 
				}
				$har[1]=$har[1]  .  "\]"; 
			}
			else
			{
					$har[1]=$har[1]  .  "\, " . $_ . "\=>\{" . $namehash{$_}[1] . "}"; 
			}
		}
	}
	$har[1]=$har[1] . "\, content=>\"" . $content . "\"";
	# $har[1]=$har[1] . "\, tag=>\"" . $har[0] . "\"";
	$har[1]=~s/\{\,/\{/g;
	$har[1]=~s/\(\,/\(/g;
	$har[1]=~s/\[\,/\[/g;
	$har[1]=~s/[ ]+/ /g;
	$har[1]=~s/\t//g;
	$depth--;
	return @har;
}
sub Hasher
{
	my $line=shift; 
	my $flag=0;
if ($line=~/\/>/) 
	{
		$flag=1;
	}
	my @hash;
	$line=~s/<//;
    $line=~s/>//;
    $line=~s/\///;
    $line=~s/\=/\=>/g;
    $line=~s/ /\#/;
    $line=~s/\" /\"\, /g;
    @hash=split/\#/, $line; 
	@hash[2]=$flag; 
	 return @hash; 
}
############################## END PARSING  XML INTO OBJECT MODEL ###############################
return $ll;
}
############################## UNPARSING  OBJECT MODEL INTO  XML ###############################
sub UNPARSER
{
	my $hr=shift;
	my %h=%{$hr};
	my %hash=%h;
	my $data_file=$hash{object_file};
	open(DATA, ">$data_file"); 
	delete $hash{object_file};
	$cn=1;
	$offset="";
	for (%hash) 
	{
        $cn=1-$cn;
		$a[$cn]=$_;
	}
	PRINTER(@a);
	close(DATA);
	return $data_file; 
sub PRINTER
	{
	 my $name=shift;
	 my $hr=shift;
	 my %hash=%{$hr};
	 my $cn=1;
	 my @a;
     my $cntar=0; my @arar;
     my $cnthash=0; my @arhash;
     my $cntattr=0; my @arattr;
     my $content="";
	 my $flag;
	 my $flagger;
	 my $i; my $j;
	 my @arr;
	 my $length;
	 $offset=$offset . "\t"; 
	 $flagger=0;
     print DATA "$offset<$name";
 	 for (%hash) 
	 {
		$cn=1-$cn;
        $a[$cn]=$_; 
        if ($cn==1) 
		{
			$flag=0;
			if ($a[1]=~/HASH/) 
			{
				$cnthash++;
				$arhash[$cnthash][0]=$a[0];
				$arhash[$cnthash][1]=$a[1];
				$flag=1;
				$flagger=1;
			}
			if ($a[1]=~/ARRAY/) 
			{
				$cntar++;
				$arar[$cntar][0]=$a[0];
				$arar[$cntar][1]=$a[1];
				$flag=1;
				$flagger=1;
			}
			if ($a[0]=~/content/) 
			{
				$content=$a[1];
				$flag=1;
				$flagger=1;
			}
			if ($flag==0) 
			{
				$cntattr++;
				$arattr[$cntattr][0]=$a[0];
				$arattr[$cntattr][1]=$a[1];
			}
        }         
     }
	 for ($i=1;$i<=$cntattr;$i++) 
	{
		  $arattr[$i]=~s/åååå/\//g;    
		 print DATA " $arattr[$i][0]=\"$arattr[$i][1]\"";
	 }
	 if ($flagger==0) 
	{
		 print DATA "\/>\n"
	 }
	 else
	{
		 print DATA "\>\n";
		 if ($content ne "") 
		{
		     $content=~s/åååå/\//g;    
			 print DATA "$offset\t$content\n";
		 }
		 if ($cnthash>0) 
		{
			 for ($i=1;$i<=$cnthash;$i++) 
			{
				$a[0]=$arhash[$i][0];
				$a[1]=$arhash[$i][1];
				&PRINTER(@a);
			 }
		 }
		 if ($cntar>0) 
		{
			 for ($i=1;$i<=$cntar;$i++) 
			{
				$length=@{$arar[$i][1]};
				$a[0]=$arar[$i][0];
                for ($j=0;$j<$length;$j++) 
				{
					$a[1]=$arar[$i][1]->[$j];
				    &PRINTER(@a);
                }
			 }
		 }
	 print DATA "$offset</$name>\n";
	 }
	 $offset=~s/\t//;
     return; 
	}
}
############################## END UNPARSING  OBJECT MODEL INTO  XML ###############################
1;