# Example Of Usage:
# Feel free to delete these lines, although please retain the copyright notice
# in the comments.
#
# Writing a hash... the following code
#
# my %x = ( "id" => "1",
#           "field1" => "value1" 
#           "field2" => "value2" );
#
# my $y = new XMLDBParser("data.xml", "element");
# $y->write(%x);
#
# ...would result in data.xml looking like the below
#
# <element id="1">
#   <field1> value1 </field1>
#   <field2> value2 </field2>
# </element>
#
# Then, this code...
# my @contents_list = $y->contents();
# for (my $i = 0; $i <= $#contents_list; $i++) {
#    my $id = $contents_list[$i];
#    my %info = $y->read($id);
#    foreach my $key (keys %info) {
#       print "$key => $info{$key}\n";
#    }
# }
#
# ...would output the following...
# id => 1
# field1 => value1
# field2 => value2
#
# Simple, isn't it?


{ package XMLDBParser;
    # Copyright (C) 2005 Rami Chowdhury
    # Licensed under the GNU LGPL
    # ---------------------------------
    # Written for simple flat text databases in a vaguely XML-like format,
    # where entries in the database are distinguished by an 'id' attribute
    # on the containing element, and further sub-elements use descriptive 
    # tags to wrap data. 
    #
    # Supported methods include...
    # - new([$filename[,$tag]]) : the constructor. Can take arguments for file
    # (which *must* exist - Safeperl will not allow files to be created) and
    # the 'container' tag.
    # - contents([$backups]) : scans the database and returns an array of ID 
    # values. If $backups is set to a true (i.e. nonzero or non-null) value,
    # will include backup entries in the returned array.
    # - read($id) : reads the entry with the given id into a hash; this will
    # contain fields for each of the XML data tags, as well as an 'id' field.
    # - get($id) : like read(), except that it removes the entry that is read
    # in, and creates a backup entry (denoted by having '_BACKUP' appended 
    # to the 'id' field) in its place.
    # - write(%data) : accepts a hash of data, and appends it to the database
    # in its simple format. 
    #
    # See the following URL for a usage example:
    # 'http://users.ox.ac.uk/cgi-bin/safeperl/mert1416/site.cgi?page=DBPRSEX'

    sub new {
        # Very basic constructor
        my $passedIn = shift;
        my $class = ref($passedIn) || $passedIn;
        my $self = {};
        # Allows a filename to be set as the database. Defaults to 'data.xml'
        $self->{filename} = "test.xml";
        if (@_) {
            $self->{filename} = shift;
        }
        # Accepts a container tag to be set. Defaults to 'element'
        $self->{tag} = "entry";
        if (@_) {
            $self->{tag} = shift;
        }
        bless ($self, $class);
        return $self;
    }
    
    sub filename {
        my $self = shift;
        # An argument means you're setting the property. Otherwise return it.
        if (@_) {
            $self->{filename} = shift;
            return 1;
        }
        else {
            return $self->{file};
        }
    }
    
    sub tag {
        my $self = shift;
        # An argument means you're setting the property. Otherwise return it.
        if (@_) {
            $self->{tag} = shift;
            return 1;
        }
        else {
            return $self->{tag};
        }
    }
    
    sub contents {
        my $self = shift;
        # Include backups?
        my $backups = 0;
        if (@_) {
            $backups = shift;
        }
        # What tag are we parsing for?
        my $tag = $self->{tag};
        # Sets the paths. Bloody Safeperl.
        my $inPath = $self->{filename};
        $inPath = "out/$inPath";
        # Opens file and locks it
        open(DATA,"$inPath") or HTMLError("Unable to access main database");
        flock(DATA,2) or HTMLError("Unable to lock main database");
        # Parses the file for entries
        my @entries;
        my $line; my $id;
        while (<DATA>) {
            $line = $_;
            if ($line =~ /<$tag id=\"(.*?)\">/) {
                $id = $1;
                unless ( ($id =~ /BACKUP/) || ($backups) ) {
                    push(@entries, $id)
                }
            }
        }
        close(DATA);
        return @entries;
    }
    
    sub get {
        my $self = shift;
        # Accepts an id attribute
        my ($id) = @_;
        # What tag are we parsing for?
        my $tag = $self->{tag};
        # Sets the paths. Bloody Safeperl.
        my $inPath = $self->{filename};
        $inPath = "out/$inPath";
        my $outPath = $self->{filename};
        $outPath = ">$outPath";
        # Opens file and locks it
        open(DATA,"$inPath") or HTMLError("Unable to access main database");
        flock(DATA,2) or HTMLError("Unable to lock main database");
        # Parses the file for the relevant entry
        my $found = 0;
        my $line;
        my $bigString = "";
        my @allLines;
        while (<DATA>) {
            $line = $_;
            if ($found == 1) {
                if ($line =~ /<\/$tag>/) {
                    $bigString = "$bigString<id>$id</id>";
                    $found = 17;
                }
                else {
                    $bigString = "$bigString$line";
                }
                $line = "";
            }
            elsif ($found == 17) {
                # Do nothing
            }
            elsif ($found == 18) {
                if ($line =~ /<\/$tag>/) {
                    $found = 17;
                }
                $line = "";
            }
            else {
                if ( $line =~ /<$tag id="$id">/ ) {
                    $found = 1;
                    $line = "";
                }
                elsif ($line =~ /<$tag id="$id.BACKUP"/) {
                    $found = 18;
                    $line = "";
                }
            }
            push(@allLines,$line);
        }
        if ($found == 0) {
            HTMLError("Undefined $tag requested");
        }
        close(DATA);
        # reprint data
        open(DATA,"$outPath");
        flock(DATA,2) or HTMLError("Unable to lock main database");
        foreach my $one (@allLines) {
            print DATA $one;
        }
        close(DATA);
        # Now pulls data out of the big string
        my %data;
        while ($bigString =~ s/<(.*?)>(.*?)<\/\1>/[]/smi) {
            $data{$1} = $2;
        }
        # Now writes the backup entry
        unless ( ($id =~ /BACKUP/) or ($id !~ /\w/) ) {
            my %data2 = %data;
            $data2{id} = "$data{id}_BACKUP";
            $self->write(%data2);
        }
        # returns
        return %data;
    }
    
    sub read {
        my $self = shift;
        # Accepts an id attribute
        my ($id) = @_;
        # What tag are we parsing for?
        my $tag = $self->{tag};
        # Sets the paths. Bloody Safeperl.
        my $inPath = $self->{filename};
        $inPath = "out/$inPath";
        my $outPath = $self->{filename};
        $outPath = ">$outPath";
        # Opens file and locks it
        open(DATA,"$inPath") or HTMLError("Unable to access main database");
        flock(DATA,2) or HTMLError("Unable to lock main database");
        # Parses the file for the relevant entry
        my $found = 0;
        my $line;
        my $bigString = "";
        # Main loop
        while (<DATA>) {
            $line = $_;
            if ($found == 1) {
                if ($line =~ /<\/$tag>/) {
                    $bigString = "$bigString<id>$id</id>";
                    $found = 17;
                }
                else {
                    $bigString = "$bigString$line";
                }
            }
            elsif ($found == 17) {
                # Do nothing
            }
            elsif ($found == 18) {
                if ($line =~ /<\/$tag>/) {
                    $found = 17;
                }
            }
            else {
                if ( $line =~ /<$tag id="$id">/ ) {
                    $found = 1;
                }
                elsif ($line =~ /<$tag id="$id.BACKUP"/) {
                    $found = 18;
                }
            }
        }
        if ($found == 0) {
            HTMLError("Undefined $tag requested");
        }
        close(DATA);
        # Now pulls data out of the big string
        my %data;
        while ($bigString =~ s/<(.*?)>(.*?)<\/\1>/[]/smi) {
            $data{$1} = $2;
        }
        # Returns
        return %data;
    }
    
    sub write {
        my $self = shift;
        # Accepts a hash
        my (%data) = @_;
        # Tag to use in writing
        my $tag = $self->{tag};
        # Path setting
        my $outPath = $self->{filename};
        $outPath = ">>$outPath";
        # Opens and locks file
        open(DATA,"$outPath") or HTMLError("Cannot write to database");
        flock(DATA,2) or HTMLError("Unable to lock main database");
        # Now the writing
        print DATA "\n<$tag id=\"$data{id}\">\n";
        foreach my $one (keys %data) {
            unless ($one eq 'id') {
            print DATA "\t<$one>$data{$one}</$one>\n";
            }
        }
        print DATA "</$tag>\n";
        # Finishes up
        close(DATA);

    }
    
}