The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Data::Workflow::Resource;

#################################################################################
#
# Author:  Nat Goodman
# Created: 05-11-19
# $Id: 
#
# Base Resource class
# Resources are units of data that are manipulated as a whole
#
#################################################################################

use strict;
use Class::AutoClass;
use Carp;
use Data::Workflow::Util qw(clean_id flatten);
use Data::Workflow::Version;

use vars qw(@ISA @AUTO_ATTRIBUTES @OTHER_ATTRIBUTES %SYNONYMS %DEFAULTS %AUTODB);
@ISA = qw(Class::AutoClass);

@AUTO_ATTRIBUTES=qw(namespace_id relative_id default_version resource_pool
		    _id _id2version
		    verbose);
@OTHER_ATTRIBUTES=qw(modtime checktime);
%SYNONYMS=();
%DEFAULTS=(versions=>[],_id2version=>{});
%AUTODB=
  (-collection=>'Resource',
   -keys=>qq(id string),
   -transients=>qq(verbose));
Class::AutoClass::declare(__PACKAGE__);

sub _init_self {
  my ($self, $class, $args) = @_;
  return unless $class eq __PACKAGE__;
  confess "Mandatory parameter -resource_pool missing" unless $self->resource_pool;
  $self->id($args->id) if $args->id; # do it here so pool will be set
  my $default_version=$self->default_version ||
    $self->default_version(new Data::Workflow::Version(-resource=>$self));
  $self->add_version($default_version);
}
#sub id {
#  my($self)=@_;
#  join('/',grep {$_} $self->get(qw(namespace_id relative_id)));
#}
sub id {
  my $self=shift @_;
  my $id=@_? $_[0]: $self->_id;
  if (@_) {
    my($namespace_id,$relative_id);
    unless ($id=~/^\w+:/) {	# normal case
      ($namespace_id,$relative_id)=$self->split_resource_id($id);
    } else {			# id is uri
#     ($namespace_id,$relative_id)=$id=~/^(\w+:)\/(\/.*)$/; # leave one slash on relative_id 
#      ($namespace_id,$relative_id)=$id=~/^(\w+:)\/\/(.*)$/;
      my $sep;			# just so regexp will work
      ($namespace_id,$sep,$relative_id)=$id=~m#^(\w+://.*?)(/|$ )(.*?)(/|$ )$#x;
      # add generic namespace, just in case...
      my $pool=$self->resource_pool;
      $pool->add_namespace($pool->new_namespace('uri',$namespace_id));
    }
    $self->set(_id=>$id,namespace_id=>$namespace_id,relative_id=>$relative_id);
  }
  $id;
}
sub split_resource_id {
  my($self,$id)=@_;
  my $pool=$self->resource_pool;
  # find the namespace (if any) for this resource
  # the correct namespace is the one matching the longest prefix of the resource
  my $id2namespace=$pool->_id2namespace;
  my @namespace_ids=keys %$id2namespace;
  $id=clean_id($id);
  my @id_parts=split('/',$id);
  my($namespace_id,$relative_id);
  while (@id_parts) {
    $namespace_id=join('/',@id_parts);
    last if grep {$namespace_id eq $_} @namespace_ids;
    pop(@id_parts);
  }
  if (@id_parts) {		# got a match. also need part of id that sits below namespace
    ($relative_id)=$id=~/^$namespace_id\/(.*)$/;
  } else {
    ($namespace_id,$relative_id)=('',$id);
#    $namespace_id=$id;
  }
  ($namespace_id,$relative_id);
}

sub versions {
  my $self=shift @_;
  if (@_) {
    my @versions=flatten(@_);
    my $id2version=$self->_id2version({});      # start with a blank slate
    $self->add_versions(@versions);             # add new ones
  }
  my @versions=values %{$self->_id2version};
  wantarray? @versions: \@versions;
}
sub new_version {
  my($self,$id)=@_;
  #print "Resource.pm new Version $id $self\n";
  new Data::Workflow::Version(-id=>$id,-resource=>$self);
}
sub id2version {
  my $self=shift @_;
  return $self->_id2version unless @_;
  return $self->_id2version($_[0]) if 'HASH' eq ref $_[0];
  my $id=shift @_;
  @_? $self->_id2version->{$id}=$_[0]: $self->_id2version->{$id};
}
sub add_versions {
  my $self=shift @_;
  my @versions=flatten(@_);
  my @results;
  my $id2version=$self->_id2version;
  for my $version (@versions) {
    ref $version or $version=$self->new_version($version); # version can be id or object
    my $version_id=$version->id;
    next if $id2version->{$version_id}; # version already exists
    $id2version->{$version_id}=$version; 
    push(@results,$version);
  }
  wantarray? @results: \@results;
}
sub add_version {
  my($self,$version)=@_;
  ($version)=$self->add_versions($version);
  $version;
}
sub get_versions {
  my $self=shift @_;
  my $id2version=$self->_id2version;
  my @versions=grep {defined $_} @$id2version{@_};
  wantarray? @versions: \@versions;
}
sub get_version {
  my($self,$version_id)=@_;
  $self->_id2version->{$version_id};
}
sub resource {$_[0]};		# for compliance with Version
*resource_id=\&id;		# for compliance with Version
sub namespace {$_[0]->resource_pool->id2namespace($_[0]->namespace_id);}
sub type {$_[0]->namespace->type}
sub checktime {my $self=shift; $self->default_version->checktime(@_); }
sub modtime_autoset {$_[0]->namespace->modtime_autoset;}
#sub full_id {$_[0]->namespace->full_id($_[0])}                     # TRASHED
#sub modtime {my $self=shift; $self->namespace->modtime($self,@_);} # handled by AUTOLOAD

# Resources need certain behavior from their Namespaces,
# but aside from the few methods above, the available
# methods vary by subclass. 
# This AUTOLOAD provides the interface between generic
# Resource and specific Namespace classes
#
# A further complication is that some methods take the
# version object as an argument while others will break
# if it is passed in.
#
use vars qw($AUTOLOAD);
sub AUTOLOAD {
  my $self=shift;
  my $method=$AUTOLOAD;
  $method=~s/^.*:://;             # strip class qualification
  return if $method eq 'DESTROY'; # the books say you should do this
  return $self->namespace->method_from_resource($method,$self,@_);
}

1;