view release on metacpan or  search on metacpan

lib/Metabase/Fact.pm  view on Meta::CPAN

    # initialize guid if not provided
    if ( !defined $args->{guid} ) {
        $args->{guid} = lc _guid();
    }

    # initialize the object
    my $self = bless {}, $class;

    $self->{content} = $args->{content};

    my $meta = $self->{metadata} = { core => {} };
    $meta->{core}{guid}           = $class->__validate_guid( $args->{guid} );
    $meta->{core}{creation_time}  = $args->{creation_time} || _zulu_datetime();
    $meta->{core}{update_time}    = $meta->{core}{creation_time};
    $meta->{core}{schema_version} = $args->{schema_version};
    $meta->{core}{type}           = $self->type;
    $meta->{core}{valid}          = _bool( defined $args->{valid} ? $args->{valid} : 1 );

    # validate creator via mutator if given
    $self->set_creator( $args->{creator} ) if defined $args->{creator};

    # validate resource field
    $meta->{core}{resource} = $self->validate_resource( $args->{resource} );

    return $self;
}

# Content accessor
sub content { $_[0]->{content} }

# Accessors for core metadata

sub creation_time  { $_[0]->{metadata}{core}{creation_time} }
sub guid           { $_[0]->{metadata}{core}{guid} }
sub resource       { $_[0]->{metadata}{core}{resource} }
sub schema_version { $_[0]->{metadata}{core}{schema_version} }

# Creator can be set once after the fact is created

sub creator { $_[0]->{metadata}{core}{creator} }

sub set_creator {
    my ( $self, $uri ) = @_;

    Carp::confess("can't set creator; it is already set")
      if $self->creator;

    # validate $uri
    my $obj = Metabase::Resource->new($uri);
    unless ( $obj->type eq 'Metabase-Resource-metabase-user' ) {
        Carp::confess( "creator must be a Metabase User Profile resource URI of\n"
              . "the form 'metabase:user:XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX'" );
    }

    $self->{metadata}{core}{creator} = $obj;
}

# update_time can always be modified

sub update_time { $_[0]->{metadata}{core}{update_time} }

sub touch {
    my ($self) = @_;
    $self->{metadata}{core}{update_time} = _zulu_datetime();
}

# valid can be modified

sub valid { $_[0]->{metadata}{core}{valid} }

sub set_valid {
    my ( $self, $val ) = @_;
    $self->{metadata}{core}{valid} = _bool($val);
}

# metadata structure accessors

sub core_metadata {
    my $self = shift;
    return { %{ $self->{metadata}{core} } };
}

sub core_metadata_types {
    return {
        creation_time  => '//str',
        creator        => '//str',
        guid           => '//str',
        resource       => '//str',
        schema_version => '//num',
        type           => '//str',
        update_time    => '//str',
        valid          => '//bool',
    };
}

sub resource_metadata {
    my $self = shift;
    $self->{metadata}{resource} ||= $self->resource->metadata;
    return { %{ $self->{metadata}{resource} } };
}

sub resource_metadata_types {
    my $self = shift;
    return $self->resource->metadata_types;
}

# persistence routines

# Class might not be in its own file -- check if method can resolve
# or else try to load it
my $id_re    = qr/[_a-z]+/i;
my $class_re = qr/^$id_re(?:::$id_re)*$/;

sub _load_fact_class {
    my ( $class, $fact_class ) = @_;
    unless ( defined $fact_class ) {
        Carp::confess "Can't load undef as a module";
    }
    unless ( $fact_class =~ $class_re ) {
        Carp::confess "'$fact_class' does not look like a class name";