123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163 |
- package XML::Serializer;
- use strict;
- my $root_element = "root";
- my $indent = " ";
- #my $XML_HEADER = << "XMLHEADER";
- #<?xml version="1.0" encoding="__CHARSET__"?>
- #<?xml-stylesheet type="text/xsl" href="__XSLT__" ?>
- #XMLHEADER
- my $XML_HEADER = << "XMLHEADER";
- <?xml version="1.0" encoding="__CHARSET__"?>
- XMLHEADER
- sub WITH_HEADER {
- return 1;
- }
- sub new {
- my ($this, $data, $root_name, $xslt) = @_;
- my %fields = (
- _charset => "utf-8",
- _data => "",
- _output => "",
- _root_name => $root_name ? $root_name : "root",
- _xslt => $xslt ? $xslt : ""
- );
- if (defined $data) {
- $fields{_data} = $data;
- }
- return bless \%fields, $this;
- }
- sub set_root_name {
- my ($this, $root_name) = @_;
- $this->{_root_name} = $root_name;
- }
- sub set_data {
- my ($this, $data) = @_;
- $this->{_data} = $data;
- }
- sub set_charset {
- my ($this, $charset) = @_;
- $this->{_charset} = $charset;
- }
- sub set_xslt {
- my ($this, $xslt) = @_;
- $this->{_xslt} = $xslt;
- }
- sub to_string{
- my ($this, $header) = @_;
- if ($header) {
- $this->{_output} = &_make_xml_header($this->{_charset}, $this->{_xslt});
- }
- $this->{_output} .= &_to_string($this->{_data}, $this->{_root_name});
- }
- sub to_formatted{
- my ($this, $header) = @_;
- if ($header) {
- $this->{_output} = &_make_xml_header($this->{_charset}, $this->{_xslt});
- }
- $this->{_output} .= &_to_formatted($this->{_root_name}, $this->{_data});
- }
- sub _make_xml_header {
- my $header = $XML_HEADER;
- $header =~ s/__CHARSET__/$_[0]/;
- $header =~ s/__XSLT__/$_[1]/;
- return $header;
- }
- sub _to_string {
- my ($obj, $name) = @_;
- my $output = "";
- if (ref($obj) eq "HASH") {
- my $attr_list = "";
- my $tmp_mid = "";
- foreach (sort keys %$obj) {
- if ($_ =~ /^@/) {
- $attr_list = &_to_string($_, $obj->{$_});
- }
- $tmp_mid .= &_to_string($_, $obj->{$_});
- }
- $output = &_start_node($name, $attr_list) . $tmp_mid . &_end_node($name);
- }
- elsif (ref($obj) eq "ARRAY") {
- foreach (@$obj) {
- $output .= &_to_string($_, $name);
- }
- }
- else {
- if ($_ =~ /^@(.+)$/) {
- return "$1=\"$obj\" ";
- } else {
- $output = &_start_node($name) . $obj . &_end_node($name);
- }
- }
- return $output;
- }
- sub _to_formatted {
- my ($name, $obj, $depth) = @_;
- # if (!$obj) { $obj = ""; }
- if (!defined($depth)) { $depth = 0; }
- my $output = "";
- if (ref($obj) eq "HASH") {
- my $attr_list = "";
- my $tmp_mid = "";
- foreach (sort keys %$obj) {
- if ($_ =~ /^@/) {
- $attr_list = &_to_string($_, $obj->{$_});
- }
- $tmp_mid .= &_to_formatted($_, $obj->{$_}, $depth+1);
- }
- $output = &_start_node($name, $attr_list, $depth) . "\n" . $tmp_mid . &_end_node($name, $depth);
- }
- elsif (ref($obj) eq "ARRAY") {
- foreach (@$obj) {
- $output .= &_to_formatted($name, $_, $depth);
- }
- }
- else {
- if ($_ =~ /^@(.+)$/) {
- #return "$1=\"$obj\" ";
- } else {
- $output .= &_start_node($name, "", $depth);
- $output .= $obj;
- $output .= &_end_node($name);
- }
- }
- return $output;
- }
- sub _start_node {
- my $ret = "";
- if (defined $_[2]) {
- for(1..$_[2]) { $ret .= $indent; }
- }
- my $tag = $_[0] ? $_[0] : "";
- my $attr = $_[1] ? $_[1] : "";
- $ret .= "<$tag $attr>";
- return $ret;
- }
- sub _end_node {
- my $ret = "";
- if (defined $_[1]) {
- for(1..$_[1]) { $ret .= $indent; }
- }
- if (defined $_[0]) {
- $ret .= "</$_[0]>\n";
- }
- return $ret;
- }
- 1;
|