package SQL::Translator::Role::BuildArgs;
+
+=head1 NAME
+
+SQL::Translator::Role::BuildArgs - Remove undefined constructor arguments
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use Moo;
+ with qw(SQL::Translator::Role::BuildArgs);
+
+=head1 DESCRIPTION
+
+This L<Moo::Role> wraps BUILDARGS to remove C<undef> constructor
+arguments for backwards compatibility with the old L<Class::Base>-based
+L<SQL::Translator::Schema::Object>.
+
+=cut
+
use Moo::Role;
around BUILDARGS => sub {
package SQL::Translator::Role::Error;
+
+=head1 NAME
+
+SQL::Translator::Role::Error - Error setter/getter for objects and classes
+
+=head1 SYNOPSIS
+
+In the class consuming the role:
+
+ package Foo;
+ use Moo;
+ with qw(SQL::Translator::Role::Error);
+
+ sub foo {
+ ...
+ return $self->error("Something failed")
+ unless $some_condition;
+ ...
+ }
+
+In code using the class:
+
+ Foo->foo or die Foo->error;
+ # or
+ $foo->foo or die $foo->error;
+
+=head1 DESCRIPTION
+
+This L<Moo::Role> provides a method for getting and setting error on a
+class or object.
+
+=cut
+
use Moo::Role;
use Sub::Quote qw(quote_sub);
default => quote_sub(q{ '' }),
);
+=head1 METHODS
+
+=head2 $object_or_class->error([$message])
+
+If called with an argument, sets the error message and returns undef,
+otherwise returns the message.
+
+As an implementation detail, for compatibility with L<Class::Base>, the
+message is stored in C<< $object->{_ERROR} >> or C<< $Class::ERROR >>,
+depending on whether the invocant is an object.
+
+=cut
+
around error => sub {
my ($orig, $self) = (shift, shift);
return undef;
};
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<Class::Base/Error Handling>
+
+=back
+
+=cut
+
1;
package SQL::Translator::Role::ListAttr;
+
+=head1 NAME
+
+SQL::Translator::Role::ListAttr - context-sensitive list attributes
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use Moo;
+ use SQL::Translator::Role::ListAttr;
+
+ with ListAttr foo => ( uniq => 1, append => 1 );
+
+=head1 DESCRIPTION
+
+This package provides a variable L<Moo::Role> for context-sensitive list
+attributes.
+
+=cut
+
use strictures 1;
use SQL::Translator::Utils qw(parse_list_arg ex2err);
use List::MoreUtils qw(uniq);
subs => [qw(has around)],
);
+=head1 FUNCTIONS
+
+=head2 ListAttr $name => %parameters;
+
+Returns a L<Moo::Role> providing an arrayref attribute named C<$name>,
+and wrapping the accessor to provide context-sensitivity both for
+setting and getting. If no C<builder> or C<default> is provided, the
+default value is the empty list.
+
+On setting, the arguments are parsed using
+L<SQL::Translator::Utils/parse_list_arg>, and the accessor will return
+an array reference or a list, depending on context.
+
+=head3 Parameters
+
+=over
+
+=item append
+
+If true, the setter will append arguments to the existing ones, rather
+than replacing them.
+
+=item uniq
+
+If true, duplicate items will be removed, keeping the first one seen.
+
+=item may_throw
+
+If accessing the attribute might L<throw|SQL::Translator::Utils/throw>
+an exception (e.g. from a C<builder> or C<isa> check), this should be
+set to make the accessor store the exception using
+L<SQL::Translator::Role::Error> and return undef.
+
+=item undef_if_empty
+
+If true, and the list is empty, the accessor will return C<undef>
+instead of a reference to an empty in scalar context.
+
+=back
+
+Unknown parameters are passed through to the has call L<has|Moo/has> for
+the attribute.
+
+=cut
sub make_variant {
my ($class, $target_package, $name, %arguments) = @_;
});
}
+=head1 SEE ALSO
+
+=over
+
+=item L<SQL::Translator::Utils>
+
+=item L<SQL::Translator::Role::Error>
+
+=back
+
+=cut
+
1;
package SQL::Translator::Schema::Role::Compare;
-use Moo::Role;
-sub equals {
+=head1 NAME
+
+SQL::Translator::Schema::Role::Compare - compare objects
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use Moo;
+ with qw(SQL::Translator::Schema::Role::Compare);
+
+ $obj->equals($other);
+
+=head1 DESCRIPTION
-=pod
+This L<Moo::Role> provides a method to compare if two objects are the
+same.
+
+=cut
+
+use Moo::Role;
+
+=head1 METHODS
=head2 equals
=cut
+sub equals {
my $self = shift;
my $other = shift;
package SQL::Translator::Schema::Role::Extra;
+
+=head1 NAME
+
+SQL::Translator::Schema::Role::Extra - "extra" attribute for schema classes
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use Moo;
+ with qw(SQL::Translator::Schema::Role::Extra);
+
+=head1 DESCRIPTION
+
+This role provides methods to set and get a hashref of extra attributes
+for schema objects.
+
+=cut
+
use Moo::Role;
use Sub::Quote qw(quote_sub);
-=head1 Methods
-
-The following methods are defined here, therefore all schema objects
-using this role will have them.
+=head1 METHODS
=head2 extra
package SQL::Translator::Types;
+
+=head1 NAME
+
+SQL::Translator::Types - Type checking functions
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use Moo;
+ use SQL::Translator::Types qw(schema_obj);
+
+ has foo => ( is => 'rw', isa => schema_obj('Trigger') );
+
+=head1 DESCRIPTIONS
+
+This module exports fuctions that return coderefs suitable for L<Moo>
+C<isa> type checks.
+Errors are reported using L<SQL::Translator::Utils/throw>.
+
+=cut
+
use strictures 1;
use SQL::Translator::Utils qw(throw);
use Exporter qw(import);
our @EXPORT_OK = qw(schema_obj);
+=head1 FUNCTIONS
+
+=head2 schema_obj($type)
+
+Returns a coderef that checks that its arguments is an object of the
+class C<< SQL::Translator::Schema::I<$type> >>.
+
+=cut
+
sub schema_obj {
my ($class) = @_;
my $name = lc $class;
or 'native') transforms the string to the given target style.
to
+=head2 throw
+
+Throws the provided string as an object that will stringify back to the
+original string. This stops it from being mangled by L<Moo>'s C<isa>
+code.
+
+=head2 ex2err
+
+Wraps an attribute accessor to catch any exception raised using
+L</throw> and store them in C<< $self->error() >>, finally returning
+undef. A reference to this function can be passed directly to
+L<Moo/around>.
+
+ around foo => \&ex2err;
+
+ around bar => sub {
+ my ($orig, $self) = (shift, shift);
+ return ex2err($orig, $self, @_) if @_;
+ ...
+ };
+
=head1 AUTHORS
Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
projects / dbsrgits/SQL-Translator.git / commitdiff