package GCBackend::GCBackendLibXml;

###################################################
#
#  Copyright 2005-2007 Tian
#
#  This file is part of GCstar.
#
#  GCstar is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  GCstar is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with GCstar; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
###################################################

use strict;
use utf8;

use XML::LibXML;



{
    package GCBackend::GCBeLibXml;

    sub new
    {
        my ($proto) = @_;
        my $class = ref($proto) || $proto;
        my $self  = {};
        bless $self, $class;
        return $self;
    }

    sub load
    {
        my ($self, $modelLoader, $file, $splash, $caller) = @_;
        my @data = ();

        my $parser = XML::LibXML->new;
        my $doc = $parser->parse_file($file);
        my $root = $doc->getDocumentElement();
        
        # Get Model
        my $model = $root->getAttribute('type');
        if ($model eq 'inline')
        {
        }
        else
        {
            $modelLoader->setCurrentModel($model);
        }
        
        tie @data, 'GCDomTie', $root;
#        for my $i(0..$#data - 1)
#        {
#            $caller->{toBeDisplayed}->{$i} = 1;
#        }
        return (\@data);
    }
    
    sub save
    {
        my ($self, $splash) = @_;
    }
    
}



{
    package GCDomTie;
    use base qw(Tie::Array);

    sub TIEARRAY
    {
        my ($class, $root) = @_;

        my @nodes = $root->getChildrenByTagName('item');
        my $self = {nodes => \@nodes};

        bless $self, $class;
        return $self;
    }

    sub FETCH
    {
        my ($self, $index) = @_;

        my $data = $self->{nodes}->[$index];
        if (ref($data) eq 'HASH')
        {
            return $data;
        }
        else
        {
            my %tiedElement;
            tie %tiedElement, 'GCElementTie', $data;
            $self->{nodes}->[$index] = \%tiedElement;
            return \%tiedElement;
        }
    }

    sub STORE
    {
        my ($self, $index, $data) = @_;

        $self->{nodes}->[$index] = $data;
    }

    sub DELETE
    {
        my ($self, $index) = @_;
        delete $self->{nodes}->[$index];
    }

    sub EXISTS
    {
        my ($self, $index) = @_;
        return exists $self->{nodes}->[$index];
    }

    sub FETCHSIZE
    {
        my ($self) = @_;
        return scalar @{$self->{nodes}};
    }

    sub STORESIZE
    {
        my ($self, $count)  = @_;
        my $currentNumber = $self->FETCHSIZE;
        if ($count > $currentNumber)
        {
            foreach ($count - $currentNumber .. $count)
            {
                $self->STORE($_, {});
            }
        } 
        elsif ($count < $currentNumber)
        {
            foreach (0 .. $currentNumber - $count - 2)
            {
                $self->POP;
            }
        }
    }

     sub POP
     {
         my ($self) = @_;
         return pop @{$self->{nodes}};
     }

     sub PUSH
     {
         my ($self, @values) = @_;
         push @{$self->{nodes}}, @values;
     }
}

# TIEHASH, FETCH, STORE, EXISTS, DELETE, CLEAR, FIRSTKEY, NEXTKEY, SCALAR
{
    package GCElementTie;
    use base qw(Tie::Hash);
    
    sub TIEHASH
    {
        my ($class, $element) = @_;

        my $self = {element => $element, cached => {}};
        bless $self, $class;
        return $self;
    }

    sub FETCH
    {
        my ($self, $key) = @_;

        # We return cached value if it exists.
        #  We only cache on write. Read are made from DOM until modified.
        if (! exists $self->{cached}->{$key})
        {
            # Build cache
            my $child = $self->{element}->firstChild;
            while ($child = $child->nextSibling)
            #foreach my $child($self->{element}->childNodes)
            {
                next if $child->nodeType != XML::LibXML::XML_ELEMENT_NODE;
                next if $child->nodeName ne $key;
                
                if ($child->firstChild->nextSibling)
                {
                    my @lines = $child->getChildrenByTagName('line');
                    my @multipleList;
                    foreach my $line(@lines)
                    {
                        my @lineArray;
                        foreach my $col($line->getChildrenByTagName('col'))
                        {
                            push @lineArray, $col->textContent;
                        }
                        push @multipleList, \@lineArray;
                    }
                    $self->{cached}->{$child->nodeName} = \@multipleList;
                }
                else
                {
                    $self->{cached}->{$child->nodeName} = $child->textContent;
                }
                last;
            }
        }
        return $self->{cached}->{$key};
    }

    sub STORE
    {
        my ($self, $key, $value) = @_;

        $self->{cached}->{$key} = $value;
    }

    sub EXISTS
    {
        my ($self, $key) = @_;

        # First look if it exists into cache
        return 1 if exists $self->{cached}->{$key};
        # Then look if we have a child with this tag
        return scalar $self->{element}->getChildrenByTagName($key);
    }

    sub DELETE
    {
        my ($self, $key) = @_;

        # First delete from cache
        delete $self->{cached}->{$key};
        # As we didn't remove it when adding it to cache (for performance
        # issues), we should have to do it now
        my $node = $self->{element}->getChildrenByTagName($key)->pop;
        $self->{element}->removeChild($node)
            if defined $node;
    }

    sub CLEAR
    {
        my ($self) = @_;
        $self->{cached} = {};
        $self->{element}->removeChildNodes;
    }

    sub FIRSTKEY
    {
        my ($self) = @_;

        # Initialize key list
        # As we don't remove from DOM when adding to cache
        # all the keys could be retrieved from DOM
        my @xmlTags;
        foreach ($self->{element}->childNodes)
        {
            push @xmlTags, $_->nodeName
                if $_->nodeType == XML::LibXML::XML_ELEMENT_NODE;
        }
        $self->{keys} = \@xmlTags;
        return shift @{$self->{keys}};
    }

    sub NEXTKEY
    {
        my ($self, $previous) = @_;
        return shift @{$self->{keys}};
    }

    sub SCALAR
    {
        my ($self) = @_;
        return scalar $self->{element}->childNodes;
    }
}



1;
