File manager - Edit - /usr/local/cpanel/3rdparty/perl/542/cpanel-lib/SVG/Parser/Base.pm
Back
package SVG::Parser::Base; use strict; use vars qw($VERSION); $VERSION="1.03"; #------------------------------------------------------------------------------- # XML declaration defaults use constant SVG_DEFAULT_DECL_VERSION => "1.0"; use constant SVG_DEFAULT_DECL_ENCODING => "UTF-8"; use constant SVG_DEFAULT_DECL_STANDALONE => "yes"; # Document type definition defaults use constant SVG_DEFAULT_DOCTYPE_NAME => "svg"; use constant SVG_DEFAULT_DOCTYPE_SYSID => "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd"; use constant SVG_DEFAULT_DOCTYPE_PUBID => "-//W3C//DTD SVG 1.0//EN"; #------------------------------------------------------------------------------- # debug: simple debug method sub debug ($$;@) { my ($self,$what,@msgs)=@_; return unless $self->{-debug}; my $first=1; my $name||=ref($self); my $length||=length($name); if (@msgs) { foreach (@msgs) { next unless defined $_; printf STDERR "+++%s %-8s: %s\n", ($first?$name:" "x$length), ($first?$what:" "),$_; $first=0; } } else { printf STDERR "+++%s %s\n",$name,$what; } } #------------------------------------------------------------------------------- use constant ARG_IS_STRING => "string"; use constant ARG_IS_HANDLE => "handle"; use constant ARG_IS_HASHRF => "hash"; use constant ARG_IS_INVALID => "nonsuch"; #------------------------------------------------------------------------------- # is it a bird...is it a plane? sub identify ($$) { my ($self,$source)=@_; return ARG_IS_INVALID unless $source; # assume a string unless we determine differently my $type=ARG_IS_STRING; # check for various filehandle cases if (ref $source) { my $class = ref($source); if (UNIVERSAL::isa($source,'IO::Handle')) { # it's a new-style filehandle $type=ARG_IS_HANDLE; } elsif (tied($source)) { # it's a tied filehandle? no strict 'refs'; $type=ARG_IS_HANDLE if defined &{"${class}::TIEHANDLE"}; } } else { # it's an old-style filehandle? no strict 'refs'; $type=ARG_IS_HANDLE if eval { *{$source}{IO} }; } # possibly a hash argument is called via parse_file (SAX) $type=ARG_IS_HASHRF if ref($source) and $type eq ARG_IS_STRING; return $type; } #------------------------------------------------------------------------------- # Additional SVG.pm processing sub process_attrs ($$) { my ($parser,$attrs)=@_; if (exists $attrs->{style}) { my %styles=split /\s*[:;]\s*/,$attrs->{style}; $attrs->{style}=\%styles; } } #--------------------------------------------------------------------------------------- # Shared Expat/SAX Handlers # create and set SVG document object as root element sub StartDocument { my $parser=shift; # gather SVG constuctor attributes my %svg_attr; %svg_attr=%{delete $parser->{__svg_attr}} if exists $parser->{__svg_attr}; $svg_attr{-nostub}=1; # instantiate SVG document object $parser->{__svg}=new SVG(%svg_attr); # empty element list $parser->{__elements}=[]; # empty unassigned attlist list (for internal DTD subset handling) $parser->{__unassigned_attlists}=[]; # cdata count $parser->{__in_cdata}=0; $parser->debug("Start",$parser."/".$parser->{__svg}); } # handle start of element - extend chain by one sub StartTag { my ($parser,$type,%attrs)=@_; my $elements=$parser->{__elements}; my $svg=$parser->{__svg}; # some attributes need extra processing $parser->process_attrs(\%attrs); if (@$elements) { my $parent=$elements->[-1]; push @$elements, $parent->element($type,%attrs); } else { $svg->{-inline}=1 if $type ne "svg"; #inlined my $el=$svg->element($type,%attrs); $svg->{-document} = $el; push @$elements, $el; } $parser->debug("Element",$type); } # handle end of element - shorten chain by one sub EndTag { my ($parser,$type)=@_; my $elements=$parser->{__elements}; pop @$elements; } # handle cannonical data (text) sub Text { my ($parser,$text)=@_; my $elements=$parser->{__elements}; return if $text=~/^\s*$/s; #ignore redundant whitespace my $parent=$elements->[-1]; # are we in a CDATA section? (see CdataStart/End below) if ($parser->{__in_cdata}) { my $current=$parent->{-CDATA} || ''; $parent->CDATA($current.$parser->{__svg}{-elsep}.$text); } else { my $current=$parent->{-cdata} || ''; $parent->cdata($current.$parser->{__svg}{-elsep}.$text); } $parser->debug("CDATA","\"$text\""); } # handle cannonical data (CDATA sections) sub CdataStart { my $parser=shift; $parser->{__in_cdata}++; $parser->debug("CDATA","start->"); } sub CdataEnd { my $parser=shift; my $elements=$parser->{__elements}; my $parent=$elements->[-1]; my $current=$parent->{-CDATA} || ''; $parent->CDATA($current.$parser->{__svg}{-elsep}); $parser->{__in_cdata}--; $parser->debug("CDATA","<-end"); } # handle processing instructions sub PI { my ($parser,$target,$data)=@_; my $elements=$parser->{__elements}; if (my $parent=$elements->[-1]) { /^<\?(.*)\?>/; $parent->pi($1); }; $parser->debug("PI",$_); } # handle XML Comments sub Comment { my ($parser,$data)=@_; my $elements=$parser->{__elements}; if (my $parent=$elements->[-1]) { # SVG.pm doesn't handle comment prior to document start $parent->comment($data); } $parser->debug("Comment",$data); } # return root SVG document object as result of parse() sub FinishDocument { my $parser=shift; my $svg=$parser->{__svg}; # add any attlists that were seen before their element if (my $attlists=$parser->{__unassigned_attlists}) { foreach my $unassigned_attlist (@$attlists) { # if the element is still missing this will complain (if the parser didn't) $svg->attlist_decl(@$unassigned_attlist); } } $parser->debug("Done"); return $parser->{__svg}; } #--------------------------------------------------------------------------------------- # handle XML declaration, if present sub XMLDecl { my ($parser,$version,$encoding,$standalone)=@_; my $svg=$parser->{__svg}; $svg->{-version}=$version || $parser->SVG_DEFAULT_DECL_VERSION; $svg->{-encoding}=$encoding || $parser->SVG_DEFAULT_DECL_ENCODING; $svg->{-standalone}=$standalone?"yes":"no"; $parser->debug("XMLDecl","-version=\"$svg->{-version}\"", "-encoding=\"$svg->{-encoding}\"","-standalone=\"$svg->{-standalone}\""); } # handle Doctype declaration, if present sub Doctype { my ($parser,$name,$sysid,$pubid,$internal)=@_; my $svg=$parser->{__svg}; $svg->{-docroot}=$name || $parser->SVG_DEFAULT_DOCTYPE_NAME; $svg->{-sysid}=$sysid || $parser->SVG_DEFAULT_DOCTYPE_SYSID; $svg->{-pubid}=$pubid || $parser->SVG_DEFAULT_DOCTYPE_PUBID; $parser->debug("Doctype", "-docroot=\"$svg->{-docroot}\"", "-sysid=\"$svg->{-sysid}\"", "-pubid=\"$svg->{-pubid}\"", ); } #--------------------------------------------------------------------------------------- # Unparsed (Expat, Entity, Base, Sysid, Pubid, Notation) sub Unparsed { my ($parser,$name,$base,$sysid,$pubid,$notation)=@_; my $svg=$parser->{__svg}; my %entity=(name=>$name, sysid=>$sysid, notation=>$notation); $entity{base}=$base if defined $base; $entity{sysid}=$sysid if defined $sysid; $svg->entity_decl(%entity); } # Notation (Expat, Notation, Base, Sysid, Pubid) sub Notation { my ($parser,$name,$base,$sysid,$pubid)=@_; my $svg=$parser->{__svg}; my %notation=(name=>$name); $notation{base}=$base if defined $base; $notation{sysid}=$sysid if defined $sysid; $notation{pubid}=$pubid if defined $pubid; $svg->notation_decl(%notation); } # Entity (Expat, Name, Val, Sysid, Pubid, Ndata, IsParam) sub Entity { my ($parser,$name,$val,$sysid,$pubid,$data,$isp)=@_; my $svg=$parser->{__svg}; $isp||=0; if (defined $val) { $svg->entity_decl(name=>$name, value=>$val, isp=>$isp); } elsif (defined $pubid) { $svg->entity_decl(name=>$name, sysid=>$sysid, pubid=>$pubid, ndata=>$data, isp=>$isp); } else { $svg->entity_decl(name=>$name, sysid=>$sysid, ndata=>$data, isp=>$isp); } } # Element (Expat, Name, Model) sub Element { my ($parser,$name,$model)=@_; my $svg=$parser->{__svg}; if (defined $model) { # convert model to string context $svg->element_decl(name=>$name, model=>qq{$model}); } else { $svg->element_decl(name=>$name); } } # Attlist (Expat, Elname, Attname, Type, Default, Fixed) sub Attlist { my ($parser,$name,$attr,$type,$default,$fixed)=@_; my $svg=$parser->{__svg}; if ($svg->getElementDeclByName($name)) { $svg->attlist_decl( name=>$name, attr=>$attr, type=>$type, default=>$default, fixed=>($fixed?1:0) ); } else { push @{$parser->{__unassigned_attlists}}, [ name=>$name, attr=>$attr, type=>$type, default=>$default, fixed=>($fixed?1:0) ]; } } #--------------------------------------------------------------------------------------- 1;
| ver. 1.4 |
Github
|
.
| PHP 8.1.34 | Generation time: 0.05 |
proxy
|
phpinfo
|
Settings