summaryrefslogtreecommitdiff
path: root/lib/gcstar/GCBackend
diff options
context:
space:
mode:
Diffstat (limited to 'lib/gcstar/GCBackend')
-rw-r--r--lib/gcstar/GCBackend/GCBackendXmlCommon.pm305
-rw-r--r--lib/gcstar/GCBackend/GCBackendXmlParser.pm491
2 files changed, 796 insertions, 0 deletions
diff --git a/lib/gcstar/GCBackend/GCBackendXmlCommon.pm b/lib/gcstar/GCBackend/GCBackendXmlCommon.pm
new file mode 100644
index 0000000..b8a3054
--- /dev/null
+++ b/lib/gcstar/GCBackend/GCBackendXmlCommon.pm
@@ -0,0 +1,305 @@
+package GCBackend::GCBackendXmlCommon;
+
+###################################################
+#
+# Copyright 2005-2010 Christian Jodar
+#
+# 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
+#
+###################################################
+
+use strict;
+use utf8;
+use filetest 'access';
+
+{
+ package GCBackend::GCBeXmlBase;
+
+ use File::Temp qw/ tempfile /;
+ use File::Copy;
+
+ my %xmlConv = (
+ '&' => '&',
+ '"' => '"',
+ '<' => '&lt;',
+ '>' => '&gt;',
+ '' => '',
+ );
+ my $toBeReplaced = join '', keys %xmlConv;
+
+ sub new
+ {
+ my ($proto, $modelLoader) = @_;
+ my $class = ref($proto) || $proto;
+ my $self = {modelLoader => $modelLoader};
+ bless $self, $class;
+ return $self;
+ }
+
+ sub getVersion
+ {
+ my $self = shift;
+ my $version = undef;
+ return $version if (! -r $self->{file});
+ open DATA, $self->{file};
+ binmode(DATA, ':utf8');
+ while (<DATA>)
+ {
+ next if ! /^\s*<collection.*/;
+ $version = $1
+ if /version="([^"]*)"/;
+ last;
+ }
+ close DATA;
+ return $version;
+ }
+
+ sub prepareModel
+ {
+ my ($self, $file) = @_;
+ open COLLECTION, $file;
+ my $model;
+ while (<COLLECTION>)
+ {
+ if (/type="(.*?)"/)
+ {
+ $model = $1;
+ last;
+ }
+ }
+ close COLLECTION;
+ $self->{modelLoader}->preloadModel($model);
+ }
+
+ sub setParameters
+ {
+ my ($self, %options) = @_;
+ $self->{$_} = $options{$_} foreach keys %options;
+ }
+
+ sub hashToXMLString
+ {
+ my %hash = @_;
+ my $result = '';
+ foreach (keys %hash)
+ {
+ $result .= " $_=\"".$hash{$_}.'"';
+ }
+ return $result;
+ }
+
+ sub listToXml
+ {
+ my $value = shift;
+ my $xml = '';
+ my $col;
+ foreach (@{$value})
+ {
+ $xml .= ' <line>
+';
+ foreach $col(@{$_})
+ {
+ (my $newCol = $col) =~ s/([$toBeReplaced])/$xmlConv{$1}/go;
+ #"
+ $xml .= " <col>$newCol</col>\n";
+ }
+ $xml .= ' </line>
+';
+ }
+ return $xml;
+ }
+
+ sub setHistories
+ {
+ my ($self, $histories) = @_;
+
+ $self->{histories} = $histories;
+ }
+
+ sub save
+ {
+ my ($self, $data, $info, $splash, $keepCurrentValueForDate) = @_;
+
+ # Save into a new file to prevent crashes during saving
+ (my ($tmpFd, $tmpFile)) = tempfile();
+ if (!$tmpFd)
+ {
+ my @error = ('SaveError', '');
+ return {error => \@error};
+ }
+
+ binmode($tmpFd, ':utf8');
+
+ my $xmlModel = '';
+ my $xmlPreferences = '';
+ my $collectionType;
+ my $versionString = '';
+
+ if (exists $self->{version})
+ {
+ $versionString = ' version="'.$self->{version}.'"';
+ }
+ if (($self->{modelLoader}->{model}->isInline)
+ || ($self->{modelLoader}->{model}->isPersonal && $self->{standAlone}))
+ {
+ $xmlModel = $self->{modelLoader}->{model}->toString('collectionInlineDescription', 1);
+ $xmlPreferences = $self->{modelLoader}->{model}->{preferences}->toXmlString;
+ $collectionType = 'inline';
+ }
+ else
+ {
+ $collectionType = $self->{modelLoader}->{model}->getName;
+ $xmlModel = $self->{modelLoader}->{model}->toStringAddedFields('userCollection');
+ }
+ my $information = ' <information>
+';
+ $information .= " <$_>".GCUtils::encodeEntities($info->{$_})."</$_>\n"
+ foreach (sort keys %{$info});
+ $information .= ' </information>';
+
+ # Change this to 1 to save history. Not fully functional yet
+ # Because we don't remove item that are no more present in data.
+ my $withHistory = 0;
+ my $histories;
+ if ($withHistory)
+ {
+ $histories = ' <histories>
+';
+ foreach (keys %{$self->{histories}})
+ {
+ $histories .= " <history name=\"$_\">\n";
+ foreach my $value(@{$self->{histories}->{$_}})
+ {
+ if (ref($value) eq 'ARRAY')
+ {
+ $histories .= ' <values>
+';
+ foreach my $entry(@$value)
+ {
+ next if $entry eq '';
+ $entry =~ GCUtils::encodeEntities($entry);
+ $histories .= " <value>$entry</value>\n";
+ }
+ $histories .= ' </values>
+';
+ }
+ else
+ {
+ next if $value eq '';
+ $histories .= ' <value>'.GCUtils::encodeEntities($value)."</value>\n";
+ }
+ }
+ $histories .= ' </history>
+';
+ }
+ $histories .= ' </histories>';
+ }
+
+ my $number = 0;
+ $number = scalar @$data;
+
+ print $tmpFd '<?xml version="1.0" encoding="UTF-8"?>
+<collection type="',$collectionType,'" items="',$number,'"', $versionString,'>
+',$information,'
+',$xmlModel,'
+',$xmlPreferences,'
+',$histories,'
+';
+ my $i = 1;
+ foreach (@$data)
+ {
+ #Perform the transformation for each image value
+ foreach my $pic(@{$self->{modelLoader}->{model}->{managedImages}})
+ {
+ $_->{$pic}
+ = $self->{modelLoader}->transformPicturePath($_->{$pic}, undef, $_, $pic);
+ }
+
+ print $tmpFd ' <item
+';
+ my @complexFields;
+ my @longFields;
+ foreach my $field(@{$self->{modelLoader}->{model}->{fieldsNames}})
+ {
+ if (ref($_->{$field}) eq 'ARRAY')
+ {
+ push @complexFields, $field;
+ }
+ elsif ($self->{modelLoader}->{model}->{fieldsInfo}->{$field}->{type}
+ eq 'long text')
+ {
+ push @longFields, $field;
+ }
+ else
+ {
+ (my $data = $_->{$field}) =~ s/([$toBeReplaced])/$xmlConv{$1}/go;
+ if (($self->{modelLoader}->{model}->{fieldsInfo}->{$field}->{type} eq 'date')
+ && ($data eq 'current')
+ && (!$keepCurrentValueForDate))
+ {
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
+ $data = sprintf('%02d/%02d/%4d', $mday, $mon+1, 1900+$year);
+ }
+ print $tmpFd ' ', $field, '="', $data, '"
+';
+ }
+ }
+ print $tmpFd ' >
+';
+ foreach my $field(@longFields)
+ {
+ #(my $data = $_->{$field}) =~ s/&/&amp;/g;
+ #$data =~ s/</&lt;/g;
+ #$data =~ s/>/&gt;/g;
+ #$data =~ s/"/&quot;/g;
+ (my $data = $_->{$field}) =~ s/([$toBeReplaced])/$xmlConv{$1}/go;
+ #"
+ print $tmpFd ' <', $field, '>', $data, '</', $field, '>
+';
+ }
+ foreach my $field(@complexFields)
+ {
+ print $tmpFd ' <', $field, '>
+', listToXml($_->{$field}), ' </', $field, '>
+';
+ }
+
+ print $tmpFd ' </item>
+';
+ $splash->setProgressForItemsDisplay($i) if $splash;
+
+ $self->{modelLoader}->restoreInfo($_)
+ if $self->{wantRestore};
+
+ $i++;
+ }
+ print $tmpFd '</collection>
+';
+ close $tmpFd;
+
+ # Now everything is OK, we move the temporary file over the correct one
+ if (!move($tmpFile, $self->{file}))
+ {
+ my @error = ('SaveError', $!);
+ return {error => \@error};
+ }
+
+ return {error => undef};
+ }
+}
+
+1;
diff --git a/lib/gcstar/GCBackend/GCBackendXmlParser.pm b/lib/gcstar/GCBackend/GCBackendXmlParser.pm
new file mode 100644
index 0000000..091823b
--- /dev/null
+++ b/lib/gcstar/GCBackend/GCBackendXmlParser.pm
@@ -0,0 +1,491 @@
+package GCBackend::GCBackendXmlParser;
+
+###################################################
+#
+# Copyright 2005-2010 Christian Jodar
+#
+# 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
+#
+###################################################
+
+use strict;
+use utf8;
+use filetest 'access';
+use GCBackend::GCBackendXmlCommon;
+
+{
+ package GCBackend::GCBeXmlParser;
+
+ use File::Temp qw/ tempfile /;
+ use File::Copy;
+
+ use base 'GCBackend::GCBeXmlBase';
+
+ my $globalInstance;
+ my $globalSplash;
+ my $globalModelLoader;
+ #my @data;
+ #my %information;
+ #my %histories;
+ my $maxId;
+ my $savedMaxId;
+ my $historyInline;
+
+ sub load
+ {
+ my ($self, $splash) = @_;
+
+ if (! -r $self->{file})
+ {
+ my @error = ('OpenError', '');
+ return {error => \@error};
+ }
+
+ $self->{data} = [];
+ $self->{information} = {};
+ $self->{histories} = ();
+ $maxId = 0;
+ $savedMaxId = 0;
+
+ $globalInstance = $self;
+ $globalSplash = $splash;
+ $globalModelLoader = $self->{modelLoader};
+
+ my $parser = XML::Parser->new(Handlers => {
+ Init => \&StartDocument,
+ Final => \&EndDocument,
+ Start => \&StartTag,
+ End => \&EndTag,
+ Char => \&Text,
+ });
+ # We have to preload the model into cache because XML::Parser is not
+ # re-entrant. Then when we begin parsing, we cannot parse the model
+ $self->prepareModel($self->{file});
+ my $error = undef;
+ while (1)
+ {
+ eval {
+ $parser->parsefile($self->{file});
+ };
+ if ($@)
+ {
+ my $errorDesc = $@;
+
+ # Here we will fix the collection if an invalid character was found by trying to remove it.
+ # There should be room for optimisation here
+
+ if ($errorDesc =~ /not\s*well-formed\s*\(invalid\s*token\)\s*.*?byte\s*(\d+)/)
+ {
+ my $charPosition = $1;
+ # We would have failed before if it cannot be opened, so we don't check that.
+ open COL, $self->{file};
+ seek COL, $charPosition, 0;
+ my $badChar;
+ read COL, $badChar, 1;
+ seek COL, 0, 0;
+ (my ($newCol, $tmpFile)) = tempfile();
+ while (<COL>)
+ {
+ s/$badChar//g;
+ print $newCol $_;
+ }
+ close $newCol;
+ close COL;
+ move($tmpFile, $self->{file});
+ }
+ else
+ {
+ $errorDesc =~ s/^\n*//;
+ my @errorArray = ('OpenFormatError', $errorDesc);
+ $error = \@errorArray;
+ last;
+ }
+ }
+ else
+ {
+ last;
+ }
+ }
+
+ # TODO : Compare performances with and without the compact below because the duplicates are checked
+ # also when adding to the graphical components
+ # Compact histories. We didn't filtered previously for performances issues
+ #GCUtils::compactHistories(\%histories);
+
+ $self->{information}->{maxId} = $maxId
+ if ! exists $self->{information}->{maxId};
+
+ # gotHistory:
+ # 0: Nothing done
+ # 1: Returning history
+ # 2: Already initialized
+
+ return {
+ error => $error,
+ data => $self->{data},
+ information => $self->{information},
+ histories => \$self->{histories},
+ gotHistory => (1 + ($historyInline ? 0 : 1)), # We always have an initalized history with this BE.
+ };
+ }
+
+ # Parser routines
+
+ # Some globals to speed up things
+ my $inCol;
+ my $inLine;
+ my $currentTag;
+ my $currentCol;
+ my $currentCount;
+ my $currentIsList;
+ my $isItem;
+ my $isInfo;
+ my $newItem;
+ my $modCap;
+ my $prefCap;
+ my $anyCap;
+ my $isInline;
+ my $inlineModel;
+ my $inlinePreferences;
+
+ my $inHistories;
+ my $historyField;
+ # history type :
+ # 1 : Single list
+ # 2 : Multiple list
+ my $historyType;
+ my $historyCap;
+
+ sub StartDocument
+ {
+ $isItem = 0;
+ $inLine = 0;
+ $inCol = 0;
+ $currentCol = '';
+ $currentCount = 0;
+ $modCap = 0;
+ $prefCap = 0;
+ $anyCap = 0;
+ $inlineModel = '';
+ $inlinePreferences = '';
+
+# SAVED HISTORIES DEACTIVATED
+# $inHistories = 0;
+# $historyField = '';
+# $historyCap = 0;
+ $historyInline = 0;
+ }
+
+ sub EndDocument
+ {
+ if (($inlineModel) && ($isInline))
+ {
+ $globalModelLoader->setCurrentModelFromInline({inlineModel => $inlineModel,
+ inlinePreferences => $inlinePreferences});
+ }
+ }
+
+ sub StartTag
+ {
+ #my ($expat, $tag, %attrs) = @_;
+ if ($isItem)
+ {
+ if ($inLine)
+ {
+ #Only a col could start in a line
+ $inCol = 1;
+ }
+ elsif ($_[1] eq 'line')
+ {
+ $inLine = 1;
+ $currentIsList = 1;
+ $newItem->{$currentTag} = [] if (ref($newItem->{$currentTag}) ne 'ARRAY');
+ push @{$newItem->{$currentTag}}, [];
+ }
+ else
+ {
+ $currentIsList = 0;
+ $currentTag = $_[1];
+ }
+ }
+ elsif ($isInfo)
+ {
+ $currentTag = $_[1];
+ $savedMaxId = 1 if $currentTag eq 'maxId';
+ }
+ else
+ {
+ my ($expat, $tag, %attrs) = @_;
+ if ($modCap)
+ {
+ $tag =~ s/^user(.)/\L$1\E/;;
+ $inlineModel .= "<$tag".GCBackend::GCBeXmlBase::hashToXMLString(%attrs).'>';
+ }
+ elsif ($prefCap)
+ {
+ $inlinePreferences .= "<$tag".GCBackend::GCBeXmlBase::hashToXMLString(%attrs).'>';
+ }
+ elsif ($tag eq 'item')
+ {
+ $newItem = \%attrs;
+ $isItem = 1;
+ }
+ elsif ($tag eq 'information')
+ {
+ $isInfo = 1;
+ }
+ elsif (($tag eq 'collectionInlineDescription') || ($tag eq 'userCollection'))
+ {
+ $modCap = 1;
+ $anyCap = 1;
+ $inlineModel = '<collection'.GCBackend::GCBeXmlBase::hashToXMLString(%attrs).">\n";
+ }
+ elsif ($tag eq 'collectionInlinePreferences')
+ {
+ $prefCap = 1;
+ $anyCap = 1;
+ $inlinePreferences = '<preferences'.GCBackend::GCBeXmlBase::hashToXMLString(%attrs).">\n";
+ }
+ elsif ($tag eq 'collection')
+ {
+ $globalSplash->setItemsTotal($attrs{items})
+ if $globalSplash;
+ if ($attrs{type} eq 'inline')
+ {
+ $isInline = 0;
+ }
+ else
+ {
+ if (! $globalModelLoader->setCurrentModel($attrs{type}))
+ {
+ die $globalModelLoader->{lang}->{ErrorModelNotFound}.$attrs{type}
+ ."\n\n"
+ .$globalModelLoader->getUserModelsDirError."\n";
+ }
+ }
+ }
+# SAVED HISTORIES DEACTIVATED
+# elsif ($tag eq 'histories')
+# {
+# $inHistories = 1;
+# $historyInline = 1;
+# }
+# elsif ($inHistories)
+# {
+# if ($tag eq 'history')
+# {
+# $historyField = $attrs{name};
+# # Default is single
+# $historyType = 1;
+# }
+# elsif ($tag eq 'values')
+# {
+# push @{$globalInstance->{histories}->{$historyField}}, [];
+# $historyType = 2;
+# }
+# elsif ($tag eq 'value')
+# {
+# if ($historyType == 1)
+# {
+# push @{$globalInstance->{histories}->{$historyField}}, '';
+# }
+# else
+# {
+# push @{$globalInstance->{histories}->{$historyField}->[-1]}, '';
+# }
+# $historyCap = 1;
+# }
+# }
+ }
+ }
+
+ sub EndTag
+ {
+ if ($anyCap)
+ {
+ if ($modCap)
+ {
+ if (($_[1] eq 'collectionInlineDescription') || ($_[1] eq 'userCollection'))
+ {
+ $anyCap = $prefCap;
+ $modCap = 0;
+ $inlineModel .= '</collection>';
+ if ($inlinePreferences)
+ {
+ $globalModelLoader->setCurrentModelFromInline({inlineModel => $inlineModel,
+ inlinePreferences => $inlinePreferences});
+ $inlineModel = undef;
+ }
+ elsif($_[1] eq 'userCollection')
+ {
+ $globalModelLoader->addFieldsToDefaultModel($inlineModel);
+ $inlineModel = undef;
+ }
+
+ }
+ else
+ {
+ (my $tag = $_[1]) =~ s/^user(.)/\L$1\E/;
+ $inlineModel .= "</$tag>\n";
+ }
+ return;
+ }
+ else
+ {
+ if ($_[1] eq 'collectionInlinePreferences')
+ {
+ $anyCap = $modCap;
+ $prefCap = 0;
+ $inlinePreferences .= '</preferences>';
+ if ($inlineModel)
+ {
+ $globalModelLoader->setCurrentModelFromInline({inlineModel => $inlineModel,
+ inlinePreferences => $inlinePreferences});
+ $inlineModel = '';
+ }
+ }
+ else
+ {
+ $inlinePreferences .= '</'.$_[1].">\n";
+ }
+ return;
+ }
+ }
+
+ if ($_[1] eq 'item')
+ {
+ push @{$globalInstance->{data}}, $newItem;
+ $currentCount++;
+# SAVED HISTORIES DEACTIVATED
+# if (!$historyInline)
+# {
+ #foreach (@{$globalModelLoader->{model}->{fieldsHistory}})
+ #{
+ # push @{$globalInstance->{histories}->{$_}}, $newItem->{$_};
+ #}
+ if ($globalModelLoader->{panel})
+ {
+ foreach (@{$globalModelLoader->{model}->{fieldsHistory}})
+ {
+ $globalModelLoader->{panel}->{$_}->addHistory($newItem->{$_}, 1);
+ }
+ }
+# }
+ foreach (@{$globalModelLoader->{model}->{fieldsNotNull}})
+ {
+ $newItem->{$_} = $globalModelLoader->{model}->{fieldsInfo}->{$_}->{init} if ! $newItem->{$_};
+ }
+
+ if (!$savedMaxId)
+ {
+ my $id = $newItem->{$globalModelLoader->{model}->{commonFields}->{id}};
+ $maxId = $id
+ if $id > $maxId;
+ }
+
+ $globalSplash->setProgressForItemsLoad($currentCount)
+ if $globalSplash;
+
+ $isItem = 0;
+ }
+ elsif ($_[1] eq 'information')
+ {
+ $isInfo = 0 if !$isItem;
+ }
+ elsif ($inCol)
+ {
+ # We are closing a col as it could not have tags inside
+ push @{$newItem->{$currentTag}->[-1]}, $currentCol;
+ $currentCol = '';
+ $inCol = 0;
+ }
+# SAVED HISTORIES DEACTIVATED
+# elsif ($inHistories)
+# {
+# $inHistories = 0 if $_[1] eq 'histories';
+# $historyField = '' if $_[1] eq 'history';
+# $historyCap = 0 if $_[1] eq 'value';
+#
+# }
+ else
+ {
+ # The only tag that could prevent us from closing a line is col, but it has
+ # already been managed
+ if ($inLine)
+ {
+ $inLine = 0;
+ }
+ else
+ {
+ $currentTag = '';
+ }
+ }
+ }
+
+ sub Text
+ {
+ if ($isItem)
+ {
+ if ((! $currentTag)
+ || $inLine
+ || $currentIsList
+ || ((!$newItem->{$currentTag}) && ($_[1] =~ /^\s*$/oms)))
+ {
+ if ($inCol)
+ {
+ return if $_[1] =~ /^\s*$/oms;
+ $currentCol .= $_[1];
+ }
+ }
+ else
+ {
+ $newItem->{$currentTag} .= $_[1];
+ }
+ }
+ elsif ($isInfo)
+ {
+ return if $_[1] =~ /^\s*$/oms;
+ $globalInstance->{information}->{$currentTag} .= $_[1];
+ }
+ else
+ {
+ if ($modCap)
+ {
+ $inlineModel .= $_[1];
+ }
+ elsif ($prefCap)
+ {
+ $inlinePreferences .= $_[1];
+ }
+# elsif ($historyCap)
+# {
+# if ($historyType == 1)
+# {
+# $globalInstance->{histories}->{$historyField}->[-1] .= $_[1];
+# }
+# else
+# {
+# $globalInstance->{histories}->{$historyField}->[-1]->[-1] .= $_[1];
+# }
+# }
+ }
+ }
+
+}
+
+
+1;