Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / SVG / XML.pm

=pod

=head1 NAME

SVG::XML - Handle the XML generation bits for SVG.pm

=head1 AUTHOR

Ronan Oger, ronan@roasp.com

=head1 SEE ALSO

perl(1),L<SVG>,L<SVG::XML>,L<SVG::Element>,L<SVG::Parser>, L<SVG::Manual>
http://www.roasp.com/
http://www.perlsvg.com/
http://www.roitsystems.com/
http://www.w3c.org/Graphics/SVG/

=cut

package SVG::XML;
use strict;
use vars qw($VERSION @ISA @EXPORT );

$VERSION = "2.26";

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
    xmlescp
    cssstyle
    xmlattrib
    xmlcomment
    xmlpi
    xmltag
    xmltagopen
    xmltagclose
    xmltag_ln
    xmltagopen_ln
    xmltagclose_ln
    processtag
    xmldecl
    dtddecl
);

sub xmlescp ($) {
    my $s=shift;
    $s = '0' unless defined $s;
    $s=join(', ',@{$s}) if(ref($s) eq 'ARRAY');
	$s=~s/&(?!#(x\w\w|\d+?);)/&amp;/g;
    $s=~s/>/&gt;/g;
    $s=~s/</&lt;/g;
    $s=~s/\"/&quot;/g;
    $s=~s/\'/&apos;/g;
    $s=~s/\`/&apos;/g;
    $s=~s/([\x00-\x1f])/sprintf('&#x%02X;',chr($1))/eg;
	#per suggestion from Adam Schneider
	$s=~s/([\200-\377])/'&#'.ord($1).';'/ge;

    return $s;
}

sub cssstyle {
    my %attrs=@_;
    return(join('; ',map { qq($_: ).$attrs{$_} } keys(%attrs)));
}

# Per suggestion from Adam Schneider
#sub xmlattrib {
#    my %attrs=@_;
#    return(join(' ',map { qq($_=").$attrs{$_}.q(") } keys(%attrs)));
#}

sub xmlattrib {
    my %attrs=@_;
    return(join(' ',map { qq($_=").xmlescp($attrs{$_}).q(") } keys(%attrs)));
}

sub xmltag ($$;@) {
    my ($name,$ns,%attrs)=@_;
    $ns=$ns?"$ns:":'';
    my $at=' '.xmlattrib(%attrs)||'';
    return qq(<$ns$name$at />);
}

sub xmltag_ln ($$;@) {
    my ($name,$ns,%attrs)=@_;
    return xmltag($name,$ns,%attrs);
}

sub xmltagopen ($$;@) {
    my ($name,$ns,%attrs)=@_;
    $ns=$ns?"$ns:":'';
    my $at=' '.xmlattrib(%attrs)||'';
    return qq(<$ns$name$at>);
}

sub xmltagopen_ln ($$;@) {
    my ($name,$ns,%attrs)=@_;
    return xmltagopen($name,$ns,%attrs);
}

sub xmlcomment ($$) {
    my ($self,$r_comment) = @_;
    my $ind = $self->{-docref}->{-elsep}.$self->{-docref}->{-indent} x $self->{-docref}->{-level};
    return(join($ind,map { qq(<!-- $_ -->)} @$r_comment));
}

sub xmlpi ($$) {
    my ($self,$r_pi) = @_;
    my $ind = $self->{-docref}->{-elsep}.$self->{-docref}->{-indent} x $self->{-docref}->{-level};
    return(join($ind,map { qq(<?$_?>)} @$r_pi));
}

*processinginstruction=\&xmlpi;

sub xmltagclose ($$) {
    my ($name,$ns)=@_;
    $ns=$ns?"$ns:":'';
    return qq(</$ns$name>);
}

sub xmltagclose_ln ($$) {
    my ($name,$ns)=@_;
    return xmltagclose($name,$ns);
}

sub dtddecl ($) {
    my $self = shift;
    my $docroot = $self->{-docroot} || 'svg';
    my $id;

    if ($self->{-pubid}) {
        $id = 'PUBLIC "'.$self->{-pubid}.'"';
        $id .= ' "'.$self->{-sysid}.'"' if ($self->{-sysid});
    } elsif (
        $self->{-sysid}) {
        $id      = 'SYSTEM "'.$self->{-sysid}.'"';
    } else {
        $id =  'PUBLIC "-//W3C//DTD SVG 1.0//EN"' .
        $self->{-docref}->{-elsep}.
        "\"$self->{-docref}->{-dtd}\""
    }

    my $at=join(' ',($docroot, $id));

    #>>>TBD: add internal() method to return this
    my $extension = (exists $self->{-internal})?$self->{-internal}->render():"";
    if (exists $self->{-extension} and $self->{-extension}) {
        $extension .= $self->{-docref}{-elsep}.
                      $self->{-extension}.
                      $self->{-docref}{-elsep};
    }
    $extension = " [".$self->{-docref}{-elsep}.$extension."]" if $extension;

    return qq[<!DOCTYPE $at$extension>];
}

sub xmldecl ($) {
    my $self = shift;

    my $version= $self->{-version} || '1.0';
    my $encoding = $self->{-encoding} || 'UTF-8';
    my $standalone = $self->{-standalone} ||'yes';