diff options
author | Jörg Frings-Fürst <jff@merkur> | 2014-07-06 15:20:38 +0200 |
---|---|---|
committer | Jörg Frings-Fürst <jff@merkur> | 2014-07-06 15:20:38 +0200 |
commit | 126bb8cb6b93240bb4d3a2b816b74c286c3d422b (patch) | |
tree | e66e1dfe77d53a52539489765c88d23e4423ae27 /lib/gcstar/GCExport |
Imported Upstream version 1.7.0upstream/1.7.0
Diffstat (limited to 'lib/gcstar/GCExport')
-rw-r--r-- | lib/gcstar/GCExport/GCExportBase.pm | 362 | ||||
-rw-r--r-- | lib/gcstar/GCExport/GCExportCSV.pm | 198 | ||||
-rw-r--r-- | lib/gcstar/GCExport/GCExportExternal.pm | 182 | ||||
-rw-r--r-- | lib/gcstar/GCExport/GCExportHTML.pm | 592 | ||||
-rw-r--r-- | lib/gcstar/GCExport/GCExportLatex.pm | 204 | ||||
-rw-r--r-- | lib/gcstar/GCExport/GCExportPDB.pm | 295 | ||||
-rw-r--r-- | lib/gcstar/GCExport/GCExportSQL.pm | 172 | ||||
-rw-r--r-- | lib/gcstar/GCExport/GCExportTarGz.pm | 174 | ||||
-rw-r--r-- | lib/gcstar/GCExport/GCExportTellico.pm | 512 | ||||
-rw-r--r-- | lib/gcstar/GCExport/GCExportXML.pm | 287 |
10 files changed, 2978 insertions, 0 deletions
diff --git a/lib/gcstar/GCExport/GCExportBase.pm b/lib/gcstar/GCExport/GCExportBase.pm new file mode 100644 index 0000000..fb23ec2 --- /dev/null +++ b/lib/gcstar/GCExport/GCExportBase.pm @@ -0,0 +1,362 @@ +package GCExport::GCExportBase; + +################################################### +# +# 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 GCExportImport; + +{ + package GCExport::GCExportBaseClass; + + use base 'GCExportImportBase'; + + use File::Basename; + use File::Copy; + use GCUtils 'glob'; + + #Methods to be overriden in specific classes + + sub new + { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new; + + bless ($self, $class); + return $self; + } + + sub getSuffix + { + return ''; + } + + sub getModels + { + return []; + } + + sub needsUTF8 + { + return 0; + } + + sub getOptions + { + } + + sub wantsDirectorySelection + { + return 0; + } + + sub wantsFieldsSelection + { + return 0; + } + + sub wantsImagesSelection + { + return 0; + } + + sub wantsFileSelection + { + return 1; + } + + sub getHeader + { + } + + sub getItem + { + } + + sub getFooter + { + } + + sub postProcess + { + } + + sub preProcess + { + } + + sub getEndInfo + { + } + + sub wantsOsSeparator + { + return 1; + } + + sub wantsSort + { + return 0; + } + + sub getNewPictureHeight + { + return 0; + } + + #End of methods to be overriden + + sub getUniqueImageFileName + { + my ($self, $suffix, $dir, $title) = @_; + + return $self->{options}->{parent}->getUniqueImageFileName($suffix, $title, $dir); + } + + sub duplicatePicture + { + my ($self, $orig, $field, $dir, $title, $newHeight) = @_; + $self->{saved}->{$field} = $orig; + my $newPic = $orig; + if ($orig && $self->{options}->{withPictures}) + { + $newPic = GCUtils::getDisplayedImage($orig, + $self->{options}->{defaultImage}, + $self->{original}); + if ($newPic eq $self->{options}->{defaultImage}) + { + $newPic = $self->{defaultImage}; + } + else + { + $newPic =~ /.*?(\.[^.]*)$/; + my $suffix = $1; + my $dest = $self->getUniqueImageFileName($suffix, + $dir, + $title); + my $picHeight = $self->getNewPictureHeight; + if ($picHeight) + { + my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file($newPic); + my ($width, $height) = ($pixbuf->get_width, $pixbuf->get_height); + my $picWidth = $width * ($picHeight / $height); + $pixbuf = GCUtils::scaleMaxPixbuf($pixbuf, $picWidth, $picHeight, 1); + my $format; + if ($suffix =~ /png/i) + { + $format = 'png'; + } + else + { + $dest =~ s/\.[^.]*$/\.jpg/; + $format = 'jpeg'; + } + $pixbuf->save($dest, $format); + } + else + { + copy($newPic, $dest); + } + $newPic = basename($dir).'/'.basename($dest); + } + } + else + { + $newPic = basename($dir).'/'.basename($self->{options}->{defaultImage}); + } + $newPic =~ s/\//\\/g if ($^O =~ /win32/i) && $self->wantsOsSeparator; + return $newPic; + } + + sub restorePicture + { + my $self = shift; + return $self->{saved}->{image}; + } + + sub restoreInfo + { + my ($self, $info) = @_; + + foreach (keys %{$self->{saved}}) + { + $info->{$_} = $self->{saved}->{$_}; + } + } + + sub transformValue + { + my ($self, $value, $field) = @_; + if ($self->{options}->{fieldsInfo}->{$field}->{type} eq 'image') + { + if ($self->{copyPictures}) + { + $value = $self->duplicatePicture($value, $field, + $self->{dirName}, + $self->{currentItem}->{ + $self->{model}->{commonFields}->{title} + }); + } + return $value; + } + return $self->{options}->{originalList}->transformValue($value, $field); + } + + sub getStockLabel + { + my ($self, $stock) = @_; + my $item = Gtk2::Stock->lookup($stock); + my $label = ''; + ($label = $item->{label}) =~ s/_// + if $item; + return $label; + } + + # If you need really specific processing, you can instead override the process method + sub process + { + my ($self, $options) = @_; + + $self->{saved} = {}; + $self->{currentItem} = undef; + + $self->{options} = $options; + + $options->{file} .= $self->getSuffix + if ($self->getSuffix) + && ($options->{file} !~ /\.\w*$/); + $self->{fileName} = $options->{file}; + $self->{original} = $options->{collection}; + $self->{origDir} = dirname($self->{original}); + $options->{collectionDir} = $self->{origDir}; + + ($self->{dirName} = $self->{fileName}) =~ s/\.[^.]*?$//; + $self->{dirName} .= '_images'; + if ( -e $self->{dirName}) + { + my @images = glob $self->{dirName}.'/*'; + unlink foreach (@images); + rmdir $self->{dirName}; + unlink $self->{dirName} if ( -e $self->{dirName}); + } + if ($self->{options}->{withPictures}) + { + mkdir $self->{dirName}; + #Get a copy of default picture + copy($self->{options}->{defaultImage},$self->{dirName}); + $self->{defaultImage} = basename($self->{dirName}).'/' + .basename($self->{options}->{defaultImage}); + } + + if (! $self->preProcess) + { + return $self->getEndInfo; + } + + my @tmpArray = @{$options->{items}}; + if ($self->wantsSort) + { + my $sorter = $self->{options}->{sorter}; + use locale; + if ($self->{model}->{fieldsInfo}->{$sorter}->{type} eq 'number') + { + @tmpArray = sort { + my $val1 = $a->{$sorter}; + my $val2 = $b->{$sorter}; + return $val1 <=> $val2; + } @tmpArray; + } + elsif ($self->{model}->{fieldsInfo}->{$sorter}->{type} eq 'date') + { + @tmpArray = sort { + my $val1 = GCPreProcess::reverseDate($a->{$sorter}); + my $val2 = GCPreProcess::reverseDate($b->{$sorter}); + return $val1 <=> $val2; + } @tmpArray; + } + else + { + @tmpArray = sort { + my $val1 = uc $self->{options}->{originalList}->transformValue($a->{$sorter}, $sorter); + my $val2 = uc $self->{options}->{originalList}->transformValue($b->{$sorter}, $sorter); + return $val1 cmp $val2; + } @tmpArray; + } + @tmpArray = reverse @tmpArray if $self->{options}->{order} eq 'desc'; + } + + $self->{sortedArray} = \@tmpArray; + + my $header = $self->getHeader($#tmpArray + 1); + my $body = ''; + + my $item; + my $idx = 0; + my $copyPictures = 0; + my @copiedPicturesFields; + if ($self->{options}->{withPictures}) + { + # If we don't specify fields, the pictures will be copied with transform value + # This one is used now + $copyPictures = 1 + if $self->wantsFieldsSelection; + # This one will be used by transform value + $self->{copyPictures} = !$copyPictures; + foreach my $field(@{$self->{options}->{fields}}) + { + push @copiedPicturesFields, $field + if $self->{options}->{fieldsInfo}->{$field}->{type} eq 'image'; + } + } + foreach $item(@tmpArray) + { + $self->{currentItem} = $item; + if ($copyPictures) + { + foreach my $pic(@copiedPicturesFields) + { + $item->{$pic} = $self->duplicatePicture($item->{$pic}, $pic, $self->{dirName}, + $item->{$self->{model}->{commonFields}->{title}}); + } + } + $body .= $self->getItem($item, $idx); + $self->restoreInfo($item); + $idx++; + } + $self->{currentItem} = undef; + my $footer = $self->getFooter($#tmpArray + 1); + + $self->postProcess(\$header, \$body); + + open EXPORTFILE, ">".$options->{file}; + binmode( EXPORTFILE, ':utf8') if $self->needsUTF8; + print EXPORTFILE "$header"; + print EXPORTFILE "$body"; + print EXPORTFILE "$footer"; + close EXPORTFILE; + + return $self->getEndInfo; + } +} + +1; diff --git a/lib/gcstar/GCExport/GCExportCSV.pm b/lib/gcstar/GCExport/GCExportCSV.pm new file mode 100644 index 0000000..c70fe01 --- /dev/null +++ b/lib/gcstar/GCExport/GCExportCSV.pm @@ -0,0 +1,198 @@ +package GCExport::GCExportCSV; + +################################################### +# +# 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 GCExport::GCExportBase; + +{ + package GCExport::GCExporterCSV; + + use base qw(GCExport::GCExportBaseClass); + use Encode; + + sub new + { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless ($self, $class); + return $self; + } + + sub getName + { + my $self = shift; + + return "CSV"; + } + + sub getOptions + { + my $self = shift; + + my $charsets = ''; + my @charsetList = Encode->encodings(':all'); + foreach (@charsetList) + { + $charsets .= $_.','; + } + + return [ + { + name => 'sep', + type => 'short text', + label => 'Separator', + default => ';' + }, + + { + name => 'rep', + type => 'short text', + label => 'Replacement', + default => ',' + }, + + { + name => 'charset', + type => 'options', + label => 'Charset', + valuesList => $charsets, + default => 'utf8', + }, + + { + name => 'withHeader', + type => 'yesno', + label => 'Header', + default => '1' + }, + + ]; + + } + + sub wantsFieldsSelection + { + return 1; + } + + sub wantsImagesSelection + { + return 1; + } + + sub wantsSort + { + return 1; + } + + sub needsUTF8 + { + my $self = shift; + return $self->{options}->{charset} eq 'utf8'; + } + + sub preProcess + { + my $self = shift; + return 1; + } + + sub transformValue + { + my ($self, $value, $field) = @_; + + if ($field) + { + $value = $self->SUPER::transformValue($value, $field); + } + $value =~ s/,+$//; + $value =~ s /$self->{options}->{sep}/$self->{options}->{rep}/g; + $value =~ s/\n|\r//g; + $value =~ s/<br\/>/ /g; + $value = encode($self->{options}->{charset}, $value) + if $self->{options}->{charset} ne 'utf8'; + return $value; + } + + sub getHeader + { + my ($self, $number) = @_; + my $result = ''; + + if ($self->{options}->{withHeader}) + { + foreach (@{$self->{options}->{fields}}) + { + #my $column = $self->{options}->{lang}->{FieldsList}->{$_}; + my $column = $self->{model}->{fieldsInfo}->{$_}->{displayed}; + $result .= $self->transformValue($column).$self->{options}->{sep}; + } + $result =~ s/$self->{options}->{sep}$//; + $result .= "\n"; + } + + return $result; + } + + sub getItem + { + my ($self, $item, $number) = @_; + my $result; + foreach (@{$self->{options}->{fields}}) + { + my $value = $item->{$_}; + $result .= $self->transformValue($value, $_).$self->{options}->{sep}; + } + $result =~ s/$self->{options}->{sep}$//; + $result .= "\n"; + + return $result; + } + + sub getFooter + { + my $self = shift; + my $result; + + return $result; + } + + sub postProcess + { + my ($self, $header, $body) = @_; + } + + sub getEndInfo + { + my $self = shift; + my $message; + + return $message; + } +} + +1; diff --git a/lib/gcstar/GCExport/GCExportExternal.pm b/lib/gcstar/GCExport/GCExportExternal.pm new file mode 100644 index 0000000..d5c096c --- /dev/null +++ b/lib/gcstar/GCExport/GCExportExternal.pm @@ -0,0 +1,182 @@ +package GCExport::GCExportExternal; + +################################################### +# +# 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 GCExport::GCExportBase; + +{ + package GCExport::GCExporterExternal; + + use File::Copy; + use File::Basename; + use Cwd; + use XML::Simple; + use GCUtils 'glob'; + use GCBackend::GCBackendXmlParser; + use base qw(GCExport::GCExportBaseClass); + + sub new + { + my ($proto, $parent) = @_; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new($parent); + bless ($self, $class); + + $self->{useZip} = $self->checkOptionalModule('Archive::Zip'); + + return $self; + } + + sub wantsOsSeparator + { + return 0; + } + + sub transformPicturePath + { + my ($self, $path, $file, $item, $field) = @_; + return $self->duplicatePicture($path, + $field, + $self->{imageDir}, + $item->{$self->{model}->{commonFields}->{title}}); + } + + sub process + { + my ($self, $options) = @_; + $self->{parsingError} = ''; + $self->{options} = $options; + $self->{options}->{withPictures} = 1; + #$self->{fileName} = $options->{file}; + my $ext = ($self->{options}->{zip} ? 'gcz' : 'gcs'); + my $outFile = $options->{file}; + $outFile .= ".$ext" if ($outFile !~ m/\.$ext$/); + #$self->{fileName} .= '.gcs' if ($self->{fileName} !~ m/\.gcs$/); + $self->{fileName} = $outFile; + $self->{fileName} =~ s/z$/s/; + my $listFile = $self->{fileName}; + my $baseDir = dirname($listFile); + my $baseName = basename($listFile, '.gcs'); + my $imagesSubDir = $baseName.'_pictures'; + $self->{imageDir} = $baseDir.'/'.$imagesSubDir; + $self->{original} = $options->{collection}; + #$self->{original} =~ s/\\/\//g if ($^O =~ /win32/i); + $self->{origDir} = dirname($self->{original}); + + eval { + chdir $baseDir; + die 'Directory not writable' if !-w '.'; + mkdir $self->{imageDir}; + + $self->{currentDir} = getcwd; + + my $backend = new GCBackend::GCBeXmlParser($self); + $backend->setParameters(file => $listFile, + version => $self->{options}->{parent}->{version}, + wantRestore => 1, + standAlone => 1); + + my $result = $backend->save($options->{items}, + $options->{originalList}->getInformation, + undef); + + if ($result->{error}) + { + die $result->{error}->[1]; + } + }; + + if ($@) + { + $self->{parsingError} = GCUtils::formatOpenSaveError( + $self->{options}->{parent}->{lang}, + $self->{fileName}, + ['SaveError', $@] + ); + } + + if ($self->{options}->{zip}) + { + chdir $baseDir; + my $zip = Archive::Zip->new(); + $zip->addFile(basename($self->{fileName})); + $zip->addDirectory(basename($self->{imageDir})); + my @images = glob $imagesSubDir.'/*'; + $zip->addFile($_) foreach @images; + my $result = $zip->writeToFileNamed($outFile); + if ($result) + { + $self->{parsingError} = GCUtils::formatOpenSaveError( + $self->{options}->{parent}->{lang}, + $outFile, + ['SaveError', $@] + ); + } + else + { + # Cleanup to remove everything but the .gcz file + unlink $self->{fileName}; + unlink foreach (@images); + rmdir $imagesSubDir; + } + } + chdir; + return $self->getEndInfo; + } + + sub getOptions + { + my $self = shift; + my @options; + + if ($self->{useZip}) + { + push @options, { + name => 'zip', + type => 'yesno', + label => 'ZipAll', + default => '0' + }; + } + + return \@options; + } + +# sub getName +# { +# my $self = shift; +# +# return "External"; +# } + + sub getEndInfo + { + my $self = shift; + return ($self->{parsingError}, 'error') + if $self->{parsingError}; + + return ''; + } +} diff --git a/lib/gcstar/GCExport/GCExportHTML.pm b/lib/gcstar/GCExport/GCExportHTML.pm new file mode 100644 index 0000000..b083545 --- /dev/null +++ b/lib/gcstar/GCExport/GCExportHTML.pm @@ -0,0 +1,592 @@ +package GCExport::GCExportHTML; + +################################################### +# +# 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 GCExport::GCExportBase; + +{ + package GCExport::GCExporterHTML; + + + use File::Copy; + use File::Basename; + use XML::Simple; + use base qw(GCExport::GCExportBaseClass); + use GCUtils 'glob'; + + our $FieldsList = 'GCSfields'; + our $GroupsList = 'GCSgroups'; + + sub new + { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + $self->{genericModels} = 0; + + bless ($self, $class); + return $self; + } + + sub getName + { + my $self = shift; + + return "HTML"; + } + + sub getSuffix + { + my $self = shift; + + return ".html"; + } + + sub needsUTF8 + { + my $self = shift; + + return 1; + } + + sub getModels + { + my $self = shift; + + return []; + } + + sub setModelsDir + { + my $self = shift; + $self->{genericModelsDir} = $ENV{GCS_SHARE_DIR}.'/html_models/GCstar'; + if ($self->{model}) + { + $self->{modelsDir} = $ENV{GCS_SHARE_DIR}.'/html_models/'.$self->{model}->getName; + if ((! $self->{model}->getName) || (! -e $self->{modelsDir})) + { + $self->{modelsDir} = $self->{genericModelsDir}; + $self->{genericModels} = 1; + } + } + } + + sub getOptions + { + my $self = shift; + $self->{modelsFiles} = ''; + + $self->setModelsDir; + + my $defaultModel = ''; + $self->{isGeneric} = {}; + foreach (glob $self->{modelsDir}.'/*') + { + next if ($_ =~ /\/CVS$/) || ($_ =~ /\.png$/); + (my $mod = basename($_)) =~ s/_/ /g; + $self->{modelsFiles} .= $mod.','; + $defaultModel = $mod if !$defaultModel; + $self->{isGeneric}->{$mod} = $self->{genericModels}; + } + $self->{genericAdded} = 0; + if (!$self->{genericModels}) + { + # Previous one was specific, we also add the generic ones. + foreach (glob $self->{genericModelsDir}.'/*') + { + next if ($_ =~ /\/CVS$/) || ($_ =~ /\.png$/); + (my $mod = basename($_)) =~ s/_/ /g; + + next if exists $self->{isGeneric}->{$mod}; + $self->{modelsFiles} .= $mod.','; + $self->{isGeneric}->{$mod} = 1; + $self->{genericAdded} = 1; + } + } + $self->{modelsFiles} .= 'UseFile,'; + return [ + { + name => 'template', + type => 'options', + label => 'FileTemplate', + valuesList => $self->{modelsFiles}, + default => $defaultModel, + changedCallback => sub {shift; $self->checkFileField(@_)}, + buttonLabel => 'Preview', + buttonCallback => sub {shift; $self->preview(@_)} + }, + + { + name => 'modelFile', + type => 'file', + label => 'TemplateExternalFile', + default => '', + insensitive => 1, + }, + + { + name => 'title', + type => 'short text', + label => 'Title', + default => 'Items list', + }, + + { + name => 'imgHeight', + type => 'number', + label => 'HeightImg', + default => 160, + min => 50, + max => 500, + }, + + { + name => 'withJs', + type => 'yesno', + label => 'WithJS', + default => '1' + }, + + { + name => 'open', + type => 'yesno', + label => 'OpenFileInBrowser', + default => '0' + }, + + ] + } + + sub getNewPictureHeight + { + my $self = shift; + return $self->{options}->{imgHeight}; + } + + sub checkFileField + { + my ($self, $data) = @_; + my ($parent, $list) = @{$data}; + return if ! $parent->{options}->{modelFile}; + my $model = $list->getValue ; + $parent->{options}->{modelFile}->set_sensitive($model eq 'UseFile'); + $parent->{fieldsSelection}->set_sensitive($self->{isGeneric}->{$model}) + if $parent->{fieldsSelection}; + } + + sub preview + { + my ($self, $data) = @_; + my ($parent, $list) = @{$data}; + (my $template = $list->getValue) =~ s/ /_/g; + my $dialog = new Gtk2::Dialog($self->getLang->{Preview}.' - '.$list->getValue, + $parent, + [qw/modal destroy-with-parent/], + 'gtk-ok' => 'ok', + ); + + my $picFile; + if ($self->{isGeneric}->{$template}) + { + $picFile = $self->{genericModelsDir}.'/'.$template.'.png'; + } + else + { + $picFile = $self->{modelsDir}.'/'.$template.'.png'; + } + if (-f $picFile) + { + my $image = Gtk2::Image->new_from_file($picFile); + $image->set_padding(10,10); + $dialog->vbox->pack_start($image,0,0,0); + } + else + { + my $label = new Gtk2::Label; + $label->set_markup('<b>'.$self->getLang->{NoPreview}.'</b>'); + $dialog->vbox->pack_start($label,1,1,0); + $dialog->set_default_size(300,300); + } + $dialog->vbox->show_all; + $dialog->run; + $dialog->destroy; + $parent->showMe; + } + + sub wantsFieldsSelection + { + my $self = shift; + return 1; + return $self->{genericAdded} || $self->{genericModels}; + } + + sub wantsImagesSelection + { + return 1; + } + + sub wantsOsSeparator + { + return 0; + } + + sub wantsSort + { + return 1; + } + + sub transformData + { + my ($self, $item, $field, $asATable) = @_; + + my $data = $item->{$field}; + if ($asATable) + { + return '' if !$data; + my $result = ''; + my $i = 1; + foreach (@{$data}) + { + my $class = ($i % 2) ? 'even' : 'odd'; + $result .= " <tr class=\"$class\">\n"; + foreach my $item(@{$_}) + { + $result .= " <td>$item</td>\n"; + } + $result .= " </tr>\n"; + $i++; + } + return $result; + } + else + { + my $value = $self->transformValue($data, $field); + $value =~ s|\n|<br />|g; + return $value; + } + } + + sub getValues + { + my ($self, $values, $filter) = @_; + my $needFilter = (length($filter) > 2); + my @result; + if ($values eq $GroupsList) + { + # We generate the list of group for the selected fields + my %groups; + foreach (@{$self->{options}->{fields}}) + { + my $group = $self->{options}->{fieldsInfo}->{$_}->{group}; + $groups{$group} = 1; + } + foreach (@{$self->{model}->{groups}}) + { + my $group = $_->{id}; + push @result, $group if $groups{$group}; + } + } + else + { + # We could have a group name or a list of fields types + my $type; + my $group; + foreach (@{$self->{options}->{fields}}) + { + $type = $self->{options}->{fieldsInfo}->{$_}->{type}; + $group = $self->{options}->{fieldsInfo}->{$_}->{group}; + push @result, $_ + if ($type ne 'triple list') + && (($group =~ /^$values$/i) || ($values eq $FieldsList)) + && (!$needFilter || ($needFilter && ($filter =~ /$type/))); + } + } + return \@result; + } + + sub preProcess + { + my $self = shift; + + $self->{errors} = 0; + $self->setModelsDir; + my $template = $self->{options}->{template}; + my $file; + my $model; + if ($template eq 'UseFile') + { + $file = $self->{options}->{modelFile}; + if ( ! -e $file) + { + $self->{errors} = $self->getLang->{ModelNotFound}; + return 0; + } + } + else + { + $template =~ s/ /_/; + if ($self->{isGeneric}->{$template}) + { + $file = $self->{genericModelsDir}.'/'.$self->{options}->{template}; + } + else + { + $file = $self->{modelsDir}.'/'.$self->{options}->{template}; + } + + $file =~ s/"//g; + #" + } + # The problem should only happen when using command line, so a die is enough. + open FILE, $file or die "\nModel $template doesn't exist for this kind of collection"; + binmode(FILE, ':utf8' ); + $model = do { local $/; <FILE> }; + close FILE; + + if ($model =~ /^<metamodel>/) + { + my $xs = XML::Simple->new; + my $meta = $xs->XMLin($model, + ForceArray => ['field']); + open FILE, $self->{genericModelsDir}.'/'.$meta->{model}; + binmode(FILE, ':utf8' ); + $model = do { local $/; <FILE> }; + close FILE; + $self->{options}->{fields} = $meta->{fields}->{field}; + } + + if ($self->{options}->{withJs}) + { + $model =~ s/(\[JAVASCRIPT\])|(\[\/JAVASCRIPT\])//gms; + $model =~ s/\[NOJAVASCRIPT\].*?\[\/NOJAVASCRIPT\]//gms; + } + else + { + $model =~ s/\[JAVASCRIPT\].*?\[\/JAVASCRIPT\]//gms; + $model =~ s/(\[NOJAVASCRIPT\])|(\[\/NOJAVASCRIPT\])//gms; + } + + # If collection does not manage lendings, remove the LENDING blocks + $model =~ s|\[LENDING\](.*?)\[/LENDING\]| $self->{model}->{hasLending} ? $1 : '' |ems; + + #Loops + while ($model =~ m/\[LOOP([0-9]+)?\s+values=([^\s]*?)\s+idx=([^\s]*?)(\s+filter=([^\s]*?))?\]\n?(.*?)\n\s*\[\/LOOP\1\]/gms) + { + my $loopNumber = $1; + my $values = $2; + my $index = $3; + my $filter = ','.$5.','; + my $motif = $6; + my $valuesArray = $self->getValues($values, $filter); + my $string; + foreach my $value(@$valuesArray) + { + (my $line = $motif) =~ s/$index/$value/gms; + # For generic models, we add an img tag for images + # and an a tag for links + if (exists $self->{options}->{fieldsInfo}->{$value}) + { + # If this is an image + if ($self->{options}->{fieldsInfo}->{$value}->{type} eq 'image') + { + # We do it only if it is between 2 tags. + $line =~ s|>\$\$$value\$\$<|><img src="\$\$$value\$\$"/><|; + } + # If this is the item URL + elsif ($value eq $self->{model}->{commonFields}->{url}) + { + # We do it only if it is between 2 tags. + $line =~ s|>\$\$$value\$\$<|><a href="\$\$$value\$\$"/>\$\$$self->{model}->{commonFields}->{title}\$\$</a><|; + } + } + $string .= $line; + } + $model =~ s/(\n?)\s*\[LOOP$loopNumber\s+values=$values\s+idx=$index(\s+filter=$filter)?\].*?\[\/LOOP$loopNumber\]/$1$string/gms; + } + $model =~ s/TITLE_FIELD/$self->{model}->{commonFields}->{title}/eg; + $model =~ s/COVER_FIELD/$self->{model}->{commonFields}->{cover}/eg; + + $model =~ m{ + \[HEADER\]\n?(.*?)\n?\[\/HEADER\].*? + \[ITEM\]\n?(.*?)\n?\[\/ITEM\].*? + \[FOOTER\]\n?(.*?)\n?\[\/FOOTER\].*? + \[POST\]\n?(.*?)\n?\[\/POST\] + }xms; + $self->{header} = $1; + $self->{item} = $2; + $self->{footer} = $3; + $self->{post} = $4; + return 1; + } + + sub getHeader + { + my ($self, $total) = @_; + + my $result = $self->{header}; + + $self->{total} = $total; + $result =~ s/\$\$PAGETITLE\$\$/$self->{options}->{title}/g; + $result =~ s/\$\$TOTALNUMBER\$\$/$total/g; + $result =~ s/\$\$ITEMS\$\$/$self->{model}->getDisplayedItems/eg; + + #Search form + $result =~ s/\$\$FORM_INPUT\$\$/$self->getLang->{InputTitle}/eg; + $result =~ s/\$\$FORM_SEARCH1\$\$/$self->getLang->{SearchType1}/eg; + $result =~ s/\$\$FORM_SEARCH2\$\$/$self->getLang->{SearchType2}/eg; + $result =~ s/\$\$FORM_SEARCHBUTTON\$\$/$self->getLang->{SearchButton}/eg; + $result =~ s/\$\$FORM_SEARCHTITLE\$\$/$self->getLang->{SearchTitle}/eg; + $result =~ s/\$\$FORM_ALLBUTTON\$\$/$self->getLang->{AllButton}/eg; + $result =~ s/\$\$FORM_ALLTITLE\$\$/$self->getLang->{AllTitle}/eg; + $result =~ s/\$\$FORM_EXPAND\$\$/$self->getLang->{Expand}/eg; + $result =~ s/\$\$FORM_EXPANDTITLE\$\$/$self->getLang->{ExpandTitle}/eg; + $result =~ s/\$\$FORM_COLLAPSE\$\$/$self->getLang->{Collapse}/eg; + $result =~ s/\$\$FORM_COLLAPSETITLE\$\$/$self->getLang->{CollapseTitle}/eg; + + #Labels + $result =~ s/\$\$([a-zA-Z0-9_]*)_LABEL\$\$/$self->{model}->getDisplayedLabel($1)/eg; + + return $result."\n"; + } + + sub getFooter + { + my ($self, $item) = @_; + + my $total = $self->{total}; + my $result = $self->{footer}; + $result =~ s/\$\$PAGETITLE\$\$/$self->{options}->{title}/g; + $result =~ s/\$\$TOTALNUMBER\$\$/$total/g; + $result =~ s/\$\$GENERATOR_NOTE\$\$/$self->getLang->{Note}/eg; + $result =~ s/\$\$BORROWED_ITEMS\$\$/$self->{options}->{lang}->{BorrowedTitle}/g; + + return $result."\n"; + } + + sub getItem + { + my ($self, $item, $idx) = @_; + my $total = $self->{total}; + my $result = $self->{item}; + + #Separator + $result =~ s/\$\$SEPARATOR\$\$/$self->{options}->{lang}->{Separator}/g; + + #Labels that need a special process + $result =~ s/\$\$URL_LABEL\$\$/$self->{options}->{lang}->{PanelWeb}/g; + + #Other labels + $result =~ s/\$\$([a-zA-Z0-9_]*)_LABEL\$\$/$self->{model}->getDisplayedLabel($1)/eg; + + #Fields that need a special process + $result =~ s/\$\$HEIGHT_PIC\$\$/$self->{options}->{imgHeight}/g; + my $url = $item->{$self->{model}->{commonFields}->{url}} || '#'; + $result =~ s/\$\$URL\$\$/$url/g; + + #Borrower + my $borrowerField = $self->{model}->{commonFields}->{borrower}->{name}; + my $tmpBorrower = $item->{$borrowerField}; + my $borrowerFlag = 1; + my $borrowerYesNo = $self->getLang->{Borrowed}; + my $borrowerOrEmpty = $tmpBorrower; + if (!$tmpBorrower || ($tmpBorrower eq 'none')) + { + $tmpBorrower = $self->{options}->{lang}->{PanelNobody}; + $borrowerFlag = 0; + $borrowerYesNo = $self->getLang->{NotBorrowed}; + $borrowerOrEmpty = ''; + } + elsif ($tmpBorrower eq 'unknown') + { + $tmpBorrower = $self->{options}->{lang}->{PanelUnknown}; + } + $result =~ s/\$\$borrower\$\$/$tmpBorrower/g; + $result =~ s/\$\$borrower_OREMPTY\$\$/$borrowerOrEmpty/g; + $result =~ s/\$\$borrower_FLAG\$\$/$borrowerFlag/g; + $result =~ s/\$\$borrower_YESNO\$\$/$borrowerYesNo/g; + + $result =~ s/\$\$IDX\$\$/$idx/g; + $result =~ s/\$\$TOP\$\$/$self->getLang->{Top}/eg; + $result =~ s/\$\$BOTTOM\$\$/$self->getLang->{Bottom}/eg; + $result =~ s/\$\$TOTALNUMBER\$\$/$total/g; + + # Stock labels + $result =~ s/\$\$(gtk-[^\$]*)\$\$/$self->getStockLabel($1)/eg; + + #Multiple list displayed as a table + $result =~ s/\$\$([a-zA-Z0-9_]*)_TABLE\$\$/$self->transformData($item, $1, 1)/eg; + + #Other fields + #$result =~ s/\$\$([A-Z_]*)\$\$/$item->{lc $1}/eg; + $result =~ s/\$\$([a-zA-Z0-9_]*)\$\$/$self->transformData($item, $1, 0)/eg; + return $result."\n"; + } + + sub postProcess + { + my ($self, $headerRef, $bodyRef) = @_; + + #Variables to be used in POST section + my $header = $$headerRef; + my $body = $$bodyRef; + my @items = @{$self->{sortedArray}}; + + eval $self->{post}; + print "Errors with HTML template in POST:\n $@\n" if $@; + + $$headerRef = $header; + $$bodyRef = $body; + } + + sub getEndInfo + { + my $self = shift; + + if ($self->{errors}) + { + return ($self->{errors}, 'error'); + } + + my $message = ''; + + if ($self->{options}->{open}) + { + $self->{options}->{parent}->launch($self->{fileName}, 'url'); + } + else + { + $message = $self->getLang->{InfoFile}.$self->{fileName}; + $message .= ' + +'.$self->getLang->{InfoDir}.$self->{dirName} + if $self->{options}->{withPictures}; + } + + return $message; + } +} + +1; diff --git a/lib/gcstar/GCExport/GCExportLatex.pm b/lib/gcstar/GCExport/GCExportLatex.pm new file mode 100644 index 0000000..0592908 --- /dev/null +++ b/lib/gcstar/GCExport/GCExportLatex.pm @@ -0,0 +1,204 @@ +package GCExport::GCExportLatex; +use utf8; + +use strict; + +use GCExport::GCExportBase; + +{ + package GCExport::GCExporterLatex; + + use base qw(GCExport::GCExportBaseClass); + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless ($self, $class); + return $self; + } + + sub getName { + my $self = shift; + return "Latex"; + } + + sub getOptions { + my $self = shift; + return [ + { + name => 'one', + type => 'yesno', + label => 'Export One Media', + default => '0', + }, + { + name => 'disc', + type => 'number', + label => '# of Media', + default => '1', + min => '0', + max => '10000', + }, + ]; + + } + + sub wantsFieldsSelection { + return 0; + } + + sub wantsImagesSelection { + return 0; + } + + sub needsUTF8 { + return 1; + } + + sub preProcess { + my $self = shift; + return 1; + } + + sub transformValue { + my ($self, $value, $field) = @_; + + if ($field) { + $value = $self->SUPER::transformValue($value, $field); + } + $value =~ s/,+$//; + $value =~ s/\n|\r//g; + $value =~ s/<br\/>/ /g; + $value =~ s/\^/\\^{}/g; + $value =~ s/\&/\\\&/g; + $value =~ s/\"/\'\'/g; + return $value; + } + + sub getHeader { + my ($self, $number) = @_; + my $result = ''; + $result = "\\documentclass[a4paper]{article} +\\usepackage{ucs} +\\usepackage[utf8]{inputenc} +\\usepackage[russian]{babel} +\\usepackage{geometry} +\\geometry{a4paper,top=1cm,bottom=1cm,left=1cm,right=1cm} +\\pagestyle{empty} +\\linespread{0.6} +\\sloppy + +\\newcommand{\\dvd}[2]{ +\\framebox[12cm]{ +\\begin{tabular}{p{0pt}\@{}p{11.9cm}} +\\rule[-6cm]{0pt}{11.7cm}&\\begin{minipage}{11.7cm} +{\\bf DVD #1} +\\begin{itemize} +\\setlength{\\parskip}{-3pt} +#2 +\\end{itemize}\\vspace{-3pt} +\\end{minipage} +\\end{tabular}}} + +\\begin{document} +\\footnotesize +"; + $result .= "\\dvd{$self->{options}->{disc}}{\n" + if $self->{options}->{one}; + return $result; + } + + sub getItem { + my ($self, $item, $number) = @_; + my $result; + return '' if ($self->{options}->{one} && + $item->{number} ne $self->{options}->{disc}); + $result .= '\item {\bf ' . $self->transformValue ($item->{title}, "title") . "}"; + $result .= ' / ' . $self->transformValue ($item->{original}, 'original') if $item->{original}; + $result .= " ($item->{date})" if $item->{date}; + # one line for russian cartoons + if ($self->transformValue ($item->{genre}, 'genre') =~ + m/Мультфильм/) { + $result .= ' м/ф'; + } elsif ($item->{genre} || $item->{director} || + $item->{audio} || $item->{time}) { + $result .= "\\\\\n\\begin{tabular}{ll}\n"; + $result .= $self->getLocal('genre') . ': & ' . + $self->transformValue ($item->{genre}, 'genre') . '\\\\' + if $item->{genre}; + $result .= $self->getLocal('director') . ": & $item->{director}\\\\" + if $item->{director}; + my $audio = $self->transformValue ($item->{audio}, 'audio') + if $item->{audio}; + $audio =~ s/\([\w\ ]+\)//g; + $audio =~ s/\([\w\ ]+\)//g; + $audio =~ s/\ ,/,/g; + $audio =~ s/\s+$//g; + $result .= $self->getLocal('audio') . ": & $audio" if length ($audio) > 0; + $result .= "; " . $self->transformValue ($item->{subt}, 'subt') . + ' (' . $self->getLocal('subt') . ')' + if $item->{subt}; + $result .= '\\\\'; + $result .= $self->getLocal('time') . ": & $item->{time} мин.\\\\" if $item->{time}; + $result .= $self->getLocal('country') . ": & $item->{country}" if $item->{country}; + $result .= "\n\\end{tabular}\n"; + } + # don't include information about media # 0 + if ((!$self->{options}->{one}) && $item->{number} != 0) { + $self->{expdata}->{$item->{number}} .= $result; + $self->{expdata}->{all} .= $self->{expdata}->{all} ? ',' . $item->{number} : $item->{number} if $self->{expdata}->{all} !~ m/$item->{number}/; + return ''; + } elsif ($self->{options}->{one}) { + return $result; + } + return ''; + } + + sub getFooter { + my $self = shift; + my $result = ''; + if ($self->{options}->{one}) { + $result = "\n}\n\\end{document}\n"; + } else { + my @data = split (/,/, $self->{expdata}->{all}); + foreach my $key (sort @data) { + $result .= "\n\n\\dvd{$key}{\n$self->{expdata}->{$key}}"; + } + $result .= "\n\\end{document}\n"; + } + return $result; + } + + sub getLocal { + my ($self, $name) = @_; + # some abbreviations for russian language + if ($self->{options}->{lang}->{LangName} eq "Russian") { + return "Реж." if $name eq "director"; + return "Звук" if $name eq "audio"; + return "Время" if $name eq "time"; + return "суб." if $name eq "subt"; + return $self->{model}->getDisplayedLabel($name); + } else { + return $self->{model}->getDisplayedLabel($name); + } + } + + sub getModels { + return ['GCfilms']; + } + + sub postProcess { + my ($self, $header, $body) = @_; + } + + sub getEndInfo { + my $self = shift; + my $message; + + return $message; + } +} + +1; diff --git a/lib/gcstar/GCExport/GCExportPDB.pm b/lib/gcstar/GCExport/GCExportPDB.pm new file mode 100644 index 0000000..af1e4db --- /dev/null +++ b/lib/gcstar/GCExport/GCExportPDB.pm @@ -0,0 +1,295 @@ +package GCExport::GCExportPDB; + +################################################### +# +# Copyright 2009-2010 Andrew Ross +# +# 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 GCExport::GCExportBase; + +{ + package GCExport::GCExporterPDB; + + use base qw(GCExport::GCExportBaseClass); + use Encode; + + my @record_lengths; + + my $EPOCH_1904 = 2082844800; # Difference between Palm's + # epoch (Jan. 1, 1904) and + # Unix's epoch (Jan. 1, 1970), + # in seconds. + + + sub new + { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless ($self, $class); + return $self; + } + + sub getOptions + { + my $self = shift; + + return [ + { + name => 'dbname', + type => 'short text', + label => 'DatabaseName', + default => 'gcstar' + }, + ]; + + } + + sub wantsFieldsSelection + { + return 1; + } + + sub wantsImagesSelection + { + return 0; + } + + sub wantsSort + { + return 1; + } + + sub needsUTF8 + { + my $self = shift; + return 0; + } + + sub getSuffix + { + my $self = shift; + + return ".pdb"; + } + + sub preProcess + { + my $self = shift; + return 1; + } + + sub transformValue + { + my ($self, $value, $field) = @_; + + if ($field) + { + $value = $self->SUPER::transformValue($value, $field); + } + $value =~ s/,+$//; + $value =~ s/\n|\r//g; + $value =~ s/<br\/>/ /g; + + return $value; + } + + sub getHeader + { + my ($self, $number) = @_; + my $result = ''; + + # clear the record lengths array + @record_lengths = (); + + # Add database title + my $name = $self->{options}->{'dbname'}; + if (length($name) > 31) + { + $name = substr($name, 0, 31); + } + while (length($name) < 32) + { + $name .= "\x00"; # pack out with null's + } + $result .= $name; + + # Add attribute flags (=0) + $result .= pack('n', 0); + + # Add file version (=0) + $result .= pack('n', 0); + + # Add dates for create time, modify time, backup time + # These dates are the number of seconds since 1st Jan 1904 + my $now = time() + $EPOCH_1904; + + $result .= pack('N', $now); + $result .= pack('N', $now); + $result .= pack('N', $now); + + # Add the Modification Number (=0) + $result .= pack('N', 0); + + # Add the offset to the Application Info + # offset calculated as: + # Title: 0x20 + # flags + version + 3 x dates 0x10 + # mod_number + app_offset 0x08 + # sortID + type 0x08 + # creator + seed 0x08 + # recordListID + cnt + 2byte 0x08 + # 8 bytes per record 8 * $number + $result .= pack('N', 0x50 + (8 * $number)); + + # Add null for the sortInfoID since we don't create a sortInfo + $result .= pack('N', 0); + + # Add the type + $result .= "DB00"; + + # Add the creator + $result .= "DBOS"; + + # add the uniqueIDseed = 0 + $result .= pack('N', 0); + + # Add the nextRecordListID = 0 when on disk + $result .= pack('N', 0); + + # add the record count + $result .= pack('n',$number); + + # The record offset table goes here, but is added in postProcess() + + # "Traditional" 2-byte gap to data + $result .= pack('n', 0); + + # Start the AppInfoID section + $result .= pack('N', 2); + + + # CHUNK_FIELD_NAMES (0) + $result .= pack('n',0); + my $fieldstring = ''; + foreach (@{$self->{options}->{fields}}) + { + my $column = $self->{model}->{fieldsInfo}->{$_}->{displayed}; + $fieldstring .= $self->transformValue($column)."\x00"; + } + $result .= pack('n', length($fieldstring)); + $result .= $fieldstring; + + # CHUNK_FIELD_TYPES (1) + $result .= pack('n',1); + $fieldstring = ''; + foreach (@{$self->{options}->{fields}}) + { + $fieldstring .= pack('n',0); + } + $result .= pack('n', length($fieldstring)); + $result .= $fieldstring; + + # CHUNK_LISTVIEW_OPTIONS (65) + $result .= pack('n',65); + $result .= pack('n',4); + $result .= pack('n',0); + $result .= pack('n',0); + + # CHUNK_LFIND_OPTIONS (128) + $result .= pack('n',128); + $result .= pack('n',2); + $result .= pack('n',0); + + return $result; + } + + sub getItem + { + my ($self, $item, $number) = @_; + my $result; + + my @lengths = (); + my $fieldstr; + foreach (@{$self->{options}->{fields}}) + { + my $value = $item->{$_}; + my $str = $self->transformValue($value, $_)."\x00"; + push (@lengths, length($str)); + $fieldstr .= $str; + } + + my $al = scalar(@lengths) * 2; + for(my $i=0;$i<=$#lengths;$i++) + { + $result .= pack('n', $al); + $al += $lengths[$i]; + } + $result .= $fieldstr; + push (@record_lengths, length($fieldstr)+(2 * scalar(@lengths))); + + return $result; + } + + sub getFooter + { + my $self = shift; + my $result; + + return $result; + } + + sub postProcess + { + my ($self, $header, $body) = @_; + + # add the index: + my $index = ""; + + my $numrecs = scalar(@record_lengths); + my $offset = length($$header) + (8*$numrecs); + + for (my $i=0;$i<$numrecs;$i++) + { + $index .= pack('N', $offset); + $index .= pack('n', 0); + $index .= pack('n', $i); + $offset += $record_lengths[$i]; + } + + # Insert the index into the header + $$header = substr($$header, 0, 0x4e).$index.substr($$header,0x4e); + } + + sub getEndInfo + { + my $self = shift; + my $message; + + return $message; + } + + +} + +1; diff --git a/lib/gcstar/GCExport/GCExportSQL.pm b/lib/gcstar/GCExport/GCExportSQL.pm new file mode 100644 index 0000000..5164d3b --- /dev/null +++ b/lib/gcstar/GCExport/GCExportSQL.pm @@ -0,0 +1,172 @@ +package GCExport::GCExportSQL; + +################################################### +# +# 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 GCExport::GCExportBase; + +{ + package GCExport::GCExporterSQL; + use base qw(GCExport::GCExportBaseClass); + + sub new + { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + + bless ($self, $class); + return $self; + } + + sub getSuffix + { + my $self = shift; + + return ""; + } + + sub getOptions + { + my $self = shift; + + return [ + { + name => 'table', + type => 'short text', + label => 'TableName', + default => 'items' + }, + { + name => 'withDrop', + type => 'yesno', + label => 'WithDrop', + default => '1' + }, + { + name => 'withCreate', + type => 'yesno', + label => 'WithCreate', + default => '1' + }, + ] + } + + sub wantsFieldsSelection + { + return 1; + } + + sub wantsImagesSelection + { + return 1; + } + + sub getName + { + my $self = shift; + + return "SQL"; + } + + sub preProcess + { + my $self = shift; + return 1; + } + + sub getHeader + { + my ($self, $number) = @_; + + my $result = ''; + + if ($self->{options}->{withDrop}) + { + $result .= 'DROP TABLE '.$self->{options}->{table}.";\n"; + } + if ($self->{options}->{withCreate}) + { + $result .= 'CREATE TABLE '.$self->{options}->{table}.' ('; + + foreach (@{$self->{options}->{fields}}) + { + my $type = $self->{model}->{fieldsInfo}->{$_}->{type}; + my $format = 'TEXT'; + $format = 'NUMBER' if ($type eq 'number') || ($type eq 'yesno'); + $result .= "$_ $format, "; + } + $result =~ s/, $//; + $result .= ");\n"; + } + + return $result; + } + + sub getFooter + { + my $self = shift; + + my $result = "COMMIT;\n"; + return $result; + } + + sub getItem + { + my ($self, $item, $number) = @_; + my $result; + + $result = 'INSERT INTO '.$self->{options}->{table}.' ('; + my $values = ''; + foreach (@{$self->{options}->{fields}}) + { + $result .= "$_, "; + my $value = $self->transformValue($item->{$_}, $_); + $value =~ s/'/''/g; + #' + $values .= "'".$value."', "; + } + $result =~ s/, $//; + $values =~ s/, $//; + + $result .= ") VALUES ($values);\n"; + return $result; + } + + sub postProcess + { + my ($self, $value, $body) = @_; + + } + + sub getEndInfo + { + my $self = shift; + my $message = $self->getLang->{InfoFile}.$self->{fileName}; + return $message; + } +} + +1;
\ No newline at end of file diff --git a/lib/gcstar/GCExport/GCExportTarGz.pm b/lib/gcstar/GCExport/GCExportTarGz.pm new file mode 100644 index 0000000..b8994d0 --- /dev/null +++ b/lib/gcstar/GCExport/GCExportTarGz.pm @@ -0,0 +1,174 @@ +package GCExport::GCExportTarGz; + +################################################### +# +# 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 GCExport::GCExportBase; + +{ + package GCExport::GCExporterTarGz; + + use File::Copy; + use File::Basename; + use Cwd; + use XML::Simple; + use GCUtils 'glob'; + use GCBackend::GCBackendXmlParser; + use base qw(GCExport::GCExportBaseClass); + + sub new + { + my ($proto, $parent) = @_; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new($parent); + bless ($self, $class); + + $self->checkModule('Compress::Zlib'); + $self->checkModule('Archive::Tar'); + + return $self; + } + + sub wantsOsSeparator + { + return 0; + } + + sub transformPicturePath + { + my ($self, $path, $file, $item, $field) = @_; + return $self->duplicatePicture($path, + $field, + $self->{currentDir}.'/'.$self->{imageDir}, + $item->{$self->{model}->{commonFields}->{title}}); + } + + sub process + { + my ($self, $options) = @_; + $self->{parsingError} = ''; + $self->{options} = $options; + $self->{options}->{withPictures} = 1; + $self->{fileName} = $options->{file}; + $self->{fileName} .= '.tar.gz' if ($self->{fileName} !~ m/\.tar\.gz$/); + + my $listFile = 'collection.gcs'; + my $baseDir = 'tmp_items_tar_gz'; + my $imagesSubDir = 'images'; + $self->{imageDir} = $baseDir.'/'.$imagesSubDir; + $self->{original} = $options->{collection}; + #$self->{original} =~ s/\\/\//g if ($^O =~ /win32/i); + $self->{origDir} = dirname($self->{original}); + (my $tarfile = $self->{fileName}) =~ s/\.gz$//; + + eval { + chdir dirname($self->{fileName}); + die 'Directory not writable' if !-w '.'; + mkdir $baseDir; + mkdir $self->{imageDir}; + + $self->{currentDir} = getcwd; + + my $backend = new GCBackend::GCBeXmlParser($self); + $backend->setParameters(file => $baseDir.'/'.$listFile, + version => $self->{options}->{parent}->{version}, + wantRestore => 1, + standAlone => 1); + + my $result = $backend->save($options->{items}, + $options->{originalList}->getInformation, + undef); + + if ($result->{error}) + { + die $result->{error}->[1]; + } + + chdir $self->{currentDir}; + + my $tar = Archive::Tar->new(); + chdir $baseDir; + + $tar->add_files($listFile, $imagesSubDir); + my @images = glob $imagesSubDir.'/*'; + $tar->add_files($_) foreach (@images); + $tar->write($tarfile); + + my $gz = Compress::Zlib::gzopen($self->{fileName}, "wb"); + $gz or die 'Cannot write'; + open(TAR, $tarfile) or die "Cannot open $tarfile"; + binmode(TAR); + my $buff; + while (read(TAR, $buff, 8 * 2**10)) + { + $gz->gzwrite($buff); + } + $gz->gzclose; + close TAR; + unlink foreach (@images); + }; + + if ($@) + { + $self->{parsingError} = GCUtils::formatOpenSaveError( + $self->{options}->{parent}->{lang}, + $self->{fileName}, + ['SaveError', $@] + ); + } + + eval { + unlink $listFile; + rmdir $imagesSubDir; + chdir '..'; + rmdir $baseDir; + $tarfile =~ s/\\/\//g if ($^O =~ /win32/i); + unlink $tarfile; + }; + return $self->getEndInfo; + } + + sub getOptions + { + my $self = shift; + my @options; + return \@options; + } + + sub getName + { + my $self = shift; + + return ".tar.gz"; + } + + sub getEndInfo + { + my $self = shift; + return ($self->{parsingError}, 'error') + if $self->{parsingError}; + + return ($self->getLang->{Info}.$self->{fileName}, 'info'); + } +} diff --git a/lib/gcstar/GCExport/GCExportTellico.pm b/lib/gcstar/GCExport/GCExportTellico.pm new file mode 100644 index 0000000..2bac594 --- /dev/null +++ b/lib/gcstar/GCExport/GCExportTellico.pm @@ -0,0 +1,512 @@ +package GCExport::GCExportTellico; + +################################################### +# +# 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 GCExport::GCExportBase; + +{ + package GCExport::GCExporterTellico; + + use base qw(GCExport::GCExportBaseClass); + use GCUtils; + + sub new + { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + bless ($self, $class); + + $self->checkModule('MIME::Base64'); + $self->checkModule('Digest::MD5'); + + #List of collections: http://www.periapsis.org/tellico/doc/collection-type-values.html + # [ entryTitle, type, extra fields ] + $self->{models} = { + GCbooks => ['Books', '2', ''], + GCfilms => ['Videos', '3', '<field flags="2" title="Rating" category="Personal" allowed="5;4;3;2;1" format="4" type="3" name="rating" />'], + GCmusics => ['Music', '4', ''], + GCcoins => ['Coin', '8', ''], + GCgames => ['Games', '11', ''] + }; + + return $self; + } + + sub getName + { + my $self = shift; + + return "Tellico"; + } + + sub getModels + { + my $self = shift; + + my @models = keys %{$self->{models}}; + return \@models; + } + + sub needsUTF8 + { + my $self = shift; + + return 1; + } + + sub getOptions + { + my $self = shift; + + return []; + } + + sub wantsFieldsSelection + { + return 0; + } + + sub preProcess + { + my $self = shift; + + $self->{imagesInfos} = {}; + return 1; + } + + sub getHeader + { + my ($self, $number) = @_; + my $result; + + my $model = $self->{model}; + my $title = $model->getDescription; + my $info = $self->{models}->{$model->getName}; + + $result = '<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE tellico PUBLIC "-//Robby Stephenson/DTD Tellico V9.0//EN" "http://periapsis.org/tellico/dtd/v9/tellico.dtd"> +<tellico xmlns="http://periapsis.org/tellico/" syntaxVersion="7" > + <collection title="'.$title.'" entryTitle="'.$info->[0].'" type="'.$info->[1].'" > + <fields> + <field name="_default" /> + '.$info->[2].' + </fields> +'; + + return $result; + } + + sub transformData + { + my ($self, $data) = @_; + + $data =~ s/&/&/g; + + return $data; + } + + sub transformList + { + my ($self, $list, $tag) = @_; + + my $result = ''; + if (ref($list) eq 'ARRAY') + { + foreach (@{$list}) + { + $result .= " <$tag>".$self->transformData($_->[0]) + ."</$tag>\n"; + } + } + else + { + foreach (split ',', $list) + { + s/;.*$//; + $result .= " <$tag>".$self->transformData($_)."</$tag>\n"; + } + } + return $result; + } + + sub encodeImage + { + my ($self, $file) = @_; + my $image = GCUtils::getDisplayedImage($file, $self->{options}->{defaultImage}, $self->{original}); + (my $suffix = $image) =~ s/.*?\.([^.]*)$/$1/; + $suffix = 'jpeg' if $suffix eq 'jpg'; + open PIC, "<$image" or return (undef,undef,undef); + my $data = do {local $/; <PIC>}; + close PIC; + my $pictureId = Digest::MD5::md5_hex($data).'.'.$suffix; + my %infos; + $infos{id} = $pictureId; + $infos{format} = uc $suffix; + $infos{width} = 120; + $infos{height} = 160; + $infos{data} = MIME::Base64::encode_base64($data); + return \%infos; + } + + sub getItem + { + my ($self, $item, $number) = @_; + + my $methodName = 'get'.$self->{model}->getName.'Item'; + + return $self->$methodName($item); + } + + sub getGCfilmsItem + { + my ($self, $movie, $number) = @_; + my $result; + + #(my $synopsis = $movie->{synopsis}) =~ s/<br>/\n/gm; + #(my $comments = $movie->{comment}) =~ s/<br>/\n/gm; + + use integer; + my $rating = $movie->{rating} / 2; + no integer; + + my $age = $movie->{age}; + my $certification; + + if ($age == 1) + { + $certification = 'U (USA)'; + } + elsif ($age == 2) + { + $certification = 'G (USA)'; + } + elsif ($age <= 5) + { + $certification = 'PG (USA)'; + } + elsif ($age <= 13) + { + $certification = 'PG-13 (USA)'; + } + elsif ($age <= 17) + { + $certification = 'R (USA)'; + } + + my $imageInfos = $self->encodeImage($movie->{image}); + $self->{imagesInfos}->{$imageInfos->{id}} = $imageInfos; + + my $year = GCPreProcess::extractYear($movie->{date}); + + $result = ' <entry> + <title>'.$self->transformData($movie->{title}).'</title> + <medium>'.$self->transformData($movie->{format}).'</medium> + <year>'.$year.'</year> + <certification>'.$certification.'</certification> + <genres> +'; + $result .= $self->transformList($movie->{genre}, 'genre'); + $result .= ' </genres> + <nationalitys> + <nationality>'.$self->transformData($movie->{country}).'</nationality> + </nationalitys> + <casts> +'; + foreach (split ',', $movie->{actors}) + { + $result .= " <cast><column>".$self->transformData($_)."</column></cast>\n"; + } + $result .= ' </casts> + <directors> + <director>'.$self->transformData($movie->{director}).'</director> + </directors> + <languages> +'; + $result .= $self->transformList($movie->{audio}, 'language'); + $result .= ' </languages> + <running-time>'.$self->transformData($movie->{time}).'</running-time> + <plot>'.$self->transformData($movie->{synopsis}).'</plot> + <rating>'.$rating.'</rating> + <comments>'.$self->transformData($movie->{comments}).'</comments> +'; + if (($movie->{borrower}) && ($movie->{borrower} ne 'none')) + { + $result .= ' <loaned>true</loaned> +'; + } + + $result .= ' <cover>'.$imageInfos->{id}.'</cover> +'; + + $result .= ' </entry> +'; + + return $result; + } + + sub getGCgamesItem + { + my ($self, $item, $number) = @_; + my $result; + + use integer; + my $rating = $item->{rating} / 2; + no integer; + + my $imageInfos = $self->encodeImage($item->{boxpic}); + $self->{imagesInfos}->{$imageInfos->{id}} = $imageInfos; + + my $year = GCPreProcess::extractYear($item->{released}); + + $result = ' <entry> + <title>'.$self->transformData($item->{name}).'</title> + <platform>'.$self->transformData($item->{platform}).'</platform> + <description>'.$self->transformData($item->{description}).'</description> + <year>'.$year.'</year> + <pur_date>'.$self->transformData($item->{added}).'</pur_date> + <genres> +'; + $result .= $self->transformList($item->{genre}, 'genre'); + $result .= ' </genres> + <publishers> + <publisher>'.$self->transformData($item->{editor}).'</publisher> + </publishers> + <rating>'.$rating.'</rating> +'; + if (($item->{borrower}) && ($item->{borrower} ne 'none')) + { + $result .= ' <loaned>true</loaned> +'; + } + if ($item->{completion} >= 100) + { + $result .= ' <completed>true</completed> +'; + } + + $result .= ' <cover>'.$imageInfos->{id}.'</cover> +'; + + $result .= ' </entry> +'; + + return $result; + } + + sub getGCbooksItem + { + my ($self, $item, $number) = @_; + my $result; + + use integer; + my $rating = $item->{rating} / 2; + no integer; + + my $imageInfos = $self->encodeImage($item->{cover}); + $self->{imagesInfos}->{$imageInfos->{id}} = $imageInfos; + + my $year = GCPreProcess::extractYear($item->{publication}); + + $result = ' <entry> + <title>'.$self->transformData($item->{title}).'</title> + <isbn>'.$self->transformData($item->{isbn}).'</isbn> + <series>'.$self->transformData($item->{serie}).'</series> + <edition>'.$self->transformData($item->{edition}).'</edition> + <binding>'.$self->transformData($item->{format}).'</binding> + <comments>'.$self->transformData($item->{description}).'</comments> + <pages>'.$self->transformData($item->{pages}).'</pages> + <pur_date>'.$self->transformData($item->{acquisition}).'</pur_date> + <pub_year>'.$year.'</pub_year> + <publisher>'.$self->transformData($item->{publisher}).'</publisher> + <authors> +'; + $result .= $self->transformList($item->{authors}, 'author'); + $result .= ' </authors> + <languages> +'; + $result .= $self->transformList($item->{language}, 'language'); + $result .= ' </languages> + <genres> +'; + $result .= $self->transformList($item->{genre}, 'genre'); + $result .= ' </genres> + <rating>'.$rating.'</rating> +'; + if (($item->{borrower}) && ($item->{borrower} ne 'none')) + { + $result .= ' <loaned>true</loaned> +'; + } + if ($item->{read}) + { + $result .= ' <read>true</read> +'; + } + + $result .= ' <cover>'.$imageInfos->{id}.'</cover> +'; + + $result .= ' </entry> +'; + + return $result; + } + + sub getGCmusicsItem + { + my ($self, $item, $number) = @_; + my $result; + + use integer; + my $rating = $item->{rating} / 2; + no integer; + + my $imageInfos = $self->encodeImage($item->{cover}); + $self->{imagesInfos}->{$imageInfos->{id}} = $imageInfos; + + my $year = GCPreProcess::extractYear($item->{release}); + + $result = ' <entry> + <title>'.$self->transformData($item->{title}).'</title> + <medium>'.$self->transformData($item->{format}).'</medium> + <year>'.$year.'</year> + <label>'.$self->transformData($item->{label}).'</label> + <comments>'.$self->transformData($item->{comment}).'</comments> + <artists> +'; + $result .= $self->transformList($item->{artist}, 'artist'); + $result .= ' </artists> + <genres> +'; + $result .= $self->transformList($item->{genre}, 'genre'); + $result .= ' </genres> + <rating>'.$rating.'</rating> + <tracks>'; + foreach (@{$item->{tracks}}) + { + $result .= ' + <track> + <column>'.$self->transformData($_->[1]).'</column> + <column>'.$self->transformData($item->{artist}).'</column> + <column>'.$self->transformData($_->[2]).'</column> + </track>' + } + $result .= ' + </tracks> +'; + + + if (($item->{borrower}) && ($item->{borrower} ne 'none')) + { + $result .= ' <loaned>true</loaned> +'; + } + $result .= ' <cover>'.$imageInfos->{id}.'</cover> +'; + + $result .= ' </entry> +'; + + return $result; + } + + sub getGCcoinsItem + { + my ($self, $item, $number) = @_; + my $result; + + my $frontInfos = $self->encodeImage($item->{front}); + $self->{imagesInfos}->{$frontInfos->{id}} = $frontInfos; + my $backInfos = $self->encodeImage($item->{back}); + $self->{imagesInfos}->{$backInfos->{id}} = $backInfos; + + $result = ' <entry> + <title>'.$self->transformData($item->{name}).'</title> + <type>'.$self->transformData($item->{currency}).'</type> + <denomination>'.$self->transformData($item->{value}).'</denomination> + <year>'.$self->transformData($item->{year}).'</year> + <country>'.$self->transformData($item->{country}).'</country> + <set>'.(($item->{type} eq 'coin') ? 'true' : 'false').'</set> + <pur_date>'.$self->transformData($item->{added}).'</pur_date> + <pur_price>'.$self->transformData($item->{estimate}).'</pur_price> + <location>'.$self->transformData($item->{location}).'</location> + <comments>'.$self->transformData($item->{comments}).'</comments> + <obverse>'.$frontInfos->{id}.'</obverse> + <reverse>'.$backInfos->{id}.'</reverse> + </entry> +'; + return $result; + } + + sub getFooter + { + my $self = shift; + my $result; + + $result = ' <images> +'; + foreach (values %{$self->{imagesInfos}}) + { + $result .= ' <image id="'.$_->{id}.'" format="'.$_->{format}. + '" width="'.$_->{width}.'" height="'.$_->{height}.'">'. + $_->{data}.'</image>'; + } + $result .=' </images> + </collection> +</tellico> +'; + + return $result; + } + + # postProcess + # Called after all processing. Use it if you need to perform extra stuff on the header. + # $header is a reference to the header string. + sub postProcess + { + my ($self, $header, $body) = @_; + + # Your code here + # As header is a reference, it can be modified on place with $$header + } + + # getEndInfo + # Used to display some information to user when export is ended. + # To localize your message, use $self->{options}->{lang}. + # Returns a string that will be displayed in a message box. + sub getEndInfo + { + my $self = shift; + my $message; + + # Your code here + # Don't do put anything in message if you don't want information to be displayed. + + return $message; + } +} + +1; diff --git a/lib/gcstar/GCExport/GCExportXML.pm b/lib/gcstar/GCExport/GCExportXML.pm new file mode 100644 index 0000000..57236ee --- /dev/null +++ b/lib/gcstar/GCExport/GCExportXML.pm @@ -0,0 +1,287 @@ +package GCExport::GCExportXML; + +################################################### +# +# 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 GCExport::GCExportBase; + +{ + package GCExport::GCExporterXML; + use base qw(GCExport::GCExportBaseClass); + + use File::Basename; + use GCUtils 'glob'; + + sub new + { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + + bless ($self, $class); + return $self; + } + + sub transformValue + { + my ($self, $value, $field) = @_; + + $value = $self->SUPER::transformValue($value, $field); + $value =~ s/&(\W)/&$1/g; + $value =~ s/"/"/g; + #" + $value =~ s/'/'/g; + #' + return $value; + } + + sub getName + { + my $self = shift; + + return "XML"; + } + + sub getSuffix + { + my $self = shift; + + return ""; + } + + sub needsUTF8 + { + my $self = shift; + + return 1; + } + + sub getOptions + { + my $self = shift; + + $self->{modelsFiles} = ''; + + if ($self->{model}->getName) + { + $self->{modelsDir} = $ENV{GCS_SHARE_DIR}.'/xml_models/'.$self->{model}->getName; + foreach (glob $self->{modelsDir}.'/*') + { + next if $_ =~ /\/CVS$/; + (my $mod = basename($_)) =~ s/_/ /g; + $self->{modelsFiles} .= ','.$mod; + } + } + + return [ + { + name => 'models', + type => 'options', + label => 'Models', + default => 'UseModel', + valuesList => 'UseModel,UseFile'.$self->{modelsFiles} + }, + + { + name => 'templatefile', + type => 'file', + label => 'ModelFile', + default => '' + }, + + { + name => 'model', + type => 'long text', + label => 'ModelText', + default => '', + height => 100 + }, + + ]; + } + + sub wantsFieldsSelection + { + return 0; + } + + sub wantsImagesSelection + { + return 1; + } + + sub preProcess + { + my $self = shift; + + my $model; + + if ($self->{options}->{models} eq 'UseModel') + { + $model = $self->{options}->{model}; + } + else + { + my $file; + if ($self->{options}->{models} eq 'UseFile') + { + $file = $self->{options}->{templatefile}; + } + else + { + (my $fileName = $self->{options}->{models}) =~ s/ /_/g; + $file = $self->{modelsDir}.'/'.$fileName; + $file =~ s/"//g; + #" + } + open FILE, $file; + #Read full file + $model = do { local $/; <FILE> }; + close FILE; + } + $model =~ m{ + \[HEADER\]\n?(.*?)\n?\[\/HEADER\].*? + \[ITEM\]\n?(.*?)\n?\[\/ITEM\].*? + \[FOOTER\]\n?(.*?)\n?\[\/FOOTER\] + }xms; + $self->{header} = $1; + $self->{item} = $2; + $self->{footer} = $3; + return 1; + } + + sub getHeader + { + my ($self, $number) = @_; + my $result = $self->{header}; + + $result =~ s/\$\{file\}/$self->{options}->{collection}/g; + $result =~ s/\$\{number\}/$number/g; + + return $result."\n"; + } + + sub getItem + { + my ($self, $item, $number) = @_; + my $result = $self->{item}; + + while ($result =~ m/\[LOOP\s+(.*?)\]\n?(.*?)\n\s*\[\/LOOP\]/gms) + { + my $values = $self->transformValue($item->{$1}, $1); + my $motif = $2; + my $string; + foreach my $value(split /,/, $values) + { + $value =~ s/^\s*//; + (my $line = $motif) =~ s/\$\$/$value/gms; + $string .= $line; + } + $result =~ s/(\n?)\s*\[LOOP\s+$1\].*?\[\/LOOP\]/$1$string/gms; + } + + while ($result =~ m/\[SPLIT\s+value=(.*?)\s+sep=(.)\]\n?(.*?)\n\s*\[\/SPLIT\]/gms) + { + my $values = $1; + $values = $item->{$values} if exists $item->{$values}; + $values = $self->transformValue($values, $1); + my $sep = ${2}; + my $motif = ${3}; + my $i = 0; + foreach my $value(split /$sep/, $values) + { + $value =~ s/^\s*//; + $motif =~ s/\$$i/$value/gms; + $i++; + } + do {$motif =~ s/\s*\$[0-9]+//mgs;}; + $result =~ s/(\n?)\s*\[SPLIT\s+value=\Q$1\E\s+sep=($sep)\].*?\[\/SPLIT\]/$1$motif/gms; + } + + foreach (keys %$item) + { + my $value = $self->transformValue($item->{$_}, $_); + $result =~ s/\$\{$_\}/$value/g; + } + + if ($item->{time}) + { + my $min = 0; + my $time = $item->{time}; + $min = ($1 * 60) + $2 if ($time =~ /([0-9]*)h\.?\s+([0-9]*)m/) + || ($time =~ /([0-9]*):([0-9]*)/); + $min = $1 if !$min && ($time =~ /([0-9]*)/); + $result =~ s/\$\{length\}/$min/g; + } + + if ($item->{date}) + { + my $year = 0; + $item->{date} =~ /([0-9]{4})/; + $year = $1; + $result =~ s/\$\{year\}/$year/g; + } + + $result =~ s/\$\{.*?\}//g; + + return $result."\n"; + } + + sub getFooter + { + my $self = shift; + my $result = $self->{footer}; + + return $result."\n"; + } + + # postProcess + # Called after all processing. Use it if you need to perform extra stuff on the header. + # $header is a reference to the header string. + sub postProcess + { + my ($self, $header, $body) = @_; + + # Your code here + # As header is a reference, it can be modified on place with $$header + } + + # getEndInfo + # Used to display some information to user when export is ended. + # To localize your message, use $self->{options}->{lang}. + # Returns a string that will be displayed in a message box. + sub getEndInfo + { + my $self = shift; + my $message; + + # Your code here + # Don't do put anything in message if you don't want information to be displayed. + + return $message; + } +} + +1; |