view release on metacpan or  search on metacpan

lib/AxKit/App/TABOO/Data.pm  view on Meta::CPAN

    }
    my $sth = $dbh->prepare($query);
    $i=1;
    foreach my $key (@keys) {
      $sth->bind_param($i, $arg{$key});
      $i++;
    }
    $sth->execute();
    return $sth->fetchrow_hashref;
}

=item C<write_xml($doc, $parent)>

Takes arguments C<$doc>, which must be an L<XML::LibXML::Document>
object, and C<$parent>, a reference to the parent node. The method
will append the object it is handed it with the data contained in the
data structure of the class in XML. This method is the jewel of this
class, it should be sufficiently generic to rarely require
subclassing. References to subclasses will be followed, and
C<write_xml> will call the C<write_xml> of that object. Arrays will be
represented with multiple instances of the same element. Fields that
have undefined values will not be included. It will also parse fields
indicated by C<elementneedsparse()>, see below. Currently, we get HTML
from TinyMCE, which we let XML::LibXML parse.

=cut


sub write_xml {
    my $self = shift;
    my $doc = shift;
    my $parent = shift;
    my $topel = $doc->createElementNS($self->xmlns(), 
				      $self->xmlprefix() .':'. $self->xmlelement());
    if ((defined($self->dbprimkey)) && (defined(${$self}{$self->dbprimkey()}))) {
      $topel->setAttributeNS($self->xmlns(), 
			     $self->xmlprefix() .':key', 
			     ${$self}{$self->dbprimkey()});
    }
    $parent->appendChild($topel);
    foreach my $key (split(/,\s*/, $self->elementorder())) {
      if (defined(${$self}{$key})) {
	my $content = ${$self}{$key};
	if (ref($content) =~ m/^AxKit::App::TABOO::Data/) {
	  # The content is a reference to one of our subclasses, it
	  # should write itself
	  $content->write_xml($doc, $topel);
	}
	elsif (ref($content) eq '') {
	  my $element = $doc->createElementNS($self->xmlns(), $self->xmlprefix() .':'. $key);
	  if (($content) && (defined($self->elementneedsparse)) && ($self->elementneedsparse =~ m/\b$key\b/)) {
	    my $hss=HTML::StripScripts::LibXML->new(
                        {Context=>'Flow',
			 BanList => [qw( style font center blink marquee ) ],
			 AllowHref => 1,
			 AllowSrc => 1,
			 AllowMailto => 1,
			 Rules   => { 
				     'caption'   => \&_style_callback,
				     'input'   => \&_style_callback,
				     'legend'   => \&_style_callback,
				     'table'   => \&_style_callback,
				     'hr'   => \&_style_callback,
				     'div'   => \&_style_callback,
				     'p'   => \&_style_callback,
				     'h1'   => \&_style_callback,
				     'h2'   => \&_style_callback,
				     'h3'   => \&_style_callback,
				     'h4'   => \&_style_callback,
				     'h5'   => \&_style_callback,
				     'h6'   => \&_style_callback,
				    }
			},   # HSS options
			 strict_comment =>1,  # HTML::Parser options
			 strict_names => 1
						   );
	    $hss->parse($content);
	    $hss->eof;
	    my $div = $doc->createElement('div');
	    $div->appendChild($hss->filtered_document);
	    $element->appendChild($div);
	  } else {
	    my $text = XML::LibXML::Text->new($content);
	    $element->appendChild($text);
	  }
	  $topel->appendChild($element);
	} elsif (ref($content) eq "ARRAY") {
	  # The content is an array, we must go through it and add an element for each.
	  foreach (@{$content}) {
	    if (ref($_) eq '') {
	      my $element = $doc->createElementNS($self->xmlns(), $self->xmlprefix() .':'. $key);
	      my $text = XML::LibXML::Text->new($_);
	      $element->appendChild($text);
	      $topel->appendChild($element);
	    } else {
	      if (ref($_) =~ m/^AxKit::App::TABOO::Data/) {
		# An element in the array contained a reference to one of our subclasses, it must be written too. 
		$_->write_xml($doc, $topel);
	      }
	    }
	  }
        } else {
	  my $element = $doc->createElementNS($self->xmlns(), $self->xmlprefix() .':'. $key);
	  my $text = XML::LibXML::Text->new($content);
	  $element->appendChild($text);
	  $topel->appendChild($element);
        }
      }
    }
    return $doc;
}

# Dispatch table for what CSS to use to replace a particular attribute
my %replace = (
    hspace  => sub { "margin-left:$_[0]px;margin-right:$_[0]px"    },
    vspace  => sub { "margin-top:$_[0]px;margin-bottom:$_[0]px"    },
    border  => sub { "border-width:$_[0]px"                         },
    align   => sub { "text-align:$_[0]"                             },
);

sub _style_callback {