Adapter-Async

 view release on metacpan or  search on metacpan

dist.ini  view on Meta::CPAN

; [PodCoverageTests]
; [Test::UnusedVars]
[Test::ReportPrereqs]
[SpellingCommonMistakesTests]
[Signature]
[CopyMakefilePLFromBuild]
[ArchiveRelease]
directory = /home/tom/dev/CPAN-Archive
;[Git::Check]
;allow_dirty = dist.ini
;changelog = Changes
[Git::Commit]
allow_dirty = dist.ini
allow_dirty = cpanfile
allow_dirty = Changes
allow_dirty = Makefile.PL
[Git::Tag]
tag_format = v%v
tag_message = Tag v%v for CPAN release
[ReversionOnRelease]
[InstallRelease]

lib/Adapter/Async/Model.pm  view on Meta::CPAN

  some_array => {
   collection => 'OrderedList',
   type => '::Thing',
  }
 };

Note that methods are applied via a UNITCHECK block by default.

=cut

use Log::Any qw($log);

use Future;

use Module::Load;
use Data::Dumper;
use Variable::Disposition qw(retain_future);

=head2 import

=over 4

lib/Adapter/Async/Model.pm  view on Meta::CPAN

	my @methods;
	for my $k (keys %$def) {
		my $details = $def->{$k};
		$details = { type => $details } unless ref $details;
		my $code;
		my %collection_class_for = (
			UnorderedMap => 'Adapter::Async::UnorderedMap::Hash',
			OrderedList  => 'Adapter::Async::OrderedList::Array',
		);
		if(defined(my $from = $details->{from})) {
			$log->tracef("Should apply field %s from %s for %s", $k, $from, $pkg);
			++$loader{$_} for grep /::/, map $type_expand->($_), @{$details}{qw(type)};
		} else {
			no strict 'refs';
			no warnings 'once';
			push @{$pkg . '::attrs'}, $k unless $details->{collection}
		}

		if(my $type = $details->{collection}) {
			my $collection_class = $collection_class_for{$type} // die "unknown collection $type";
			++$loader{$collection_class};
			$log->tracef("%s->%s collection: %s", $pkg, $k, $type);
			++$loader{$_} for grep /::/, map $type_expand->($_), @{$details}{qw(key item)};
			$code = sub {
				my $self = shift;
				die "no args expected" if @_;
				$self->{$k} //= $collection_class->new;
			}
		} else {
			my $type = $type_expand->($details->{type} // die "unknown type in package $pkg - " . Dumper($def));
			++$loader{$type} if $type =~ /::/;

			$log->tracef("%s->%s scalar %s", $pkg, $k, $type);
			$code = sub {
				my ($self) = shift;
				return $self->{$k} unless @_;
				$self->{$k} = shift;
				return $self
			}
		}

		push @methods, $k => $code;
	}

lib/Adapter/Async/Model.pm  view on Meta::CPAN

		$self
	};
	push @methods, get_or_create => sub {
		my ($self, $type, $v, $create) = @_;
		return Future->done($v) if ref $v;
		retain_future(
			$self->$type->exists($v)->then(sub {
				return $self->$type->get_key($v) if shift;

				my $item = $create->($v);
				$log->tracef("Set %s on %s for %s to %s via %s", $v, $type, "$self", $item, ''.$self->$type);
				$self->$type->set_key(
					$v => $item
				)->transform(
					done => sub { $item }
				)
			})
		)
	};

	for(sort keys %loader) {
		$log->tracef("Loading %s for %s", $_, $pkg);
		Module::Load::load($_) unless exists($defined{$_}) || $_->can('new')
	}

	my $apply_methods = sub {
		while(my ($k, $code) = splice @methods, 0, 2) {
			no strict 'refs';
			if($pkg->can($k)) {
				$log->tracef("Not creating method %s for %s since it exists already", $k, $pkg);
			} else {
				*{$pkg . '::' . $k} = $code;
			}
		}
	};

	if($args{defer_methods}) {
		require Check::UnitCheck;
		Check::UnitCheck::unitcheckify($apply_methods);
	} else {