Image::MetaData::GQview - Perl extension for GQview image metadata

   use Image::MetaData::GQview;

   my $md = Image::MetaData::GQview->new("test.jpg");
   my $md2 = Image::MetaData::GQview->new("test2.jpg", {fields => ['keywords', 'comment', 'picture info']});
   my $md3 = Image::MetaData::GQview->new({file => "test2.jpg", fields => ['keywords', 'comment', 'picture info']});
   $md->load("test.jpg");
   my $comment = $md->comment;
   my @keywords = $md->keywords;
   my $raw = $md->raw;
   $md->comment("This is a comment");
   $md->keywords(@keywords);
   $md->save("test.jpg");

   perldoc Image::MetaData::GQview

   man qview

package Image::MetaData::GQview;

use strict;

#use warnings;
## no critic (RequireUseWarnings);

use 5.008000;
use Carp;
use Fatal qw(:void open close);
use Cwd qw(abs_path);
use PerlIO;

use version; our $VERSION = qv("v2.0.0");

sub new
{
   my $param = shift;
   my $class = ref($param) || $param;
   my $file  = shift;
   my $opts  = shift || {};

   if (ref($file) eq 'HASH')
   {
      $opts = $file;
      $file = undef;
   }

   my $self = {fields => [qw(keywords comment)],};
   $self->{opts}->{file} = $file if $file;

   bless $self, $class;

   foreach (qw(file fields))
   {
      $self->{$_} = $opts->{$_} if exists($opts->{$_});
   }

   $file = $self->{opts}->{file};

   $self->load($file) if $file;

   return $self;
} ## end sub new

sub load
{
   my $self     = shift;
   my $image    = shift || $self->{imagefile};
   my $metafile = shift;

   croak("No File given!") unless $image;
   $image = abs_path($image);
   croak("No such file ($image)!") unless -e $image;

   $self->{imagefile} = $image;

   unless ($metafile)
   {
      (my $metadata1 = $image) =~ s#/([^/]*)$#/.metadata/$1.meta#;
      my $metadata2 = abs_path($ENV{HOME}) . ".gqview/metadata$image.meta";

      $metafile = $metadata1 if -r $metadata1;
      $metafile ||= $metadata2 if -r $metadata2;
   } ## end unless ($metafile)
   $self->{metafile} = $metafile;

   croak("No metadata found for image '$image'!") unless $metafile;

   open my $in, "<:utf8", $metafile;
   $self->{metadata} = eval { local $/ = undef; <$in> };
   close $in;

   # Aufbau:
   # #GQview comment (<version>)
   #
   # [keywords]
   # ...
   #
   # [comment]
   # ...
   #
   # #end
   my $select = join("|", @{$self->{fields}});
   my @fields_ext = split(/^\[($select)\]\n/m, $self->{metadata});

   # trow away the head
   shift @fields_ext;
   die "Internal Error: Metadata are not parsable" if (@fields_ext % 2) != 0; ## no critic (RequireCarping);

   # Cleanup the last field if it exists
   $fields_ext[-1] =~ s/\n*#end\n?\z/\n/ if @fields_ext > 0;

   # Now they can be put into $self
   my %fields = @fields_ext;
   $self->{data} = \%fields;

   return 1;
} ## end sub load

sub comment
{
   my $self    = shift;
   my $comment = shift;

   $comment =~ s/^\[/ [/mg if $comment;
   $self->set_field('comment', $comment) if $comment;

   return scalar($self->get_field('comment'));
} ## end sub comment

sub keywords ## no critic (RequireArgUnpacking);
{
   my $self = shift;

   $self->set_field('keywords', @_) if @_;

   my @keywords = grep {$_} $self->get_field('keywords');

   return @keywords;
} ## end sub keywords

sub raw
{
   my $self = shift;

   return $self->{metadata};
}

sub save
{
   my $self        = shift;
   my $image       = shift;
   my $newimage    = $image;
   my $metafile    = shift;
   my $newmetafile = $metafile;
   $image    ||= $self->{imagefile};
   $metafile ||= $self->{metafile};

   croak("No File given!") unless $image;
   $image = abs_path($image);
   croak("No such file ($image)!") unless -e $image;

   (my $metadata1 = $image) =~ s#/([^/]*)$#/.metadata/$1.meta#;
   my $metadata2 = abs_path($ENV{HOME}) . ".gqview/metadata$image.meta";

   my $metadata;

   # Read the gqviewrc
   if (open my $in, "<", $ENV{HOME} . "/.gqview/gqviewrc") ## no critic (RequireBriefOpen);
   {
      while (my $line = <$in>)
      {
	 chomp $line;
	 next if $line =~ /^#/;
	 if ($line =~ /^local_metadata: (true|false)$/)
	 {
	    $metadata = ($1 eq "true") ? $metadata1 : $metadata2;
	    last;
	 }
      } ## end while (my $line = <$in>)
      close $in;
   } ## end if (open my $in, "<", ...
   if ($newimage and not $newmetafile)
   {
      $metafile = $metadata;
   }

   my $false;
   my @metadirs = split(/\//, $metafile);
   pop @metadirs;
   my $metadir = "";
   while (@metadirs)
   {
      $metadir .= shift(@metadirs) . "/";
      unless (-d $metadir or mkdir($metadir))
      {
	 $false = 1;
	 last;
      }
   } ## end while (@metadirs)
   if ($false and not $newmetafile and $metafile ne $metadata2)
   {
      $false    = 0;
      $metafile = $metadata2;
      @metadirs = split(/\//, $metadata2);
      pop @metadirs;
      $metadir = "";
      while (@metadirs)
      {
	 $metadir .= shift(@metadirs) . "/";
	 unless (-d $metadir or mkdir($metadir))
	 {
	    $false = 1;
	    last;
	 }
      } ## end while (@metadirs)
   } ## end if ($false and not $newmetafile...
   croak("Cannot create directory structure for meta file '$metafile'!") if ($false);
   $self->_sync;
   if ($self->raw)
   {
      open my $meta, ">:utf8", $metafile;
      print $meta $self->raw or die("Faulty metadata"); ## no critic (RequireCarping);
      close $meta;
   } ## end if ($self->raw)

   $self->{imagefile} = $image;
   $self->{metafile}  = $metafile;

   return 1;
} ## end sub save

sub get_field
{
   my $self  = shift;
   my $field = shift || croak("get_field has to be called with a field as the first parameter");

   croak("get_field has to be called with a known field '$field' as first parameter") unless grep {/^\Q$field\E$/s} @{$self->{fields}};

   my $data = $self->{data}->{$field} || "";
   $data =~ s/\n*\z//;

   return wantarray ? split(/\n/, $data) : "$data\n";
} ## end sub get_field

sub set_field ## no critic (RequireArgUnpacking);
{
   my $self  = shift;
   my $field = shift || croak("set_field has to be called with a field as the first parameter");

   croak("set_field has to be called with a known field '$field' }as first parameter") unless grep {/^\Q$field\E$/s} @{$self->{fields}};

   my $data = join("\n", @_);
   $data =~ s/\n*\z/\n/;

   $self->{data}->{$field} = $data;

   $self->_sync;

   return 1;
} ## end sub set_field

#
# Internal method _sync
#
# This will hold the metadata in sync with the single elements
#

sub _sync
{
   my $self = shift;

   $self->{metadata} = "#GQview comment (2.0.0)\n\n";

   foreach my $field (@{$self->{fields}})
   {
      my $data = $self->{data}->{$field} || "";
      $data =~ s/\n*\z/\n\n/s;
      $data = "\n" if $data eq "\n\n";
      $self->{metadata} .= "[$field]\n" . $data;
   } ## end foreach my $field (@{$self->...

   $self->{metadata} .= "#end\n";

   return 1;
} ## end sub _sync

1;

__END__