]> git.llucax.com Git - mecon/scripts.git/blob - embperl/SimpleXMLISO.pm
Se agregan archivos complementarios para que ande el embperl.
[mecon/scripts.git] / embperl / SimpleXMLISO.pm
1 #############################################################################
2 #
3 # Apache::Session::Serialize::SimpleXML
4 # Serializes session objects using Storable and pack
5 #
6 ############################################################################
7
8 package Apache::Session::Serialize::SimpleXMLISO;
9
10 use vars qw($VERSION);
11 use XML::DumperISO;
12 use strict;
13
14 $VERSION = '0.1';
15
16 #################################################
17 #  Parsea un archivo XML con la limitacion de   #
18 #       que debe tener un tag por linea.        #
19 ################################################# 
20 sub semiXMLParse {
21    my @xml   = split( "\n", shift );
22    my @isarray;
23    my $nivel = 0;
24    my $data;
25    my $eval  = '$data=';
26    foreach my $line ( @xml ) {
27       $line =~ s/\s*(<.*>)\s*/$1/msg;
28       if ( lc( $line ) eq "<hash>" ) {
29          $eval .= "{";
30          $isarray[++$nivel] = 0;
31       }
32       if ( lc( $line ) eq "<array>" ) {
33          $eval .= "[";
34          $isarray[++$nivel] = 1;
35       }
36       if ( lc( $line ) eq "</hash>" ) {
37          $nivel--;
38          $eval .= "},";
39       }
40       if ( lc( $line ) eq "</array>" ) {
41          $nivel--;
42          $eval .= "],";
43       }
44       if ( $line =~ /<item key="(.*)">([^<>]*)(<\/item>)?/i ) {
45          $eval .= "'" . UnQuoteXMLChars( $1 ) . "'=>"
46             if ( not $isarray[$nivel] );
47          $eval .= "'" . UnQuoteXMLChars( $2 ) . "',"
48             if ( $3 );
49       }
50    }
51    chop $eval;
52    $eval .= ";";
53    eval $eval;
54
55    return $data;
56
57    ######################################################################
58    sub UnQuoteXMLChars {
59       my $str = shift;
60       $str =~ s/&amp;/&/g;
61       $str =~ s/&lt;/</g;
62       $str =~ s/&gt;/>/g;
63       $str =~ s/&apos;/\\'/g;
64       $str =~ s/&quot;/"/g;
65       return $str;
66    }
67 }
68
69 sub serialize {
70     my $session = shift;
71     my $dump = new XML::DumperISO;
72     $session->{'serialized'} = $dump->pl2xml( $session->{'data'} );
73 }
74
75 sub unserialize {
76     my $session = shift;
77     $session->{'data'} = semiXMLParse( $session->{'serialized'} );
78 }
79
80