view release on metacpan or  search on metacpan

lib/XMLTV.pm.in  view on Meta::CPAN

hashes.  But as an exception, any hash key beginning with an
underscore will be skipped over silently.  You can store 'internal use
only' data this way.

If a programme or channel hash contains a key beginning with 'debug',
this key and its value will be written out as a comment inside the
<programme> or <channel> element.  This lets you include small
debugging messages in the XML output.

=cut
sub write_data( $;@ ) {
    my $data = shift;
    my $writer = new XMLTV::Writer(encoding => $data->[0], @_);
    $writer->start($data->[1]);
    $writer->write_channels($data->[2]);
    $writer->write_programme($_) foreach @{$data->[3]};
    $writer->end();
}


# Private.
#
# get_attrs()
#
# Given a node, return a hashref of its attributes.  Skips over
# the 'x-whatever' attributes.
#
sub get_attrs( $ ) {
    my $node = shift; die if not defined $node;
    my %r = %{$node->atts()};
    foreach (keys %r) {
	if (/^x-/) {
	    delete $r{$_};
	}
	else {
	    tidy(\$r{$_});
	}
    }
    return \%r;
}


# Private.
#
# get_text()
#
# Given a node containing only text, return that text (with whitespace
# either side stripped).  If the node has no children (as in
# <foo></foo> or <foo />), this is considered to be the empty string.
#
# Parameter: whether newlines are allowed (defaults to false)
#
sub get_text( $;$ ) {
    my $node = shift;
    my $allow_nl = shift; $allow_nl = 0 if not defined $allow_nl;
    my @children = get_subelements($node);
    if (@children == 0) {
	return '';
    }
    elsif (@children == 1) {
	my $v = $children[0]->pcdata();
	t 'got pcdata: ' . d $v;
	if (not defined $v) {
	    my $name = get_name($node);
	    warn "node $name expected to contain text has other stuff\n";
	}
	else {
	    # Just hope that the encoding we got uses \n...
	    if (not $allow_nl and $v =~ tr/\n//d) {
		my $name = get_name($node);
		warn "removing newlines from content of node $name\n";
	    }
	    tidy(\$v);
	}
	t 'returning: ' . d $v;
	return $v;
    }
    elsif (@children > 1) {
	my $name = get_name($node);
	warn "node $name expected to contain text has more than one child\n";
	return undef;
    }
    else { die }
}

# Private.  Clean up parsed text.  Takes ref to scalar.
sub tidy( $ ) {
    our $v; local *v = shift; die if not defined $v;
    if ($XML::Twig::VERSION < 3.01 || $KEEP_ENCODING) {
	# Old versions of XML::Twig had stupid behaviour with
	# entities - and so do the new ones if KeepEncoding is on.
	#
	for ($v) {
	    s/&gt;/>/g;
	    s/&lt;/</g;
	    s/&apos;/\'/g;
	    s/&quot;/\"/g;
	    s/&amp;/&/g;	# needs to be last
	}
    }
    else {
	t 'new XML::Twig, not KeepEncoding, entities already dealt with';
    }

    for ($v) {
	s/^\s+//;
	s/\s+$//;

	# On Windows there seems to be an inconsistency between
	# XML::Twig and XML::Writer.  The former returns text with
	# \r\n line endings to the application, but the latter adds \r
	# characters to text outputted.  So reading some text and
	# writing it again accumulates an extra \r character.  We fix
	# this by removing \r from the input here.
	#
	tr/\r//d;
    }
}

# Private.
#
# get_subelements()