view release on metacpan or  search on metacpan

lib/XML/API.pm  view on Meta::CPAN

    my $element = shift || croak '_open($element,...)';

    my $namespace = $self->{namespace};

    # reset the output string in case it has been cached
    $self->{string} = undef;

    if ( $element eq $self->_root_element ) {
        $self->{has_root_element} = 1;
    }

    my $attrs = {};
    my @content;

    my $total = scalar(@_) - 1;
    my $next;

    foreach my $i ( 0 .. $total ) {
        if ($next) {
            $next = undef;
            next;
        }

        my $arg = $_[$i];
        if ( ref($arg) eq 'HASH' ) {
            while ( my ( $key, $val ) = each %$arg ) {
                $attrs->{$key} = _escapeXML($val);
                if ( !defined($val) ) {
                    carp "attribute '$key' undefined (element '$element')";
                    $attrs->{$key} = '';
                }
            }
        }
        elsif ( defined($arg) and $arg =~ m/^-[^0-9\.]+/o ) {
            $arg =~ s/^-//o;
            $attrs->{$arg} = _escapeXML( $_[ ++$i ] );
            if ( !defined( $attrs->{$arg} ) ) {
                carp "attribute '$arg' undefined (element '$element') ";
                $attrs->{$arg} = '';
            }
            $next = 1;
            next;
        }
        else {
            push( @content, $arg );
        }
    }

    #
    # Start with the default root element attributes and add those
    # given if this is the root element
    #
    if ( $element eq $self->_root_element ) {
        my $rootattrs = $self->_root_attrs;
        while ( my ( $key, $val ) = each %$attrs ) {
            $rootattrs->{$key} = $val;
        }
        $attrs = $rootattrs;
    }

    my ( $file, $line ) = (caller)[ 1, 2 ] if ( $self->{debug} );

    if ( $self->{langnext} ) {
        $attrs->{'xml:lang'} = delete $self->{langnext};
    }
    if ( $self->{dirnext} ) {
        $attrs->{'dir'} = delete $self->{dirnext};
    }

    my $e;
    if ( $self->{current} ) {
        $e = XML::API::Element->new(
            element => $element,
            attrs   => $attrs,
            ns      => $namespace,
            parent  => $self->{current},
        );
        $self->_add($e);
    }
    else {
        $e = XML::API::Element->new(
            element => $element,
            attrs   => $attrs,
            ns      => $namespace,
        );
        push( @{ $self->{elements} }, $e );
    }

    $self->{current} = $e;
    if ( $self->{_raw} ) {
        $self->_raw(@content);
    }
    else {
        $self->_add(@content);
    }

    $self->_comment("DEBUG: '$element' (open) at $file:$line")
      if ( $self->{debug} );

    return $e;
}

sub _add {
    my $self = shift;
    $self->{string} = undef;
    if ( !$self->{current} ) {
        croak 'Cannot use _add with no current element';
    }

    foreach my $item (@_) {
        carp "undefined input" unless ( defined($item) );
        if ( eval { $item->isa(__PACKAGE__) } ) {
            if ( refaddr($item) == refaddr($self) ) {
                croak 'Cannot _add object to itself';
            }
            if ( !$self->{current} ) {
                push( @{ $self->{elements} }, $item );
            }
            else {
                $self->{current}->add($item);
            }
            bless( $item, ref($self) );
            $item->{parent} = $self;
            weaken( $item->{parent} );

            foreach my $lang ( keys %{ $item->{langs} } ) {
                $self->{langs}->{$lang} = 1;
            }
        }
        else {
            if ( eval { $item->isa('XML::API::Element') } ) {
                $self->{current}->add($item);
            }
            elsif ( eval { $item->isa('XML::API::Cache') } ) {
                foreach my $lang ( $item->langs ) {
                    $self->{langs}->{$lang} = 1;
                }
                $self->{current}->add($item);
            }
            else {
                $self->{current}->add( _escapeXML($item) );
            }
        }
    }
}

sub _raw {
    my $self = shift;
    $self->{string} = undef;
    foreach my $item (@_) {
        carp "undefined input" unless ( defined($item) );
        if ( ref($item) and $item->isa(__PACKAGE__) ) {
            croak 'Cannot add XML::API objects as raw';
        }
        if ( $self->{current} ) {
            $self->{current}->add($item);
        }
        else {
            push( @{ $self->{elements} }, $item );
        }
    }
}

sub _close {
    my $self = shift;
    my $element = shift || croak '_close($element)';

    my ( $file, $line ) = (caller)[ 1, 2 ] if ( $self->{debug} );

    if ( !$self->{current} ) {
        carp 'attempt to close non-existent element "' . $element . '"';
        return;
    }

    if ( $element eq $self->{current}->{element} ) {
        if ( $self->{current}->parent ) {
            $self->{current} = $self->{current}->parent;
            $self->_comment("DEBUG: '$element' close at $file:$line")
              if ( $self->{debug} );
        }
        else {
            $self->{current} = undef;
        }
    }
    else {
        carp 'attempted to close element "'
          . $element
          . '" when current '
          . 'element is "'
          . $self->{current}->{element} . '"';
    }
    return;
}

sub _element {
    my $self    = shift;
    my $element = shift || croak '_element($element)';
    my $e       = $self->_open( $element, @_ );
    $self->_close($element);
    return $e;
}

#
# The implementation for element, element_open and element_close
#

sub AUTOLOAD {
    my $self    = shift;
    my $element = $AUTOLOAD;

    my ( $open, $close ) = ( 0, 0 );

    if ( $element =~ s/.*::(.+)_open$/$1/o ) {
        my $old_ns = $self->{namespace};

        if ( $element =~ s/(.+)__(.+)/$2/o ) {
            $self->{namespace} = $1;
        }

        my $e = $self->_open( $element, @_ );
        $self->{namespace} = $old_ns;
        return $e;
    }
    elsif ( $element =~ s/.*::(.+)_close$/$1/o ) {
        $element =~ s/(.+)__(.+)/$2/o;
        return $self->_close($element);
    }
    elsif ( $element =~ s/.*::(.+)_raw$/$1/o ) {