view release on metacpan or  search on metacpan

lib/EntityModel/Model.pm  view on Meta::CPAN

=cut

sub rollback {
	my $self = shift;
	undef $self->{pending};
	return $self;
}

=head2 apply_fields

Apply the field definitions for an entity.

=cut

sub apply_fields {
	my $self = shift;
	my $entity = shift;
	local $SIG{__DIE__} = sub {
		logStack("FAILED HERE ===== $_[0]");
		die @_;
	};
	my @fieldList = $self->read_fields($entity);
	foreach my $details (@fieldList) {
		my $field = $entity->new_field($details->{name});
		foreach (sort keys %$details) {
			$field->$_($details->{$_});
		}
		$entity->field->push($field);
	}
	return $self;
}

=head2 load_model

Populate the entity model from any information we can get from
the data source.

=cut

sub load_model {
	my $self = shift;
	$self->entity->clear;

	logDebug("Reading tables");
	my @tableList = $self->read_tables;
	logDebug("Import " . scalar(@tableList) . " tables");
	foreach (@tableList) {
		my $tbl = $self->add_table($_);
		$self->apply_fields($tbl);
	}
	logDebug("Import complete");
	return $self;
}

=head2 update_from

Update this entity model so that it matches the given model.

=cut

sub update_from {
	my ($self, $src) = @_;
	my %srcNames = map { $_->name => $_ } $src->entity->list;
	foreach my $e ($self->entity->list) {
		if(exists $srcNames{$e->name}) {
			my $es = delete $srcNames{$e->name};
# Mark this for update unless it's the same as the one we have already
			if($es->matches($e)) {
				logDebug("Should keep [%s]", $e->name);
			} else {
				logDebug("Should update [%s]", $e->name);
				$self->{pending}->{update}->{$es->name} = $es;
			}
		} else {
			logDebug("Should remove [%s]", $e->name);
			$self->{pending}->{remove}->{$e->name} = $e;
		}
	}
	foreach my $name (sort keys %srcNames) {
		logDebug("Should add [%s]", $name);
		$self->{pending}->{add}->{$name} = $srcNames{$name};
	}
	return $self;
}

=head2 matches

Returns true if this entity model has identical content to another given model.

=cut

sub matches {
	my ($self, $dst) = @_;
	my @srcList = sort { $a->name cmp $b->name } $self->entity->list;
	my @dstList = sort { $a->name cmp $b->name } $dst->entity->list;
	logDebug("Check match: src " . scalar(@srcList) . ", dest " . scalar(@dstList));
	return \@srcList ~~ \@dstList;
}

=head2 read_tables

Virtual method for reading table definitions.

=cut

sub read_tables { }

sub dump  {
	my $self = shift;
	my $out = shift || sub {
		print join(' ', @_) . "\n";
	};

	$out->('Entity list for ' . $self->name);
	foreach (sort { $a->name cmp $b->name } $self->entity) {
		$out->($_->name);
		$_->dump($out);
	}
	$self;
}

lib/EntityModel/Model.pm  view on Meta::CPAN

sub commit_pending_remove {
	my $self = shift;
	logInfo("Remove " . join(',', map { $_->name } $self->pending_entities('remove')));
	$self->remove_table($_) foreach $self->pending_entities('remove');
	return $self;
}

=head2 commit_pending_add

Add all pending items, ordering to resolve dependencies as required.

=cut

sub commit_pending_add {
	my $self = shift;
	logInfo("Create " . join(',', map { $_->name } $self->pending_entities('add')));
	my @pending = $self->pending_entities('add');
	ITEM:
	while(@pending) {
		my $e = shift(@pending);
		# TODO Not hugely efficient, perhaps could do with a profile run here?
		my @deps = map { $_->name } $e->dependencies;
		my @pendingNames = map { $_->name } @pending;
		my @unsatisfied = grep { $_ ~~ @deps } @pendingNames;
		my @existing = map { $_->name } $self->entity->list;
		# Include current entity in list of available entries, so that we can allow self-reference
		my @unresolved = grep { !($_ ~~ [@pendingNames, @existing, $e->name]) } @deps;
		if(@unresolved) {
			logError("%s unresolved (pending %s, deps %s for %s)", join(',', @unresolved), join(',', @pendingNames), join(',', @deps), $e->name);
			die "Dependency error";
		}
		if(@unsatisfied) {
			logInfo("%s has %d unsatisfied deps, postponing: %s", $e->name, scalar @unsatisfied, join(',',@unsatisfied));
			push @pending, $e;
			next ITEM;
		}
		$self->create_table($e);
	}
	return $self;
}

sub remove_entity { shift->remove_table(@_) }

sub remove_table {
	my $self = shift;
	my $tbl = shift;
	logDebug("Remove table " . $tbl->name);
	$self->entity->remove(sub { $_[0]->name ne $tbl->name });
	return $self;
}

sub create_table {
	my $self = shift;
	my $tbl = shift;
	logDebug("Create table " . $tbl->name);
	$self->entity->push($tbl);
	return $self;
}

sub update_table {
	my $self = shift;
	my $src = shift;
	my ($e) = grep { $_->name eq $src->name } $self->entity->list;
	logDebug("Found table [%s] for [%s]", $e->name, $src->name);
	my $dst = $self->entity_map->get($src->name);
	logDebug("Update table [%s], dest has fields: [%s]", $src->name, join(',', map { $_->name // "undef" } $dst->field->list));
	my @add = grep { !$dst->field_map->get($_->name) } $src->field->list;
	logDebug("Want to add [%s]", join(',', map { $_->name } @add));
	$self->add_field_to_table($dst, $_) foreach @add;
	return $self;
}

=head2 add_field_to_table

=cut

sub add_field_to_table {
	my $self = shift;
	my $entity = shift;
	my $field = shift;
	$entity->field->push($field->clone);
	return $self;
}

sub handler_for {
	my $self = shift;
	my $name = shift;
	logDebug("Check for handlers for [%s] node", $name);
	return;
}

sub provide_handler_for {
	my $self = shift;
	my @args = @_;
	while(@args) {
		my $k = shift(@args);
		my $v = shift(@args);
		$self->handler->set($k, $v);
	}
	return $self;
}

sub handle_item {
	my $self = shift;
	my %args = @_;
	if(my $code = $self->handler->get($args{item})) {
		logDebug("Handling [%s] with plugin", $args{item});
		$code->($self, item => $args{item}, data => $args{data});
	} else {
		logError("No handler for [%s]", $args{item});
	}
	return $self;
}

sub flush {
	my $self = shift;
	$self->commit;
}

=head2 DESTROY