view release on metacpan or  search on metacpan

lib/SVG/Parser/Base.pm  view on Meta::CPAN

    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}\"",