view release on metacpan or  search on metacpan

lib/SVG/Element.pm  view on Meta::CPAN

#-------------------------------------------------------------------------------

sub release {
    my $self = shift;

    foreach my $key ( keys( %{$self} ) ) {
        next if $key =~ /^-/;
        if ( ref( $self->{$key} ) =~ /^SVG/ ) {
            eval { $self->{$key}->release; };
        }
        delete( $self->{$key} );
    }

    return $self;
}

sub xmlify {
    my $self = shift;
    my $ns   = $self->{-namespace} || $self->{-docref}->{-namespace} || undef;
    my $xml  = '';

    #prep the attributes
    my %attrs;
    foreach my $k ( keys( %{$self} ) ) {
        if ( $k =~ /^-/ ) { next; }
        if ( ref( $self->{$k} ) eq 'ARRAY' ) {
            $attrs{$k} = join( ', ', @{ $self->{$k} } );
        }
        elsif ( ref( $self->{$k} ) eq 'HASH' ) {
            $attrs{$k} = cssstyle( %{ $self->{$k} } );
        }
        elsif ( ref( $self->{$k} ) eq '' ) {
            $attrs{$k} = $self->{$k};
        }
    }

    #prep the tag
    if ( $self->{-name} eq 'comment' && $self->{-comment} ) {
       return $self->xmlcomment( $self->{-comment} );
    }
    elsif ( $self->{-name} eq 'document' ) {

        #write the xml header
        $xml .= $self->xmldecl unless $self->{-inline};

        $xml .= $self->xmlpi( $self->{-document}->{-pi} )
            if $self->{-document}->{-pi};

        #and write the dtd if this is inline
        $xml .= $self->dtddecl unless $self->{-inline};

        #rest of the xml
        foreach my $k ( @{ $self->{-childs} } ) {
            if ( ref($k) =~ /^SVG::Element/ ) {
                $xml .= $k->xmlify($ns);
            }
        }

        return $xml;
    }
    my $is_cdataish
        = defined $self->{-cdata}
        || defined $self->{-CDATA}
        || defined $self->{-cdata_noxmlesc};
    if ( defined $self->{-childs} || $is_cdataish ) {
        $xml .= $self->{-docref}->{-elsep}
            unless ( $self->{-inline} && $self->{-name} );
        $xml .= $self->{-docref}->{-indent} x $self->{-docref}->{-level};
        $xml .= xmltagopen_ln( $self->{-name}, $ns, %attrs );
        $self->{-docref}->{-level}++;
        foreach my $k ( @{ $self->{-childs} } ) {
            if ( ref($k) =~ /^SVG::Element/ ) {
                $xml .= $k->xmlify($ns);
            }
        }

        if ( defined $self->{-cdata} ) {
            $xml .= $self->xmlescp( $self->{-cdata} );
        }
        if ( defined $self->{-CDATA} ) {
            $xml .= '<![CDATA[' . $self->{-CDATA} . ']]>';
        }
        if ( defined $self->{-cdata_noxmlesc} ) {
            $xml .= $self->{-cdata_noxmlesc};
        }

        #return without writing the tag out if it the document tag
        $self->{-docref}->{-level}--;
        unless ($is_cdataish) {
            $xml .= $self->{-docref}->{-elsep};
            $xml .= $self->{-docref}->{-indent} x $self->{-docref}->{-level};
        }
        $xml .= xmltagclose_ln( $self->{-name}, $ns );
    }
    else {
        $xml .= $self->{-docref}->{-elsep};
        $xml .= $self->{-docref}->{-indent} x $self->{-docref}->{-level};
        $xml .= xmltag_ln( $self->{-name}, $ns, %attrs );
    }

    #return the finished tag
    return $xml;
}

sub perlify {
    my $self = shift;
    my $code = '';

    #prep the attributes
    my %attrs;
    foreach my $k ( keys( %{$self} ) ) {
        next if $k =~ /^-/;
        if ( ref( $self->{$k} ) eq 'ARRAY' ) {
            $attrs{$k} = join( ', ', @{ $self->{$k} } );
        }
        elsif ( ref( $self->{$k} ) eq 'HASH' ) {
            $attrs{$k} = cssstyle( %{ $self->{$k} } );
        }
        elsif ( ref( $self->{$k} ) eq '' ) {
            $attrs{$k} = $self->{$k};
        }
    }

    if ( $self->{-comment} ) {
        $code .= "->comment($self->{-comment})";
        return $code;
    }
    elsif ( $self->{-pi} ) {
        $code .= "->pi($self->{-pi})";
        return $code;
    }
    elsif ( $self->{-name} eq 'document' ) {

        #write the xml header
        #$xml .= $self->xmldecl;
        #and write the dtd if this is inline
        #$xml .= $self->dtddecl unless $self->{-inline};
        foreach my $k ( @{ $self->{-childs} } ) {
            if ( ref($k) =~ /^SVG::Element/ ) {
                $code .= $k->perlify();
            }
        }
        return $code;
    }

    if ( defined $self->{-childs} ) {
        $code .= $self->{-docref}->{-elsep};
        $code .= $self->{-docref}->{-indent} x $self->{-docref}->{-level};
        $code
            .= $self->{-name} . '('
            . ( join ', ', ( map {"$_=>'$attrs{$_}'"} sort keys %attrs ) )
            . ')';
        if ( $self->{-cdata} ) {
            $code .= "->cdata($self->{-cdata})";
        }
        elsif ( $self->{-CDATA} ) {
            $code .= "->CDATA($self->{-CDATA})";
        }
        elsif ( $self->{-cdata_noxmlesc} ) {
            $code .= "->cdata_noxmlesc($self->{-cdata_noxmlesc})";
        }

        $self->{-docref}->{-level}++;
        foreach my $k ( @{ $self->{-childs} } ) {
            if ( ref($k) =~ /^SVG::Element/ ) {
                $code .= $k->perlify();
            }
        }
        $self->{-docref}->{-level}--;
    }
    else {
        $code .= $self->{-docref}->{-elsep};
        $code .= $self->{-docref}->{-indent} x $self->{-docref}->{-level};
        $code
            .= $self->{-name} . '('
            . ( join ', ', ( map {"$_=>'$attrs{$_}'"} sort keys %attrs ) )
            . ')';
    }

    return $code;
}
*toperl = \&perlify;

sub addchilds {
    my $self = shift;
    push @{ $self->{-childs} }, @_;
    return $self;
}

sub tag {
    my ( $self, $name, %attrs ) = @_;

    unless ( $self->{-parent} ) {

        #traverse down the tree until you find a non-document entry
        while ( $self->{-document} ) { $self = $self->{-document} }
    }
    my $tag = new SVG::Element( $name, %attrs );

    #define the element namespace
    $tag->{-namespace} = $attrs{-namespace} if ( $attrs{-namespace} );

    #add the tag to the document element
    $tag->{-docref} = $self->{-docref};
    weaken( $tag->{-docref} );

    #create the empty idlist hash ref unless it already exists
    $tag->{-docref}->{-idlist} = {}
        unless ( defined $tag->{-docref}->{-idlist} );

    #verify that the current id is unique. compain on exception
    #>>>TBD: add -strictids option to disable this check if desired
    if ( $tag->{id} ) {
        if ( $self->getElementByID( $tag->{id} ) ) {
            $self->error( $tag->{id} => 'ID already exists in document' );
            return;
        }
    }

    #add the current id reference to the document id hash

lib/SVG/Element.pm  view on Meta::CPAN

    my ( $self, %attrs ) = @_;
    return $self->tag( 'g', %attrs );
}

sub STYLE {
    my ( $self, %attrs ) = @_;

    $self->{style} = $self->{style} || {};
    foreach my $k ( keys %attrs ) {
        $self->{style}->{$k} = $attrs{$k};
    }

    return $self;
}

sub mouseaction {
    my ( $self, %attrs ) = @_;

    $self->{mouseaction} = $self->{mouseaction} || {};
    foreach my $k ( keys %attrs ) {
        $self->{mouseaction}->{$k} = $attrs{$k};
    }

    return $self;
}

sub attrib {
    my ( $self, $name, $val ) = @_;

    #verify that the current id is unique. compain on exception
    if ( $name eq 'id' ) {
        if ( $self->getElementByID($val) ) {
            $self->error( $val => 'ID already exists in document' );
            return;
        }
    }

    if ( not defined $val ) {
        if ( scalar(@_) == 2 ) {

            # two arguments only - retrieve
            return $self->{$name};
        }
        else {

            # 3rd argument is undef - delete
            delete $self->{$name};
        }
    }
    else {

        # 3 defined arguments - set
        $self->{$name} = $val;
    }

    return $self;
}
*attr      = \&attrib;
*attribute = \&attrib;

sub cdata {
    my ( $self, @txt ) = @_;
    $self->{-cdata} = join( ' ', @txt );
    return ($self);
}

sub CDATA {
    my ( $self, @txt ) = @_;
    $self->{-CDATA} = join( '\n', @txt );
    return ($self);
}

sub cdata_noxmlesc {
    my ( $self, @txt ) = @_;
    $self->{-cdata_noxmlesc} = join( '\n', @txt );
    return ($self);
}

sub filter {
    my ( $self, %attrs ) = @_;
    return $self->tag( 'filter', %attrs );
}

sub fe {
    my ( $self, %attrs ) = @_;

    return 0 unless ( $attrs{'-type'} );
    my %allowed = (
        blend            => 'feBlend',
        colormatrix      => 'feColorMatrix',
        componenttrans   => 'feComponentTrans',
        Componenttrans   => 'feComponentTrans',
        composite        => 'feComposite',
        convolvematrix   => 'feConvolveMatrix',
        diffuselighting  => 'feDiffuseLighting',
        displacementmap  => 'feDisplacementMap',
        distantlight     => 'feDistantLight',
        flood            => 'feFlood',
        funca            => 'feFuncA',
        funcb            => 'feFuncB',
        funcg            => 'feFuncG',
        funcr            => 'feFuncR',
        gaussianblur     => 'feGaussianBlur',
        image            => 'feImage',
        merge            => 'feMerge',
        mergenode        => 'feMergeNode',
        morphology       => 'feMorphology',
        offset           => 'feOffset',
        pointlight       => 'fePointLight',
        specularlighting => 'feSpecularLighting',
        spotlight        => 'feSpotLight',
        tile             => 'feTile',
        turbulence       => 'feTurbulence',
    );

    my $key     = lc( $attrs{'-type'} );
    my $fe_name = $allowed{ lc($key) } || 'error:illegal_filter_element';
    delete $attrs{'-type'};

    return $self->tag( $fe_name, %attrs );
}

sub pattern {
    my ( $self, %attrs ) = @_;
    return $self->tag( 'pattern', %attrs );
}

sub set {
    my ( $self, %attrs ) = @_;
    return $self->tag( 'set', %attrs );
}

sub stop {
    my ( $self, %attrs ) = @_;
    return $self->tag( 'stop', %attrs );