<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#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" 
#
#		&lt;xmlfile name="test" id="1"&gt;
#		This is the test XML file to check how the parser works 
#			&lt;tag1 name="first_tag"/&gt;
#			&lt;tag1 name="second_tag"/&gt;
#			&lt;tag1 name="third_tag"/&gt;
#			&lt;tag2 name="yet another tag"&gt;
#					This shows the embedding properties
#					&lt;embedded name="here it is"&gt;
#							Embedded tag
#					&lt;/embedded&gt;
#			&lt;/tag2&gt;
#		&lt;/xmlfile&gt;																													(3)
#
#	After the line (1) is executed, the $hashpars variable contains the following (the line is broken into several for convenience):
#	%object=
#		(
#			xmlfile=&gt;
#				{
#					name=&gt;"test", 
#					id=&gt;"1", 
#					tag1=&gt;
#					[
#						{
#							name=&gt;"first_tag"
#						},
#						{
#							name=&gt;"second_tag"
#						},
#						{
#							name=&gt;"third_tag"
#						}
#					], 
#					tag2=&gt;
#						{
#							name=&gt;"yet another tag", 
#							embedded=&gt;
#								{
#									name=&gt;"here it is", 
#									content=&gt;"Embedded tag"
#								}, 
#							content=&gt;"This shows the embedding properties"
#						}, 
#					content=&gt;"This is the test XML file to check how the parser works "
#				},
#			object_file=&gt;"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=&amp;UNPARSER(\%object);																						(7)
#	and returns the data file name. For the object (4) we will have the output as follows: 
#
#	&lt;xmlfile name="test" id="1"&gt;
#		This is the test XML file to check how the parser works 
#		&lt;tag2 name="yet another tag"&gt;
#			This shows the embedding properties
#			&lt;embedded name="here it is"&gt;
#				Embedded tag
#			&lt;/embedded&gt;
#		&lt;/tag2&gt;
#		&lt;tag1 name="first_tag"/&gt;
#		&lt;tag1 name="second_tag"/&gt;
#		&lt;tag1 name="third_tag"/&gt;
#	&lt;/xmlfile&gt;
#																																					(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=&lt;DATA&gt;;
close(DATA);
 my $length=@data-1; my $i;
#
#	ELIMINATE ALL THE LINE BREAKS AND MULTIPLE SPACES
#
 my $alldata="";
 for ($i=0;$i&lt;=$length;$i++)
 {
   chop $data[$i];
   $data[$i]=~s/\n//g;
   $alldata=$alldata . $data[$i];
 }
#
#	SPLIT BY &gt;
#
 $alldata=~s/&lt;\//\¤/g;				# &lt;/ to ¤ 
 $alldata=~s/\/&gt;/\ö\ö\ö\ö/g;				# /&gt; to ö
 $alldata=~s/\//åååå/g;                            # / to å
 $alldata=~s/\¤/&lt;\//g;                          # ¤ to &lt;/
 $alldata=~s/\ö\ö\ö\ö/\/&gt;/g;                          # ö to /&gt;
#
 $alldata=~s/[ ]+/ /g;                          # spaces singlize
 $alldata=~s/&lt;/\¤&lt;/g;                            # &lt; to ¤&lt;
 $alldata=~s/&gt;/&gt;\¤/g;                            # &gt; to &gt;¤
 $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&lt;=$elements_length;$i++)
 {
   if (($elements[$i]!~/&lt;!--/)&amp;&amp;($elements[$i] ne "")&amp;&amp;($elements[$i] ne " "))
   {
    $count++;
    $new_elements[$count]=$elements[$i];
	$new_elements[$count]=~s/\t//g;
	$new_elements[$count]=~s/[ ]+/ /g;
	$new_elements[$count]=~s/&gt;[ ]+/&gt;/g;
   } 
 }
 $counter=1;
 $depth=0;
 @har=Builder(); 
 $ll=$har[0] ."=&gt;{" . $har[1] . "},  object_file=&gt;\"" . $data_file . "\""; 
 $ll="\%object=(" . $ll . ")";
 $ll=~s/ =&gt;\{\}\,//g;
 $ll=~s/\{ /\{/g;
 $ll=~s/åååå/\//g;
 $ll=~s/, content=&gt;\"\"//g;

sub Builder
{
 my $i;
	my @har; 
	my @harr; 
	my $line;
    my $names;
	my %namehash; 
	my %namecount;
	$namecount=0;
	$depth++;
	if ($counter&gt;$count) 
	{
		return;
	}
	my $content="";
	$line=$new_elements[$counter];
	@har=Hasher($line); 
	$counter++; 
	if ($line=~/\/&gt;/) 
	{
		$depth--;
		return @har;
	}
	$line=$new_elements[$counter];
	while ($line!~/&lt;\//) 
	{
		if ($line!~/&lt;/) 
		{
			$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{$_}&gt;1) 
			{
				$har[1]=$har[1] . "\, " . $_ . "\=&gt;\[";
				for ($i=1;$i&lt;=$namecount{$_};$i++) 
				{
					$har[1]=$har[1]  .  "\,{" . $namehash{$_}[$i] . "}"; 
				}
				$har[1]=$har[1]  .  "\]"; 
			}
			else
			{
					$har[1]=$har[1]  .  "\, " . $_ . "\=&gt;\{" . $namehash{$_}[1] . "}"; 
			}
		}
	}
	$har[1]=$har[1] . "\, content=&gt;\"" . $content . "\"";
	# $har[1]=$har[1] . "\, tag=&gt;\"" . $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=~/\/&gt;/) 
	{
		$flag=1;
	}
	my @hash;
	$line=~s/&lt;//;
    $line=~s/&gt;//;
    $line=~s/\///;
    $line=~s/\=/\=&gt;/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, "&gt;$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&lt;$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&lt;=$cntattr;$i++) 
	{
		  $arattr[$i]=~s/åååå/\//g;    
		 print DATA " $arattr[$i][0]=\"$arattr[$i][1]\"";
	 }
	 if ($flagger==0) 
	{
		 print DATA "\/&gt;\n"
	 }
	 else
	{
		 print DATA "\&gt;\n";
		 if ($content ne "") 
		{
		     $content=~s/åååå/\//g;    
			 print DATA "$offset\t$content\n";
		 }
		 if ($cnthash&gt;0) 
		{
			 for ($i=1;$i&lt;=$cnthash;$i++) 
			{
				$a[0]=$arhash[$i][0];
				$a[1]=$arhash[$i][1];
				&amp;PRINTER(@a);
			 }
		 }
		 if ($cntar&gt;0) 
		{
			 for ($i=1;$i&lt;=$cntar;$i++) 
			{
				$length=@{$arar[$i][1]};
				$a[0]=$arar[$i][0];
                for ($j=0;$j&lt;$length;$j++) 
				{
					$a[1]=$arar[$i][1]-&gt;[$j];
				    &amp;PRINTER(@a);
                }
			 }
		 }
	 print DATA "$offset&lt;/$name&gt;\n";
	 }
	 $offset=~s/\t//;
     return; 
	}
}
############################## END UNPARSING  OBJECT MODEL INTO  XML ###############################
1;</pre></body></html>