DBIx-Class-Helpers-2.035000/0000775000175000017500000000000013624003631013664 5ustar frewfrewDBIx-Class-Helpers-2.035000/inc/0000775000175000017500000000000013624003631014435 5ustar frewfrewDBIx-Class-Helpers-2.035000/inc/Dist/0000775000175000017500000000000013624003631015340 5ustar frewfrewDBIx-Class-Helpers-2.035000/inc/Dist/Zilla/0000775000175000017500000000000013624003631016413 5ustar frewfrewDBIx-Class-Helpers-2.035000/inc/Dist/Zilla/Plugin/0000775000175000017500000000000013624003631017651 5ustar frewfrewDBIx-Class-Helpers-2.035000/inc/Dist/Zilla/Plugin/DBICSgen.pm0000644000175000017500000000265213624003631021530 0ustar frewfrewpackage Dist::Zilla::Plugin::DBICSgen; use strict; use warnings; # ABSTRACT: common tests to check syntax of your modules use Moose; use Module::Runtime 'use_module'; require lib; with 'Dist::Zilla::Role::FileGatherer'; has schema => ( is => 'ro', isa => 'Str', required => 1, ); has lib => ( is => 'rw' ); unlink $_ for glob 't/lib/*.sql'; sub gather_files { my $self = shift; lib->import(split q(,), $self->lib); my $schema = $self->schema; use_module($schema); $schema->generate_ddl; $self->add_file( Dist::Zilla::File::OnDisk->new(name => $_)) for glob 't/lib/*.sql'; } no Moose; __PACKAGE__->meta->make_immutable; 1; =begin Pod::Coverage gather_files mvp_multivalue_args =end Pod::Coverage =head1 SYNOPSIS In your dist.ini: [CompileTests] skip = Test$ =head1 DESCRIPTION This is an extension of L, providing the following files: =over 4 =item * t/00-compile.t - a standard test to check syntax of bundled modules This test will find all modules and scripts in your dist, and try to compile them one by one. This means it's a bit slower than loading them all at once, but it will catch more errors. =back This plugin accepts the following options: =over 4 =item * skip: a regex to skip compile test for modules matching it. The match is done against the module name (C), not the file path (F). =back DBIx-Class-Helpers-2.035000/lib/0000775000175000017500000000000013624003631014432 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/0000775000175000017500000000000013624003631015220 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/0000775000175000017500000000000013624003631016265 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/0000775000175000017500000000000013624003631017504 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/0000775000175000017500000000000013624003631020704 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/GenerateSource.pm0000644000175000017500000000440313624003631024154 0ustar frewfrewpackage DBIx::Class::Helper::Schema::GenerateSource; $DBIx::Class::Helper::Schema::GenerateSource::VERSION = '2.035000'; # ABSTRACT: Generate sources directly from your Schema use strict; use warnings; use parent 'DBIx::Class::Schema'; use Scalar::Util 'blessed'; sub _schema_class { blessed($_[0]) || $_[0] } sub _generate_class_name { $_[0]->_schema_class . '::GeneratedResult::__' . uc $_[1] } sub _generate_class { die $@ unless eval " package $_[1]; use parent '$_[2]'; __PACKAGE__->table(__PACKAGE__->table); 1; "; } sub generate_source { my ($self, $moniker, $base) = @_; my $class = $self->_generate_class_name($moniker); $self->_generate_class($class, $base); $self->register_class($moniker, $class); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Schema::GenerateSource - Generate sources directly from your Schema =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::GenerateSource'); __PACKAGE__->generate_source(User => 'MyCompany::BaseResult::User'); =head1 DESCRIPTION This helper allows you to handily and correctly add new result sources to your schema based on existing result sources. Typically this would be done with something like: package MyApp::Schema::Result::MessegeQueue; use parent 'MyCo::Schema::Result::MessageQueue'; __PACKAGE__->table(__PACKAGE__->table); 1; which clearly is in its own file. This should still be done when you need to add columns or really do B other than just basic addition of the result source to your schema. B: This component correctly generates an "anonymous" subclass of the given base class. Do not depend on the name of the subclass as it is currently considered unstable. =head1 METHODS =head2 generate_source $schema->generate_source(User => 'MyCompany::BaseResult::User') The first argument to C is the C to register the class as, the second argument is the base class for the new result source. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/LintContents.pm0000644000175000017500000001476013624003631023674 0ustar frewfrewpackage DBIx::Class::Helper::Schema::LintContents; $DBIx::Class::Helper::Schema::LintContents::VERSION = '2.035000'; # ABSTRACT: suite of methods to find violated "constraints" use strict; use warnings; use parent 'DBIx::Class::Schema'; use Scalar::Util 'blessed'; sub null_check_source { my ($self, $source_name, $non_nullable_columns) = @_; return $self->resultset($source_name)->search({ -or => [ map +{ $_ => undef }, @$non_nullable_columns, ], }) } sub null_check_source_auto { my ($self, $source_name) = @_; my %ci = %{ $self->source($source_name)->columns_info }; $self->null_check_source($source_name, [grep { !$ci{$_}->{is_nullable} } keys %ci]); } sub dup_check_source { my ($self, $source, $unique_columns) = @_; $self->resultset($source)->search(undef, { columns => $unique_columns, group_by => $unique_columns, having => \'count(*) > 1', }) } sub dup_check_source_auto { my ($self, $source) = @_; my %uc = $self->source($source)->unique_constraints; return { map { $_ => scalar $self->dup_check_source($source, $uc{$_}) } keys %uc } } sub _fk_cond_fixer { my ($self, $cond) = @_; return { map { my $k = $_; my $v = $cond->{$_}; $_ =~ s/^(self|foreign)\.// for $k, $v; ($v => $k) } keys %$cond } } sub fk_check_source_auto { my ($self, $from_moniker) = @_; my $from_source = $self->source($from_moniker); my %rels = map { $_ => $from_source->relationship_info($_) } $from_source->relationships; return { map { $_ => scalar $self->fk_check_source( $from_moniker, $from_source->related_source($_), $self->_fk_cond_fixer($rels{$_}->{cond}) ) } grep { my %r = %{$rels{$_}}; ref $r{cond} eq 'HASH' && ($r{attrs}{is_foreign_rel} || $r{attrs}{is_foreign_key_constraint}) } keys %rels } } sub fk_check_source { my ($self, $source_from, $source_to, $columns) = @_; my $to_rs = blessed $source_to ? $source_to->resultset : $self->resultset($source_to) ; my $me = $self->resultset($source_from)->current_source_alias; $self->resultset($source_from)->search({ -not_exists => $to_rs ->search({ map +( "self.$_" => { -ident => "other.$columns->{$_}" } ), keys %$columns }, { alias => 'other', })->as_query, }, { alias => 'self', }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Schema::LintContents - suite of methods to find violated "constraints" =head1 SYNOPSIS package MyApp::Schema; use parent 'DBIx::Class::Schema'; __PACKAGE__->load_components('Helper::Schema::LintContents'); 1; And later, somewhere else: say "Incorrectly Null Users:"; for ($schema->null_check_source_auto('User')->all) { say '* ' . $_->id } say "Duplicate Users:"; my $duplicates = $schema->dup_check_source_auto('User'); for (keys %$duplicates) { say "Constraint: $_"; for ($duplicates->{$_}->all) { say '* ' . $_->id } } say "Users with invalid FK's:"; my $invalid_fks = $schema->fk_check_source_auto('User'); for (keys %$invalid_fks) { say "Rel: $_"; for ($invalid_fks->{$_}->all) { say '* ' . $_->id } } =head1 DESCRIPTION Some people think that constraints make their databases slower. As silly as that is, I have been in a similar situation! I'm here to help you, dear developers! Basically this is a suite of methods that allow you to find violated "constraints." To be clear, the constraints I mean are the ones you tell L about, real constraints are fairly sure to be followed. =head1 METHODS =head2 fk_check_source my $busted = $schema->fk_check_source( 'User', 'Group', { group_id => 'id' }, ); C takes three arguments, the first is the B source moniker of a relationship. The second is the B source or source moniker of a relationship. The final argument is a hash reference representing the columns of the relationship. The return value is a resultset of the B source that do not have a corresponding B row. To be clear, the example given above would return a resultset of C rows that have a C that points to a C that does not exist. =head2 fk_check_source_auto my $broken = $schema->fk_check_source_auto('User'); C takes a single argument: the source to check. It will check all the foreign key (that is, C) relationships for missing... C rows. The return value will be a hashref where the keys are the relationship name and the values are resultsets of the respective violated relationship. =head2 dup_check_source my $smashed = $schema->fk_check_source( 'Group', ['id'] ); C takes two arguments, the first is the source moniker to be checked. The second is an arrayref of columns that "should be" unique. The return value is a resultset of the source that duplicate the passed columns. So with the example above the resultset would return all groups that are "duplicates" of other groups based on C. =head2 dup_check_source_auto my $ruined = $schema->dup_check_source_auto('Group'); C takes a single argument, which is the name of the resultsource in which to check for duplicates. It will return a hashref where they keys are the names of the unique constraints to be checked. The values will be resultsets of the respective duplicate rows. =head2 null_check_source my $blarg = $schema->null_check_source('Group', ['id']); C tales two arguments, the first is the name of the source to check. The second is an arrayref of columns that should contain no nulls. The return value is simply a resultset of rows that contain nulls where they shouldn't be. =head2 null_check_source_auto my $wrecked = $schema->null_check_source_auto('Group'); C takes a single argument, which is the name of the resultsource in which to check for nulls. The return value is simply a resultset of rows that contain nulls where they shouldn't be. This method automatically uses the configured columns that have C set to false. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/Verifier/0000775000175000017500000000000013624003631022457 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/Verifier/RelationshipColumnName.pm0000644000175000017500000000402213624003631027431 0ustar frewfrewpackage DBIx::Class::Helper::Schema::Verifier::RelationshipColumnName; $DBIx::Class::Helper::Schema::Verifier::RelationshipColumnName::VERSION = '2.035000'; # ABSTRACT: Verify that relationships and column names are distinct use strict; use warnings; use MRO::Compat; use mro 'c3'; use base 'DBIx::Class::Helper::Schema::Verifier'; sub result_verifiers { ( sub { my ($s, $result) = @_; my @columns = $result->columns; my %relationships = map { $_ => 1 } $result->relationships; my @mistakes = grep { $relationships{$_} } @columns; my $exp = 'See DBIx::Class::Helper::Schema::Verifier::RelationshipColumnName for more details'; if (@mistakes == 1) { die "$result has a relationship name that is the same as a column name: @mistakes, $exp" } elsif (@mistakes) { die "$result has relationship names that are the same as column names: @mistakes, $exp" } }, shift->next::method, ) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Schema::Verifier::RelationshipColumnName - Verify that relationships and column names are distinct =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::Verifier::RelationshipColumnName'); =head1 DESCRIPTION C verifies that none of your columns have the same name as a relationship. If you create a relationship that has the same name as a column, to access the column you will be forced to use C, additionally it is just confusing having them be the same name. What I tend to do is define the columns to be something like C and have the relationship then be simply C. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/Verifier/ColumnInfo.pm0000644000175000017500000000644013624003631025070 0ustar frewfrewpackage DBIx::Class::Helper::Schema::Verifier::ColumnInfo; $DBIx::Class::Helper::Schema::Verifier::ColumnInfo::VERSION = '2.035000'; # ABSTRACT: Verify that Results only use approved column_info keys use strict; use warnings; use MRO::Compat; use mro 'c3'; use base 'DBIx::Class::Helper::Schema::Verifier'; my @allowed_keys = ( # defaults from ::ResultSource qw( accessor auto_nextval data_type default_value extra is_auto_increment is_foreign_key is_nullable is_numeric retrieve_on_insert sequence size ), # ::InflateColumn::DateTime qw( floating_tz_ok inflate_datetime locale timezone ), # ::InflateColumn::File and ::InflateColumn::FS qw( file_column_path fs_column_path fs_new_on_update is_file_column is_fs_column ), # ::Helpers qw( is_serializable keep_storage_value remove_column ) ); sub allowed_column_keys { @allowed_keys } sub result_verifiers { my $self = shift; my %allowed = map { $_ => 1 } $self->allowed_column_keys; ( sub { my ($s, $result, $set) = @_; my $column_info = $result->columns_info; for my $col_name (keys %$column_info) { for my $key (keys %{ $column_info->{$col_name} }) { if (!$allowed{$key}) { die sprintf join(' ', qw(Forbidden column config <%s> used in column <%s> in result <%s>. You can explicitly allow it by adding it to your schema's allowed_column_keys method.)), $key, $col_name, $result; } } } }, $self->next::method, ) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Schema::Verifier::ColumnInfo - Verify that Results only use approved column_info keys =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::Verifier::ColumnInfo'); # optionally add some non-standard allowed keys sub allowed_column_keys { my $self = shift; my @keys = $self->next::method; push @keys, qw(is_serializable keep_storage_value remove_column); return @keys; } =head1 DESCRIPTION C verifies that none of your columns use non-approved configuration keys. L doesn't do any key verification, so this Helper makes sure you don't get burned by a typo like using C instead of C. If your schema uses a non-approved column config key, it will refuse to load and instead offer a hopefully helpful message pointing out the error. =head1 METHODS =head2 allowed_column_keys() It's entirely possible that you would like to use some non-default config keys, especially if you use some column-extension components. Override this method in your schema and append your new keys to the list returned by the superclass call. The overridden method must return a list of keys. sub allowed_column_keys { my $self = shift; my @keys = $self->next::method; # modify @keys as needed return @keys; } =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/Verifier/Parent.pm0000644000175000017500000000310713624003631024245 0ustar frewfrewpackage DBIx::Class::Helper::Schema::Verifier::Parent; $DBIx::Class::Helper::Schema::Verifier::Parent::VERSION = '2.035000'; # ABSTRACT: Verify that the Results and ResultSets have the correct base class use strict; use warnings; use MRO::Compat; use mro 'c3'; use base 'DBIx::Class::Helper::Schema::Verifier'; sub result_verifiers { ( sub { my ($s, $result, $set) = @_; my $base_result = $s->base_result; my $base_set = $s->base_resultset; die "$result is not a $base_result" unless $result->isa($base_result); die "$set is not a $base_set" unless $set->isa($base_set); }, shift->next::method, ) } sub base_result { 'DBIx::Class::Core' } sub base_resultset { 'DBIx::Class::ResultSet' } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Schema::Verifier::Parent - Verify that the Results and ResultSets have the correct base class =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::Verifier::Parent'); sub base_result { 'MyApp::Schema::Result' } sub base_resultset { 'MyApp::Schema::ResultSet' } =head1 DESCRIPTION C verifies that all of your results and resultsets use the base class that you specify. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/Verifier/C3.pm0000644000175000017500000000271013624003631023260 0ustar frewfrewpackage DBIx::Class::Helper::Schema::Verifier::C3; $DBIx::Class::Helper::Schema::Verifier::C3::VERSION = '2.035000'; # ABSTRACT: Verify that the Results and ResultSets of your Schemata use c3 use strict; use warnings; use MRO::Compat; use mro 'c3'; use base 'DBIx::Class::Helper::Schema::Verifier'; sub result_verifiers { ( sub { my ($s, $result, $set) = @_; for ($result, $set) { my $mro = mro::get_mro($_); die "$_ does not use c3, it uses $mro" unless $mro eq 'c3'; } }, shift->next::method, ) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Schema::Verifier::C3 - Verify that the Results and ResultSets of your Schemata use c3 =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::Verifier::C3'); =head1 DESCRIPTION C verifies that all of your results and resultsets use the C C. If you didn't know this was important L. Note: this will probably fail on your schema because L does not use C. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/QuoteNames.pm0000644000175000017500000000203513624003631023321 0ustar frewfrewpackage DBIx::Class::Helper::Schema::QuoteNames; $DBIx::Class::Helper::Schema::QuoteNames::VERSION = '2.035000'; # ABSTRACT: force C on use strict; use warnings; use parent 'DBIx::Class::Schema'; use DBIx::Class::Helpers::Util 'normalize_connect_info'; sub connection { my $self = shift; my $args = normalize_connect_info(@_); $args->{quote_names} = 1; $self->next::method($args) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Schema::QuoteNames - force C on =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::QuoteNames'); =head1 DESCRIPTION This helper merely forces C on, no matter how your settings are configured. You should use it. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/DidYouMean.pm0000644000175000017500000000362313624003631023242 0ustar frewfrewpackage DBIx::Class::Helper::Schema::DidYouMean; $DBIx::Class::Helper::Schema::DidYouMean::VERSION = '2.035000'; # ABSTRACT: Nice error messages when you misspell the name of a ResultSet use strict; use warnings; use parent 'DBIx::Class::Schema'; use Text::Brew 'distance'; use Try::Tiny; use namespace::clean; sub source { my ($self, @rest) = @_; my $method = $self->next::can; try { $self->$method(@rest) } catch { if (m/Can't find source for (.+?) at/) { my @presentsources = map { (distance($_, $1))[0] < 3 ? " * $_ <-- Possible Match\n" : " $_\n"; } sort $self->storage->schema->sources; die <<"ERR"; $_ The ResultSet "$1" is not part of your schema. To help you debug this issue, here's a list of the actual sources that the schema knows about: @presentsources ERR } die $_; } } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Schema::DidYouMean - Nice error messages when you misspell the name of a ResultSet =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::DidYouMean'); Elsewhere: $schema->resultset('Usre')->search(...)->... And a nice exception gets thrown: The ResultSet "Usre" is not part of your schema. To help you debug this issue, here's a list of the actual sources that the schema knows about: Account Permission Role * User <-- Possible Match =head1 DESCRIPTION This helper captures errors thrown when you use the C method on your schema and typo the source name. It tries to highlight the best guess as to which you meant to type. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/Verifier.pm0000644000175000017500000000604013624003631023013 0ustar frewfrewpackage DBIx::Class::Helper::Schema::Verifier; $DBIx::Class::Helper::Schema::Verifier::VERSION = '2.035000'; # ABSTRACT: Verify the Results and ResultSets of your Schemata use strict; use warnings; use MRO::Compat; use mro 'c3'; use Try::Tiny; use namespace::clean; use base 'DBIx::Class::Schema'; sub result_verifiers { return () } our $_FATAL = 1; our @_ERRORS; sub register_source { my ($self, $name, $rclass) = @_; unless ($_FATAL) { $self->$_($rclass->result_class, $rclass->resultset_class) for $self->result_verifiers; } else { for ($self->result_verifiers) { try { $self->$_($rclass->result_class, $rclass->resultset_class) } catch { push @_ERRORS, $_ } } } $self->next::method($name, $rclass); } sub load_namespaces { local $_FATAL = 1; shift->next::method(@_); my @e = @_ERRORS; @_ERRORS = (); die sort @e if @e; } sub load_classes { local $_FATAL = 1; shift->next::method(@_); my @e = @_ERRORS; @_ERRORS = (); die sort @e if @e; } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Schema::Verifier - Verify the Results and ResultSets of your Schemata =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::Verifier'); sub result_verifiers { ( sub { my ($self, $result, $set) = @_; for ($result, $set) { die "$_ does not start with the letter A" unless m/^A/ } }, shift->next::method, ) } =head1 DESCRIPTION C is a minuscule framework to assist in creating schemata that are to your very own exacting specifications. It is inspired by my own travails in discovering that C<< use mro 'c3' >> is both required and barely documented in much Perl code. As time goes by I expect to add many more verifiers, but with this inaugural release I am merely including L. =head1 INTERFACE METHODS =head2 result_verifiers You must implement C in your subclass of C<::Verifier>. Each verifier gets called on the schema and gets each result and resultset together as arguments. You can use this to validate almost anything about the results and resultsets of a schema; contributions are warmly welcomed. =head1 MORE ERRORS Initially I kept this module simple, but after using it in production at L I found that showing the user the first error that occurred and then giving up was pretty annoying. Now C wraps both L and L and shows all the exceptions encoutered as a list at the end of loading all the results. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Schema/DateTime.pm0000644000175000017500000000177213624003631022743 0ustar frewfrewpackage DBIx::Class::Helper::Schema::DateTime; $DBIx::Class::Helper::Schema::DateTime::VERSION = '2.035000'; # ABSTRACT: DateTime helper use strict; use warnings; use parent 'DBIx::Class::Schema'; sub datetime_parser { return shift->storage->datetime_parser } sub parse_datetime { return shift->datetime_parser->parse_datetime(@_) } sub format_datetime { return shift->datetime_parser->format_datetime(@_) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Schema::DateTime - DateTime helper =head1 SYNOPSIS package MyApp::Schema; __PACKAGE__->load_components('Helper::Schema::DateTime'); ... $schema->resultset('Book')->search({ written_on => $schema->format_datetime(DateTime->now) }); =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultClass/0000775000175000017500000000000013624003631021750 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultClass/Tee.pm0000644000175000017500000000455513624003631023032 0ustar frewfrewpackage DBIx::Class::Helper::ResultClass::Tee; $DBIx::Class::Helper::ResultClass::Tee::VERSION = '2.035000'; # ABSTRACT: Inflate to multiple result classes at the same time use utf8; use Moo; use Module::Runtime 'use_module'; use Scalar::Util 'blessed'; has inner_classes => ( is => 'ro', required => 1, coerce => sub { [ map { s/^::/DBIx::Class::ResultClass::/; s/::HRI$/::HashRefInflator/; $_ } @{$_[0]} ] }, ); sub inflate_result { my ($self, @rest) = @_; [ map scalar use_module($_)->inflate_result(@rest), @{$self->inner_classes} ] } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultClass::Tee - Inflate to multiple result classes at the same time =head1 SYNOPSIS my ($hashref, $obj) = $rs->search(undef, { result_class => DBIx::Class::Helper::ResultClass::Tee->new( inner_classes => [ '::HRI', 'MyApp::Schema::Result::User'], ), })->first->@*; (If you've never seen C<< ->@* >> before, check out L, added in Perl v5.20!) =head1 DESCRIPTION This result class has one obvious use case: when you have prefetched data and L is the simplest way to access all the data, but you still want to use some of the methods on your existing result class. =encoding UTF-8 The other important I of this module is that it is an example of how to make a "parameterized" result class. It's almost a secret that L supports using objects to inflate results. This is an incredibly powerful feature that can be used to make consistent interfaces to do all kinds of things. Once when I was at Micro Technology Services, Inc. I used it to efficiently do a "reverse synthetic, LIKE-ish join". The "relationship" was basically C<< foreign.name =~ self.name >>, which cannot actually be done if you want to go from within the database, but if you are able to load the entire foreign table into memory this can be done on-demand, and cached within the result class for (in our case) the duration of a request. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/IgnoreWantarray.pm0000644000175000017500000000213213624003631023152 0ustar frewfrewpackage DBIx::Class::Helper::IgnoreWantarray; $DBIx::Class::Helper::IgnoreWantarray::VERSION = '2.035000'; use parent 'DBIx::Class::Helper::ResultSet::IgnoreWantarray'; use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Get rid of search context issues 1; __END__ =pod =head1 NAME DBIx::Class::Helper::IgnoreWantarray - (DEPRECATED) Get rid of search context issues =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/0000775000175000017500000000000013624003631021436 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/DateMethods1/0000775000175000017500000000000013624003631023720 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/DateMethods1/Announcement.pod0000644000175000017500000001410113624003631027051 0ustar frewfrew# PODNAME: DBIx::Class::Helper::ResultSet::DateMethods1::Announce # ABSTRACT: Original Announcement of DBIx::Class::Helper::ResultSet::DateMethods1 __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::DateMethods1::Announce - Original Announcement of DBIx::Class::Helper::ResultSet::DateMethods1 =head1 Content L I got inspired while on vacation to Crested Butte, CO and started a branch in DBIC called merely, "date-ops." The idea was to allow users to call various date functions, portably, directly in DBIC. With some help from some people who use other databases, I got it working with SQL Server, SQLite, PostgreSQL, MySQL, and Oracle. Unfortunately after we finished it ( L ) it merely languished. There were some technical issues we never got around to ironing out, mostly because it wasn't clear to us what the cost of not taking care of them would be. Fast forward a few more months and I was working on a greenfield project at work. I wanted to do some date math in the database, so far I did all of my development against SQLite but deployed to SQL Server, and it looked like the date ops were my solution. I decided that given that I was the primary author of them, I could live with deploying them to production. I did exactly that and had pretty much no problems. Well, no problems until I had to upgrade DBIC. Every time I needed to upgrade DBIC I had to merge/rebase the branch. It turned out to be much more work than I bargained for, and I ended up just never updating DBIC. At some point ( L ) I decided that I needed to upgrade DBIC and that maintaining these date ops was no longer tenable. Armed with three more years of experience than I had when I started I embarked on converting the date ops to date methods, that would work as Helpers. In addition to not being core, so I could release at my own pace, I could also version the API, so if I end up making some critical mistakes or needing to break the API for some features in the future, I can merely release C<::DateMethods2>. So without further ado: =head1 Announcing C Do you store dates in your database? Do you ever want to manipulate them efficiently? Well here's your solution! First, how do you search in a more comprehensible way? $rs->dt_on_or_before( { -ident => '.when_created' }, DateTime->now->subtract(days => 7), ); C (as well as C, C, or C) merely aliases C<< <= >>, C<< < >>, C<< >= >>, and C<< > >>, respectively. Instead of trying to think about the numerical meaning of a date on a timeline, just use these named methods. In addition to the nicer name, they can take L object (which are automatically converted to UTC), and autoprepend L when passed an C<-ident> that starts with a C<.>. You can pass any of a value, a column (via C<-ident>), a subquery, literal sql, or a C object to either parameter slots of these methods. Second, how do I really leverage this module to do stuff with dates in my database? Here's a query I originally wrote with date ops. Basically it groups some columns by some "date parts" like year, month, day, etc. You can use it to make nice reports of things like how many things have been done per month, or maybe find out if the system is more busy in the summer: $rs->search(undef, { columns => { count => '*', year => $rs->dt_SQL_pluck({ -ident => '.start' }, 'year'), month => $rs->dt_SQL_pluck({ -ident => '.start' }, 'month'), }, group_by => [ $rs->dt_SQL_pluck({ -ident => '.start' }, 'year'), $rs->dt_SQL_pluck({ -ident => '.start' }, 'month'), ], )->hri->all I use that exact query (though I give the user a UI for which dateparts to include) in my system, and it works on SQL Server and SQLite, and it's fast. Awesome. Or how about a query to discover how many issues were resolved before the next full day after their creation? Check it out: # note that 'day', 1 should also work $rs->dt_before( { -ident => '.resolution' }, $rs->dt_SQL_add({ -ident => '.creation' }, 'hour', 24), )->all Both of the above queries work on all of the supported datebases! Third, some little helpers to extend the above. On top of those things, I also throw in a couple other handy methods. One, C converts a DateTime object to a string, in the UTC timezone. Hopefully you shouldn't need it directly, but I've already ended up using it in places where our code forced me to return a simple hash to get merged into a search query, instead of letting me call methods on an RS. Another lagniappe is C which returns some literal sql that resolves to the current date and time in UTC on your database. You can pass it in to search just like you would datetime. So if your server and your database have in sync clocks, these would do the same thing: $rs->dt_on_or_before( { -ident => '.when_created' }, DateTime->now->subtract(days => 7), ); $rs->dt_on_or_before( { -ident => '.when_created' }, $rs->dt_SQL_add($rs->utc->now, 'day', -7), ); (NOTE: many people seem to hold suspect the idea that the clock is correct on a given server. If you can't trust the clock of a server, you probably can't trust the server. Use NTP.) And that's it. I hope you can use and enjoy these helpers! =head1 SEE ALSO L =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/CorrelateRelationship.pm0000644000175000017500000001222013624003631026271 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::CorrelateRelationship; $DBIx::Class::Helper::ResultSet::CorrelateRelationship::VERSION = '2.035000'; # ABSTRACT: Easily correlate your ResultSets use strict; use warnings; use DBIx::Class::Helper::ResultSet::Util correlate => { -as => 'corr' }; sub correlate { corr(@_) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::CorrelateRelationship - Easily correlate your ResultSets =head1 SYNOPSIS package MyApp::Schema::ResultSet::Author; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw(Helper::ResultSet::CorrelateRelationship)); sub with_book_count { my $self = shift; $self->search(undef, { '+columns' => { book_count => $self->correlate('books')->count_rs->as_query } }); } 1; And then elsewhere, like in a controller: my $rows = $schema->resultset('Author')->with_book_count->all; =head1 DESCRIPTION Correlated queries are one of the coolest things I've learned about for SQL since my initial learning of SQL. Unfortunately they are somewhat confusing. L has supported doing them for a long time, but generally people don't think of them because they are so rare. I won't go through all the details of how they work and cool things you can do with them, but here are a couple high level things you can use them for to save you time or effort. If you want to select a list of authors and counts of books for each author, you B use C and something like C, but then you'd need to make your select list match your C and it would just be a hassle forever after that. The L is a perfect example of how to implement this. If you want to select a list of authors and two separate kinds of counts of books for each author, as far as I know, you B use a correlated subquery in L. Here is an example of how you might do that: package MyApp::Schema::ResultSet::Author; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw(Helper::ResultSet::CorrelateRelationship)); sub with_good_book_count { my $self = shift; $self->search(undef, { '+columns' => { good_book_count => $self->correlate('books')->good->count_rs->as_query } }); } sub with_bad_book_count { my $self = shift; $self->search(undef, { '+columns' => { bad_book_count => $self->correlate('books')->bad->count_rs->as_query } }); } 1; And then elsewhere, like in a controller: my $rows = $schema->resultset('Author') ->with_bad_book_count ->with_good_book_count ->all; This assumes that the Book resultset has C and C methods. See L for a nice way to apply it to your entire schema. =head1 METHODS =head2 correlate $rs->correlate($relationship_name) Correlate takes a single argument, a relationship for the invocant, and returns a resultset that can be used in the selector list. =head1 EXAMPLES =head2 counting CD's and Tracks of Artists If you had an Artist ResultSet and you wanted to count the tracks and CD's per Artist, here is a recipe that will work: sub with_track_count { my $self = shift; $self->search(undef, { '+columns' => { track_count => $self->correlate('cds') ->related_resultset('tracks') ->count_rs ->as_query } }); } sub with_cd_count { my $self = shift; $self->search(undef, { '+columns' => { cd_count => $self->correlate('cds') ->count_rs ->as_query } }); } # elsewhere my @artists = $artists->with_cd_count->with_track_count->all; Note that the following will B work: sub BUSTED_with_track_count { my $self = shift; $self->search(undef, { '+columns' => { track_count => $self->related_resultset('cds') ->correlate('tracks') ->count_rs ->as_query } }); } The above is broken because C returns a fresh resultset that will only work as a subquery to the ResultSet it was chained off of. The upshot of that is that the above C relationship is on the C ResultSet, whereas the query is for the Artist ResultSet, so the correlation will be "broken" by effectively "joining" to columns that are not in the current scope. For the same reason, the following will also not work: sub BUSTED2_with_track_count { my $self = shift; $self->search(undef, { '+columns' => { track_count => $self->correlate('cds') ->correlate('tracks') ->count_rs ->as_query } }); } =head1 SEE ALSO =over =item * L =item * L =back =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/AutoRemoveColumns.pm0000644000175000017500000000662313624003631025430 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::AutoRemoveColumns; $DBIx::Class::Helper::ResultSet::AutoRemoveColumns::VERSION = '2.035000'; # ABSTRACT: Automatically remove columns from a ResultSet use strict; use warnings; use parent 'DBIx::Class::Helper::ResultSet::RemoveColumns', 'DBIx::Class::ResultSet'; __PACKAGE__->mk_group_accessors(inherited => '_fetchable_columns'); my %dont_fetch = ( text => 1, ntext => 1, blob => 1, clob => 1, bytea => 1, ); sub _should_column_fetch { my ( $self, $column ) = @_; my $info = $self->result_source->column_info($column); if (!defined $info->{remove_column}) { if (defined $info->{data_type} && $dont_fetch{lc $info->{data_type}} ) { $info->{remove_column} = 1; } else { $info->{remove_column} = 0; } } return $info->{remove_column}; } sub fetchable_columns { my $self = shift; if (!$self->_fetchable_columns) { $self->_fetchable_columns([ grep $self->_should_column_fetch($_), $self->result_source->columns ]); } return $self->_fetchable_columns; } sub _resolved_attrs { local $_[0]->{attrs}{remove_columns} = $_[0]->{attrs}{remove_columns} || $_[0]->fetchable_columns; return $_[0]->next::method; } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::AutoRemoveColumns - Automatically remove columns from a ResultSet =head1 SYNOPSIS package MySchema::Result::Bar; use strict; use warnings; use parent 'DBIx::Class::Core'; __PACKAGE__->table('KittenRobot'); __PACKAGE__->add_columns( id => { data_type => 'integer', is_auto_increment => 1, }, kitten => { data_type => 'integer', }, robot => { data_type => 'text', is_nullable => 1, }, your_mom => { data_type => 'blob', is_nullable => 1, remove_column => 0, }, ); 1; package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::AutoRemoveColumns'); =head1 DESCRIPTION This component automatically removes "heavy-weight" columns. To be specific, columns of type C, C, C, C, or C. You may use the C key in the column info to specify directly whether or not to remove the column automatically. See L for a nice way to apply it to your entire schema. =head1 METHODS =head2 _should_column_fetch $self->_should_column_fetch('kitten') returns true if a column should be fetched or not. This fetches a column if it is not of type C, C, C, C, or C or the C is set to true. If you only wanted to explicitly state which columns to remove you might override this method like this: sub _should_column_fetch { my ( $self, $column ) = @_; my $info = $self->column_info($column); return !defined $info->{remove_column} || $info->{remove_column}; } =head2 fetchable_columns simply returns a list of columns that are fetchable. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/ResultClassDWIM.pm0000644000175000017500000000323413624003631024721 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::ResultClassDWIM; $DBIx::Class::Helper::ResultSet::ResultClassDWIM::VERSION = '2.035000'; # ABSTRACT: result_class => '::HRI' == WIN use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub result_class { my ($self, $result_class) = @_; return $self->next::method unless defined $result_class; if (!ref $result_class) { if ($result_class eq '::HRI') { $result_class = 'DBIx::Class::ResultClass::HashRefInflator' } else { $result_class =~ s/^::/DBIx::Class::ResultClass::/; } } $self->next::method($result_class); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::ResultClassDWIM - result_class => '::HRI' == WIN =head1 SYNOPSIS package MyApp::Schema::ResultSet::Foo; __PACKAGE__->load_components(qw{Helper::ResultSet::ResultClassDWIM}); ... 1; And then elsewhere: my $data = $schema->resultset('Foo')->search({ name => 'frew' }, { result_class => '::HRI' })->all; =head1 DESCRIPTION This component allows you to prefix your C with C<::> to indicate that it should use the default namespace, namely, C. C<::HRI> has been hardcoded to work. Of course C<::HashRefInflator> would also work fine. See L for a nice way to apply it to your entire schema. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/IgnoreWantarray.pm0000644000175000017500000000276313624003631025116 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::IgnoreWantarray; $DBIx::Class::Helper::ResultSet::IgnoreWantarray::VERSION = '2.035000'; # ABSTRACT: Get rid of search context issues use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub search :DBIC_method_is_indirect_sugar{ $_[0]->throw_exception ('->search is *not* a mutator, calling it in void context makes no sense') if !defined wantarray && (caller)[0] !~ /^\QDBIx::Class::/; shift->search_rs(@_); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::IgnoreWantarray - Get rid of search context issues =head1 SYNOPSIS package MyApp::Schema::ResultSet::Foo; __PACKAGE__->load_components(qw{Helper::ResultSet::IgnoreWantarray}); ... 1; And then else where, like in a controller: my $rs = $self->paginate( $schema->resultset('Foo')->search({ name => 'frew' }) ); =head1 DESCRIPTION This component makes search always return a ResultSet, instead of returning an array of your database in array context. See L for a nice way to apply it to your entire schema. =head1 METHODS =head2 search Override of the default search method to force it to return a ResultSet. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/SetOperations.pm0000644000175000017500000001144513624003631024576 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::SetOperations; $DBIx::Class::Helper::ResultSet::SetOperations::VERSION = '2.035000'; # ABSTRACT: Do set operations with DBIx::Class use strict; use warnings; use parent 'DBIx::Class::ResultSet'; # cribbed from perlfaq4 sub _compare_arrays { my ($self, $first, $second) = @_; no warnings; # silence spurious -w undef complaints return 0 unless @$first == @$second; for (my $i = 0; $i < @$first; $i++) { return 0 if $first->[$i] ne $second->[$i]; } return 1; } sub union { shift->_set_operation( UNION => @_ ); } sub union_all { shift->_set_operation( "UNION ALL" => @_ ); } sub intersect { shift->_set_operation( INTERSECT => @_ ); } sub intersect_all { shift->_set_operation( "INTERSECT ALL" => @_ ); } sub _except_keyword { my $self = shift; $self->{_except_keyword} ||= ( $self->result_source->schema->storage->sqlt_type eq 'Oracle' ? "MINUS" : "EXCEPT" ); } sub except { my ( $self, @args ) = @_; $self->_set_operation( $self->_except_keyword => @args ); } sub except_all { # not supported on most DBs shift->_set_operation( "EXCEPT ALL" => @_ ); } sub _set_operation { my ( $self, $operation, $other ) = @_; my @sql; my @params; my $as = $self->_resolved_attrs->{as}; my @operands = ( $self, ref $other eq 'ARRAY' ? @$other : $other ); for (@operands) { $self->throw_exception("ResultClass of ResultSets do not match!") unless $self->result_class eq $_->result_class; my $attrs = $_->_resolved_attrs; $self->throw_exception('ResultSets do not all have the same selected columns!') unless $self->_compare_arrays($as, $attrs->{as}); my ($sql, @bind) = @{${$_->as_query}}; $sql =~ s/^\s*\((.*)\)\s*$/$1/; push @sql, $sql; push @params, @bind; } my $query = q<(> . join(" $operation ", @sql). q<)>; my $attrs = $self->_resolved_attrs; return $self->result_source->resultset->search(undef, { alias => $self->current_source_alias, from => [{ $self->current_source_alias => \[ $query, @params ], -alias => $self->current_source_alias, -source_handle => $self->result_source->handle, }], columns => $attrs->{as}, result_class => $self->result_class, }); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::SetOperations - Do set operations with DBIx::Class =head1 SYNOPSIS package MyApp::Schema::ResultSet::Foo; __PACKAGE__->load_components(qw{Helper::ResultSet::SetOperations}); ... 1; And then elsewhere, like in a controller: my $rs1 = $rs->search({ foo => 'bar' }); my $rs2 = $rs->search({ baz => 'biff' }); for ($rs1->union($rs2)->all) { ... } =head1 DESCRIPTION This component allows you to use various set operations with your ResultSets. See L for a nice way to apply it to your entire schema. Component throws exceptions if ResultSets have different ResultClasses or different "Columns Specs." The basic idea here is that in SQL if you use a set operation they must be selecting the same columns names, so that the results will all match. The deal with the ResultClasses is that DBIC needs to inflate the results the same for the entire ResultSet, so if one were to try to apply something like a union in a table with the same column name but different classes DBIC wouldn't be doing what you would expect. A nice way to use this is with L. You might have something like the following sketch autocompletion code: my $rs1 = $schema->resultset('Album')->search({ name => { -like => "$input%" } }, { columns => [qw( id name ), { tablename => \['?', [{} => 'album']], }], }); my $rs2 = $schema->resultset('Artist')->search({ name => { -like => "$input%" } }, { columns => [qw( id name ), { tablename => \['?', [{} => 'artist']], }], }); my $rs3 = $schema->resultset('Song')->search({ name => { -like => "$input%" } }, { columns => [qw( id name ), { tablename => \['?', [{} => 'song']], }], }); $_->result_class('DBIx::Class::ResultClass::HashRefInflator') for ($rs1, $rs2, $rs3); my $data = [$rs1->union([$rs2, $rs3])->all]; =head1 METHODS =head2 union =head2 union_all =head2 intersect =head2 intersect_all =head2 except =head2 except_all All of these methods take a single ResultSet or an ArrayRef of ResultSets as the parameter only parameter. On Oracle C will issue a C operation. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/RemoveColumns.pm0000644000175000017500000000372313624003631024575 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::RemoveColumns; $DBIx::Class::Helper::ResultSet::RemoveColumns::VERSION = '2.035000'; # ABSTRACT: Remove columns from a ResultSet use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub _resolved_attrs { my $self = $_[0]; my $attrs = $self->{attrs}; # not copying on purpose... if ( !$attrs->{columns} && !$attrs->{select} && $attrs->{remove_columns} ) { my %rc = map { $_ => 1 } @{$attrs->{remove_columns}}; $attrs->{columns} = [ grep { !$rc{$_} } $self->result_source->columns ] } return $self->next::method; } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::RemoveColumns - Remove columns from a ResultSet =head1 SYNOPSIS package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::RemoveColumns'); # in code using resultset: my $rs = $schema->resultset('Bar')->search(undef, { remove_columns => ['giant_text_col', 'password'], }); =head1 DESCRIPTION This component allows convenient removal of columns from a select. Normally to do this you would do this by listing all of the columns B the ones you want to remove. This does that part for you. See L for a nice way to apply it to your entire schema. It doesn't get a lot more complicated than the synopsis. If you are interested in having more control, check out L. =over =item * Load the component =item * Put an C of columns to remove in the C search attribute. =item * Profit. =back =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/0000775000175000017500000000000013624003631023251 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/RemoveColumns.pm0000644000175000017500000000124713624003631026407 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::RemoveColumns; $DBIx::Class::Helper::ResultSet::Shortcut::RemoveColumns::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub remove_columns { shift->search(undef, { remove_columns => shift }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::RemoveColumns =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/ResultsExist.pm0000644000175000017500000000254413624003631026270 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::ResultsExist; $DBIx::Class::Helper::ResultSet::Shortcut::ResultsExist::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub results_exist_as_query { my $self = shift; my $reified = $self->search_rs( {}, { columns => { _results_existence_check => \ '42' } } )->as_query; $$reified->[0] = "( SELECT EXISTS $$reified->[0] )"; $reified; } sub results_exist { my $self = shift; my $query = $self->results_exist_as_query; $$query->[0] .= ' AS _existence_subq'; my( undef, $sth ) = $self->result_source ->schema ->storage ->_select( $query, \'*', {}, {}, ); $sth->fetchall_arrayref->[0][0] ? 1 : 0; } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::ResultsExist =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/OrderByMagic.pm0000644000175000017500000000243613624003631026121 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::OrderByMagic; $DBIx::Class::Helper::ResultSet::Shortcut::OrderByMagic::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::Helper::ResultSet::Shortcut::OrderBy', 'DBIx::Class::ResultSet'; sub order_by { my ($self, @order) = @_; return $self->next::method(@order) if @order && ref($order[0]); my @clauses; foreach (@order) { foreach my $col (split(/\s*,\s*/)) { my $dir = 'asc'; if (substr($col, 0, 1) eq '!') { $col = substr($col, 1); # take everything after '!' $dir = 'desc'; } # add csa prefix if necessary $col = join('.', $self->current_source_alias, $col) if index($col, '.') == -1; push @clauses, { "-$dir" => $col }; } } return $self->next::method(\@clauses); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::OrderByMagic =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Search/0000775000175000017500000000000013624003631024456 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Search/NotLike.pm0000644000175000017500000000161513624003631026362 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Search::NotLike; $DBIx::Class::Helper::ResultSet::Shortcut::Search::NotLike::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::Helper::ResultSet::Shortcut::Search::Base'; sub not_like { my ($self, $columns, $cond) = @_; return $self->_helper_apply_search({ '-not_like' => $cond }, $columns); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Search::NotLike =head2 not_like($column || \@columns, $cond) $rs->not_like('lyrics', '%zebra%'); $rs->not_like(['lyrics', 'title'], '%zebra%'); =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Search/NotNull.pm0000644000175000017500000000154313624003631026410 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Search::NotNull; $DBIx::Class::Helper::ResultSet::Shortcut::Search::NotNull::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::Helper::ResultSet::Shortcut::Search::Base'; sub not_null { my ($self, @columns) = @_; return $self->_helper_apply_search({ '!=' => undef }, @columns); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Search::NotNull =head2 not_null(@columns || \@columns) $rs->not_null('status'); $rs->not_null(['status', 'title']); =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Search/Like.pm0000644000175000017500000000156013624003631025700 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Search::Like; $DBIx::Class::Helper::ResultSet::Shortcut::Search::Like::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::Helper::ResultSet::Shortcut::Search::Base'; sub like { my ($self, $columns, $cond) = @_; return $self->_helper_apply_search({ '-like' => $cond }, $columns); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Search::Like =head2 like($column || \@columns, $cond) $rs->like('lyrics', '%zebra%'); $rs->like(['lyrics', 'title'], '%zebra%'); =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Search/Base.pm0000644000175000017500000000340213624003631025663 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Search::Base; $DBIx::Class::Helper::ResultSet::Shortcut::Search::Base::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; #--------------------------------------------------------------------------# # _helper_unwrap_columns(@columns) #--------------------------------------------------------------------------# sub _helper_unwrap_columns { my ($self, @columns) = @_; if (@columns == 1 && ref($columns[0]) && ref($columns[0]) eq 'ARRAY') { @columns = @{ $columns[0] }; } return @columns; } #--------------------------------------------------------------------------# # _helper_meify($column) #--------------------------------------------------------------------------# sub _helper_meify { my ($self, $column) = @_; return $self->current_source_alias . $column if $column =~ m/^\./; return $column; } #--------------------------------------------------------------------------# # _helper_apply_search($cond, @columns) #--------------------------------------------------------------------------# sub _helper_apply_search { my ($self, $cond, @columns) = @_; @columns = $self->_helper_unwrap_columns(@columns); my $rs = $self; foreach my $column (@columns) { $rs = $rs->search_rs({ $self->_helper_meify($column) => $cond }); } return $rs; } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Search::Base =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Search/Null.pm0000644000175000017500000000151113624003631025722 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Search::Null; $DBIx::Class::Helper::ResultSet::Shortcut::Search::Null::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::Helper::ResultSet::Shortcut::Search::Base'; sub null { my ($self, @columns) = @_; return $self->_helper_apply_search({ '=' => undef }, @columns); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Search::Null =head2 null(@columns || \@columns) $rs->null('status'); $rs->null(['status', 'title']); =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/LimitedPage.pm0000644000175000017500000000212713624003631025773 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::LimitedPage; $DBIx::Class::Helper::ResultSet::Shortcut::LimitedPage::VERSION = '2.035000'; use strict; use warnings; use parent qw( DBIx::Class::Helper::ResultSet::Shortcut::Rows DBIx::Class::Helper::ResultSet::Shortcut::Page DBIx::Class::ResultSet ); sub limited_page { my $self = shift; if (@_ == 1) { my $arg = shift; if (ref $arg) { my ( $page, $rows ) = @$arg{qw(page rows)}; return $self->page($page)->rows($rows); } else { return $self->page($arg); } } elsif (@_ == 2) { my ( $page, $rows ) = @_; return $self->page($page)->rows($rows); } else { die 'Invalid args passed to get_page method'; } } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::LimitedPage =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/AddColumns.pm0000644000175000017500000000122713624003631025640 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::AddColumns; $DBIx::Class::Helper::ResultSet::Shortcut::AddColumns::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub add_columns { shift->search(undef, { '+columns' => shift }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::AddColumns =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Distinct.pm0000644000175000017500000000124013624003631025363 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Distinct; $DBIx::Class::Helper::ResultSet::Shortcut::Distinct::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub distinct { $_[0]->search(undef, { distinct => defined $_[1] ? $_[1] : 1 }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Distinct =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Prefetch.pm0000644000175000017500000000122313624003631025343 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Prefetch; $DBIx::Class::Helper::ResultSet::Shortcut::Prefetch::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub prefetch { return shift->search(undef, { prefetch => shift }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Prefetch =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/OrderBy.pm0000644000175000017500000000121113624003631025146 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::OrderBy; $DBIx::Class::Helper::ResultSet::Shortcut::OrderBy::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub order_by { shift->search(undef, { order_by => shift }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::OrderBy =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Columns.pm0000644000175000017500000000120713624003631025225 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Columns; $DBIx::Class::Helper::ResultSet::Shortcut::Columns::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub columns { shift->search(undef, { columns => shift }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Columns =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/GroupBy.pm0000644000175000017500000000121113624003631025167 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::GroupBy; $DBIx::Class::Helper::ResultSet::Shortcut::GroupBy::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub group_by { shift->search(undef, { group_by => shift }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::GroupBy =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/HasRows.pm0000644000175000017500000000124713624003631025177 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::HasRows; $DBIx::Class::Helper::ResultSet::Shortcut::HasRows::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::Helper::ResultSet::Shortcut::Rows', 'DBIx::Class::ResultSet'; sub has_rows { !! shift->rows(1)->next } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::HasRows =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Search.pm0000644000175000017500000000144513624003631025016 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Search; $DBIx::Class::Helper::ResultSet::Shortcut::Search::VERSION = '2.035000'; use strict; use warnings; use parent (qw( DBIx::Class::Helper::ResultSet::Shortcut::Search::Null DBIx::Class::Helper::ResultSet::Shortcut::Search::NotNull DBIx::Class::Helper::ResultSet::Shortcut::Search::Like DBIx::Class::Helper::ResultSet::Shortcut::Search::NotLike )); 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Search =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Limit.pm0000644000175000017500000000123513624003631024664 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Limit; $DBIx::Class::Helper::ResultSet::Shortcut::Limit::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::Helper::ResultSet::Shortcut::Rows', 'DBIx::Class::ResultSet'; sub limit { return shift->rows(@_) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Limit =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Page.pm0000644000175000017500000000117013624003631024460 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Page; $DBIx::Class::Helper::ResultSet::Shortcut::Page::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub page { shift->search(undef, { page => shift }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Page =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/Rows.pm0000644000175000017500000000117013624003631024536 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::Rows; $DBIx::Class::Helper::ResultSet::Shortcut::Rows::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub rows { shift->search(undef, { rows => shift }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::Rows =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut/HRI.pm0000644000175000017500000000125313624003631024230 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut::HRI; $DBIx::Class::Helper::ResultSet::Shortcut::HRI::VERSION = '2.035000'; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub hri { shift->search(undef, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut::HRI =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/DateMethods1.pm0000644000175000017500000006436613624003631024273 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::DateMethods1; $DBIx::Class::Helper::ResultSet::DateMethods1::VERSION = '2.035000'; # ABSTRACT: Work with dates in your RDBMS nicely use parent 'DBIx::Class::ResultSet'; use strict; use warnings; use DBI qw(:sql_types); use DBIx::Introspector; use Safe::Isa; sub _flatten_thing { my ($self, $thing) = @_; die 'you dummy' unless defined $thing; my $ref = ref $thing; return ('?', $thing) if !$ref; if ($ref eq 'HASH' && exists $thing->{'-ident'}) { my $thing = $thing->{'-ident'}; $thing = $self->current_source_alias . $thing if $thing =~ m/^\./; return $self->result_source->storage->sql_maker->_quote($thing) } return ${$thing} if $ref eq 'SCALAR'; # FIXME: this should have the right bind type return ('?', $self->utc($thing)) if $thing->$_isa('DateTime'); return @{${$thing}}; } sub _introspector { my $d = DBIx::Introspector->new(drivers => '2013-12.01'); $d->decorate_driver_unconnected(MSSQL => now_utc_sql => 'GETUTCDATE()'); $d->decorate_driver_unconnected(SQLite => now_utc_sql => q); $d->decorate_driver_unconnected(mysql => now_utc_sql => 'UTC_TIMESTAMP()'); $d->decorate_driver_unconnected(Oracle => now_utc_sql => 'sys_extract_utc(SYSTIMESTAMP)'); $d->decorate_driver_unconnected(Pg => now_utc_sql => 'CURRENT_TIMESTAMP'); MSSQL: { my %part_map = ( year => 'year', quarter => 'quarter', month => 'month', day_of_year => 'dayofyear', day_of_month => 'day', week => 'week', day_of_week => 'ISO_WEEK', hour => 'hour', minute => 'minute', second => 'second', millisecond => 'millisecond', nanosecond => 'nanosecond', non_iso_day_of_week => 'weekday', timezone_as_minutes => 'TZoffset', ); $d->decorate_driver_unconnected(MSSQL => datepart_sql => sub { sub { my ($date_sql, $part) = @_; my ($sql, @args) = @$date_sql; return [ "DATEPART($part_map{$part}, $sql)", @args ] } }); my %diff_part_map = %part_map; $diff_part_map{day} = delete $diff_part_map{day_of_year}; delete $diff_part_map{day_of_month}; delete $diff_part_map{day_of_week}; $d->decorate_driver_unconnected(MSSQL => dateadd_sql => sub { sub { my ($date_sql, $unit, $amount_sql) = @_; my ($d_sql, @d_args) = @{$date_sql}; my ($a_sql, @a_args) = @{$amount_sql}; return [ "DATEADD($diff_part_map{$unit}, CAST($a_sql AS int), $d_sql)", @a_args, @d_args, ]; } }); $d->decorate_driver_unconnected(MSSQL => datesubtract_sql => sub { sub { my ($date_sql, $unit, $amount_sql) = @_; my ($d_sql, @d_args) = @{$date_sql}; my ($a_sql, @a_args) = @{$amount_sql}; return [ # no idea if this works.. "DATEADD($diff_part_map{$unit}, -1 * CAST($a_sql AS int), $d_sql)", @a_args, @d_args, ]; } }); } SQLITE: { my %part_map = ( month => 'm', day_of_month => 'd', year => 'Y', hour => 'H', day_of_year => 'j', minute => 'M', second => 'S', day_of_week => 'w', week => 'W', # maybe don't support these or prefix them with 'sqlite.'? julian_day => 'J', seconds_since_epoch => 's', fractional_seconds => 'f', ); $d->decorate_driver_unconnected(SQLite => datepart_sql => sub { sub { my ($date_sql, $part) = @_; my ($sql, @args) = @$date_sql; return [ "STRFTIME('%$part_map{$part}', $sql)", @args ] } }); my %diff_part_map = ( day => 'days', hour => 'hours', minute => 'minutes', second => 'seconds', month => 'months', year => 'years', ); $d->decorate_driver_unconnected(SQLite => dateadd_sql => sub { sub { my ($date_sql, $unit, $amount_sql) = @_; my ($d_sql, @d_args) = @{$date_sql}; my ($a_sql, @a_args) = @{$amount_sql}; die "unknown part $unit" unless $diff_part_map{$unit}; return [ "DATETIME($d_sql, $a_sql || ?)", @d_args, @a_args, " $diff_part_map{$unit}" ]; } }); $d->decorate_driver_unconnected(SQLite => datesubtract_sql => sub { sub { my ($date_sql, $unit, $amount_sql) = @_; my ($d_sql, @d_args) = @{$date_sql}; my ($a_sql, @a_args) = @{$amount_sql}; die "unknown part $unit" unless $diff_part_map{$unit}; return [ "DATETIME($d_sql, '-' || $a_sql || ?)", @d_args, @a_args, " $diff_part_map{$unit}" ]; } }); } PG: { my %part_map = ( century => 'century', decade => 'decade', day_of_month => 'day', day_of_week => 'dow', day_of_year => 'doy', seconds_since_epoch => 'epoch', hour => 'hour', iso_day_of_week => 'isodow', iso_year => 'isoyear', microsecond => 'microseconds', millenium => 'millenium', millisecond => 'milliseconds', minute => 'minute', month => 'month', quarter => 'quarter', second => 'second', timezone => 'timezone', timezone_hour => 'timezone_hour', timezone_minute => 'timezone_minute', week => 'week', year => 'year', ); my %diff_part_map = %part_map; delete $diff_part_map{qw( day_of_week day_of_year iso_day_of_week iso_year millenium quarter seconds_since_epoch timezone timezone_hour timezone_minute )}; $diff_part_map{day} = delete $diff_part_map{day_of_month}; $d->decorate_driver_unconnected(Pg => datepart_sql => sub { sub { my ($date_sql, $part) = @_; my ($sql, @args) = @$date_sql; @args = ([{ dbd_attrs => SQL_TIMESTAMP }, $args[0]]) if $sql eq '?' && @args == 1; return [ "date_part(?, $sql)", $part_map{$part}, @args ] } }); $d->decorate_driver_unconnected(Pg => dateadd_sql => sub { sub { my ($date_sql, $unit, $amount_sql) = @_; my ($d_sql, @d_args) = @{$date_sql}; my ($a_sql, @a_args) = @{$amount_sql}; @d_args = ([{ dbd_attrs => SQL_TIMESTAMP }, $d_args[0]]) if $d_sql eq '?' && @d_args == 1; die "unknown part $unit" unless $diff_part_map{$unit}; return [ "($d_sql + $a_sql * interval '1 $diff_part_map{$unit}')", @d_args, @a_args, ]; } }); $d->decorate_driver_unconnected(Pg => datesubtract_sql => sub { sub { my ($date_sql, $unit, $amount_sql) = @_; my ($d_sql, @d_args) = @{$date_sql}; my ($a_sql, @a_args) = @{$amount_sql}; @d_args = ([{ dbd_attrs => SQL_TIMESTAMP }, $d_args[0]]) if $d_sql eq '?' && @d_args == 1; die "unknown part $unit" unless $diff_part_map{$unit}; return [ "($d_sql - $a_sql * interval '1 $diff_part_map{$unit}')", @d_args, @a_args, ]; } }); } MYSQL: { my %part_map = ( microsecond => 'MICROSECOND', second => 'SECOND', minute => 'MINUTE', hour => 'HOUR', day_of_month => 'DAY', week => 'WEEK', month => 'MONTH', quarter => 'QUARTER', year => 'YEAR', second_microsecond => 'SECOND_MICROSECOND', minute_microsecond => 'MINUTE_MICROSECOND', minute_second => 'MINUTE_SECOND', hour_microsecond => 'HOUR_MICROSECOND', hour_second => 'HOUR_SECOND', hour_minute => 'HOUR_MINUTE', day_microsecond => 'DAY_MICROSECOND', day_second => 'DAY_SECOND', day_minute => 'DAY_MINUTE', day_hour => 'DAY_HOUR', year_month => 'YEAR_MONTH', ); my %diff_part_map = %part_map; $diff_part_map{day} = delete $diff_part_map{day_of_month}; delete $diff_part_map{qw( second_microsecond minute_microsecond minute_second hour_microsecond hour_second hour_minute day_microsecond day_second day_minute day_hour year_month )}; $d->decorate_driver_unconnected(mysql => datepart_sql => sub { sub { my ($date_sql, $part) = @_; my ($sql, @args) = @$date_sql; return [ "EXTRACT($part_map{$part} FROM $sql)", @args ] } }); $d->decorate_driver_unconnected(mysql => dateadd_sql => sub { sub { my ($date_sql, $unit, $amount_sql) = @_; my ($d_sql, @d_args) = @{$date_sql}; my ($a_sql, @a_args) = @{$amount_sql}; die "unknown part $unit" unless $diff_part_map{$unit}; return [ "DATE_ADD($d_sql, INTERVAL $a_sql $diff_part_map{$unit})", @d_args, @a_args, ]; } }); $d->decorate_driver_unconnected(mysql => datesubtract_sql => sub { sub { my ($date_sql, $unit, $amount_sql) = @_; my ($d_sql, @d_args) = @{$date_sql}; my ($a_sql, @a_args) = @{$amount_sql}; die "unknown part $unit" unless $diff_part_map{$unit}; return [ "DATE_SUB($d_sql, INTERVAL $a_sql $diff_part_map{$unit})", @d_args, @a_args, ]; } }); } ORACLE: { my %part_map = ( second => 'SECOND', minute => 'MINUTE', hour => 'HOUR', day_of_month => 'DAY', month => 'MONTH', year => 'YEAR', ); $d->decorate_driver_unconnected(Oracle => datepart_sql => sub { sub { my ($date_sql, $part) = @_; my ($sql, @args) = @$date_sql; return [ "EXTRACT($part_map{$part} FROM TO_TIMESTAMP($sql))", @args ] } }); my %diff_part_map = %part_map; $diff_part_map{day} = delete $diff_part_map{day_of_month}; delete $diff_part_map{$_} for qw(year month); $d->decorate_driver_unconnected(Oracle => dateadd_sql => sub { sub { my ($date_sql, $unit, $amount_sql) = @_; my ($d_sql, @d_args) = @{$date_sql}; my ($a_sql, @a_args) = @{$amount_sql}; die "unknown unit $unit" unless $diff_part_map{$unit}; return [ "(TO_TIMESTAMP($d_sql) + NUMTODSINTERVAL($a_sql, ?))", @d_args, @a_args, $diff_part_map{$unit} ]; } }); $d->decorate_driver_unconnected(Oracle => datesubtract_sql => sub { sub { my ($date_sql, $unit, $amount_sql) = @_; my ($d_sql, @d_args) = @{$date_sql}; my ($a_sql, @a_args) = @{$amount_sql}; die "unknown unit $unit" unless $diff_part_map{$unit}; return [ # no idea if this works.. "(TO_TIMESTAMP($d_sql) - NUMTODSINTERVAL($a_sql, ?))", @d_args, @a_args, $diff_part_map{$unit} ]; } }); } return $d; } use namespace::clean; sub delete { my $self = shift; $self = $self->as_subselect_rs if $self->_resolved_attrs->{_DBICH_DM1}; return $self->next::method(@_); } sub update { my $self = shift; $self = $self->as_subselect_rs if $self->_resolved_attrs->{_DBICH_DM1}; return $self->next::method(@_); } sub utc { my ($self, $datetime) = @_; my $tz_name = $datetime->time_zone->name; die "floating dates are not allowed" if $tz_name eq 'floating'; $datetime = $datetime->clone->set_time_zone('UTC') unless $tz_name eq 'UTC'; $_[0]->result_source->storage->datetime_parser->format_datetime($datetime) } sub dt_before { my ($self, $l, $r) = @_; my ($l_sql, @l_args) = _flatten_thing($self, $l); my ($r_sql, @r_args) = _flatten_thing($self, $r); return $self->search(\[ "$l_sql < $r_sql", @l_args, @r_args ], { _DBICH_DM1 => 1 }); } sub dt_on_or_before { my ($self, $l, $r) = @_; my ($l_sql, @l_args) = _flatten_thing($self, $l); my ($r_sql, @r_args) = _flatten_thing($self, $r); $self->search(\[ "$l_sql <= $r_sql", @l_args, @r_args ], { _DBICH_DM1 => 1 }); } sub dt_on_or_after { my ($self, $l, $r) = @_; my ($l_sql, @l_args) = _flatten_thing($self, $l); my ($r_sql, @r_args) = _flatten_thing($self, $r); return $self->search(\[ "$l_sql >= $r_sql", @l_args, @r_args ], { _DBICH_DM1 => 1 }); } sub dt_after { my ($self, $l, $r) = @_; my ($l_sql, @l_args) = _flatten_thing($self, $l); my ($r_sql, @r_args) = _flatten_thing($self, $r); return $self->search(\[ "$l_sql > $r_sql", @l_args, @r_args ], { _DBICH_DM1 => 1 }); } my $d; sub utc_now { my $self = shift; my $storage = $self->result_source->storage; $storage->ensure_connected; $d ||= _introspector(); return \( $d->get($storage->dbh, undef, 'now_utc_sql') ); } sub dt_SQL_add { my ($self, $thing, $unit, $amount) = @_; my $storage = $self->result_source->storage; $storage->ensure_connected; $d ||= _introspector(); return \( $d->get($storage->dbh, undef, 'dateadd_sql')->( [ _flatten_thing($self, $thing) ], $unit, [ _flatten_thing($self, $amount) ], ) ); } sub dt_SQL_subtract { my ($self, $thing, $unit, $amount) = @_; my $storage = $self->result_source->storage; $storage->ensure_connected; $d ||= _introspector(); return \( $d->get($storage->dbh, undef, 'datesubtract_sql')->( [ _flatten_thing($self, $thing) ], $unit, [ _flatten_thing($self, $amount) ], ) ); } sub dt_SQL_pluck { my ($self, $thing, $part) = @_; my $storage = $self->result_source->storage; $storage->ensure_connected; $d ||= _introspector(); return \( $d->get($storage->dbh, undef, 'datepart_sql')->( [ _flatten_thing($self, $thing) ], $part, ) ); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::DateMethods1 - Work with dates in your RDBMS nicely =head1 SYNOPSIS package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::DateMethods1'); # in code using resultset # get count per year/month $rs->search(undef, { columns => { count => '*', year => $rs->dt_SQL_pluck({ -ident => '.start' }, 'year'), month => $rs->dt_SQL_pluck({ -ident => '.start' }, 'month'), }, group_by => [ $rs->dt_SQL_pluck({ -ident => '.start' }, 'year'), $rs->dt_SQL_pluck({ -ident => '.start' }, 'month'), ], }); # mysql (SELECT `me`.*, EXTRACT(MONTH FROM `me`.`start`), EXTRACT(YEAR FROM `me`.`start`) FROM `HasDateOps` `me` GROUP BY EXTRACT(YEAR FROM `me`.`start`), EXTRACT(MONTH FROM `me`.`start`)) # SQLite (SELECT "me".*, STRFTIME('%m', "me"."start"), STRFTIME('%Y', "me"."start") FROM "HasDateOps" "me" GROUP BY STRFTIME('%Y', "me"."start"), STRFTIME('%m', "me"."start")) =head1 DESCRIPTION See L for a nice way to apply it to your entire schema. This ResultSet component gives the user tools to do B portable date manipulation in the database. Before embarking on a cross database project, take a look at L to see what might break on switching databases. This package has a few types of methods. =over =item Search Shortcuts These, like typical ResultSet methods, return another ResultSet. See L, L, L, and L. =item The date helper There is only one: L. Makes searching with dates a little easier. =item SQL generators These help generate more complex queries. The can be used in many different parts of L. See L, L, and L. =back =head1 TYPES Because these methods are so limited in scope they can be a bit more smart than typical C trees. There are "smart types" that this package supports. =over =item * vanilla scalars (C<1>, C<2012-12-12 12:12:12>) bound directly as untyped values =item * hashrefs with an C<-ident> (C<< { -ident => '.foo' } >>) As usual this gets flattened into a column. The one special feature in this module is that columns starting with a dot will automatically be prefixed with L. =item * L objects C objects work as if they were passed to L. =item * C (C<< \'NOW()' >>) As usual in C, C's will be flattened into regular SQL. =item * C (C<< \["SELECT foo FROM bar WHERE id = ?", [{}, 1]] >>) As usual in C, C's will be flattened into SQL with bound values. =back Anything not mentioned in the above list will explode, one way or another. =head1 IMPLEMENTATION =encoding utf8 The exact details for the functions your database engine provides. If a piece of functionality is flagged with ⚠, it means that the feature in question is not portable at all, and only supported on that engine. =head2 C =over =item * L - L =item * L - L Supported units =over =item * year =item * quarter =item * month =item * day_of_year =item * day_of_month =item * week =item * day_of_week =item * hour =item * minute =item * second =item * millisecond =item * nanosecond ⚠ =item * non_iso_day_of_week SQL Server offers both C and C. For interop reasons C uses the C version. =item * timezone_as_minutes ⚠ =back =item * L - L Supported units =over =item * year =item * quarter =item * month =item * day =item * week =item * hour =item * minute =item * second =item * millisecond =item * nanosecond ⚠ =item * iso_day_of_week =item * timezone_as_minutes ⚠ =back =back =head2 C =over =item * L - L =item * L - L Note: C's pluck implementation pads numbers with zeros, because it is implemented on based on a formatting function. If you want your code to work on SQLite you'll need to strip off (or just numify) what you get out of the database first. Available units =over =item * month =item * day_of_month =item * year =item * hour =item * day_of_year =item * minute =item * second =item * day_of_week =item * week =item * julian_day ⚠ =item * seconds_since_epoch =item * fractional_seconds ⚠ =back =item * L - L Available units =over =item * day =item * hour =item * minute =item * second =item * month =item * year =back =back =head2 C =over =item * L - L =item * L - L Available units =over =item * century ⚠ =item * decade ⚠ =item * day_of_month =item * day_of_week =item * day_of_year =item * seconds_since_epoch =item * hour =item * iso_day_of_week =item * iso_year =item * microsecond =item * millenium ⚠ =item * millisecond =item * minute =item * month =item * quarter =item * second =item * timezone ⚠ =item * timezone_hour ⚠ =item * timezone_minute ⚠ =item * week =item * year =back =item * L - Addition and L To be clear, it ends up looking like: C<< ("some_column" + 5 * interval '1 minute') >> Available units =over =item * century ⚠ =item * decade ⚠ =item * day =item * hour =item * microsecond ⚠ =item * millisecond =item * minute =item * month =item * second =item * week =item * year =back =back =head2 C =over =item * L - L =item * L - L Available units =over =item * microsecond =item * second =item * minute =item * hour =item * day_of_month =item * week =item * month =item * quarter =item * year =item * second_microsecond ⚠ =item * minute_microsecond ⚠ =item * minute_second ⚠ =item * hour_microsecond ⚠ =item * hour_second ⚠ =item * hour_minute ⚠ =item * day_microsecond ⚠ =item * day_second ⚠ =item * day_minute ⚠ =item * day_hour ⚠ =item * year_month ⚠ =back =item * L - L Available units =over =item * microsecond =item * second =item * minute =item * hour =item * day =item * week =item * month =item * quarter =item * year =back =back =head2 C =over =item * L - L =item * L - L Available units =over =item * second =item * minute =item * hour =item * day_of_month =item * month =item * year =back =item * L - Addition and L To be clear, it ends up looking like: C<< ("some_column" + NUMTODSINTERVAL(4, 'MINUTE') >> Available units =over =item * second =item * minute =item * hour =item * day =back =back =head1 CONTRIBUTORS These people worked on the original implementation, and thus deserve some credit for at least providing me a reference to implement this based off of: =over =item Alexander Hartmaier (abraxxa) for Oracle implementation details =item Devin Austin (dhoss) for Pg implementation details =item Rafael Kitover (caelum) for providing a test environment with lots of DBs =back =head1 WHENCE dt_SQL_diff? The original implementation of these date helpers (originally dubbed date operators) included a third operator called C<"diff">. It existed to subtract one date from another and return a duration. After using it a few times and getting bitten every time, I decided to stop using it and instead compare against actual dates always. If someone can come up with a good use case I am interested in re-implementing C, but I worry that it will be very unportable and generally not very useful. =head1 METHODS =head2 utc $rs->search({ 'some_date' => $rs->utc($datetime), })->all Takes a L object, updates the C to C, and formats it according to whatever database engine you are using. Dies if you pass it a date with a C<< floating time_zone >>. =head2 utc_now Returns a C representing the way to get the current date and time in C for whatever database engine you are using. =head2 dt_before $rs->dt_before({ -ident => '.start' }, { -ident => '.end' })->all Takes two values, each an expression of L. =head2 dt_on_or_before $rs->dt_on_or_before({ -ident => '.start' }, DateTime->now)->all Takes two values, each an expression of L. =head2 dt_on_or_after $rs->dt_on_or_after(DateTime->now, { ident => '.end' })->all Takes two values, each an expression of L. =head2 dt_after $rs->dt_after({ ident => '.end' }, $rs->get_column('datecol')->as_query)->all Takes two values, each an expression of L. =head2 dt_SQL_add # which ones start in 3 minutes? $rs->dt_on_or_after( { ident => '.start' }, $rs->dt_SQL_add($rs->utc_now, 'minute', 3) )->all Takes three arguments: a date conforming to L, a unit, and an amount. The idea is to add the given unit to the datetime. See your L for what units are accepted. =head2 dt_SQL_subtract Same as L, but subtracts the amount. Only confirmed to work with Postgres, MySQL and SQLite. It should work with Oracle and MSSQL, but due to lack of access to those DB engines the implementation was done only based on docs. This method was implemented by L and sponsored by L. =head2 dt_SQL_pluck # get count per year $rs->search(undef, { columns => { count => '*', year => $rs->dt_SQL_pluck({ -ident => '.start' }, 'year'), }, group_by => [$rs->dt_SQL_pluck({ -ident => '.start' }, 'year')], })->hri->all Takes two arguments: a date conforming to L and a unit. The idea is to pluck a given unit from the datetime. See your L for what units are accepted. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/VirtualView.pm0000644000175000017500000000630513624003631024257 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::VirtualView; $DBIx::Class::Helper::ResultSet::VirtualView::VERSION = '2.035000'; # ABSTRACT: Clean up your SQL namespace (DEPRECATED) use strict; use warnings; use vars qw($VERSION); use parent 'DBIx::Class::ResultSet'; sub as_virtual_view { my $self = shift; return $self->as_subselect_rs; } use Carp::Clan; carp 'This module is deprecated! Please use DBIx::Class::ResultSet::as_subselect_rs instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use DBIx::Class::ResultSet::as_subselect_rs instead!' if $VERSION >= 4; 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::VirtualView - Clean up your SQL namespace (DEPRECATED) =head1 SYNOPSIS # note that this is normally a component for a ResultSet package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::VirtualView'); # and then in code that uses the ResultSet Join with relation x my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' }); # 'x' now pollutes the query namespace # So the following works as expected my $ok_rs = $rs->search({'x.other' => 1}); # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and # def) we look for one row with contradictory terms and join in another table # (aliased 'x_2') which we never use my $broken_rs = $rs->search({'x.name' => 'def'}); my $rs2 = $rs->as_virtual_view; # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away my $not_joined_rs = $rs2->search({'x.other' => 1}); # works as expected: finds a 'table' row related to two x rows (abc and def) my $correctly_joined_rs = $rs2->search({'x.name' => 'def'}); =head1 DESCRIPTION This component is will allow you to clean up your SQL namespace. See L for a nice way to apply it to your entire schema. =head1 DEPRECATED This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 METHODS =head2 as_virtual_view Act as a barrier to SQL symbols. The resultset provided will be made into a "virtual view" by including it as a subquery within the from clause. From this point on, any joined tables are inaccessible to ->search on the resultset (as if it were simply where-filtered without joins). See L for example. =head1 NOTE You don't I to use this as a Component. If you prefer you can use it in the following manner: # in code using ResultSet: use DBIx::Class:Helper::VirtualView; my $new_rs = DBIx::Class::Helper::VirtualView::as_virtual_view($rs); =head1 THANKS Thanks to ijw from #dbix-class for the idea for this helper (originally called seal), most of the code, and most of the documentation. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/NoColumns.pm0000644000175000017500000000253413624003631023713 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::NoColumns; $DBIx::Class::Helper::ResultSet::NoColumns::VERSION = '2.035000'; # ABSTRACT: Look ma, no columns! use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub no_columns { $_[0]->search(undef, { columns => [] }) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::NoColumns - Look ma, no columns! =head1 SYNOPSIS package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::NoColumns'); # in code using resultset: my $rs = $schema->resultset('Bar')->no_columns->search(undef, { '+columns' => { 'foo' => 'me.foo' }, }); =head1 DESCRIPTION This component simply gives you a method to clear the set of columns to be selected. It's just handy sugar. See L for a nice way to apply this to your entire schema. =head1 METHODS =head2 no_columns $rs->no_columns Returns resultset with zero columns configured, fresh for the addition of new columns. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Shortcut.pm0000644000175000017500000001575413624003631023621 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Shortcut; $DBIx::Class::Helper::ResultSet::Shortcut::VERSION = '2.035000'; # ABSTRACT: Shortcuts to common searches (->order_by, etc) use strict; use warnings; use parent (qw( DBIx::Class::Helper::ResultSet::Shortcut::AddColumns DBIx::Class::Helper::ResultSet::Shortcut::Columns DBIx::Class::Helper::ResultSet::Shortcut::Distinct DBIx::Class::Helper::ResultSet::Shortcut::GroupBy DBIx::Class::Helper::ResultSet::Shortcut::HasRows DBIx::Class::Helper::ResultSet::Shortcut::HRI DBIx::Class::Helper::ResultSet::Shortcut::Limit DBIx::Class::Helper::ResultSet::Shortcut::OrderByMagic DBIx::Class::Helper::ResultSet::Shortcut::Prefetch DBIx::Class::Helper::ResultSet::Shortcut::LimitedPage DBIx::Class::Helper::ResultSet::Shortcut::RemoveColumns DBIx::Class::Helper::ResultSet::Shortcut::ResultsExist DBIx::Class::Helper::ResultSet::Shortcut::Rows DBIx::Class::Helper::ResultSet::Shortcut::Page DBIx::Class::Helper::ResultSet::Shortcut::Search )); 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Shortcut - Shortcuts to common searches (->order_by, etc) =head1 SYNOPSIS package MyApp::Schema::ResultSet::Foo; __PACKAGE__->load_components(qw{Helper::ResultSet::Shortcut}); ... 1; And then elsewhere: # let's say you grab a resultset from somewhere else my $foo_rs = get_common_rs() # but I'd like it sorted! ->order_by({ -desc => 'power_level' }) # and without those other dumb columns ->columns([qw/cromulence_ratio has_jimmies_rustled/]) # but get rid of those duplicates ->distinct # and put those straight into hashrefs, please ->hri # but only give me the first 3 ->rows(3); =head1 DESCRIPTION This helper provides convenience methods for resultset modifications. See L for a nice way to apply it to your entire schema. =head1 SEE ALSO This component is actually a number of other components put together. It will get more components added to it over time. If you are worried about all the extra methods you won't use or something, using the individual shortcuts is a simple solution. All the documentation will remain here, but the individual components are: =over 2 =item * L =item * L =item * L (adds the "magic string" functionality to C)) =item * L =item * L =item * L =item * L (inherits from C) =item * L (inherits from C) =item * L =item * L =item * L =item * L (inherits from C and L) =item * L =back =head1 METHODS =head2 distinct $foo_rs->distinct # equivalent to... $foo_rs->search(undef, { distinct => 1 }); =head2 group_by $foo_rs->group_by([ qw/ some column names /]) # equivalent to... $foo_rs->search(undef, { group_by => [ qw/ some column names /] }); =head2 order_by $foo_rs->order_by({ -desc => 'col1' }); # equivalent to... $foo_rs->search(undef, { order_by => { -desc => 'col1' } }); You can also specify the order as a "magic string", e.g.: $foo_rs->order_by('!col1') # ->order_by({ -desc => 'col1' }) $foo_rs->order_by('col1,col2') # ->order_by([qw(col1 col2)]) $foo_rs->order_by('col1,!col2') # ->order_by([{ -asc => 'col1' }, { -desc => 'col2' }]) $foo_rs->order_by(qw(col1 col2)) # ->order_by([qw(col1 col2)]) Can mix it all up as well: $foo_rs->order_by(qw(col1 col2 col3), 'col4,!col5') =head2 hri $foo_rs->hri; # equivalent to... $foo_rs->search(undef, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' }); =head2 rows $foo_rs->rows(10); # equivalent to... $foo_rs->search(undef, { rows => 10 }) =head2 limit This is an alias for C. $foo_rs->limit(10); # equivalent to... $foo_rs->rows(10); =head2 has_rows A lighter way to check the resultset contains any data rather than calling C<< $rs->count >>. =head2 page $foo_rs->page(2); # equivalent to... $foo_rs->search(undef, { page => 2 }) =head2 limited_page $foo_rs->limited_page(2, 3); # equivalent to... $foo_rs->search(undef, { page => 2, rows => 3 }) =head2 columns $foo_rs->columns([qw/ some column names /]); # equivalent to... $foo_rs->search(undef, { columns => [qw/ some column names /] }); =head2 add_columns $foo_rs->add_columns([qw/ some column names /]); # equivalent to... $foo_rs->search(undef, { '+columns' => [qw/ some column names /] }); =head2 remove_columns $foo_rs->remove_columns([qw/ some column names /]); # equivalent to... $foo_rs->search(undef, { remove_columns => [qw/ some column names /] }); =head2 prefetch $foo_rs->prefetch('bar'); # equivalent to... $foo_rs->search(undef, { prefetch => 'bar' }); =head2 results_exist my $results_exist = $schema->resultset('Bar')->search({...})->results_exist; # there is no easily expressable equivalent, so this is not exactly a # shortcut. Nevertheless kept in this class for historical reasons Uses C SQL function to check if the query would return anything. Usually much less resource intensive the more common C<< foo() if $rs->count >> idiom. =head2 results_exist_as_query ...->search( {}, { '+columns' => { subquery_has_members => $some_correlated_rs->results_exist_as_query }}, ); # there is no easily expressable equivalent, so this is not exactly a # shortcut. Nevertheless kept in this class for historical reasons The query generator behind L. Can be used standalone in complex queries returning a boolean result within a larger query context. =head2 null(@columns || \@columns) $rs->null('status'); $rs->null(['status', 'title']); =head2 not_null(@columns || \@columns) $rs->not_null('status'); $rs->not_null(['status', 'title']); =head2 like($column || \@columns, $cond) $rs->like('lyrics', '%zebra%'); $rs->like(['lyrics', 'title'], '%zebra%'); =head2 not_like($column || \@columns, $cond) $rs->not_like('lyrics', '%zebra%'); $rs->not_like(['lyrics', 'title'], '%zebra%'); =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/SearchOr.pm0000644000175000017500000000742413624003631023507 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::SearchOr; $DBIx::Class::Helper::ResultSet::SearchOr::VERSION = '2.035000'; # ABSTRACT: Combine ResultSet searches with OR's use strict; use warnings; use parent 'DBIx::Class::ResultSet'; use List::Util 'first'; use Carp::Clan; use namespace::clean; sub search_or { my $self = shift; my @others = @{shift @_ }; croak 'All ResultSets passed to search_or must have the same result_source ' . 'as the invocant!' if first { $self->result_source != $_->result_source } @others; $self->search({ -or => [ map $_->_resolved_attrs->{where}, @others ], }); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::SearchOr - Combine ResultSet searches with OR's =head1 SYNOPSIS package MyApp::Schema::ResultSet::Tests; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw(Helper::ResultSet::IgnoreWantarray Helper::ResultSet::SearchOr)); sub failed { my $self = shift; my $me = $self->current_source_alias; $self->search({ "$me.passed" => '0' }); } sub untested { my $self = shift; my $me = $self->current_source_alias; $self->search({ "$me.passed" => undef }); } sub not_passed { my $self = shift; my $me = $self->current_source_alias; $self->search_or([$self->failed, $self->untested]); } 1; =head1 DESCRIPTION I would argue that the most important feature of L is the fact that you can "chain" ResultSet searches. Unfortunately this can cause problems when you need to reuse multiple ResultSet methods as... well as or's. In the past I got around this by doing: $rs->foo->union([ $rs->bar]); While this works, it can generate some hairy SQL pretty fast. This Helper is supposed to basically be a lightweight union. Note that it therefor has a number of L. The thing that makes this module special is that the ResultSet that is doing the "search_or" ing still limits everything correctly. To be clear, the following only returns C<$user>'s friends that match either of the following criteria: my $friend_rs = $schema->resultset('Friend'); my @internet_friends = $user->friends->search_or([ $friend_rs->on_facebook, $friend_rs->on_twitter, ])->all; With a union, you'd have to implement it like this: $user->friends->on_facebook->union([ $user->friends->on_twitter ]); The union will work, but it will generate more complex SQL that may have lower performance on your database. See L for a nice way to apply it to your entire schema. =head1 METHODS =head2 search_or my $new_rs = $rs->search_or([ $rs->foo, $rs->bar ]); C takes a single arrayref of ResultSets. The ResultSets B point to the same source or you will get an error message. Additionally, no check is made to ensure that more than one ResultSet is in the ArrayRef, but only passing one ResultSet would not make any sense. =head1 LIMITATIONS Because this module us basically an expression union and not a true union, C's won't Just Work. If you have a ResultSet method that uses a C and you want to C it with another method, you'll need to do something like this: my @authors = $authors->search(undef, { join => 'books' })->search_or([ $authors->wrote_good_books, $authors->wrote_bestselling_books, ])->all; Furthermore, if you want to C two methods that C in the same relationship via alternate paths you B use L. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Explain.pm0000644000175000017500000001017313624003631023374 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Explain; $DBIx::Class::Helper::ResultSet::Explain::VERSION = '2.035000'; # ABSTRACT: Get query plan for a ResultSet use strict; use warnings; use parent 'DBIx::Class::ResultSet'; use DBIx::Introspector; sub _introspector { my $d = DBIx::Introspector->new(drivers => '2013-12.01'); $d->decorate_driver_connected(MSSQL => splain => 'GETUTCDATE()'); $d->decorate_driver_connected( SQLite => splain => sub { sub { my ($dbh, $query) = @_; my ($sql, @bind) = @{$$query}; $sql =~ s/\s*\((.*)\)\s*/$1/; shift->selectall_arrayref("EXPLAIN $sql", undef, @bind) }, }, ); $d->decorate_driver_connected( Pg => splain => sub { sub { my ($dbh, $query) = @_; my ($sql, @bind) = @{$$query}; shift->selectall_arrayref("EXPLAIN ANALYZE $sql", undef, @bind) }, }, ); $d->decorate_driver_connected( mysql => splain => sub { sub { my ($dbh, $query) = @_; my ($sql, @bind) = @{$$query}; shift->selectall_arrayref("EXPLAIN EXTENDED $sql", undef, @bind) }, }, ); return $d; } use namespace::clean; my $i; sub explain { $i ||= _introspector(); my $self = shift; my $storage = $self->result_source->storage; $storage->ensure_connected; my $dbh = $storage->dbh; $i->get($dbh, undef, 'splain')->($dbh, $self->as_query) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Explain - Get query plan for a ResultSet =head1 SYNOPSIS This module mostly makes sense to be used without setting as a component: use Devel::Dwarn; Dwarn DBIx::Class::ResultSet::Explain::explain($rs) But as usual, if you prefer to use it as a component here's how: package MyApp::Schema::ResultSet::Foo; __PACKAGE__->load_components(qw{Helper::ResultSet::Explain}); ... 1; And then in a script or something: use Devel::Dwarn; Dwarn $rs->explain; =head1 DESCRIPTION This is just a handy little tool that gives you the query plan for a given ResultSet. The output is in no way normalized, so just treat it as a debug tool or something. The only supported DB's are those listed below. Have fun! See L for a nice way to apply it to your entire schema. =head1 EXAMPLE OUTPUT FROM SUPPORTED DB's =head2 SQlite [ [ 0, "Init", 0, 10, 0, "", "00", undef, ], [ 1, "OpenRead", 0, 3, 0, 4, "00", undef, ], [ 2, "Rewind", 0, 9, 0, "", "00", undef, ], [ 3, "Rowid", 0, 1, 0, "", "00", undef, ], [ 4, "Column", 0, 1, 2, "", "00", undef, ], [ 5, "Column", 0, 2, 3, "", "00", undef, ], [ 6, "Column", 0, 3, 4, "", "00", undef, ], [ 7, "ResultRow", 1, 4, 0, "", "00", undef, ], [ 8, "Next", 0, 3, 0, "", "01", undef, ], [ 9, "Halt", 0, 0, 0, "", "00", undef, ], [ 10, "Transaction", 0, 0, 17, 0, "01", undef, ], [ 11, "Goto", 0, 1, 0, "", "00", undef, ], ] =head2 Pg [ [ "Seq Scan on \"Gnarly\" me (cost=0.00..16.20 rows=620 width=100) (actual time=0.002..0.002 rows=0 loops=1)", ], [ "Planning time: 0.189 ms", ], [ "Execution time: 0.039 ms", ], ] =head2 mysql [ [ 1, "SIMPLE", "me", "ALL", undef, undef, undef, undef, 1, 100, "", ], ] =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/OneRow.pm0000644000175000017500000000413213624003631023203 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::OneRow; $DBIx::Class::Helper::ResultSet::OneRow::VERSION = '2.035000'; # ABSTRACT: The first you always wanted use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub one_row { shift->search(undef, { rows => 1})->next } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::OneRow - The first you always wanted =head1 SYNOPSIS # note that this is normally a component for a ResultSet package MySchema::ResultSet::Person; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::OneRow'); sub person_named { $_[0]->search({ name => $_[1] })->one_row } =head1 DESCRIPTION This component codifies an alternate version of L. In practical use, C allows a user to do something like the following: my $rs = $schema->resultset('Foo')->search({ name => 'bar' }); my $first = $rs->first; my @rest; while (my $row = $rs->next) { push @rest, $row } Problematically, if you call C without the while loop afterwards B you got back more than one row, you are leaving a cursor open. Depending on your database this could increase memory usage or cause errors with later queries. Fundamentally the difference is that when you use C you are guaranteed to exhaust the underlying cursor. Generally speaking, unless you are doing something unusual, C is a good default. =head1 METHODS =head2 one_row Limits the ResultSet to a single row, and then returns the matching result object. In case no rows match, C is returned as normal. =head1 THANKS Thanks to Aran Clary Deltac (BLUEFEET) for initially writing this module, and thanks to L for sponsoring that initial developmentl =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Errors.pm0000644000175000017500000000365413624003631023256 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Errors; $DBIx::Class::Helper::ResultSet::Errors::VERSION = '2.035000'; # ABSTRACT: add exceptions to help when calling Result methods on an ResultSets use strict; use warnings; use parent 'DBIx::Class::ResultSet'; my $std_err = qq{Can't locate object method "%s" via package "%s" } . qq{at %s line %d.\n}; my $cust_err = qq{You're trying to call a Result ("%s") method ("%s") } . qq{on a ResultSet ("%s") at %s line %d.\n}; sub AUTOLOAD { my $self = shift; my($class) = ref $self || $self; my($meth) = $DBIx::Class::Helper::ResultSet::Errors::AUTOLOAD =~ m/::([^:]+)$/; return if $meth eq 'DESTROY'; my($callpack, $callfile, $callline) = caller; my $rclass = $self->result_source->result_class; die sprintf $cust_err, $rclass, $meth, $class, $callfile, $callline if $rclass->can($meth); die sprintf $std_err, $meth, $class, $callfile, $callline; } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Errors - add exceptions to help when calling Result methods on an ResultSets =head1 SYNOPSIS package MyApp::Schema::ResultSet::Foo; __PACKAGE__->load_components(qw{Helper::ResultSet::Errors}); ... 1; And then in a script or something: my $col = $rs->id # dies with a helpful error! =head1 DESCRIPTION Users new to C often make the mistake of treating ResultSets like Results. This helper ameliorates the situation by giving a helpful error when the user calls methods for the result on the ResultSet. See L for a nice way to apply it to your entire schema. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Random.pm0000644000175000017500000000667613624003631023231 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Random; $DBIx::Class::Helper::ResultSet::Random::VERSION = '2.035000'; # ABSTRACT: Get random rows from a ResultSet use strict; use warnings; use parent 'DBIx::Class::ResultSet'; use Module::Runtime 'use_module'; use Try::Tiny; sub _introspector { my $d = use_module('DBIx::Introspector') ->new(drivers => '2013-12.01'); $d->decorate_driver_unconnected(ACCESS => rand_sql => 'RND()' ); $d->decorate_driver_unconnected(Oracle => rand_sql => 'dbms_random.value' ); $d->decorate_driver_unconnected(Pg => rand_sql => 'RANDOM()' ); $d->decorate_driver_unconnected(MSSQL => rand_sql => 'NEWID()' ); $d->decorate_driver_unconnected(SQLite => rand_sql => 'RANDOM()' ); $d } my $d; sub _rand_order_by { my $self = shift; my $storage = $self->result_source->storage; $storage->ensure_connected; $d ||= $self->_introspector; return try { $d->get($storage->dbh, undef, 'rand_sql') } catch { 'RAND()' }; } sub rand { my $self = shift; my $amount = shift || 1; $self->throw_exception('rand can only return a positive amount of rows') unless $amount > 0; $self->throw_exception('rand can only return an integer amount of rows') unless $amount == int $amount; my $order_by = $self->_rand_order_by; return $self->search(undef, { rows=> $amount, order_by => \$order_by}); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Random - Get random rows from a ResultSet =head1 SYNOPSIS # note that this is normally a component for a ResultSet package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::Random'); # in code using resultset: my $random_row = $schema->resultset('Bar')->rand->single; =head1 DESCRIPTION This component allows convenient selection of random rows. See L for a nice way to apply it to your entire schema. Currently this works by doing something akin to SELECT TOP($x) from $table ORDER BY RANDOM() Lots of people think this is slow. My own benchmarks show that doing the above, for 10 rows in a table with just over 8 million rows, is nearly instant. Although that was with SQL Server, and different databases will handle that differently. So please, if you have performance issues and want this to work with your database, get in touch and I will do what I can to get it to work quickly enough to suite your needs. =head1 METHODS =head2 rand This method takes a single argument, being the size of the random ResultSet to return. It defaults to 1. This Component will throw exceptions if the argument is not an integer or not greater than zero. =head2 _rand_order_by This module currently does an C on some db specific function. If for some reason it guesses incorrectly for your database the easiest way to fix that in the short-term (ie without patching upstream) is to override this method. So for example, if your db uses C instead of C and it's not in the predefined list of dbs you could just do the following in your ResultSet class: sub _rand_order_by { 'RAND()' } =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Union.pm0000644000175000017500000000213113624003631023057 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Union; $DBIx::Class::Helper::ResultSet::Union::VERSION = '2.035000'; use parent 'DBIx::Class::Helper::ResultSet::SetOperations'; use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Get rid of search context issues 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Union - (DEPRECATED) Get rid of search context issues =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Util.pm0000644000175000017500000000417213624003631022713 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Util; $DBIx::Class::Helper::ResultSet::Util::VERSION = '2.035000'; use strict; use warnings; # ABSTRACT: Helper utilities for DBIx::Class ResultSets use Sub::Exporter::Progressive -setup => { exports => [ qw( correlate ), ], }; my $recent_dbic; sub correlate { my ($rs, $rel) = @_; my $source = $rs->result_source; $recent_dbic = $source->can('resolve_relationship_condition') ? 1 : 0 if not defined $recent_dbic; return $source->related_source($rel)->resultset ->search( ($recent_dbic ? $source->resolve_relationship_condition( rel_name => $rel, foreign_alias => "${rel}_alias", self_alias => $rs->current_source_alias, )->{condition} : scalar $source->_resolve_condition( $source->relationship_info($rel)->{cond}, "${rel}_alias", $rs->current_source_alias, $rel ) ), { alias => "${rel}_alias" } ); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Util - Helper utilities for DBIx::Class ResultSets =head1 DESCRIPTION These functions will slowly become the core implementations of many existing components. The reason for this is that often you are not able to or unwilling to add a component to an object, as adding the component fundamentally changes the object. If instead you merely act on the object with a subroutine you are not committing as seriously. =head1 EXPORTS =head2 correlate correlate($author_rs, 'books') This function allows you to correlate a resultset with one of it's relationships. It takes the ResultSet and relationship name as arguments. See L for an in depth example. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Bare.pm0000644000175000017500000000255513624003631022652 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Bare; $DBIx::Class::Helper::ResultSet::Bare::VERSION = '2.035000'; # ABSTRACT: Get an unsearched ResultSet use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub bare { shift->result_source->resultset } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Bare - Get an unsearched ResultSet =head1 SYNOPSIS package MyApp::Schema::ResultSet::KV; __PACKAGE__->load_components(qw{Helper::ResultSet::Bare}); sub set_value { my ($self, $key, $value) = @_; $self->bare->create_or_update({ key => $key, value => $value, }); } 1; =head1 DESCRIPTION Once in a blue moon you will find yourself in the frustrating position of needing a vanilla ResultSet when all you have is a ResultSet that has a search applied to it. That's what this helper is for; it gives you a method to get at an unsearched version of the ResultSet. =head1 METHODS =head2 C my $plain_rs = $searched_rs->bare; Takes no arguments and returns the ResultSet as if nothing were searched against it at all. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet/Me.pm0000644000175000017500000000354313624003631022340 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet::Me; $DBIx::Class::Helper::ResultSet::Me::VERSION = '2.035000'; # ABSTRACT: Define predefined searches more nicely use strict; use warnings; use parent 'DBIx::Class::ResultSet'; sub me { join('.', shift->current_source_alias, shift || q{}) } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet::Me - Define predefined searches more nicely =head1 SYNOPSIS # note that this is normally a component for a ResultSet package MySchema::ResultSet::Bar; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; use constant CANDY => 1; __PACKAGE__->load_components('Helper::ResultSet::Me'); sub candy { $_[0]->search({ $_[0]->me.'type' => CANDY }) } sub cake { $_[0]->search({ $_[0]->me('type') => CAKE }) } # in code using resultset: my $candy_bars = $schema->resultset('Bar')->candy; my $cake_bars = $schema->resultset('Bar')->cake; =head1 DESCRIPTION This component allows slightly nicer predefined search definition. See L for a nice way to apply it to your entire schema. It defines a single method that is shorter and (to most) clearer than L, which is what it uses for the L method. =head1 METHODS =head2 me Merely returns the SQL namespace for the current search with a C<.> at the end, allowing internal resultset methods to be defined with C<< $self->me >> instead of C<< $self->current_source_alias . q(.) >>. Also, if you pass it a single argument it will append that to the returned string. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/VirtualView.pm0000644000175000017500000000207413624003631022324 0ustar frewfrewpackage DBIx::Class::Helper::VirtualView; $DBIx::Class::Helper::VirtualView::VERSION = '2.035000'; use parent 'DBIx::Class::Helper::ResultSet::VirtualView'; use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Clean up your SQL namespace 1; __END__ =pod =head1 NAME DBIx::Class::Helper::VirtualView - (DEPRECATED) Clean up your SQL namespace =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/0000775000175000017500000000000013624003631020253 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/ProxyResultSetMethod.pm0000644000175000017500000001035413624003631024747 0ustar frewfrewpackage DBIx::Class::Helper::Row::ProxyResultSetMethod; $DBIx::Class::Helper::Row::ProxyResultSetMethod::VERSION = '2.035000'; # ABSTRACT: Efficiently reuse ResultSet methods from results with fallback use strict; use warnings; use parent 'DBIx::Class::Helper::Row::SelfResultSet', 'DBIx::Class::Row'; use Sub::Name (); use DBIx::Class::Candy::Exports; export_methods [qw( proxy_resultset_method )]; __PACKAGE__->mk_group_accessors(inherited => '_proxy_slots'); sub proxy_resultset_method { my ($self, $name, $attr) = @_; my $rs_method = $attr->{resultset_method} || "with_$name"; my $slot = $attr->{slot} || $name; $self->_proxy_slots([]) unless $self->_proxy_slots; push @{$self->_proxy_slots}, $slot; no strict 'refs'; my $method = $self . '::' . $name; *{$method} = Sub::Name::subname $method, sub { my ($self) = @_; use strict 'refs'; unless ($self->has_column_loaded($slot)) { # boo. The accessor checks that there's an actual column defined, so we # skip it so we can cache results. $self->{_column_data}{$slot} = undef; $self->set_column( $slot, $self->self_rs ->search(undef, { columns => [] }) ->$rs_method ->get_column($slot) ->next, ); } return $self->get_column($slot) } } sub copy { delete local @{$_[0]->{_column_data}}{@{$_[0]->_proxy_slots||[]}}; shift->next::method(@_); } sub update { delete local @{$_[0]->{_dirty_columns}}{@{$_[0]->_proxy_slots||[]}}; shift->next::method(@_); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::ProxyResultSetMethod - Efficiently reuse ResultSet methods from results with fallback =head1 SYNOPSIS ResultSet: package MyApp::Schema::ResultSet::Foo; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw( Helper::ResultSet::CorrelateRelationship )); ...; sub with_friend_count { shift->search(undef, { '+columns' => { 'friend_count' => $self->correlate('friends')->count_rs->as_query, }, }) } Result: package MyApp::Schema::Result::Foo; use parent 'DBIx::Class::Core'; __PACKAGE__->load_components(qw( Helper::Row::ProxyResultSetMethod )); __PACKAGE__->proxy_resultset_method('friend_count'); or with L: package MyApp::Schema::Result::Foo; use DBIx::Class::Candy -components => ['Helper::Row::ProxyResultSetMethod']; proxy_resultset_method 'friend_count'; Elsewhere: my $row = $foo_rs->first; say $row->friend_count . ' friends'; =head1 DESCRIPTION This module makes reusing resultset methods from a result trivially easy. You should be using it. =head1 METHODS =head2 proxy_resultset_method __PACKAGE__->proxy_resultset_method( $name => { slot => $slot, resultset_method => $rs_method }); C's first argument is the name of the method to generate and is required. The other two arguments, C<$slot>, and C<$resultset_method> are optional. If unspecified C<$slot> will default to C<$name> and C<$resultset_method> will default to C<"with_$name">. C<$slot> is the column that the data being retrieved is stored as in the ResultSet method being proxied to. C<$resultset_method> is (duh) the ResultSet method being proxied to. If you did not call the C method on your ResultSet, and call the proxy method, it will transparently B and do the call and fetch the needed data. E.g.: my $foo = $schema->resultset('Foo')->first; ## did not call with_friend_count print $foo->friend_count; ## will produce desired result magically =head1 CANDY EXPORTS If used in conjunction with L this component will export: =over =item proxy_resultset_method =back =head1 DEDICATION This module is dedicated to Ray Bradbury, who wrote Something Wicked This Way Comes, Dandelion Wine, and numerous short stories, plays, etc etc. Read this author's books. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/ProxyResultSetUpdate.pm0000644000175000017500000000447313624003631024756 0ustar frewfrewpackage DBIx::Class::Helper::Row::ProxyResultSetUpdate; $DBIx::Class::Helper::Row::ProxyResultSetUpdate::VERSION = '2.035000'; # ABSTRACT: Efficiently reuse ResultSet updates from results use strict; use warnings; use parent 'DBIx::Class::Helper::Row::SelfResultSet', 'DBIx::Class::Row'; sub update { my ($self, $upd) = @_; $self->set_inflated_columns($upd) if $upd; my %to_update = $self->get_dirty_columns or return $self; $self->throw_exception( "Not in database" ) unless $self->in_storage; # copied directly from DBIx::Class::Row except for this line my $rows = $self->self_rs->update(\%to_update); if ($rows == 0) { $self->throw_exception( "Can't update ${self}: row not found" ); } elsif ($rows > 1) { $self->throw_exception("Can't update ${self}: updated more than one row"); } $self->{_dirty_columns} = {}; $self->{related_resultsets} = {}; delete $self->{_column_data_in_storage}; return $self; } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::ProxyResultSetUpdate - Efficiently reuse ResultSet updates from results =head1 SYNOPSIS ResultSet: package MyApp::Schema::ResultSet::Foo; use parent 'DBIx::Class::ResultSet'; sub update { my ($self, $data) = @_; die 'you fool!' if $data->{name} eq 'fool'; return $self->next::method($data); } Result: package MyApp::Schema::Result::Foo; use parent 'DBIx::Class::Core'; __PACKAGE__->load_components(qw( Helper::Row::ProxyResultSetUpdate )); ... or with L: package MyApp::Schema::Result::Foo; use DBIx::Class::Candy -components => ['Helper::Row::ProxyResultSetMethod']; ... =head1 DESCRIPTION This module makes reusing resultset updates from a result trivially easy. Often the only way that people share update methods is by overriding update in their resultset to use L. Unfortunately, that can end up being wildly inefficient. Instead, if you can write your update in terms of the resultset, you can make your code much faster and more efficient. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/RelationshipDWIM.pm0000644000175000017500000000366113624003631023737 0ustar frewfrewpackage DBIx::Class::Helper::Row::RelationshipDWIM; $DBIx::Class::Helper::Row::RelationshipDWIM::VERSION = '2.035000'; # ABSTRACT: Type less for your relationships! use strict; use warnings; use parent 'DBIx::Class::Row'; sub default_result_namespace { die 'you forgot to set your default_result_namespace' } sub belongs_to { my ( $self, @args ) = @_; $args[1] =~ s/^::/$self->default_result_namespace . '::'/e; $self->next::method(@args); } sub has_many { my ( $self, @args ) = @_; $args[1] =~ s/^::/$self->default_result_namespace . '::'/e; $self->next::method(@args); } sub might_have { my ( $self, @args ) = @_; $args[1] =~ s/^::/$self->default_result_namespace . '::'/e; $self->next::method(@args); } sub has_one { my ( $self, @args ) = @_; $args[1] =~ s/^::/$self->default_result_namespace . '::'/e; $self->next::method(@args); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::RelationshipDWIM - Type less for your relationships! =head1 SYNOPSIS Base clase: package MyApp::Schema::Result; use parent 'DBIx::Class::Core'; __PACKAGE__->load_components('Helper::Row::RelationshipDWIM'); sub default_result_namespace { 'MyApp::Schema::Result' } 1; Result class: package MyApp::Schema::Result::Foo; use parent 'MyApp::Schema::Result'; # Define various class bits here # succinct relationship definition yeah! __PACKAGE__->has_many(friends => '::Person', 'foo_id'); # or with DBIx::Class::Candy: has_many friends => '::Person', 'foo_id'; 1; =head1 DESCRIPTION This module prepends your C to related objects if they begin with C<::>. Simple but handy. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/OnColumnMissing.pm0000644000175000017500000000751713624003631023705 0ustar frewfrewpackage DBIx::Class::Helper::Row::OnColumnMissing; $DBIx::Class::Helper::Row::OnColumnMissing::VERSION = '2.035000'; # ABSTRACT: Configurably handle access of missing columns use strict; use warnings; use parent 'DBIx::Class::Row'; sub on_column_missing { 'warn' } sub on_column_missing_die { die "Column $_[1] has not been loaded" } sub on_column_missing_warn { warn "Column $_[1] has not been loaded" } sub on_column_missing_nothing {} sub get_column { my ($self, $column_name) = @_; if ($self->has_column_loaded($column_name)) { $self->next::method($column_name) } else { my $action = $self->on_column_missing; unless (ref $action) { $action = "on_column_missing_$action" unless ref $action; $action = $self->can($action); } scalar $self->$action($column_name) } } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::OnColumnMissing - Configurably handle access of missing columns =head1 SYNOPSIS package MyApp::Schema::Result::Account; use parent 'DBIx::Class::Core'; __PACKAGE__->load_components(qw(Helper::Row::OnColumnMissing)); __PACKAGE__->table('Account'); __PACKAGE__->add_columns( id => { data_type => 'integer', is_auto_increment => 1, }, name => { data_type => 'varchar', size => 25, }, book => { data_type => 'text' }, ); sub on_column_missing { 'die' } 1; Or with L: package MyApp::Schema::Result::Account; use DBIx::Class::Candy -components => ['Helper::Row::OnColumnMissing']; table 'Account'; column id => { data_type => 'integer', is_auto_increment => 1, }; column amount => { data_type => 'float', keep_storage_value => 1, }; column book => { data_type => 'text' }; sub on_column_missing { 'die' } 1; Elsewhere: my $row = $rs->search(undef, { columns => [qw( id name )] })->one_row; $row->book # dies =head1 DESCRIPTION This module is written to handle the odd condition where you have limited the columns retrieved from the database but accidentally access one of the ones not included. It is configurable by tweaking the C return value. =head1 MODES You specify the C by returning the C from the C method. By default the C returned is C. The predefined modes are: =over 2 =item C Dies with C. =item C Warns with C. =item C Does nothing =back You can predefine more modes by defining methods named C, and also override the default modes by overriding the corresponding methods. If you need ad-hoc behavior you can return a code reference and that will be called as a method on the object. =head2 ADVANCED USAGE If for some reason you find that you need to change your C at runtime, you can always replace the C with an accessor. For example: __PACKAGE__->mk_group_accessors(inherited => 'on_column_missing'); __PACKAGE__->on_column_missing('warn'); Elsewhere: $row->on_column_missing('die'); If you are especially crazy you could even do something like this: $row->on_column_missing(sub { my ($self, $column) = @_; $self ->result_source ->resultset ->search({ id => $self->id }) ->get_column($column) ->single }); Though if you do that I would make it a named mode (maybe C?) =head1 THANKS Thanks L for funding the development of this module. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/OnColumnChange.pm0000644000175000017500000002362713624003631023461 0ustar frewfrewpackage DBIx::Class::Helper::Row::OnColumnChange; $DBIx::Class::Helper::Row::OnColumnChange::VERSION = '2.035000'; # ABSTRACT: Do things when the values of a column change use strict; use warnings; use parent 'DBIx::Class::Helper::Row::StorageValues', 'DBIx::Class::Row'; use List::Util 'first'; use DBIx::Class::Candy::Exports; use namespace::clean; export_methods [qw(before_column_change around_column_change after_column_change)]; __PACKAGE__->mk_group_accessors(inherited => $_) for qw(_before_change _around_change _after_change); sub before_column_change { die 'Invalid number of arguments. One $column => $args pair at a time.' unless @_ == 3; my $self = shift; my $column = shift; my $args = shift; die 'method is a required parameter' unless $args->{method}; $args->{column} = $column; $args->{txn_wrap} = !!$args->{txn_wrap}; $self->_before_change([]) unless $self->_before_change; push @{$self->_before_change}, $args; } sub around_column_change { die 'Invalid number of arguments. One $column => $args pair at a time.' unless @_ == 3; my $self = shift; my $column = shift; my $args = shift; die 'no method passed!' unless $args->{method}; $args->{column} = $column; $args->{txn_wrap} = !!$args->{txn_wrap}; $self->_around_change([]) unless $self->_around_change; push @{$self->_around_change}, $args; } sub after_column_change { die 'Invalid number of arguments. One $column => $args pair at a time.' unless @_ == 3; my $self = shift; my $column = shift; my $args = shift; die 'no method passed!' unless $args->{method}; $args->{column} = $column; $args->{txn_wrap} = !!$args->{txn_wrap}; $self->_after_change([]) unless $self->_after_change; unshift @{$self->_after_change}, $args; } sub update { my ($self, $args) = @_; $self->set_inflated_columns($args) if $args; my %dirty = $self->get_dirty_columns or return $self; my @all_before = @{$self->_before_change || []}; my @all_around = @{$self->_around_change || []}; my @all_after = @{$self->_after_change || []}; # prepare functions my @before = grep { defined $dirty{$_->{column}} } @all_before; my @around = grep { defined $dirty{$_->{column}} } @all_around; my @after = grep { defined $dirty{$_->{column}} } @all_after; my $inner = $self->next::can; my $final = $self->on_column_change_allow_override_args ? sub { $self->$inner } : sub { $self->$inner($args) }; for ( reverse @around ) { my $fn = $_->{method}; my $old = $self->get_storage_value($_->{column}); my $new = $dirty{$_->{column}}; my $old_final = $final; $final = sub { $self->$fn($old_final, $old, $new) }; } # do we wrap it in a transaction? my $txn_wrap = first { defined $dirty{$_->{column}} && $_->{txn_wrap} } @all_before, @all_around, @all_after; my $guard; $guard = $self->result_source->schema->txn_scope_guard if $txn_wrap; for (@before) { my $fn = $_->{method}; my $old = $self->get_storage_value($_->{column}); my $new = $dirty{$_->{column}}; $self->$fn($old, $new); } my $ret = $final->(); for (@after) { my $fn = $_->{method}; my $old = $self->get_storage_value($_->{column}); my $new = $dirty{$_->{column}}; $self->$fn($old, $new); } $guard->commit if $txn_wrap; $ret } sub on_column_change_allow_override_args { 0 } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::OnColumnChange - Do things when the values of a column change =head1 SYNOPSIS package MyApp::Schema::Result::Account; use parent 'DBIx::Class::Core'; __PACKAGE__->load_components(qw(Helper::Row::OnColumnChange)); __PACKAGE__->table('Account'); __PACKAGE__->add_columns( id => { data_type => 'integer', is_auto_increment => 1, }, amount => { data_type => 'float', keep_storage_value => 1, }, ); sub on_column_change_allow_override_args { 1 } __PACKAGE__->before_column_change( amount => { method => 'bank_transfer', txn_wrap => 1, } ); sub bank_transfer { my ($self, $old_value, $new_value) = @_; my $delta = abs($old_value - $new_value); if ($old_value < $new_value) { Bank->subtract($delta) } else { Bank->add($delta) } } 1; or with L: package MyApp::Schema::Result::Account; use DBIx::Class::Candy -components => ['Helper::Row::OnColumnChange']; table 'Account'; column id => { data_type => 'integer', is_auto_increment => 1, }; column amount => { data_type => 'float', keep_storage_value => 1, }; sub on_column_change_allow_override_args { 1 } before_column_change amount => { method => 'bank_transfer', txn_wrap => 1, }; sub bank_transfer { my ($self, $old_value, $new_value) = @_; my $delta = abs($old_value - $new_value); if ($old_value < $new_value) { Bank->subtract($delta) } else { Bank->add($delta) } } 1; =head1 DESCRIPTION This module codifies a pattern that I've used in a number of projects, namely that of doing B when a column changes it's value in the database. It leverages L for passing in the C<$old_value>, which do not have to use. If you leave the C out of the column definition it will just pass C in as the $old_value. Also note the C option. This allows you to specify that you want the call to C and the call to the method you requested to be wrapped in a transaction. If you end up calling more than one method due to multiple column change methods and more than one specify C it will still only wrap once. I've gone to great lengths to ensure that order is preserved, so C and C changes are called in order of definition and C changes are called in reverse order. To be clear, the change methods only get called if the value will be changed after C runs. It correctly looks at the current value of the column as well as the arguments passed to C. =head1 CANDY EXPORTS If used in conjunction with L this component will export: =over =item before_column_change =item around_column_change =item after_column_change =back =head1 NO SURPRISE RACE CONDITIONS One thing that should be made totally clear is that the column change callbacks are in effect B<< only once >> in a given update. If you expect to be able to do something weird like calling one of the callbacks which changes a value with an accessor which calls a callback etc etc, you probably just need to write some code to do that yourself. This helper is specifically made with the aim of reacting to changes immediately before they hit the database. =head1 METHODS =head2 before_column_change __PACKAGE__->before_column_change( col_name => { method => 'method', # <-- anything that can be called as a method txn_wrap => 1, # <-- true if you want it to be wrapped in a txn } ); Note: the arguments passed to C will be C<< $self, $old_value, $new_value >>. =head2 after_column_change __PACKAGE__->after_column_change( col_name => { method => 'method', # <-- anything that can be called as a method txn_wrap => 1, # <-- true if you want it to be wrapped in a txn } ); Note: the arguments passed to C will be C<< $self, $new_value, $new_value >>. (Because the old value has been changed.) =head2 around_column_change __PACKAGE__->around_column_change( col_name => { method => 'method', # <-- anything that can be called as a method txn_wrap => 1, # <-- true if you want it to be wrapped in a txn } ); Note: the arguments passed to C will be C<< $self, $next, $old_value, $new_value >>. Around is subtly different than the other two callbacks. You B call C<$next> in your method or it will not work at all. A silly example of how this is done could be: sub around_change_name { my ($self, $next, $old, $new) = @_; my $govt_records = $self->govt_records; $next->(); $govt_records->update({ name => $new }); } Note: the above code implies a weird database schema. I haven't actually seen a time when I've needed around yet, but it seems like there is a use-case. Also Note: you don't get to change the args to C<$next>. If you think you should be able to, you probably don't understand what this component is for. That or you know something I don't (equally likely.) =head2 on_column_change_allow_override_args This is a method that allows a user to circumvent a strange bug in the initial implementation. Basically, if the user wanted, she could use L to override the value of a given column before C gets called, thus replacing the value. Unfortunately this worked in the case of accessors setting the value, but not if the user had used an argument to C. To be clear, if you want the following to actually replace the value: __PACKAGE__->before_column_change( name => { method => sub { my ($self, $old, $new) = @_; $self->name(uc $new); }, }, ); you will need to define this in your result class: sub on_column_change_allow_override_args { 1 } If for some reason you need the old style, a default of false is already set. If you are painted in the corner and need both, you can create an accessor and set it yourself to change the behavior: __PACKAGE__->mk_group_accessors(inherited => 'on_column_change_allow_override_args'); ... $obj->on_column_change_allow_override_args(1); # works the new way =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/CleanResultSet.pm0000644000175000017500000000204513624003631023505 0ustar frewfrewpackage DBIx::Class::Helper::Row::CleanResultSet; $DBIx::Class::Helper::Row::CleanResultSet::VERSION = '2.035000'; # ABSTRACT: Get an unfiltered ResultSet from the row use strict; use warnings; use parent 'DBIx::Class::Row'; sub clean_rs { return shift->result_source->resultset } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::CleanResultSet - Get an unfiltered ResultSet from the row =head1 SYNOPSIS In result class: __PACKAGE__->load_components('Helper::Row::CleanResultSet'); Elsewhere: $row->clean_rs->$some_rs_method similar to: $row->result_source->resultset->$some_rs_method =head1 DESCRIPTION Sometimes you need to be able to access the ResultSet containing all rows. =head1 METHODS =head2 clean_rs $row->clean_rs =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/StorageValues.pm0000644000175000017500000000735513624003631023405 0ustar frewfrewpackage DBIx::Class::Helper::Row::StorageValues; $DBIx::Class::Helper::Row::StorageValues::VERSION = '2.035000'; # ABSTRACT: Keep track of stored vs in-memory row values use strict; use warnings; use parent 'DBIx::Class::Row'; __PACKAGE__->mk_group_accessors(inherited => '_storage_value_columns'); __PACKAGE__->mk_group_accessors(inherited => '_storage_values'); sub _has_storage_value { $_[0]->column_info($_[1])->{keep_storage_value} } sub storage_value_columns { my $self = shift; if (!$self->_storage_value_columns) { $self->_storage_value_columns([ grep $self->_has_storage_value($_), $self->result_source->columns ]); } return $self->_storage_value_columns; } sub store_storage_values { my $self = shift; $self->_storage_values({ map { my $acc = ($self->column_info($_)->{accessor} || $_); $_ => $self->$acc } @{$self->storage_value_columns} }); $self->_storage_values; } sub get_storage_value { $_[0]->_storage_values->{$_[1]} } sub new { my $class = shift; my $ret = $class->next::method(@_); $ret->_storage_values({}); $ret; } sub inflate_result { my $class = shift; my $ret = $class->next::method(@_); $ret->store_storage_values; $ret; } sub insert { my $self = shift; my $ret = $self->next::method(@_); $ret->store_storage_values; $ret; } sub update { my $self = shift; my $ret = $self->next::method(@_); $ret->store_storage_values; $ret; } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::StorageValues - Keep track of stored vs in-memory row values =head1 SYNOPSIS package MyApp::Schema::Result::BlogPost; use parent 'DBIx::Class::Core'; __PACKAGE__->load_components(qw(Helper::Row::StorageValues)); __PACKAGE__->table('BlogPost'); __PACKAGE__->add_columns( id => { data_type => 'integer', is_auto_increment => 1, }, title => { data_type => 'varchar', length => 32, keep_storage_value => 1, }, body => { data_type => 'text', }, ); 1; # elsewhere: my $post = $blog_rs->create({ title => 'Components for fun and profit', body => '...', }); $post->title('Components for fun'); warn sprintf 'Changing title from %s to %s', $post->storage_value('title'), $post->title; $post->update; =head1 DESCRIPTION This component keeps track of the value for a given column in the database. If you change the column's value and do not call C, the C will be different; once C is called the C will be set to the value of the accessor. Note that the fact that it uses the accessor is an important distinction. If you are using L or L it will get the non-storage or inflated values, respectively. =head1 METHODS =head2 _has_storage_value $self->_has_storage_value('colname') returns true if we should store the storage value from the database. Override this if you'd like to enable storage on all integers or something like that: sub _has_storage_value { my ( $self, $column ) = @_; my $info = $self->column_info($column); return defined $info->{data_type} && $info->{data_type} eq 'integer'; } =head2 storage_value_columns $self->storage_value_columns returns a list of columns to store =head2 get_storage_value $self->get_storage_value('colname') returns the value for that column which is in storage =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/SelfResultSet.pm0000644000175000017500000000331013624003631023350 0ustar frewfrewpackage DBIx::Class::Helper::Row::SelfResultSet; $DBIx::Class::Helper::Row::SelfResultSet::VERSION = '2.035000'; # ABSTRACT: Easily use ResultSet methods for the current row use strict; use warnings; use parent 'DBIx::Class::Row'; sub self_rs { my ($self) = @_; my $rs = $self->result_source->resultset; return $rs->search( $self->ident_condition( $rs->current_source_alias ) ); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::SelfResultSet - Easily use ResultSet methods for the current row =head1 SYNOPSIS In result class: __PACKAGE__->load_components('Helper::Row::SelfResultSet'); Elsewhere: $row->self_rs->$some_rs_method->single =head1 DESCRIPTION Sometimes you need to be able to access a ResultSet containing just the current row. A good reason to do that would be if you had a ResultSet method that adds in some calculated data, like counts of a relationship. You could use this to get at that counted data without duplicating the logic for the counting. Due to primitives provided by L this references the current values, or in C terms, the dirty values. So if you modify the primary columns it will be temporarily incorrect. For what it's worth I'm not married to this behavior and I'd rather you get in touch with me before you depend on it. =head1 METHODS =head2 self_rs $row->self_rs returns a ResultSet containing B the current row. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/NumifyGet.pm0000644000175000017500000000364013624003631022521 0ustar frewfrewpackage DBIx::Class::Helper::Row::NumifyGet; $DBIx::Class::Helper::Row::NumifyGet::VERSION = '2.035000'; # ABSTRACT: Force numeric "context" on numeric columns use strict; use warnings; use parent 'DBIx::Class::Row'; use Try::Tiny; sub get_column { my ($self, $col) = @_; my $value = $self->next::method($col); $value += 0 if defined($value) and # for nullable and autoinc fields try { $self->_is_column_numeric($col) }; return $value; } sub get_columns { my ($self, $col) = @_; my %columns = $self->next::method($col); for (keys %columns) { $columns{$_} += 0 if defined($columns{$_}) and # for nullable and autoinc fields try { $self->_is_column_numeric($_) }; } return %columns; } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::NumifyGet - Force numeric "context" on numeric columns =head1 SYNOPSIS package MyApp::Schema::Result::Foo_Bar; __PACKAGE__->load_components(qw{Helper::Row::NumifyGet Core}); __PACKAGE__->table('Foo'); __PACKAGE__->add_columns( foo => { data_type => 'integer', is_nullable => 0, is_numeric => 1, }, ); sub TO_JSON { return { foo => $self->foo, # this becomes 0 instead of "0" due to context } } =head1 METHODS =head2 get_column This is the method that "converts" the values. It just checks for C and if that is true it will numify the value. =head2 get_columns This method also "converts" values, but this one is called a lot more rarely. Again, It just checks for C and if that is true it will numify the value. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/JoinTable.pm0000644000175000017500000002167013624003631022464 0ustar frewfrewpackage DBIx::Class::Helper::Row::JoinTable; $DBIx::Class::Helper::Row::JoinTable::VERSION = '2.035000'; # ABSTRACT: Easily set up join tables with DBIx::Class use strict; use warnings; use parent 'DBIx::Class::Row'; use DBIx::Class::Helpers::Util 'get_namespace_parts'; use Lingua::EN::Inflect (); use DBIx::Class::Candy::Exports; export_methods [qw( join_table generate_primary_key generate_has_manys generate_many_to_manys generate_relationships set_table add_join_columns )]; my $decamelize = sub { my $s = shift; $s =~ s{([^a-zA-Z]?)([A-Z]*)([A-Z])([a-z]?)}{ my $fc = pos($s)==0; my ($p0,$p1,$p2,$p3) = ($1,lc$2,lc$3,$4); my $t = $p0 || $fc ? $p0 : '_'; $t .= $p3 ? $p1 ? "${p1}_$p2$p3" : "$p2$p3" : "$p1$p2"; $t; }ge; $s; }; sub _pluralize { my $self = shift; my $original = shift or return; return join q{_}, split /\s+/, Lingua::EN::Inflect::PL(join q{ }, split /_/, $original); } sub _defaults { my ($self, $params) = @_; $params->{namespace} ||= [ get_namespace_parts($self) ]->[0]; $params->{left_method} ||= $decamelize->($params->{left_class}); $params->{right_method} ||= $decamelize->($params->{right_class}); $params->{self_method} ||= $decamelize->($self); $params->{left_method_plural} ||= $self->_pluralize($params->{left_method}); $params->{right_method_plural} ||= $self->_pluralize($params->{right_method}); $params->{self_method_plural} ||= $self->_pluralize($params->{self_method}); return $params; } sub join_table { my ($self, $params) = @_; $self->set_table($params); $self->add_join_columns($params); $self->generate_relationships($params); $self->generate_primary_key($params); } sub generate_primary_key { my ($self, $params) = @_; $self->_defaults($params); $self->set_primary_key("$params->{left_method}_id", "$params->{right_method}_id"); } sub generate_has_manys { my ($self, $params) = @_; $params = $self->_defaults($params); "$params->{namespace}::$params->{left_class}"->has_many( $params->{self_method} => $self, "$params->{left_method}_id" ); "$params->{namespace}::$params->{right_class}"->has_many( $params->{self_method} => $self, "$params->{right_method}_id" ); } sub generate_many_to_manys { my ($self, $params) = @_; $params = $self->_defaults($params); "$params->{namespace}::$params->{left_class}"->many_to_many( $params->{right_method_plural} => $params->{self_method}, $params->{right_method} ); "$params->{namespace}::$params->{right_class}"->many_to_many( $params->{left_method_plural} => $params->{self_method}, $params->{left_method} ); } sub generate_relationships { my ($self, $params) = @_; $params = $self->_defaults($params); $self->belongs_to( $params->{left_method} => "$params->{namespace}::$params->{left_class}", "$params->{left_method}_id" ); $self->belongs_to( $params->{right_method} => "$params->{namespace}::$params->{right_class}", "$params->{right_method}_id" ); } sub set_table { my ($self, $params) = @_; $self->table("$params->{left_class}_$params->{right_class}"); } sub _add_join_column { my ($self, $params) = @_; my $class = $params->{class}; my $method = $params->{method}; my $default = { data_type => 'integer', is_nullable => 0, is_numeric => 1, }; $self->ensure_class_loaded($class); my @datas = qw{is_nullable extra data_type size is_numeric}; my @class_column_info = ( map { my $info = $class->column_info($_); my $result = {}; my $defined = undef; for (@datas) { if (defined $info->{$_}) { $defined = 1; $result->{$_} = $info->{$_}; } } $result = $default unless $defined; $result; } $class->primary_columns ); if (@class_column_info == 1) { $self->add_columns( "${method}_id" => $class_column_info[0], ); } else { my $i = 0; for (@class_column_info) { $i++; $self->add_columns( "${method}_${i}_id" => $_ ); } } } sub add_join_columns { my ($self, $params) = @_; $params = $self->_defaults($params); my $l_class = "$params->{namespace}::$params->{left_class}"; my $r_class = "$params->{namespace}::$params->{right_class}"; $self->_add_join_column({ class => $l_class, method => $params->{left_method} }); $self->_add_join_column({ class => $r_class, method => $params->{right_method} }); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::JoinTable - Easily set up join tables with DBIx::Class =head1 SYNOPSIS package MyApp::Schema::Result::Foo_Bar; __PACKAGE__->load_components(qw{Helper::Row::JoinTable Core}); __PACKAGE__->join_table({ left_class => 'Foo', left_method => 'foo', right_class => 'Bar', right_method => 'bar', }); # the above is the same as: __PACKAGE__->table('Foo_Bar'); __PACKAGE__->add_columns( foo_id => { data_type => 'integer', is_nullable => 0, is_numeric => 1, }, bar_id => { data_type => 'integer', is_nullable => 0, is_numeric => 1, }, ); $self->set_primary_key(qw{foo_id bar_id}); __PACKAGE__->belongs_to( foo => 'MyApp::Schema::Result::Foo' 'foo_id'); __PACKAGE__->belongs_to( bar => 'MyApp::Schema::Result::Bar' 'bar_id'); or with L: package MyApp::Schema::Result::Foo_Bar; use DBIx::Class::Candy -components => ['Helper::Row::JoinTable']; join_table { left_class => 'Foo', left_method => 'foo', right_class => 'Bar', right_method => 'bar', }; =head1 METHODS All the methods take a configuration hashref that looks like the following: { left_class => 'Foo', left_method => 'foo', # see NOTE left_method_plural => 'foos', # see NOTE, not required, used for # many_to_many rel name in right_class # which is not generated by default right_class => 'Bar', right_method => 'bar', # see NOTE right_method_plural => 'bars', # see NOTE, not required, used for # many_to_many rel name in left_class # which is not generated by default namespace => 'MyApp', # default is guessed via *::Foo self_method => 'foobars', # not required, used for setting the name of the # join table's relationship in a has_many # which is not generated by default } =head2 join_table This is the method that you probably want. It will set your table, add columns, set the primary key, and set up the relationships. =head2 add_join_columns Adds two non-nullable integer fields named C<"${left_method}_id"> and C<"${right_method}_id"> respectively. =head2 generate_has_manys Installs methods into C and C to get to the join table. The methods will be named what's passed into the configuration hashref as C. =head2 generate_many_to_manys Installs many_to_many methods into C and C. The methods will be named what's passed into the configuration hashref as C for the C and C for the C. =head2 generate_primary_key Sets C<"${left_method}_id"> and C<"${right_method}_id"> to be the primary key. =head2 generate_relationships This adds relationships to C<"${namespace}::Schema::Result::$left_class"> and C<"${namespace}::Schema::Result::$left_class"> respectively. =head2 set_table This method sets the table to "${left_class}_${right_class}". =head1 CANDY EXPORTS If used in conjunction with L this component will export: =over =item join_table =item generate_primary_key =item generate_has_manys =item generate_many_to_manys =item generate_relationships =item set_table =item add_join_columns =back =head2 NOTE This module uses (an internal fork of) L to default the method names and uses L for pluralization. =head1 CHANGES BETWEEN RELEASES =head2 Changes since 0.* Originally this module would use data_type => 'integer', is_nullable => 0, is_numeric => 1, for all joining columns. It now infers C, C, C, and C from the foreign tables. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/SubClass.pm0000644000175000017500000000726213624003631022335 0ustar frewfrewpackage DBIx::Class::Helper::Row::SubClass; $DBIx::Class::Helper::Row::SubClass::VERSION = '2.035000'; # ABSTRACT: Convenient subclassing with DBIx::Class use strict; use warnings; use parent 'DBIx::Class::Row'; use DBIx::Class::Helpers::Util qw{get_namespace_parts assert_similar_namespaces}; use DBIx::Class::Candy::Exports; export_methods [qw(subclass generate_relationships set_table)]; sub subclass { my $self = shift; my $namespace = shift; $self->set_table; $self->generate_relationships($namespace); } sub generate_relationships { my $self = shift; my ($namespace) = get_namespace_parts($self); foreach my $rel ($self->relationships) { my $rel_info = $self->relationship_info($rel); my $class = $rel_info->{class}; assert_similar_namespaces($self, $class); my (undef, $result) = get_namespace_parts($class); $self->add_relationship( $rel, "${namespace}::$result", $rel_info->{cond}, $rel_info->{attrs} ); }; } sub set_table { my $self = shift; $self->table($self->table); } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::SubClass - Convenient subclassing with DBIx::Class =head1 SYNOPSIS # define parent class package ParentSchema::Result::Bar; use strict; use warnings; use parent 'DBIx::Class'; __PACKAGE__->load_components('Core'); __PACKAGE__->table('Bar'); __PACKAGE__->add_columns(qw/ id foo_id /); __PACKAGE__->set_primary_key('id'); __PACKAGE__->belongs_to( foo => 'ParentSchema::Result::Foo', 'foo_id' ); # define subclass package MySchema::Result::Bar; use strict; use warnings; use parent 'ParentSchema::Result::Bar'; __PACKAGE__->load_components(qw{Helper::Row::SubClass Core}); __PACKAGE__->subclass; or with L: # define subclass package MySchema::Result::Bar; use DBIx::Class::Candy -base => 'ParentSchema::Result::Bar', -components => ['Helper::Row::SubClass']; subclass; =head1 DESCRIPTION This component is to allow simple subclassing of L Result classes. =head1 METHODS =head2 subclass This is probably the method you want. You call this in your child class and it imports the definitions from the parent into itself. =head2 generate_relationships This is where the cool stuff happens. This assumes that the namespace is laid out in the recommended C format. If the parent has C related to C, and you inherit from C in C, you will automatically get the relationship to C. =head2 set_table This is a super basic method that just sets the current classes' table to the parent classes' table. =head1 CANDY EXPORTS If used in conjunction with L this component will export: =over =item join_table =item subclass =item generate_relationships =item set_table =back =head1 NOTE This Component is mostly aimed at those who want to subclass parts of a schema, maybe for sharing a login system in a few different projects. Do not confuse it with L, which solves an entirely different problem. DBIx::Class::DynamicSubclass is for when you want to store a few very similar classes in the same table (Employee, Person, Boss, etc) whereas this component is merely for reusing an existing schema. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Row/ToJSON.pm0000644000175000017500000001037613624003631021672 0ustar frewfrewpackage DBIx::Class::Helper::Row::ToJSON; $DBIx::Class::Helper::Row::ToJSON::VERSION = '2.035000'; # ABSTRACT: Remove the boilerplate from your TO_JSON functions use strict; use warnings; use parent 'DBIx::Class::Row'; __PACKAGE__->mk_group_accessors(inherited => '_serializable_columns'); __PACKAGE__->mk_group_accessors(inherited => '_unserializable_data_types'); my $dont_serialize = { text => 1, ntext => 1, blob => 1, }; sub _is_column_serializable { my ( $self, $column ) = @_; my $info = $self->column_info($column); if (!defined $info->{is_serializable}) { if (defined $info->{data_type} && $self->unserializable_data_types->{lc $info->{data_type}} ) { $info->{is_serializable} = 0; } else { $info->{is_serializable} = 1; } } return $info->{is_serializable}; } sub serializable_columns { my $self = shift; if (!$self->_serializable_columns) { $self->_serializable_columns([ grep $self->_is_column_serializable($_), $self->result_source->columns ]); } return $self->_serializable_columns; } sub TO_JSON { my $self = shift; my $columns_info = $self->columns_info($self->serializable_columns); return { map +($_ => $self->$_), map +($columns_info->{$_}{accessor} || $_), keys %$columns_info }; } sub unserializable_data_types { my $self = shift; if (!$self->_unserializable_data_types) { $self->_unserializable_data_types($dont_serialize); } return $self->_unserializable_data_types; } 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Row::ToJSON - Remove the boilerplate from your TO_JSON functions =head1 SYNOPSIS package MyApp::Schema::Result::KittenRobot; use parent 'DBIx::Class::Core'; __PACKAGE__->load_components(qw{Helper::Row::ToJSON}); __PACKAGE__->table('KittenRobot'); __PACKAGE__->add_columns( id => { data_type => 'integer', is_auto_increment => 1, }, kitten => { data_type => 'integer', }, robot => { data_type => 'text', is_nullable => 1, }, your_mom => { data_type => 'blob', is_nullable => 1, is_serializable => 1, }, ); 1; This helper adds a JSON method like the following: sub TO_JSON { return { id => $self->id, kitten => $self->kitten, # robot => $self->robot, # <-- doesn't serialize text columns your_mom => $self->your_mom, # <-- normally wouldn't but explicitly # asked for in the column spec above } } =head1 METHODS =head2 _is_column_serializable $self->_is_column_serializable('kitten') returns true if a column should be serializable or not. Currently this marks everything as serializable unless C is set to false, or C is a C, C, or C columns. If you wanted to only have explicit serialization you might override this method to look like this: sub _is_column_serializable { my ( $self, $column ) = @_; my $info = $self->column_info($column); return defined $info->{is_serializable} && $info->{is_serializable}; } =head2 serializable_columns $self->serializable_columns simply returns a list of columns that TO_JSON should serialize. =head2 TO_JSON $self->TO_JSON returns a hashref representing your object. Override this method to add data to the returned hashref: sub TO_JSON { my $self = shift; return { customer_name => $self->customer->name, %{ $self->next::method }, } } =head2 unserializable_data_types $self->unserializable_data_types Simply returns a hashref of data types that TO_JSON should not serialize. Defaults to C, C, or C. If you wanted to allow serialization of text data types, you might override this method to look like this: sub unserializable_data_types { return { blob => 1, ntext => 1, }; } =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/ResultSet.pm0000644000175000017500000000347513624003631022003 0ustar frewfrewpackage DBIx::Class::Helper::ResultSet; $DBIx::Class::Helper::ResultSet::VERSION = '2.035000'; # ABSTRACT: All the ResultSet Helpers in one place use parent qw{ DBIx::Class::Helper::ResultSet::AutoRemoveColumns DBIx::Class::Helper::ResultSet::CorrelateRelationship DBIx::Class::Helper::ResultSet::IgnoreWantarray DBIx::Class::Helper::ResultSet::Me DBIx::Class::Helper::ResultSet::NoColumns DBIx::Class::Helper::ResultSet::Random DBIx::Class::Helper::ResultSet::RemoveColumns DBIx::Class::Helper::ResultSet::ResultClassDWIM DBIx::Class::Helper::ResultSet::SearchOr DBIx::Class::Helper::ResultSet::SetOperations DBIx::Class::Helper::ResultSet::Shortcut }; 1; __END__ =pod =head1 NAME DBIx::Class::Helper::ResultSet - All the ResultSet Helpers in one place =head1 DESCRIPTION This is just a simple Helper helper that includes all of the ResultSet Helpers in one convenient module. It does not include deprecated helpers. =head2 NOTE You probably want this applied to your entire schema. The most convenient way to do that is to make a base ResultSet and inherit from that in all of your custom ResultSets as well has make it the default ResultSet for the non-custom ResultSets. Example: package My::App::Schema::ResultSet; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet'); 1; package My::App::Schema; use parent 'DBIx::Class::Schema'; My::App::Schema->load_namespaces( default_resultset_class => 'ResultSet', ); 1; =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/JoinTable.pm0000644000175000017500000000210413624003631021704 0ustar frewfrewpackage DBIx::Class::Helper::JoinTable; $DBIx::Class::Helper::JoinTable::VERSION = '2.035000'; use parent 'DBIx::Class::Helper::Row::JoinTable'; use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Easily set up join tables with DBIx::Class 1; __END__ =pod =head1 NAME DBIx::Class::Helper::JoinTable - (DEPRECATED) Easily set up join tables with DBIx::Class =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/SubClass.pm0000644000175000017500000000207113624003631021557 0ustar frewfrewpackage DBIx::Class::Helper::SubClass; $DBIx::Class::Helper::SubClass::VERSION = '2.035000'; use parent 'DBIx::Class::Helper::Row::SubClass'; use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Convenient subclassing with DBIx::Class 1; __END__ =pod =head1 NAME DBIx::Class::Helper::SubClass - (DEPRECATED) Convenient subclassing with DBIx::Class =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helper/Random.pm0000644000175000017500000000205513624003631021262 0ustar frewfrewpackage DBIx::Class::Helper::Random; $DBIx::Class::Helper::Random::VERSION = '2.035000'; use parent 'DBIx::Class::Helper::ResultSet::Random'; use Carp::Clan; carp 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 3; croak 'This module is deprecated! Please use the namespaced version instead!' if $VERSION >= 4; # ABSTRACT: (DEPRECATED) Get random rows from a ResultSet 1; __END__ =pod =head1 NAME DBIx::Class::Helper::Random - (DEPRECATED) Get random rows from a ResultSet =head1 DESCRIPTION This component has been suplanted by L. In the next major version (3) we will begin issuing a warning on it's use. In the major version after that (4) we will remove it entirely. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helpers/0000775000175000017500000000000013624003631017667 5ustar frewfrewDBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helpers/Util.pm0000644000175000017500000001317713624003631021151 0ustar frewfrewpackage DBIx::Class::Helpers::Util; $DBIx::Class::Helpers::Util::VERSION = '2.035000'; use strict; use warnings; # ABSTRACT: Helper utilities for DBIx::Class components use Sub::Exporter::Progressive -setup => { exports => [ qw( get_namespace_parts is_load_namespaces is_not_load_namespaces assert_similar_namespaces order_by_visitor normalize_connect_info ), ], }; sub get_namespace_parts { my $package = shift; if ($package =~ m/(^[\w:]+::Result)::([\w:]+)$/) { return ($1, $2); } else { die "$package doesn't look like ".'$namespace::Result::$resultclass'; } } sub is_load_namespaces { my $namespace = shift; $namespace =~ /^[\w:]+::Result::[\w:]+$/; } sub is_not_load_namespaces { my $namespace = shift; $namespace =~ /^([\w:]+)::[\w]+$/ and $1 !~ /::Result/; } sub assert_similar_namespaces { my $ns1 = shift; my $ns2 = shift; die "Namespaces $ns1 and $ns2 are dissimilar" unless is_load_namespaces($ns1) and is_load_namespaces($ns2) or is_not_load_namespaces($ns1) and is_not_load_namespaces($ns2); } sub _order_by_visitor_HASHREF { my ($hash, $callback) = @_; my %ret; # there should only be one k/v pair, but DBIC checks for that and I'm not # going to reimplement said check here. for my $k (keys %$hash) { my $v = $hash->{$k}; if (my $v_ref = ref $v) { if ($v_ref eq 'ARRAY' ) { $ret{$k} = [ map $callback->($_), @$v ] } else { die 'this should never happen' } } else { $ret{$k} = ($callback->($v)); } } \%ret } sub order_by_visitor { my ($order, $callback) = @_; if (my $top_ref = ref $order) { if ($top_ref eq 'HASH') { return _order_by_visitor_HASHREF($order, $callback) } elsif ($top_ref eq 'ARRAY') { return [ map { if (my $ref = ref $_) { if ($ref eq 'HASH') { _order_by_visitor_HASHREF($_, $callback) } else { die 'this should never happen' } } else { $callback->($_) } } @$order ]; } } else { return $callback->($order) } } sub normalize_connect_info { my %all; if (!ref $_[0]) { %all = ( dsn => $_[0], ( exists $_[1] ? (user => $_[1], exists $_[2] ? ( password => $_[2], ( exists $_[3] && ref $_[3] ? %{$_[3]} : () ), ( exists $_[4] && ref $_[4] ? %{$_[4]} : () ), ) : () ) : () ), ) } elsif (ref $_[0] eq 'CODE') { %all = ( dbh_maker => $_[0], ( exists $_[1] && ref $_[1] ? %{$_[1]} : () ), ) } else { %all = %{$_[0]} } return \%all; } 1; __END__ =pod =head1 NAME DBIx::Class::Helpers::Util - Helper utilities for DBIx::Class components =head1 SYNOPSIS use DBIx::Class::Helpers::Util ':all'; my ($namespace, $class) = get_namespace_parts('MyApp:Schema::Person'); is $namespace, 'MyApp::Schema'; is $class, 'Person'; if (is_load_namespaces('MyApp::Schema::Result::Person')) { print 'correctly structured project'; } if (is_not_load_namespaces('MyApp::Schema::Person')) { print 'incorrectly structured project'; } if (assert_similar_namespaces('MyApp::Schema::Person', 'FooApp::Schema::People')) { print 'both projects are structured similarly'; } if (assert_similar_namespaces('MyApp::Schema::Result::Person', 'FooApp::Schema::Result::People')) { print 'both projects are structured similarly'; } # in a resultset sub search { my ($self, $search, $attrs) = @_; $attrs->{order_by} = order_by_visitor($attrs->{order_by}, sub { my $field = shift; return 'foo_bar' if $field eq 'foo.bar'; return $field; }) if $attrs && $attrs->{order_by}; $self->next::method($search, $attrs); } # in schema sub connection { my $self = shift; my $args = normalize_connect_info(@_); $args->{quote_names} = 1; $self->next::method($args) } =head1 DESCRIPTION A collection of various helper utilities for L stuff. Probably only useful for components. =head1 EXPORTS =head2 order_by_visitor This function allows you to easily transform C clauses. See L for example. =head2 get_namespace_parts Returns the namespace and class name of a package. See L for example. =head2 is_load_namespaces Returns true if a package is structured in a way that would work for load_namespaces. See L for example. =head2 is_not_load_namespaces Returns true if a package is structured in a way that would not work for load_namespaces. See L for example. =head2 assert_similar_namespaces Dies if both packages are structured in the same way. The same means both are load_namespaces or both are not. See L for example. =head2 normalize_connect_info Takes L that can be passed to connect and normalizes them into the final and simplest form, a single hashref. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/lib/DBIx/Class/Helpers.pm0000644000175000017500000000301313624003631020220 0ustar frewfrewpackage DBIx::Class::Helpers; $DBIx::Class::Helpers::VERSION = '2.035000'; use strict; use warnings; # ABSTRACT: Simplify the common case stuff for DBIx::Class. 1; # this class isn't meant to be used __END__ =pod =head1 NAME DBIx::Class::Helpers - Simplify the common case stuff for DBIx::Class. =head1 SYNOPSIS package MyApp::Schema::Result::Foo_Bar; __PACKAGE__->load_components(qw{Helper::JoinTable Core}); __PACKAGE__->join_table({ left_class => 'Foo', left_method => 'foo', right_class => 'Bar', right_method => 'bar', }); # define parent class package ParentSchema::Result::Bar; use strict; use warnings; use parent 'DBIx::Class'; __PACKAGE__->load_components('Core'); __PACKAGE__->table('Bar'); __PACKAGE__->add_columns(qw/ id foo_id /); __PACKAGE__->set_primary_key('id'); __PACKAGE__->belongs_to( foo => 'ParentSchema::Result::Foo', 'foo_id' ); # define subclass package MySchema::Result::Bar; use strict; use warnings; use parent 'ParentSchema::Result::Bar'; __PACKAGE__->load_components(qw{Helper::SubClass Core}); __PACKAGE__->subclass; =head1 SEE ALSO L, L, L =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBIx-Class-Helpers-2.035000/CONTRIBUTING.md0000644000175000017500000000311513624003631016113 0ustar frewfrewWhen contributing, please take care to have sane history. For simple features it should be a single commit. If you need complex history, add functionality per commit in the order such that everything passes tests for each commit. When submitting a PR, in the commit include a line in the Changes underneath {{$NEXT}} of the form: - Fix the foobar whatsit (Thanks FullName!) If there is an existing issue, include it in the line: - Create special cat mode (Thanks FullName!) (Closes GH#123) If, inexplicably, there is an existing issue in RT, prefix the issue number with RT: - Create standard dog mode (Thanks FullName!) (Closes RT#100123) ## DDL To Generate ddl.sql which will allow you to run prove -l use the following command: perl -Ilib -It/lib -MTestSchema -E'TestSchema->generate_ddl; my $t = TestSchema->connect; $t->deploy' Eventually that will be migrated into it's own Dzil plugin, but for now that should work ## Testing To run tests against all major supported databases use: ``` $ maint/dockerprove -lr t ``` You can set DBIITEST_STARTUP to 10 or 15 to wait longer for the databases to be ready to test against. Default is 5s. ## Writing Tests By default, tests will only be run against SQLite. To write tests that will run on other DBs, use Test::Roo, and compose in the role A::Role::TestConnect. This will lazily connect (and deploy) the schema once the schema method is called. To run tests only if connected, check the connected method. For the simplest example of this, take a look at t/ResultSet/Explain.t. ## Releasing ``` $ maint/release ``` DBIx-Class-Helpers-2.035000/Makefile.PL0000644000175000017500000000440513624003631015637 0ustar frewfrew# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.010. use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Simplify the common case stuff for DBIx::Class.", "AUTHOR" => "Arthur Axel \"fREW\" Schmidt ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "DBIx-Class-Helpers", "LICENSE" => "perl", "NAME" => "DBIx::Class::Helpers", "PREREQ_PM" => { "Carp::Clan" => "6.04", "DBIx::Class" => "0.0826", "DBIx::Class::Candy" => "0.003001", "DBIx::Introspector" => "0.001002", "Lingua::EN::Inflect" => 0, "List::Util" => 0, "Module::Runtime" => 0, "Moo" => 2, "Safe::Isa" => 0, "Sub::Exporter::Progressive" => "0.001006", "Text::Brew" => 0, "Try::Tiny" => 0, "namespace::clean" => "0.23", "parent" => 0 }, "TEST_REQUIRES" => { "DBD::SQLite" => 0, "DateTime::Format::SQLite" => 0, "Test::Deep" => 0, "Test::Fatal" => "0.006", "Test::More" => "0.94", "Test::Roo" => "1.003", "aliased" => "0.34" }, "VERSION" => "2.035000", "test" => { "TESTS" => "t/*.t t/ResultClass/*.t t/ResultSet/*.t t/ResultSet/DateMethods1/*.t t/ResultSet/RemoveColumns/*.t t/ResultSet/Shortcut/*.t t/ResultSet/Shortcut/Search/*.t t/Row/*.t t/Schema/*.t t/Schema/Verifier/*.t" } ); my %FallbackPrereqs = ( "Carp::Clan" => "6.04", "DBD::SQLite" => 0, "DBIx::Class" => "0.0826", "DBIx::Class::Candy" => "0.003001", "DBIx::Introspector" => "0.001002", "DateTime::Format::SQLite" => 0, "Lingua::EN::Inflect" => 0, "List::Util" => 0, "Module::Runtime" => 0, "Moo" => 2, "Safe::Isa" => 0, "Sub::Exporter::Progressive" => "0.001006", "Test::Deep" => 0, "Test::Fatal" => "0.006", "Test::More" => "0.94", "Test::Roo" => "1.003", "Text::Brew" => 0, "Try::Tiny" => 0, "aliased" => "0.34", "namespace::clean" => "0.23", "parent" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); DBIx-Class-Helpers-2.035000/weaver.ini0000644000175000017500000000036713624003631015662 0ustar frewfrew[-Exec] [@CorePrep] [Name] [Region / prelude] [Generic / SYNOPSIS] [Generic / DESCRIPTION] [Generic / OVERVIEW] [Leftovers] [Collect / ATTRIBUTES] command = attr [Collect / METHODS] command = method [Region / postlude] [Authors] [Legal] DBIx-Class-Helpers-2.035000/META.json0000644000175000017500000000402513624003631015304 0ustar frewfrew{ "abstract" : "Simplify the common case stuff for DBIx::Class.", "author" : [ "Arthur Axel \"fREW\" Schmidt " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.010, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "DBIx-Class-Helpers", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "Carp::Clan" : "6.04", "DBIx::Class" : "0.0826", "DBIx::Class::Candy" : "0.003001", "DBIx::Introspector" : "0.001002", "Lingua::EN::Inflect" : "0", "List::Util" : "0", "Module::Runtime" : "0", "Moo" : "2", "Safe::Isa" : "0", "Sub::Exporter::Progressive" : "0.001006", "Text::Brew" : "0", "Try::Tiny" : "0", "namespace::clean" : "0.23", "parent" : "0" } }, "test" : { "requires" : { "DBD::SQLite" : "0", "DateTime::Format::SQLite" : "0", "Test::Deep" : "0", "Test::Fatal" : "0.006", "Test::More" : "0.94", "Test::Roo" : "1.003", "aliased" : "0.34" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/frioux/DBIx-Class-Helpers/issues" }, "homepage" : "https://github.com/frioux/DBIx-Class-Helpers", "repository" : { "type" : "git", "url" : "https://github.com/frioux/DBIx-Class-Helpers.git", "web" : "https://github.com/frioux/DBIx-Class-Helpers" } }, "version" : "2.035000", "x_serialization_backend" : "JSON::XS version 3.04" } DBIx-Class-Helpers-2.035000/t/0000775000175000017500000000000013624003631014127 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/author-pod-syntax.t0000644000175000017500000000045413624003631017723 0ustar frewfrew#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); DBIx-Class-Helpers-2.035000/t/Schema/0000775000175000017500000000000013624003631015327 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/Schema/GenerateSource.t0000644000175000017500000000067113624003631020431 0ustar frewfrewuse strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; TestSchema->load_components('Helper::Schema::GenerateSource'); TestSchema->generate_source(PsychoKiller => 'Lolbot'); my $class = TestSchema->class('PsychoKiller'); ok($class, 'PsychoKiller gets registered'); ok($class->isa('Lolbot'), 'PsychoKiller inherits from Lolbot'); ok(ref($class) ne 'Lolbot', '... but PsychoKiller is not just a Lolbot'); done_testing; DBIx-Class-Helpers-2.035000/t/Schema/LintContents.t0000644000175000017500000000472313624003631020144 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; subtest 'null_check_source_auto' => sub { my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; local $schema->source('Gnarly')->column_info('literature')->{is_nullable} = 0; cmp_deeply [map +{ $_ => $schema->null_check_source_auto($_)->count }, sort $schema->sources], supersetof( { Bar => 0 }, { Bloaty => 0 }, { Foo => 0 }, { Foo_Bar => 0 }, { Gnarly => 3 }, { Gnarly_Station => 0 }, { Station => 0 }, ), 'errors for Gnarly null_check_source'; }; subtest 'dub_check_source_auto' => sub { my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; $schema->resultset('Gnarly')->create({ id => 100 + $_, name => 'foo' }) for 1, 2; $schema->resultset('Gnarly')->create({ id => 200 + $_, name => 'bar' }) for 1, 2; $schema->source('Gnarly')->add_unique_constraint(['name']); cmp_deeply [map { my $source = $_; my $constraints = $schema->dup_check_source_auto($source); map { my $constraint_name = $_; +{ "$source $constraint_name" => $constraints->{$constraint_name}->count } } sort keys %$constraints; } grep { $_ ne 'Bloaty' } sort $schema->sources], supersetof( { "Bar primary" => 0 }, { "Foo primary" => 0 }, { "Foo_Bar primary" => 0 }, { "Gnarly Gnarly_name" => 2 }, { "Gnarly primary" => 0 }, { "Gnarly_Station primary" => 0 }, { "Station primary" => 0 }, ), 'Gnarly_name duplicated twice'; }; subtest 'fk_check_source_auto' => sub { my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; $schema->resultset('Foo_Bar')->delete; $schema->resultset('Foo_Bar')->create({ foo_id => 1010, bar_id => 2020, }); $schema->resultset('Foo_Bar')->create({ foo_id => 1111, bar_id => 2222, }); cmp_deeply [map { my $source = $_; my $constraints = $schema->fk_check_source_auto($source); map { my $fk_constraint_name = $_; +{ "$source $fk_constraint_name" => $constraints->{$fk_constraint_name}->count } } sort keys %$constraints; } grep { $_ ne 'Bloaty' } sort $schema->sources], supersetof( { "Bar foo" => 0 }, { "Foo bar" => 0 }, { "Foo_Bar bar" => 2 }, { "Foo_Bar foo" => 2 }, { "Gnarly_Station gnarly" => 0 }, { "Gnarly_Station station" => 0 }, ), 'foo and bar constraints broken'; }; done_testing; DBIx-Class-Helpers-2.035000/t/Schema/Verifier/0000775000175000017500000000000013624003631017102 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/Schema/Verifier/RelationshipColumnName.t0000644000175000017500000000203613624003631023706 0ustar frewfrewuse strict; use warnings; use lib 't/lib'; use Test::More; use Test::Fatal; is(exception { TSchema->$_('TPassResult', 'Set') for TSchema->result_verifiers; }, undef, 'Result and Set are fine'); like(exception { TSchema->$_('TFailResult1', 'Set') for TSchema->result_verifiers; }, qr/^TFailResult1 has a relationship name that is the same as a column name: a/, 'Result fails (single)'); like(exception { TSchema->$_('TFailResult2', 'Set') for TSchema->result_verifiers; }, qr/^TFailResult2 has relationship names that are the same as column names: a b/, 'Result fails (plural)'); done_testing; BEGIN { package TSchema; use base 'DBIx::Class::Helper::Schema::Verifier::RelationshipColumnName'; package TPassResult; sub columns { qw(a b c) } sub relationships { qw(e f g) } package Set; package TFailResult1; sub columns { qw(a b c) } sub relationships { qw(a f g) } package TFailResult2; sub columns { qw(a b c) } sub relationships { qw(a b g) } } DBIx-Class-Helpers-2.035000/t/Schema/Verifier/ColumnInfo.t0000644000175000017500000000326313624003631021342 0ustar frewfrewuse strict; use warnings; use lib 't/lib'; use Test::More; use Test::Fatal; is(exception { TSchema->$_('TPassResult', 'Set') for TSchema->result_verifiers; }, undef, 'Standard keys are allowed'); my $e = exception { TSchema->$_('TFailResult1', 'Set') for TSchema->result_verifiers; }; like $e, qr/^Forbidden column config/, 'Forbidden keys fail verification'; like $e, qr/bad1/, 'Failed column mentioned'; like $e, qr/unallowed_key/, 'Bad key mentioned'; like $e, qr/TFailResult1/, 'Failing class mentioned'; is(exception { TSchema->$_('TPassResultExtended', 'Set') for TSchema->result_verifiers; }, undef, 'Extended allow list works'); done_testing; BEGIN { package TSchema; use base 'DBIx::Class::Helper::Schema::Verifier::ColumnInfo'; sub allowed_column_keys { my @list = $_[0]->next::method; push @list, 'you_should_allow_this'; @list } package TPassResult; sub columns_info { # all the default keys { thing => { accessor => 1, data_type => 1, size => 1, is_nullable => 1, is_auto_increment => 1, is_numeric => 1, is_foreign_key => 1, default_value => 1, sequence => 1, retrieve_on_insert => 1, auto_nextval => 1, extra => { extra_keys => 1, }, }, } } package TFailResult1; sub columns_info { { bad1 => { unallowed_key => 1, }, } } package TPassResultExtended; sub columns_info { { bad2 => { you_should_allow_this => 1, } } } package Set; } DBIx-Class-Helpers-2.035000/t/Schema/Verifier/Parent.t0000644000175000017500000000163013624003631020516 0ustar frewfrewuse strict; use warnings; use lib 't/lib'; use Test::More; use Test::Fatal; is(exception { TSchema->$_('TPassResult', 'TPassResultSet') for TSchema->result_verifiers; }, undef, 'Result and Set are fine'); like(exception { TSchema->$_('TFailResult', 'TPassResultSet') for TSchema->result_verifiers; }, qr/^TFailResult is not a Herp/, 'Result fails'); like(exception { TSchema->$_('TPassResult', 'TFailResultSet') for TSchema->result_verifiers; }, qr/^TFailResultSet is not a Derp/, 'ResultSet fails'); done_testing; BEGIN { package TSchema; use base 'DBIx::Class::Helper::Schema::Verifier::Parent'; sub base_result { 'Herp' } sub base_resultset { 'Derp' } package Herp; use Moo; package Derp; use Moo; package TPassResult; use base 'Herp'; package TPassResultSet; use base 'Derp'; package TFailResult; use Moo; package TFailResultSet; use Moo; } DBIx-Class-Helpers-2.035000/t/Schema/Verifier/C3.t0000644000175000017500000000130613624003631017532 0ustar frewfrewuse strict; use warnings; use lib 't/lib'; use Test::More; use Test::Fatal; use aliased 'DBIx::Class::Helper::Schema::Verifier::C3'; is(exception { C3->$_('Cat', 'Cat') for C3->result_verifiers; }, undef, 'Result and Set are fine'); like(exception { C3->$_('Foo', 'Cat') for C3->result_verifiers; }, qr/^Foo does not use c3, it uses dfs/, 'Result fails'); like(exception { C3->$_('Cat', 'Bar') for C3->result_verifiers; }, qr/^Bar does not use c3, it uses dfs/, 'ResultSet fails'); done_testing; BEGIN { package Foo; use base 'DBIx::Class::Core'; package Bar; use base 'DBIx::Class::ResultSet'; package Cat; use MRO::Compat; use mro 'c3'; use base 'DBIx::Class'; } DBIx-Class-Helpers-2.035000/t/Schema/DidYouMean.t0000644000175000017500000000041413624003631017507 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Fatal; use TestSchema; my $schema = TestSchema->deploy_or_connect(); like( exception { $schema->resultset('foo_Bar') }, qr/\* Foo_Bar <--/, 'found correct RS', ); done_testing; DBIx-Class-Helpers-2.035000/t/Schema/DateTime.t0000644000175000017500000000074613624003631017215 0ustar frewfrewuse strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; use DateTime; TestSchema->load_components('Helper::Schema::DateTime'); my $schema = TestSchema->deploy_or_connect(); isa_ok($schema->datetime_parser, 'DateTime::Format::SQLite'); my $dt = DateTime->now; my $s = $schema->format_datetime($dt); is( $schema->format_datetime($schema->parse_datetime($s)), $schema->format_datetime($dt), 'format_datetime and parse_datetime roundtrip', ); done_testing; DBIx-Class-Helpers-2.035000/t/Schema/Verifier.t0000644000175000017500000000051713624003631017270 0ustar frewfrewuse strict; use warnings; use lib 't/lib'; use Test::More; use Test::Fatal; my $e = exception { require VerifySchema }; like($e, qr/^Derp: .*::A\b/m, 'Schema verify checks all input'); like($e, qr/^Herp: .*::A\b/m, 'Schema runs all checks per r/set'); like($e, qr/^Derp: .*::B\b/m, 'Schema verify checks all r/sets'); done_testing; DBIx-Class-Helpers-2.035000/t/ResultClass/0000775000175000017500000000000013624003631016373 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/ResultClass/Tee.t0000755000175000017500000000107613624003631017302 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; use DBIx::Class::Helper::ResultClass::Tee; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Gnarly')->search(undef, { result_class => DBIx::Class::Helper::ResultClass::Tee->new( inner_classes => ['::HRI', 'TestSchema::Result::Gnarly'], ) }); my $arr = $rs->first; cmp_deeply($arr->[0], superhashof({ name => "frew", }), '::HRI'); is($arr->[1]->name, 'frew', 'TestSchema::Result::Gnarly'); done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/0000775000175000017500000000000013624003631016061 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/ResultSet/RemoveColumns/0000775000175000017500000000000013624003631020657 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/ResultSet/RemoveColumns/_resolved_attrs.t0000644000175000017500000000113313624003631024237 0ustar frewfrew#!/usr/bin/env perl use strict; use warnings; use lib 't/lib'; use Test::More (tests => 2); use Devel::Dwarn; $Data::Dumper::Maxdepth = 4; use TestSchema; my $schema = TestSchema->deploy_or_connect(); my $q_gnarly = $schema->resultset('Gnarly') ->search(undef, { columns => [ qw(id) ], group_by => [ qw(id) ] }) ->count_rs ->as_query; ok(${ $q_gnarly }->[0] !~ /"me"\."id", "me"\."id"/); my $q_bloaty = $schema->resultset('Bloaty') ->search(undef, { columns => [ qw(id) ], group_by => [ qw(id) ] }) ->count_rs ->as_query; ok(${ $q_bloaty }->[0] !~ /"me"\."id", "me"\."id"/); DBIx-Class-Helpers-2.035000/t/ResultSet/CorrelateRelationship.t0000644000175000017500000000213313624003631022545 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Gnarly')->search(undef, { '+columns' => { old_gnarlies => $schema->resultset('Gnarly') ->correlate('gnarly_stations') ->search({ station_id => { '>' => 2 }}) ->count_rs->as_query, new_gnarlies => $schema->resultset('Gnarly') ->correlate('gnarly_stations') ->search({ station_id => { '<=' => 2 }}) ->count_rs->as_query, }, result_class => '::HRI', }); cmp_deeply([$rs->all], [ { id => 1, literature => undef, name => "frew", new_gnarlies => 1, old_gnarlies => 1, your_mom => undef }, { id => 2, literature => undef, name => "frioux", new_gnarlies => 1, old_gnarlies => 0, your_mom => undef }, { id => 3, literature => undef, name => "frooh", new_gnarlies => 1, old_gnarlies => 0, your_mom => undef } ], 'relationship correlated correctly'); done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/DateMethods1/0000775000175000017500000000000013624003631020343 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/ResultSet/DateMethods1/sqlite.t0000644000175000017500000000521713624003631022034 0ustar frewfrew#!perl use strict; use warnings; use Test::More; use lib 't/lib'; use A::ResultSet::DateMethods1; A::ResultSet::DateMethods1->run_tests(SQLite => { engine => 'SQLite', utc_now => q, stringified_date => '2014-02-08 04:43:00', plucked_minute => '09', plucked_second => '08', connect_info => [ 'dbi:SQLite::memory:' ], add_sql_prefix => \[ 'DATETIME("me"."a_date", ? || ?)', 1, ' seconds' ], add_sql_by_part => { day => \[ 'DATETIME("a_date", ? || ?)', 1, ' days' ], hour => \[ 'DATETIME("a_date", ? || ?)', 2, ' hours' ], minute => \[ 'DATETIME("a_date", ? || ?)', 3, ' minutes' ], month => \[ 'DATETIME("a_date", ? || ?)', 4, ' months' ], second => \[ 'DATETIME("a_date", ? || ?)', 5, ' seconds' ], year => \[ 'DATETIME("a_date", ? || ?)', 6, ' years' ], }, subtract_sql_prefix => \[ q{DATETIME("me"."a_date", '-' || ? || ?)}, 1, ' seconds' ], subtract_sql_by_part => { day => \[ q{DATETIME("a_date", '-' || ? || ?)}, 1, ' days' ], hour => \[ q{DATETIME("a_date", '-' || ? || ?)}, 2, ' hours' ], minute => \[ q{DATETIME("a_date", '-' || ? || ?)}, 3, ' minutes' ], month => \[ q{DATETIME("a_date", '-' || ? || ?)}, 4, ' months' ], second => \[ q{DATETIME("a_date", '-' || ? || ?)}, 5, ' seconds' ], year => \[ q{DATETIME("a_date", '-' || ? || ?)}, 6, ' years' ], }, pluck_sql_prefix => \[ q ], pluck_sql_by_part => { year => \[ q ], month => \[ q ], day_of_month => \[ q ], hour => \[ q ], day_of_year => \[ q ], minute => \[ q ], second => \[ q ], day_of_week => \[ q ], week => \[ q ], julian_day => \[ q ], seconds_since_epoch => \[ q ], fractional_seconds => \[ q ], }, pluck_sql_by_part_result => { month => '01', day_of_month => '02', hour => '03', day_of_year => '002', minute => '04', second => '05', week => '01', julian_day => '2455928.627835648', seconds_since_epoch => '1325473445', fractional_seconds => '05.000', }, }); done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/DateMethods1/oracle.t0000644000175000017500000000406013624003631021773 0ustar frewfrew#!perl use strict; use warnings; use Test::More; use lib 't/lib'; use A::ResultSet::DateMethods1; local $SIG{__WARN__} = sub { my $warning = shift; return if $warning =~ m/DBIx::Class::Storage::DBI::Oracle.*sql_(?:limit_dialect|quote_char)/; print STDERR $warning; }; A::ResultSet::DateMethods1->run_tests(Oracle => { on_connect_call => 'datetime_setup', engine => 'Oracle', utc_now => 'sys_extract_utc(SYSTIMESTAMP)', stringified_date => '2014-02-08 04:43:00', storage_type => 'Oracle', add_sql_prefix => \[ '(TO_TIMESTAMP("me"."a_date") + NUMTODSINTERVAL(?, ?))', 1, 'SECOND', ], add_sql_by_part => { day => \[ '(TO_TIMESTAMP("a_date") + NUMTODSINTERVAL(?, ?))', 1, 'DAY' ], hour => \[ '(TO_TIMESTAMP("a_date") + NUMTODSINTERVAL(?, ?))', 2, 'HOUR' ], minute => \[ '(TO_TIMESTAMP("a_date") + NUMTODSINTERVAL(?, ?))', 3, 'MINUTE' ], second => \[ '(TO_TIMESTAMP("a_date") + NUMTODSINTERVAL(?, ?))', 5, 'SECOND' ], }, add_sql_by_part_result => { day => '2012-12-13 00:00:00.000000000', hour => '2012-12-12 02:00:00.000000000', millisecond => '2012-12-12 00:00:00.007000000', minute => '2012-12-12 00:03:00.000000000', month => '2013-04-12 00:00:00.000000000', quarter => '2015-03-12 00:00:00.000000000', second => '2012-12-12 00:00:05.000000000', week => '2013-02-20 00:00:00.000000000', year => '2018-12-12 00:00:00.000000000', }, pluck_sql_prefix => \[ 'EXTRACT(SECOND FROM TO_TIMESTAMP("me"."a_date"))' ], pluck_sql_by_part => { second => \[ 'EXTRACT(SECOND FROM TO_TIMESTAMP("a_date"))' ], minute => \[ 'EXTRACT(MINUTE FROM TO_TIMESTAMP("a_date"))' ], hour => \[ 'EXTRACT(HOUR FROM TO_TIMESTAMP("a_date"))' ], day_of_month => \[ 'EXTRACT(DAY FROM TO_TIMESTAMP("a_date"))' ], month => \[ 'EXTRACT(MONTH FROM TO_TIMESTAMP("a_date"))' ], year => \[ 'EXTRACT(YEAR FROM TO_TIMESTAMP("a_date"))' ], }, }); done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/DateMethods1/mysql.t0000644000175000017500000001031413624003631021672 0ustar frewfrew#!perl use strict; use warnings; use Test::More; use lib 't/lib'; use A::ResultSet::DateMethods1; A::ResultSet::DateMethods1->run_tests(mysql => { engine => 'mysql', utc_now => 'UTC_TIMESTAMP()', stringified_date => '2014-02-08 04:43:00', storage_type => 'mysql', pluck_sql_prefix => \[ 'EXTRACT(SECOND FROM `me`.`a_date`)' ], pluck_sql_by_part => { microsecond => \[ 'EXTRACT(MICROSECOND FROM `a_date`)' ], second => \[ 'EXTRACT(SECOND FROM `a_date`)' ], minute => \[ 'EXTRACT(MINUTE FROM `a_date`)' ], hour => \[ 'EXTRACT(HOUR FROM `a_date`)' ], day_of_month => \[ 'EXTRACT(DAY FROM `a_date`)' ], week => \[ 'EXTRACT(WEEK FROM `a_date`)' ], month => \[ 'EXTRACT(MONTH FROM `a_date`)' ], quarter => \[ 'EXTRACT(QUARTER FROM `a_date`)' ], year => \[ 'EXTRACT(YEAR FROM `a_date`)' ], second_microsecond => \[ 'EXTRACT(SECOND_MICROSECOND FROM `a_date`)' ], minute_microsecond => \[ 'EXTRACT(MINUTE_MICROSECOND FROM `a_date`)' ], minute_second => \[ 'EXTRACT(MINUTE_SECOND FROM `a_date`)' ], hour_microsecond => \[ 'EXTRACT(HOUR_MICROSECOND FROM `a_date`)' ], hour_second => \[ 'EXTRACT(HOUR_SECOND FROM `a_date`)' ], hour_minute => \[ 'EXTRACT(HOUR_MINUTE FROM `a_date`)' ], day_microsecond => \[ 'EXTRACT(DAY_MICROSECOND FROM `a_date`)' ], day_second => \[ 'EXTRACT(DAY_SECOND FROM `a_date`)' ], day_minute => \[ 'EXTRACT(DAY_MINUTE FROM `a_date`)' ], day_hour => \[ 'EXTRACT(DAY_HOUR FROM `a_date`)' ], year_month => \[ 'EXTRACT(YEAR_MONTH FROM `a_date`)' ], }, pluck_sql_by_part_result => { microsecond => 0, second_microsecond => '5000000', minute_microsecond => '405000000', minute_second => 405, hour_microsecond => '30405000000', hour_second => 30405, hour_minute => 304, day_microsecond => '2030405000000', day_second => '2030405', day_minute => 20304, day_hour => 203, year_month => '201201', }, add_sql_prefix => \[ 'DATE_ADD(`me`.`a_date`, INTERVAL ? SECOND)', 1 ], add_sql_by_part => { day => \[ 'DATE_ADD(`a_date`, INTERVAL ? DAY)', 1 ], hour => \[ 'DATE_ADD(`a_date`, INTERVAL ? HOUR)', 2 ], microsecond => \[ 'DATE_ADD(`a_date`, INTERVAL ? MICROSECOND)', 7 ], minute => \[ 'DATE_ADD(`a_date`, INTERVAL ? MINUTE)', 3 ], month => \[ 'DATE_ADD(`a_date`, INTERVAL ? MONTH)', 4 ], quarter => \[ 'DATE_ADD(`a_date`, INTERVAL ? QUARTER)', 8 ], second => \[ 'DATE_ADD(`a_date`, INTERVAL ? SECOND)', 5 ], week => \[ 'DATE_ADD(`a_date`, INTERVAL ? WEEK)', 9 ], year => \[ 'DATE_ADD(`a_date`, INTERVAL ? YEAR)', 6 ], }, add_sql_by_part_result => { microsecond => '2012-12-12 00:00:00.000007', second => qr/^2012-12-12 00:00:05/, quarter => '2014-12-12 00:00:00', week => '2013-02-13 00:00:00', }, subtract_sql_prefix => \[ 'DATE_SUB(`me`.`a_date`, INTERVAL ? SECOND)', 1 ], subtract_sql_by_part => { day => \[ 'DATE_SUB(`a_date`, INTERVAL ? DAY)', 1 ], hour => \[ 'DATE_SUB(`a_date`, INTERVAL ? HOUR)', 2 ], microsecond => \[ 'DATE_SUB(`a_date`, INTERVAL ? MICROSECOND)', 7 ], minute => \[ 'DATE_SUB(`a_date`, INTERVAL ? MINUTE)', 3 ], month => \[ 'DATE_SUB(`a_date`, INTERVAL ? MONTH)', 4 ], quarter => \[ 'DATE_SUB(`a_date`, INTERVAL ? QUARTER)', 8 ], second => \[ 'DATE_SUB(`a_date`, INTERVAL ? SECOND)', 5 ], week => \[ 'DATE_SUB(`a_date`, INTERVAL ? WEEK)', 9 ], year => \[ 'DATE_SUB(`a_date`, INTERVAL ? YEAR)', 6 ], }, subtract_sql_by_part_result => { microsecond => '2012-12-11 23:59:59.999993', second => qr/^2012-12-11 23:59:55/, quarter => '2010-12-12 00:00:00', week => '2012-10-10 00:00:00', }, }); done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/DateMethods1/mssql.t0000644000175000017500000000571613624003631021676 0ustar frewfrew#!perl use strict; use warnings; use Test::More; use lib 't/lib'; use A::ResultSet::DateMethods1; A::ResultSet::DateMethods1->run_tests(MSSQL => { engine => 'MSSQL', utc_now => 'GETUTCDATE()', stringified_date => '2014-02-08 04:43:00.000', storage_type => 'MSSQL', add_sql_prefix => \[ 'DATEADD(second, CAST(? AS int), [me].[a_date])', 1 ], add_sql_by_part_skip => { nanosecond => "doesn't work with DATETIME data type", }, add_sql_by_part => { day => \[ 'DATEADD(dayofyear, CAST(? AS int), [a_date])', 1 ], hour => \[ 'DATEADD(hour, CAST(? AS int), [a_date])', 2 ], millisecond => \[ 'DATEADD(millisecond, CAST(? AS int), [a_date])', 7 ], minute => \[ 'DATEADD(minute, CAST(? AS int), [a_date])', 3 ], month => \[ 'DATEADD(month, CAST(? AS int), [a_date])', 4 ], nanosecond => \[ 'DATEADD(nanosecond, CAST(? AS int), [a_date])', 8 ], quarter => \[ 'DATEADD(quarter, CAST(? AS int), [a_date])', 9 ], second => \[ 'DATEADD(second, CAST(? AS int), [a_date])', 5 ], week => \[ 'DATEADD(week, CAST(? AS int), [a_date])', 10 ], year => \[ 'DATEADD(year, CAST(? AS int), [a_date])', 6 ], }, add_sql_by_part_result => { day => '2012-12-13 00:00:00.000', hour => '2012-12-12 02:00:00.000', millisecond => '2012-12-12 00:00:00.007', minute => '2012-12-12 00:03:00.000', month => '2013-04-12 00:00:00.000', quarter => '2015-03-12 00:00:00.000', second => '2012-12-12 00:00:05.000', week => '2013-02-20 00:00:00.000', year => '2018-12-12 00:00:00.000', }, pluck_sql_prefix => \[ q ], pluck_sql_by_part => { year => \[ 'DATEPART(year, [a_date])' ], quarter => \[ 'DATEPART(quarter, [a_date])' ], month => \[ 'DATEPART(month, [a_date])' ], day_of_year => \[ 'DATEPART(dayofyear, [a_date])' ], day_of_month => \[ 'DATEPART(day, [a_date])' ], week => \[ 'DATEPART(week, [a_date])' ], day_of_week => \[ 'DATEPART(ISO_WEEK, [a_date])' ], hour => \[ 'DATEPART(hour, [a_date])' ], minute => \[ 'DATEPART(minute, [a_date])' ], second => \[ 'DATEPART(second, [a_date])' ], millisecond => \[ 'DATEPART(millisecond, [a_date])' ], nanosecond => \[ 'DATEPART(nanosecond, [a_date])' ], non_iso_day_of_week => \[ 'DATEPART(weekday, [a_date])' ], timezone_as_minutes => \[ 'DATEPART(TZoffset, [a_date])' ], }, pluck_sql_by_part_skip => { timezone_as_minutes => 'not supported by DateTime data type', }, pluck_sql_by_part_result => { millisecond => 0, nanosecond => 0, non_iso_day_of_week => 2, }, }); done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/DateMethods1/bugs.t0000644000175000017500000000057513624003631021475 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use DateTime; use Test::More; use TestSchema; use Test::Fatal 'lives_ok'; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; lives_ok { $schema->resultset('HasDateOps') ->dt_before(DateTime->now, { -ident => '.a_date' }) ->delete; } 'does not explode due to spurious qualifier'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/DateMethods1/pg.t0000644000175000017500000001146213624003631021140 0ustar frewfrew#!perl use strict; use warnings; use Test::More; use lib 't/lib'; use A::ResultSet::DateMethods1; A::ResultSet::DateMethods1->run_tests(Pg => { engine => 'Pg', utc_now => 'CURRENT_TIMESTAMP', stringified_date => '2014-02-08 04:43:00+0000', storage_type => 'Pg', add_sql_prefix => \[ q<("me"."a_date" + ? * interval '1 second')>, 1], add_sql_by_part => { century => \[ q<("a_date" + ? * interval '1 century')>, 7 ], day => \[ q<("a_date" + ? * interval '1 day')>, 1 ], decade => \[ q<("a_date" + ? * interval '1 decade')>, 8 ], hour => \[ q<("a_date" + ? * interval '1 hour')>, 2 ], microsecond => \[ q<("a_date" + ? * interval '1 microseconds')>, 9 ], millisecond => \[ q<("a_date" + ? * interval '1 milliseconds')>, 10 ], minute => \[ q<("a_date" + ? * interval '1 minute')>, 3 ], month => \[ q<("a_date" + ? * interval '1 month')>, 4 ], second => \[ q<("a_date" + ? * interval '1 second')>, 5 ], week => \[ q<("a_date" + ? * interval '1 week')>, 11 ], year => \[ q<("a_date" + ? * interval '1 year')>, 6 ], }, add_sql_by_part_result => { century => '2712-12-12 00:00:00', decade => '2092-12-12 00:00:00', microsecond => '2012-12-12 00:00:00.000009', millisecond => '2012-12-12 00:00:00.01', week => '2013-02-27 00:00:00', }, subtract_sql_prefix => \[ q<("me"."a_date" - ? * interval '1 second')>, 1], subtract_sql_by_part => { century => \[ q<("a_date" - ? * interval '1 century')>, 7 ], day => \[ q<("a_date" - ? * interval '1 day')>, 1 ], decade => \[ q<("a_date" - ? * interval '1 decade')>, 8 ], hour => \[ q<("a_date" - ? * interval '1 hour')>, 2 ], microsecond => \[ q<("a_date" - ? * interval '1 microseconds')>, 9 ], millisecond => \[ q<("a_date" - ? * interval '1 milliseconds')>, 10 ], minute => \[ q<("a_date" - ? * interval '1 minute')>, 3 ], month => \[ q<("a_date" - ? * interval '1 month')>, 4 ], second => \[ q<("a_date" - ? * interval '1 second')>, 5 ], week => \[ q<("a_date" - ? * interval '1 week')>, 11 ], year => \[ q<("a_date" - ? * interval '1 year')>, 6 ], }, subtract_sql_by_part_result => { century => '1312-12-12 00:00:00', decade => '1932-12-12 00:00:00', microsecond => '2012-12-11 23:59:59.999991', millisecond => '2012-12-11 23:59:59.99', week => '2012-09-26 00:00:00', }, pluck_sql_prefix => \[ 'date_part(?, "me"."a_date")', 'second' ], pluck_sql_by_part => { century => \[ 'date_part(?, "a_date")', 'century' ], decade => \[ 'date_part(?, "a_date")', 'decade' ], day_of_month => \[ 'date_part(?, "a_date")', 'day' ], day_of_week => \[ 'date_part(?, "a_date")', 'dow' ], day_of_year => \[ 'date_part(?, "a_date")', 'doy' ], seconds_since_epoch => \[ 'date_part(?, "a_date")', 'epoch' ], hour => \[ 'date_part(?, "a_date")', 'hour' ], iso_day_of_week => \[ 'date_part(?, "a_date")', 'isodow' ], iso_year => \[ 'date_part(?, "a_date")', 'isoyear' ], microsecond => \[ 'date_part(?, "a_date")', 'microseconds' ], millenium => \[ 'date_part(?, "a_date")', 'millenium' ], millisecond => \[ 'date_part(?, "a_date")', 'milliseconds' ], minute => \[ 'date_part(?, "a_date")', 'minute' ], month => \[ 'date_part(?, "a_date")', 'month' ], quarter => \[ 'date_part(?, "a_date")', 'quarter' ], second => \[ 'date_part(?, "a_date")', 'second' ], timezone => \[ 'date_part(?, "a_date")', 'timezone' ], timezone_hour => \[ 'date_part(?, "a_date")', 'timezone_hour' ], timezone_minute => \[ 'date_part(?, "a_date")', 'timezone_minute' ], week => \[ 'date_part(?, "a_date")', 'week' ], year => \[ 'date_part(?, "a_date")', 'year' ], }, pluck_sql_by_part_skip => { millenium => 'not supported by DateTime data type', timezone => 'not supported by DateTime data type', timezone_hour => 'not supported by DateTime data type', timezone_minute => 'not supported by DateTime data type', }, pluck_sql_by_part_result => { century => 21, decade => 201, seconds_since_epoch => '1325473445', iso_day_of_week => 1, iso_year => 2012, microsecond => '5000000', millisecond => 5000, }, }); done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/IgnoreWantarray.t0000644000175000017500000000122413624003631021357 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Fatal; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my ($rs) = $schema->resultset('Foo')->search; my ($rs2) = $schema->resultset('Bar')->search; my ($rs3) = $schema->resultset('Foo')->first->bars; my ($rs4) = $schema->resultset('Bar')->first->foos; isa_ok $rs, 'DBIx::Class::ResultSet'; isa_ok $rs2, 'DBIx::Class::ResultSet'; isa_ok $rs3, 'DBIx::Class::ResultSet'; isa_ok $rs4, 'DBIx::Class::ResultSet'; like(exception { $schema->resultset('Bar')->search }, qr/search is \*not\* a mutator/, 'correctly die in void ctx'); done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/ResultClassDWIM.t0000644000175000017500000000140313624003631021167 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); my $expect = [ $rs->search(undef, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' })->all ]; ok scalar @{$expect}, 'make sure test environment is not ruined forever'; cmp_deeply [ $rs->search(undef, { result_class => '::HashRefInflator' })->all ], $expect, '::HashRefInflator works'; cmp_deeply [ $rs->search(undef, { result_class => '::HashRefInflator' })->all ], $expect, '::HRI works'; my $rs2 = $rs->search(undef); $rs2->result_class('::HRI'); cmp_deeply [ $rs2->all ], $expect, '::HRI also works from result_class accessor'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/RemoveColumns.t0000644000175000017500000000262313624003631021045 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; RemoveColumns: { my $rs = $schema->resultset('Foo')->search({ id => 1 }, { result_class => 'DBIx::Class::ResultClass::HashRefInflator', 'remove_columns' => ['bar_id'], }); cmp_deeply [$rs->all], [{ id => 1 }], 'remove_columns works'; cmp_deeply [$rs->search({ id => { '!=' => 4 } })->all], [{ id => 1 }], 'chaining remove_columns works';; cmp_deeply [ $rs->search({ id => { '!=' => 4 } }, { '+columns' => 'bar_id' })->all ], [{ bar_id => 1, id => 1 }], 'chaining and +columns works with remove_columns'; } AutoRemoveColumns: { my $rs = $schema->resultset('Bloaty')->search({ id => 1 }, { result_class => 'DBIx::Class::ResultClass::HashRefInflator', }); cmp_deeply [$rs->all], [{ id => 1 }], 'remove_columns works'; cmp_deeply [$rs->search({ id => { '!=' => 4 } })->all], [{ id => 1 }], 'chaining remove_columns works';; cmp_deeply [ $rs->search({ id => { '!=' => 4 } }, { '+columns' => 'name' })->all ], [{ name => 1, id => 1 }], 'chaining and +columns works with remove_columns'; } done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/SetOperations.t0000644000175000017500000000573013624003631021050 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use Test::Fatal 'dies_ok', 'lives_ok'; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo')->search({ id => 1 }); my $rs2 = $schema->resultset('Foo')->search({ id => { '>=' => 3 } }); my $rs3 = $schema->resultset('Foo')->search({ id => [ 1, 3 ] }); cmp_deeply [ sort map $_->id, $rs2->union($rs2)->all ], [3, 4, 5], 'union returns correct values'; cmp_deeply [ sort map $_->id, $rs2->union_all($rs2)->all ], [3, 3, 4, 4, 5, 5], 'union returns correct values'; cmp_deeply [ sort map $_->id, $rs2->union($rs)->all ], [1, 3, 4, 5], 'union returns correct values'; cmp_deeply [ sort map $_->id, $rs3->union($rs)->all ], [1, 3], 'union returns correct values'; cmp_deeply [ sort map $_->id, $rs3->union_all($rs)->all ], [1, 1, 3], 'union returns correct values'; cmp_deeply [ sort map $_->id, $rs2->intersect($rs)->all ], [], 'intersect returns correct values'; cmp_deeply [ sort map $_->id, $rs3->intersect($rs)->all ], [1], 'intersect returns correct values'; cmp_deeply [ sort map $_->id, $rs->intersect($rs3)->all ], [1], 'intersect returns correct values'; cmp_deeply [ sort map $_->id, $rs2->intersect($rs3)->all ], [3], 'intersect returns correct values'; cmp_deeply [ sort map $_->id, $rs3->intersect($rs2)->all ], [3], 'intersect returns correct values'; cmp_deeply [ sort map $_->id, $rs2->except($rs)->all ], [3, 4, 5], 'except returns correct values'; cmp_deeply [ sort map $_->id, $rs->except($rs2)->all ], [1], 'except returns correct values'; cmp_deeply [ sort map $_->id, $rs3->except($rs)->all ], [3], 'except returns correct values'; cmp_deeply [ sort map $_->id, $rs->except($rs3)->all ], [], 'except returns correct values'; cmp_deeply [ sort map $_->id, $rs2->except($rs3)->all ], [4, 5], 'except returns correct values'; cmp_deeply [ sort map $_->id, $rs3->except($rs2)->all ], [1], 'except returns correct values'; dies_ok { my $rs3 = $rs->search(undef, { columns => ['id'] }); $rs->union($rs3) ; } 'unioning differing ColSpecs dies'; dies_ok { $rs->union($rs->search_rs(undef, { result_class => 'DBIx::Class::ResultClass::HashRefInflator'})) ; } 'unioning with differing ResultClasses dies'; dies_ok { $rs->union($schema->resultset('Bar')) } 'unioning differing ResultSets dies'; { my $rs3 = $rs->search(undef, { columns => ['id'], '+select' => [\'"foo" as station'], '+as' => ['station'], }); my $rs4 = $schema->resultset('Bar')->search(undef, { columns => ['id'], '+select' => [\'"bar" as station'], '+as' => ['station'], }); $rs3->result_class('DBIx::Class::ResultClass::HashRefInflator'); $rs4->result_class('DBIx::Class::ResultClass::HashRefInflator'); my $rs5 = $rs3->union($rs4); lives_ok { [ $rs5->all ] } q{unioning differing ResultSets does not die when you know what you're doing}; } done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/0000775000175000017500000000000013624003631017674 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/RemoveColumns.t0000644000175000017500000000132313624003631022654 0ustar frewfrewuse strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo')->search({ id => 1 }, { result_class => 'DBIx::Class::ResultClass::HashRefInflator', }) ->remove_columns(['bar_id']); cmp_deeply [$rs->all], [{ id => 1 }], 'remove_columns shortcut works'; cmp_deeply [$rs->search({ id => { '!=' => 4 } })->all], [{ id => 1 }], 'chaining remove_columns works';; cmp_deeply [ $rs->search({ id => { '!=' => 4 } }, { '+columns' => 'bar_id' })->all ], [{ bar_id => 1, id => 1 }], 'chaining and +columns works with remove_columns'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/OrderByMagic.t0000644000175000017500000000141513624003631022367 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); my %tests = ( 'id' => [{ -asc => 'me.id' }], '!id' => [{ -desc => 'me.id' }], 'id,!bar_id' => [{ -asc => 'me.id' }, { -desc => 'bar_id' }], 'id, !bar_id' => [{ -asc => 'me.id' }, { -desc => 'bar_id' }], 'id ,!bar_id' => [{ -asc => 'me.id' }, { -desc => 'bar_id' }], 'id , !bar_id' => [{ -asc => 'me.id' }, { -desc => 'bar_id' }], ); while (my ($order, $expect) = each(%tests)) { cmp_deeply [$rs->order_by($order)->all], [$rs->search({},{order_by => $expect})->all], "order_by works: $order"; } done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/ResultsExist.t0000644000175000017500000000335513624003631022543 0ustar frewfrew#!perl use strict; use warnings; use Test::Roo; use lib 't/lib'; with 'A::Role::TestConnect'; my $ran = 0; top_test 'basic functionality' => sub { my $self = shift; my $schema = $self->schema; SKIP: { skip 'cannot test without a connection', 1 unless $self->connected; $ran++ if $self->engine eq 'SQLite'; $schema->prepopulate; my $rs = $schema->resultset( 'Foo' )->search({ id => { '>' => 0 } }); my $rs2 = $schema->resultset( 'Foo' )->search({ id => { '<' => 0 } }); ok( $rs->results_exist, 'check rs has some results' ); ok(!$rs2->results_exist, 'and check that rs has no results' ); is_deeply( [ $rs->search({}, { order_by => 'id', columns => { id => "id", has_lesser => $rs->search( { 'correlation.id' => { '<' => { -ident => "me.id" } } }, { alias => 'correlation' } )->results_exist_as_query, has_greater => $rs->search( { 'correlation.id' => { '>' => { -ident => "me.id" } } }, { alias => 'correlation' } )->results_exist_as_query, }})->hri->all ], [ { id => 1, has_lesser => 0, has_greater => 1 }, { id => 2, has_lesser => 1, has_greater => 1 }, { id => 3, has_lesser => 1, has_greater => 1 }, { id => 4, has_lesser => 1, has_greater => 1 }, { id => 5, has_lesser => 1, has_greater => 0 }, ], "Correlated-existence works", ); } }; run_me(SQLite => { engine => 'SQLite', connect_info => [ 'dbi:SQLite::memory:'], }); run_me(Pg => { engine => 'Pg' }); run_me(mysql => { engine => 'mysql' }); ok $ran, 'tests were run against default SQLite'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/Search/0000775000175000017500000000000013624003631021101 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/Search/NotLike.t0000644000175000017500000000057113624003631022634 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Search'); cmp_deeply [$rs->not_like('me.name', 'bar%')->all], [$rs->search({ 'me.name' => { '-not_like' => 'bar%' } })->all], 'not_like works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/Search/NotNull.t0000644000175000017500000000054713624003631022665 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Search'); cmp_deeply [$rs->not_null(['me.id'])->all], [$rs->search({ 'me.id' => { '!=' => undef } })->all], 'not_null works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/Search/Base.t0000644000175000017500000000100213624003631022127 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply ['fizz', 'bizz'], [$rs->_helper_unwrap_columns('fizz', 'bizz')], 'unwrap array'; cmp_deeply ['fizz', 'bizz'], [$rs->_helper_unwrap_columns(['fizz', 'bizz'])], 'unwrap arrayref'; is $rs->_helper_meify('id'), 'id', 'not meifying'; is $rs->_helper_meify('.id'), 'me.id', 'meifying'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/Search/Like.t0000644000175000017500000000055513624003631022155 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Search'); cmp_deeply [$rs->like('me.name', 'bar%')->all], [$rs->search({ 'me.name' => { '-like' => 'bar%' } })->all], 'like works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/Search/Null.t0000644000175000017500000000075213624003631022202 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Search'); cmp_deeply [$rs->null('me.id')->all], [$rs->search({ 'me.id' => undef })->all], 'null works the same'; cmp_deeply [$rs->null('.id', 'bar_id')->all], [$rs->search({ 'me.id' => undef, 'bar_id' => undef })->all], 'null works the same for 2 params'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/LimitedPage.t0000644000175000017500000000137113624003631022245 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->limited_page(2, 3)->all], [$rs->search({},{ page => 2, rows => 3 })->all], 'limited_page works the same'; cmp_deeply [$rs->limited_page({ page => 2, rows => 3 })->all], [$rs->search({},{ page => 2, rows => 3 })->all], 'limited_page works the same'; cmp_deeply [$rs->limited_page({ page => 2 })->all], [$rs->search({},{ page => 2 })->all], 'limited_page works the same'; cmp_deeply [$rs->limited_page(2)->all], [$rs->limited_page({ page => 2 })->all], 'limited_page works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/AddColumns.t0000644000175000017500000000062413624003631022112 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->search(undef, { columns => 'id' })->add_columns('bar_id')->all], [$rs->search(undef, { columns => ['id', 'bar_id'] })->all], 'add_columns works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/Distinct.t0000644000175000017500000000051613624003631021642 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->distinct->all], [$rs->search(undef,{distinct => 1})->all], 'distinct works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/Prefetch.t0000644000175000017500000000053213624003631021617 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->prefetch('bar')->all], [$rs->search(undef,{prefetch => 'bar' })->all], 'prefetch works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/HasRows.t0000644000175000017500000000040613624003631021445 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); ok($rs->has_rows, 'check rs has rows'); done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/GroupBy.t0000644000175000017500000000054113624003631021446 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->group_by(['me.id'])->all], [$rs->search(undef,{group_by => ['me.id']})->all], 'group_by works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/Columns.t0000644000175000017500000000054013624003631021476 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->columns(['bar_id'])->all], [$rs->search(undef,{columns => ['bar_id']})->all], 'columns works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/OrderBy.t0000644000175000017500000000102013624003631021416 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->order_by({ -desc => 'me.id' })->all], [$rs->search({},{order_by => { -desc => 'me.id' }})->all], 'hashref order_by works the same'; cmp_deeply [$rs->order_by(['me.id'])->all], [$rs->search({},{order_by => { -asc => 'me.id' }})->all], 'arrayref order_by works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/Limit.t0000644000175000017500000000046513624003631021142 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->rows(2)->all], [$rs->limit(2)->all], 'limit works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/Rows.t0000644000175000017500000000050213624003631021006 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->rows(2)->all], [$rs->search({},{rows => 2})->all], 'rows works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Shortcut/HRI.t0000644000175000017500000000057613624003631020511 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); cmp_deeply [$rs->hri->all], [$rs->search(undef,{ result_class => 'DBIx::Class::ResultClass::HashRefInflator' })->all], 'hri works the same'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/NoColumns.t0000644000175000017500000000075113624003631020164 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Gnarly')->no_columns->search(undef, { result_class => '::HRI', }); { local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /ResultSets with an empty selection are deprecated/; }; cmp_deeply([$rs->all], [ { }, { }, { } ], 'no columns selected'); } done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/SearchOr.t0000644000175000017500000000174513624003631017761 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Fatal 'dies_ok'; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; $schema->resultset('Gnarly')->update({ literature => 'boo.' }); $schema->resultset('Gnarly')->create({ id => 4, name => 'fismboc' }); my $rs = $schema->resultset('Gnarly')->search({ literature => 'boo.' }); is($rs->count, 3, 'base rs has three results'); my $rs2 = $schema->resultset('Gnarly')->search({ name => 'frew' }); is($rs2->count, 1, 'rs2 has 1 result'); my $rs3 = $schema->resultset('Gnarly')->search({ name => 'frioux' }); is($rs3->count, 1, 'rs3 has 1 result'); my $rs4 = $schema->resultset('Gnarly')->search({ name => 'fismboc' }); is($rs4->count, 1, 'rs4 has 1 result'); is($rs->search_or([$rs2, $rs3, $rs4])->count, 2, 'only two things are in all of rs and in any of rs2, rs3, or rs4'); dies_ok { $rs->search_or([$schema->resultset('Bloaty')]) } 'or-ing differing ResultSets dies'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Explain.t0000644000175000017500000000135313624003631017646 0ustar frewfrew#!perl use Test::Roo; use Test::Fatal; use Data::Dumper::Concise; use lib 't/lib'; with 'A::Role::TestConnect'; sub rs { shift->schema->resultset('Gnarly') } my $ran; top_test basic => sub { my $self = shift; my $rs = $self->rs; SKIP: { skip 'cannot test without a connection', 1 unless $self->connected; $ran++ if $self->engine eq 'SQLite'; my $s; my $e = exception { $s = $rs->explain }; ok(!$e, 'valid SQL') or diag $e; note(Dumper($s)) if $s; } }; run_me(SQLite => { engine => 'SQLite', connect_info => [ 'dbi:SQLite::memory:'], }); run_me(Pg => { engine => 'Pg' }); run_me(mysql => { engine => 'mysql' }); ok $ran, 'tests were run against default SQLite'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Random.t0000644000175000017500000000111513624003631017462 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $row = $schema->resultset('Foo')->rand->single; # testing actual randomness is hard, and it's not actually random anyway, # so suck it. ok $row->id >= 1 && $row->id <= 5, 'row is one of the rows from the database'; my @rows = map $_->id, $schema->resultset('Foo')->rand(4)->all; ok @rows == 4, 'correct amount of rows selected'; for (@rows) { ok $_ >= 1 && $_ <= 5, 'row is one of the rows from the database'; } done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/OneRow.t0000644000175000017500000000042313624003631017454 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Gnarly'); isa_ok($rs->one_row, 'TestSchema::Result::Gnarly', '->one_row'); done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Errors.t0000644000175000017500000000064413624003631017524 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Fatal; use TestSchema; my $schema = TestSchema->deploy_or_connect(); my $f = __FILE__; like exception { $schema->resultset('Gnarly')->literature }, qr{^\QYou're trying to call a Result ("TestSchema::Result::Gnarly") method ("literature") on a ResultSet ("TestSchema::ResultSet::Gnarly") at $f line 15.\E}, 'exceptional'; done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Bare.t0000644000175000017500000000065513624003631017123 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Foo'); my $rs2 = $schema->resultset('Foo')->search({ id => { '>=' => 3 } }); my $count = $rs->count; ok($count != $rs2->count, 'Search actually finds a differing set of rows'); is($rs2->bare->count, $count, 'Bare clears search'); done_testing; DBIx-Class-Helpers-2.035000/t/ResultSet/Me.t0000644000175000017500000000047513624003631016613 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; my $schema = TestSchema->deploy_or_connect(); my $rs = $schema->resultset('Gnarly'); my $alias = $rs->current_source_alias; is $rs->me, "$alias.", 'me without args'; is $rs->me('col'), "$alias.col", 'me with args'; done_testing; DBIx-Class-Helpers-2.035000/t/Row/0000775000175000017500000000000013624003631014676 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/Row/ProxyResultSetUpdate.t0000644000175000017500000000162513624003631021224 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use Test::Fatal; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $rs = $schema->resultset('Bloaty'); $rs->search({ id => 1000 })->delete; my $row = $schema->resultset('Bloaty')->create({ id => 1000, name => 'woo', literature => 'bored', your_mom => 'hyuug', }); $row->name('woot'); $row->update({ literature => 'exciting' }); cmp_deeply( [{ name => 'woot', literature => 'exciting', }], \@TestSchema::ResultSet::Bloaty::stuff, 'update correctly proxied', ); $rs->search({ id => 1000 })->update({ id => 999 }); my $e = exception { $row->update({ literature => 'wonderful' }) }; like($e, qr/row not found/, 'dies when row gone missing'); #like($e, qr/updated more than one row/, 'dies when row ambiguous'); # not sure how to provoke this done_testing; DBIx-Class-Helpers-2.035000/t/Row/ProxyResultSetMethod.t0000644000175000017500000000265013624003631021221 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $g = $schema->resultset('Gnarly')->search({ id => 1 })->single; subtest 'unloaded data' => sub { is($g->id_plus_one, 2, 'basic test'); is($g->id_plus_two, 3, 'slot and specified method'); is($g->id_plus_two, 3, 'slot and specified method(2)'); }; my $g2 = $schema->resultset('Gnarly')->with_id_plus_one->search({ id => 2 })->single; subtest 'loaded data' => sub { is($g2->id_plus_one, 3, 'basic'); is($g2->id_plus_two, 4, 'slot and specified method'); }; subtest 'copy result' => sub { ok !$schema->resultset('Gnarly')->search({ id => 100 })->count, 'will not accidentally collide'; ok my $g3 = $g->copy({ id => 100 }), 'Copied result'; isa_ok $g3, 'DBIx::Class::Row'; is $g3->id, 100, 'id is correctly overridden'; }; subtest 'copy result without any proxy defined' => sub { my $bloaty = $schema->resultset('Bloaty')->first; ok my $bcopy = $bloaty->copy({ id => 100, name => 'boo' }), 'Copied result'; is $bcopy->id, 100, 'id is correctly overridden'; }; subtest 'update result' => sub { my $g2 = $schema->resultset('Gnarly')->search({ id => 2 })->single; is($g2->id_plus_one, 3, 'basic'); $g2->update({ literature => 'Expiration Date' }); ok 1, q(Update didn't explode); }; done_testing; DBIx-Class-Helpers-2.035000/t/Row/RelationshipDWIM.t0000644000175000017500000000067013624003631020206 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $r = $schema->resultset('Bar')->result_class; ok $r->has_relationship('foo'), 'has Foo'; ok $r->has_relationship('foos'), 'has foos'; ok $r->has_relationship('might_have_foo'), 'might have Foo'; ok $r->has_relationship('has_one_foo'), 'has one Foo'; done_testing; DBIx-Class-Helpers-2.035000/t/Row/OnColumnMissing.t0000644000175000017500000000200113624003631020136 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Fatal 'exception';; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $row = $schema->resultset('Gnarly') ->search(undef, { columns => ['id'] }) ->one_row; ok($row->id, 'row loaded'); { my $warning; local $SIG{__WARN__} = sub { $warning = shift }; $row->literature; like($warning, qr/Column literature has not been loaded/, 'warnings'); }; { local $TestSchema::Result::Gnarly::MISSING = 'die'; my $e = exception { $row->literature }; like($e, qr/Column literature has not been loaded/, 'exceptions'); }; { local $TestSchema::Result::Gnarly::MISSING = 'nothing'; is ($row->literature, undef, 'undef in scalar context'); is_deeply ([$row->literature], [undef], 'undef in list context'); }; { my $custom; local $TestSchema::Result::Gnarly::MISSING = sub { $custom = $_[1] }; $row->literature; is($custom, 'literature', 'custom action'); }; done_testing; DBIx-Class-Helpers-2.035000/t/Row/OnColumnChange.t0000644000175000017500000000711113624003631017721 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use Test::Fatal 'exception', 'dies_ok';; use TestSchema; use TestSchema::Result::Bar; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; like( exception { TestSchema::Result::Bar->after_column_change( foo_id => { method => sub { 1; } }, id => { method => sub { 1; } }, ); }, qr/Invalid number of arguments\. One \$column => \$args pair at a time\./, ); TestSchema::Result::Bar->after_column_change( foo_id => { method => sub { push @TestSchema::Result::Bar::events, [after_foo_id => $_[1], $_[2]] } }, ); TestSchema::Result::Bar->after_column_change( id => { method => sub { is($schema->storage->{transaction_depth}, 1, 'transactions turned on for id'); push @TestSchema::Result::Bar::events, [after_id => $_[1], $_[2]] }, txn_wrap => 1, }, ); my $another_txn_test = sub { is($schema->storage->{transaction_depth}, 0, 'transactions turned off for non-txn') }; TestSchema::Result::Bar->around_column_change( foo_id => { method => sub { my ( $self, $fn, $old, $new ) = @_; push @TestSchema::Result::Bar::events, [pre_around_foo_id => $old, $new]; $another_txn_test->(); $fn->(); push @TestSchema::Result::Bar::events, [post_around_foo_id => $old, $new]; }, }, ); my $first = $schema->resultset('Bar')->search(undef, { order_by => 'id' })->first; is($first->foo_id, 1, 'foo_id starts as 1'); $first->foo_id(2); $first->update; is($first->foo_id, 2, 'foo_id is updated to 2'); $another_txn_test = sub {}; cmp_deeply([ [ 'before_foo_id', 1, 2 ], # comes from TestSchema::Result::Bar [ 'pre_around_foo_id', 1, 2 ], [ 'post_around_foo_id', 1, 2 ], [ 'after_foo_id', 2, 2 ], ], \@TestSchema::Result::Bar::events, 'subs fire in correct order and with correct args'); @TestSchema::Result::Bar::events = (); $first->update({ foo_id => 1, id => 99 }); is($first->foo_id, 1, 'foo_id is updated'); is($first->id, 99, 'id is updated'); cmp_deeply([ [ 'before_foo_id', 2, 1 ], [ 'pre_around_foo_id', 2, 1 ], [ 'post_around_foo_id', 2, 1 ], [ 'after_id', undef, 99 ], [ 'after_foo_id', 1, 1 ] ], \@TestSchema::Result::Bar::events, '... even with args passed to update'); TestSchema::Result::Foo->after_column_change( bar_id => { method => sub { die }, txn_wrap => 1, }, ); my $foo = $schema->resultset('Foo')->search(undef, { order_by => 'id' })->first; my $bar = $schema->resultset('Bar')->search( { id => { '!=' => $first->id } } )->first; dies_ok( sub { $foo->update({ bar_id => $bar->id }); }, 'after_column_change method triggered when updating via foreign key column', ); dies_ok( sub { $foo->update({ bar => $first }); }, 'after_column_change method triggered when updating via relationship accessor', ); TestSchema::Result::Bar->before_column_change( test_flag => { method => sub { my ($self, $old, $new) = @_; $self->test_flag($new + 1); }, }, ); subtest 'old style' => sub { is $bar->test_flag, undef, 'test_flag not yet set'; $bar->update({ test_flag => 1 }); is $bar->test_flag, 1, 'test_flag could not be overridden with before_column_change'; }; subtest 'new style' => sub { TestSchema::Result::Bar->on_column_change_allow_override_args(1); is $bar->test_flag, 1, 'test_flag not yet set'; $bar->update({ test_flag => 2 }); is $bar->test_flag, 3, 'test_flag could be overridden with before_column_change'; }; done_testing; DBIx-Class-Helpers-2.035000/t/Row/CleanResultSet.t0000644000175000017500000000042013624003631017752 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; cmp_deeply $schema->resultset('Bar'), $schema->resultset('Bar')->first->clean_rs; done_testing; DBIx-Class-Helpers-2.035000/t/Row/StorageValues.t0000644000175000017500000000210613624003631017644 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; my $first = $schema->resultset('Bar')->search(undef, { order_by => 'id' })->first; is($first->foo_id, 1, 'foo_id starts as 1'); is($first->get_storage_value('foo_id'), 1, 'foo_id storage value starts as 1'); $first->foo_id(2); is($first->foo_id, 2, 'foo_id changes to 2'); is($first->get_storage_value('foo_id'), 1, 'foo_id storage value is still 1'); $first->update; is($first->get_storage_value('foo_id'), 2, 'foo_id storage value is updated to 2'); my $new = $schema->resultset('Bar')->new({ id => 999, foo_id => 1, }); is($new->foo_id, 1, 'new row of course has set values'); is($new->get_storage_value('foo_id'), undef, 'and storage values are unset'); $new->foo_id(2); is($new->foo_id, 2, 'updated row has new value'); is($new->get_storage_value('foo_id'), undef, 'but storage values are unchanged'); $new->insert; is($new->get_storage_value('foo_id'), 2, 'storage value updated after insert'); done_testing; DBIx-Class-Helpers-2.035000/t/Row/SelfResultSet.t0000644000175000017500000000165513624003631017634 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; $schema->resultset('Foo_Bar')->delete; $schema->resultset('Foo_Bar')->populate([ [qw(foo_id bar_id)], [1, 2], [2, 1], [4, 5], ]); subtest 'single pk column' => sub { for ($schema->resultset('Bar')->all) { subtest 'Bar.id: ' . $_->id => sub { is ($_->self_rs->count, 1, 'single row in self_rs'); is ($_->self_rs->single->id, $_->id, 'id matches'); }; } }; subtest 'multi pk' => sub { for ($schema->resultset('Foo_Bar')->all) { subtest 'Foo_Bar: ' . $_->foo_id . ' ' . $_->bar_id => sub { is ($_->self_rs->count, 1, 'single row in self_rs'); is ($_->self_rs->single->foo_id, $_->foo_id, 'foo_id matches'); is ($_->self_rs->single->bar_id, $_->bar_id, 'bar_id matches'); }; } }; done_testing; DBIx-Class-Helpers-2.035000/t/Row/JoinTable.t0000644000175000017500000000355413624003631016737 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; { my $bar_rs = TestSchema->resultset('Foo_Bar'); is $bar_rs->result_source->from, 'Foo_Bar', 'set table works'; relationships: { my $bar_info = $bar_rs->result_source->relationship_info('bar'); is $bar_info->{class}, 'TestSchema::Result::Bar', 'namespace correctly defaulted'; my $foo_info = $bar_rs->result_source->relationship_info('foo'); is $foo_info->{class}, 'TestSchema::Result::Foo', 'namespace and method name correctly defaulted'; } cmp_deeply [ $bar_rs->result_source->primary_columns ], [qw{foo_id bar_id}], 'set primary keys works'; cmp_deeply $bar_rs->result_source->column_info('bar_id'), { data_type => 'integer', size => 12, }, 'bar_id infers column info correctly'; } { relationships: { my $g_rs = $schema->resultset('Gnarly'); my $s_rs = $schema->resultset('Station'); my $g_s_rs = $schema->resultset('Gnarly_Station'); cmp_deeply $g_s_rs->result_source->column_info('gnarly_id'), { data_type => 'int', }, 'gnarly_id defaults column info correctly'; is $s_rs->result_source->relationship_info('gnarly_stations')->{class}, 'TestSchema::Result::Gnarly_Station', 'Left has_many defaulted correctly'; is $g_rs->result_source->relationship_info('gnarly_stations')->{class}, 'TestSchema::Result::Gnarly_Station', 'Right has_many defaulted correctly'; cmp_deeply [ map $_->id, $s_rs->find(1)->gnarlies ], [ 1, 2, 3 ], 'Left many_to_many defaulted correctly'; cmp_deeply [ map $_->id, $g_rs->find(1)->stations ], [ 1, 3 ], 'Right many_to_many defaulted correctly'; } } done_testing; DBIx-Class-Helpers-2.035000/t/Row/NumifyGet.t0000644000175000017500000000244713624003631016777 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use Test::Fatal 'lives_ok'; use List::Util 'first'; use TestSchema; use B; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; # stolen from JSON::PP sub is_numeric { my $value = shift; my $b_obj = B::svref_2object(\$value); my $flags = $b_obj->FLAGS; return (( $flags & B::SVf_IOK or $flags & B::SVp_IOK or $flags & B::SVf_NOK or $flags & B::SVp_NOK ) and !($flags & B::SVf_POK )) } ok(is_numeric($schema->resultset('Foo')->first->bar_id),"bar_id has been 'numified' w/o is_numeric set"); for (map $_->id, $schema->resultset('Foo')->all) { ok(is_numeric($_), "id $_ has been 'numified'"); } for (map +{$_->get_columns}, $schema->resultset('Foo')->all) { ok(is_numeric($_->{id}), "id $_->{id} has been 'numified'"); } for (map +{$_->get_inflated_columns}, $schema->resultset('Foo')->all) { ok(is_numeric($_->{id}), "id $_->{id} has been 'numified'"); } for (map +{$_->get_inflated_columns}, $schema->resultset('Foo')->all) { ok(is_numeric($_->{id}), "id $_->{id} has been 'numified'"); } for ($schema->resultset('Foo')->search(undef, { columns => { lol => 'id' }, })->all) { lives_ok { $_->get_column('lol') } "doesn't break when using columns"; } done_testing; DBIx-Class-Helpers-2.035000/t/Row/SubClass.t0000644000175000017500000000134413624003631016602 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use TestSchema; namespacing: { my $foo_rs = TestSchema->resultset('Foo'); my $bar_info = $foo_rs->result_source->relationship_info('bar'); is $bar_info->{class}, 'TestSchema::Result::Bar', 'namespacing seems to work'; my $bar_rs = TestSchema->resultset('Bar'); my $foo_info = $bar_rs->result_source->relationship_info('foo'); is $foo_info->{class}, 'TestSchema::Result::Foo', 'namespacing seems to work'; } table: { my $foo_rs = TestSchema->resultset('Foo'); is $foo_rs->result_source->from, 'Foo', 'set table works'; my $bar_rs = TestSchema->resultset('Bar'); is $bar_rs->result_source->from, 'Bar', 'set table works'; } done_testing; DBIx-Class-Helpers-2.035000/t/Row/ToJSON.t0000644000175000017500000000372513624003631016144 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Deep; use TestSchema; my $schema = TestSchema->deploy_or_connect(); $schema->prepopulate; SIMPLE_JSON: { my $datas = [ map $_->TO_JSON, $schema->resultset('Bar')->search(undef, { order_by => 'id' })->all ]; cmp_deeply($datas, [map superhashof($_), { id => 1, foo_id => 1, },{ id => 2, foo_id => 2, },{ id => 3, foo_id => 3, },{ id => 4, foo_id => 4, },{ id => 5, foo_id => 5, }], 'simple TO_JSON works'); } MORE_COMPLEX_JSON: { my $datas = [ map $_->TO_JSON, $schema->resultset('Gnarly')->search(undef, { order_by => 'id' })->all ]; cmp_deeply($datas, [{ id => 1, name => 'frew', your_mom => undef, },{ id => 2, name => 'frioux', your_mom => undef, },{ id => 3, name => 'frooh', your_mom => undef, }], 'complex TO_JSON works'); } ACCESSOR_CLASS: { my $datas = [ map $_->TO_JSON, $schema->resultset('HasAccessor')->search(undef, { order_by => 'id' })->all ]; cmp_deeply($datas, [{ id => 1, usable_column => 'aa', alternate_name => 'bb', },{ id => 2, usable_column => 'cc', alternate_name => 'dd', },{ id => 3, usable_column => 'ee', alternate_name => 'ff', }], 'accessor fields with TO_JSON works'); } SERIALIZE_ALL_DATA_TYPES: { my $datas = [ map $_->TO_JSON, $schema->resultset('SerializeAll')->search(undef, { order_by => 'id' })->all ]; cmp_deeply($datas, [{ id => 1, text_column => 'frew', },{ id => 2, text_column => 'frioux', },{ id => 3, text_column => 'frooh', }], 'serialize all data types with TO_JSON'); } done_testing; DBIx-Class-Helpers-2.035000/t/utilities.t0000644000175000017500000001032713624003631016330 0ustar frewfrew#!perl use strict; use warnings; use lib 't/lib'; use Test::More; use Test::Fatal qw( lives_ok dies_ok );; use Test::Deep; use DBIx::Class::Helpers::Util ':all'; my ($ns, $class) = get_namespace_parts('Project::Schema::Result::Child'); is $ns, 'Project::Schema::Result', 'namespace part of get_namespace_parts works'; is $class, 'Child', 'result part of get_namespace_parts works'; ($ns, $class) = get_namespace_parts('Project::Schema::Result::HouseHold::Child'); is $ns, 'Project::Schema::Result', 'namespace part of get_namespace_parts works'; is $class, 'HouseHold::Child', 'result part of get_namespace_parts works'; subtest is_load_namespaces => sub { ok is_load_namespaces('P::Result::Foo'), 'is_load_namespaces works when correct'; ok !is_load_namespaces('P::Foo'), 'is_load_namespaces works when incorrect'; ok is_load_namespaces('P::Result::Foo::Bar'), 'is_load_namespaces works with two levels namespace'; }; subtest is_not_load_namespaces => sub { ok is_not_load_namespaces('P::Foo'), 'is_not_load_namespaces works correct'; ok !is_not_load_namespaces('P::Result::Foo'), 'is_not_load_namespaces works when incorrect'; }; subtest assert_similar_namespaces => sub { lives_ok { assert_similar_namespaces('P::Foo', 'L::Bar') } 'assert_similar_namespaces works when both non-namespace'; lives_ok { assert_similar_namespaces('P::Result::Foo', 'L::Result::Bar') } 'assert_similar_namespaces works when both namespace'; dies_ok { assert_similar_namespaces('P::Foo', 'L::Result::Bar') } 'assert_similar_namespaces works when right is namespace'; dies_ok { assert_similar_namespaces('P::Result::Foo', 'L::Bar') } 'assert_similar_namespaces works when left is namespace'; lives_ok { assert_similar_namespaces('P::Result::Foo::Bar', 'L::Result::Foo::Bar')} 'assert_similar_namespaces works with two levels of right namespace'; }; subtest order_by_vistor => sub { my $complex_order_by = [ { -desc => [qw( foo bar )] }, 'baz', { -asc => 'biff' } ]; cmp_deeply( order_by_visitor($complex_order_by, sub{shift}), $complex_order_by, 'roundtrip' ); cmp_deeply( order_by_visitor('frew', sub{'bar'}), 'bar', 'simplest ever' ); cmp_deeply( order_by_visitor({ -asc => 'foo' }, sub{'bar'}), { -asc => 'bar' }, 'simple hash' ); cmp_deeply( order_by_visitor([{ -asc => 'foo' }, 'bar'], sub{ if ($_[0] eq 'foo') { return 'foot' } else { return $_[0] } }), [{ -asc => 'foot' }, 'bar'], 'typical' ); }; subtest normalize_connect_info => sub { subtest 'form 1' => sub { cmp_deeply( normalize_connect_info('dbi:foo'), { dsn => 'dbi:foo' }, 'dsn', ); cmp_deeply( normalize_connect_info('dbi:foo', 'user'), { dsn => 'dbi:foo', user => 'user', }, 'dsn, user', ); cmp_deeply( normalize_connect_info('dbi:foo', 'user', 'pass'), { dsn => 'dbi:foo', user => 'user', password => 'pass', }, 'dsn, user, pass', ); cmp_deeply( normalize_connect_info('dbi:foo', 'user', 'pass', { LongReadLen => 1 }, ), { dsn => 'dbi:foo', user => 'user', password => 'pass', LongReadLen => 1, }, 'dsn, user, pass, dbi_opts', ); cmp_deeply( normalize_connect_info('dbi:foo', 'user', 'pass', { LongReadLen => 1 }, { quote_names => 1 }, ), { dsn => 'dbi:foo', user => 'user', password => 'pass', LongReadLen => 1, quote_names => 1, }, 'all params', ); }; subtest 'form 2' => sub { my $s = sub {}; cmp_deeply( normalize_connect_info($s), { dbh_maker => $s }, 'just sub', ); cmp_deeply( normalize_connect_info($s, { quote_names => 1 }), { dbh_maker => $s, quote_names => 1 }, 'sub and options', ); }; }; done_testing; DBIx-Class-Helpers-2.035000/t/lib/0000775000175000017500000000000013624003631014675 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/TestSchema-0.001-PostgreSQL.sql0000644000175000017500000000633713624003631022122 0ustar frewfrew-- -- Created by SQL::Translator::Producer::PostgreSQL -- Created on Fri Feb 21 08:38:44 2020 -- -- -- Table: Bloaty -- DROP TABLE "Bloaty" CASCADE; CREATE TABLE "Bloaty" ( "id" integer NOT NULL, "name" character varying NOT NULL, "literature" text, "your_mom" bytea, PRIMARY KEY ("id") ); -- -- Table: Gnarly -- DROP TABLE "Gnarly" CASCADE; CREATE TABLE "Gnarly" ( "id" integer NOT NULL, "name" character varying NOT NULL, "literature" text, "your_mom" bytea, PRIMARY KEY ("id") ); -- -- Table: HasAccessor -- DROP TABLE "HasAccessor" CASCADE; CREATE TABLE "HasAccessor" ( "id" integer NOT NULL, "usable_column" character varying NOT NULL, "unusable_column" character varying NOT NULL, PRIMARY KEY ("id") ); -- -- Table: HasDateOps -- DROP TABLE "HasDateOps" CASCADE; CREATE TABLE "HasDateOps" ( "id" integer NOT NULL, "a_date" timestamp NOT NULL, "b_date" timestamp, PRIMARY KEY ("id") ); -- -- Table: Search -- DROP TABLE "Search" CASCADE; CREATE TABLE "Search" ( "id" integer NOT NULL, "name" character varying NOT NULL, PRIMARY KEY ("id") ); -- -- Table: SerializeAll -- DROP TABLE "SerializeAll" CASCADE; CREATE TABLE "SerializeAll" ( "id" integer NOT NULL, "text_column" text NOT NULL, PRIMARY KEY ("id") ); -- -- Table: Station -- DROP TABLE "Station" CASCADE; CREATE TABLE "Station" ( "id" integer NOT NULL, "name" character varying NOT NULL, PRIMARY KEY ("id") ); -- -- Table: Bar -- DROP TABLE "Bar" CASCADE; CREATE TABLE "Bar" ( "id" bigint NOT NULL, "foo_id" integer NOT NULL, "test_flag" integer, PRIMARY KEY ("id") ); CREATE INDEX "Bar_idx_foo_id" on "Bar" ("foo_id"); -- -- Table: Foo -- DROP TABLE "Foo" CASCADE; CREATE TABLE "Foo" ( "id" integer NOT NULL, "bar_id" integer NOT NULL, PRIMARY KEY ("id") ); CREATE INDEX "Foo_idx_bar_id" on "Foo" ("bar_id"); -- -- Table: Foo_Bar -- DROP TABLE "Foo_Bar" CASCADE; CREATE TABLE "Foo_Bar" ( "foo_id" integer NOT NULL, "bar_id" bigint NOT NULL, PRIMARY KEY ("foo_id", "bar_id") ); CREATE INDEX "Foo_Bar_idx_bar_id" on "Foo_Bar" ("bar_id"); CREATE INDEX "Foo_Bar_idx_foo_id" on "Foo_Bar" ("foo_id"); -- -- Table: Gnarly_Station -- DROP TABLE "Gnarly_Station" CASCADE; CREATE TABLE "Gnarly_Station" ( "gnarly_id" integer NOT NULL, "station_id" integer NOT NULL, PRIMARY KEY ("gnarly_id", "station_id") ); CREATE INDEX "Gnarly_Station_idx_gnarly_id" on "Gnarly_Station" ("gnarly_id"); CREATE INDEX "Gnarly_Station_idx_station_id" on "Gnarly_Station" ("station_id"); -- -- Foreign Key Definitions -- ALTER TABLE "Bar" ADD CONSTRAINT "Bar_fk_foo_id" FOREIGN KEY ("foo_id") REFERENCES "Foo" ("id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; ALTER TABLE "Foo_Bar" ADD CONSTRAINT "Foo_Bar_fk_bar_id" FOREIGN KEY ("bar_id") REFERENCES "Bar" ("id") DEFERRABLE; ALTER TABLE "Foo_Bar" ADD CONSTRAINT "Foo_Bar_fk_foo_id" FOREIGN KEY ("foo_id") REFERENCES "Foo" ("id") DEFERRABLE; ALTER TABLE "Gnarly_Station" ADD CONSTRAINT "Gnarly_Station_fk_gnarly_id" FOREIGN KEY ("gnarly_id") REFERENCES "Gnarly" ("id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; ALTER TABLE "Gnarly_Station" ADD CONSTRAINT "Gnarly_Station_fk_station_id" FOREIGN KEY ("station_id") REFERENCES "Station" ("id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; DBIx-Class-Helpers-2.035000/t/lib/TestSchema-0.001-SQLServer.sql0000644000175000017500000001301313624003631021732 0ustar frewfrew-- -- Created by SQL::Translator::Generator::Role::DDL -- Created on Fri Feb 21 08:38:44 2020 -- -- -- Turn off constraints -- IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Gnarly_Station' AND type = 'U') ALTER TABLE [Gnarly_Station] NOCHECK CONSTRAINT all; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Foo_Bar' AND type = 'U') ALTER TABLE [Foo_Bar] NOCHECK CONSTRAINT all; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Foo' AND type = 'U') ALTER TABLE [Foo] NOCHECK CONSTRAINT all; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Bar' AND type = 'U') ALTER TABLE [Bar] NOCHECK CONSTRAINT all; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Station' AND type = 'U') ALTER TABLE [Station] NOCHECK CONSTRAINT all; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'SerializeAll' AND type = 'U') ALTER TABLE [SerializeAll] NOCHECK CONSTRAINT all; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Search' AND type = 'U') ALTER TABLE [Search] NOCHECK CONSTRAINT all; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'HasDateOps' AND type = 'U') ALTER TABLE [HasDateOps] NOCHECK CONSTRAINT all; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'HasAccessor' AND type = 'U') ALTER TABLE [HasAccessor] NOCHECK CONSTRAINT all; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Gnarly' AND type = 'U') ALTER TABLE [Gnarly] NOCHECK CONSTRAINT all; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Bloaty' AND type = 'U') ALTER TABLE [Bloaty] NOCHECK CONSTRAINT all; -- -- Drop tables -- IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Gnarly_Station' AND type = 'U') DROP TABLE [Gnarly_Station]; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Foo_Bar' AND type = 'U') DROP TABLE [Foo_Bar]; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Foo' AND type = 'U') DROP TABLE [Foo]; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Bar' AND type = 'U') DROP TABLE [Bar]; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Station' AND type = 'U') DROP TABLE [Station]; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'SerializeAll' AND type = 'U') DROP TABLE [SerializeAll]; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Search' AND type = 'U') DROP TABLE [Search]; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'HasDateOps' AND type = 'U') DROP TABLE [HasDateOps]; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'HasAccessor' AND type = 'U') DROP TABLE [HasAccessor]; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Gnarly' AND type = 'U') DROP TABLE [Gnarly]; IF EXISTS (SELECT name FROM sysobjects WHERE name = 'Bloaty' AND type = 'U') DROP TABLE [Bloaty]; -- -- Table: [Bloaty] -- CREATE TABLE [Bloaty] ( [id] int NOT NULL, [name] varchar NOT NULL, [literature] text NULL, [your_mom] blob NULL, CONSTRAINT [Bloaty_pk] PRIMARY KEY ([id]) ); -- -- Table: [Gnarly] -- CREATE TABLE [Gnarly] ( [id] int NOT NULL, [name] varchar NOT NULL, [literature] text NULL, [your_mom] blob NULL, CONSTRAINT [Gnarly_pk] PRIMARY KEY ([id]) ); -- -- Table: [HasAccessor] -- CREATE TABLE [HasAccessor] ( [id] int NOT NULL, [usable_column] varchar NOT NULL, [unusable_column] varchar NOT NULL, CONSTRAINT [HasAccessor_pk] PRIMARY KEY ([id]) ); -- -- Table: [HasDateOps] -- CREATE TABLE [HasDateOps] ( [id] int NOT NULL, [a_date] datetime NOT NULL, [b_date] datetime NULL, CONSTRAINT [HasDateOps_pk] PRIMARY KEY ([id]) ); -- -- Table: [Search] -- CREATE TABLE [Search] ( [id] int NOT NULL, [name] varchar NOT NULL, CONSTRAINT [Search_pk] PRIMARY KEY ([id]) ); -- -- Table: [SerializeAll] -- CREATE TABLE [SerializeAll] ( [id] int NOT NULL, [text_column] text NOT NULL, CONSTRAINT [SerializeAll_pk] PRIMARY KEY ([id]) ); -- -- Table: [Station] -- CREATE TABLE [Station] ( [id] int NOT NULL, [name] varchar NOT NULL, CONSTRAINT [Station_pk] PRIMARY KEY ([id]) ); -- -- Table: [Bar] -- CREATE TABLE [Bar] ( [id] integer NOT NULL, [foo_id] integer NOT NULL, [test_flag] integer NULL, CONSTRAINT [Bar_pk] PRIMARY KEY ([id]) ); CREATE INDEX [Bar_idx_foo_id] ON [Bar] ([foo_id]); -- -- Table: [Foo] -- CREATE TABLE [Foo] ( [id] integer NOT NULL, [bar_id] integer NOT NULL, CONSTRAINT [Foo_pk] PRIMARY KEY ([id]) ); CREATE INDEX [Foo_idx_bar_id] ON [Foo] ([bar_id]); -- -- Table: [Foo_Bar] -- CREATE TABLE [Foo_Bar] ( [foo_id] integer NOT NULL, [bar_id] integer NOT NULL, CONSTRAINT [Foo_Bar_pk] PRIMARY KEY ([foo_id], [bar_id]) ); CREATE INDEX [Foo_Bar_idx_bar_id] ON [Foo_Bar] ([bar_id]); CREATE INDEX [Foo_Bar_idx_foo_id] ON [Foo_Bar] ([foo_id]); -- -- Table: [Gnarly_Station] -- CREATE TABLE [Gnarly_Station] ( [gnarly_id] int NOT NULL, [station_id] int NOT NULL, CONSTRAINT [Gnarly_Station_pk] PRIMARY KEY ([gnarly_id], [station_id]) ); CREATE INDEX [Gnarly_Station_idx_gnarly_id] ON [Gnarly_Station] ([gnarly_id]); CREATE INDEX [Gnarly_Station_idx_station_id] ON [Gnarly_Station] ([station_id]); ALTER TABLE [Bar] ADD CONSTRAINT [Bar_fk_foo_id] FOREIGN KEY ([foo_id]) REFERENCES [Foo] ([id]) ON DELETE CASCADE ON UPDATE CASCADE; ALTER TABLE [Foo_Bar] ADD CONSTRAINT [Foo_Bar_fk_bar_id] FOREIGN KEY ([bar_id]) REFERENCES [Bar] ([id]); ALTER TABLE [Foo_Bar] ADD CONSTRAINT [Foo_Bar_fk_foo_id] FOREIGN KEY ([foo_id]) REFERENCES [Foo] ([id]); ALTER TABLE [Gnarly_Station] ADD CONSTRAINT [Gnarly_Station_fk_gnarly_id] FOREIGN KEY ([gnarly_id]) REFERENCES [Gnarly] ([id]) ON DELETE CASCADE ON UPDATE CASCADE; ALTER TABLE [Gnarly_Station] ADD CONSTRAINT [Gnarly_Station_fk_station_id] FOREIGN KEY ([station_id]) REFERENCES [Station] ([id]) ON DELETE CASCADE ON UPDATE CASCADE;DBIx-Class-Helpers-2.035000/t/lib/TestSchema-0.001-SQLite.sql0000644000175000017500000000471613624003631021257 0ustar frewfrew-- -- Created by SQL::Translator::Producer::SQLite -- Created on Fri Feb 21 08:38:44 2020 -- BEGIN TRANSACTION; -- -- Table: "Bloaty" -- CREATE TABLE "Bloaty" ( "id" INTEGER PRIMARY KEY NOT NULL, "name" varchar NOT NULL, "literature" text, "your_mom" blob ); -- -- Table: "Gnarly" -- CREATE TABLE "Gnarly" ( "id" INTEGER PRIMARY KEY NOT NULL, "name" varchar NOT NULL, "literature" text, "your_mom" blob ); -- -- Table: "HasAccessor" -- CREATE TABLE "HasAccessor" ( "id" INTEGER PRIMARY KEY NOT NULL, "usable_column" varchar NOT NULL, "unusable_column" varchar NOT NULL ); -- -- Table: "HasDateOps" -- CREATE TABLE "HasDateOps" ( "id" INTEGER PRIMARY KEY NOT NULL, "a_date" datetime NOT NULL, "b_date" datetime ); -- -- Table: "Search" -- CREATE TABLE "Search" ( "id" INTEGER PRIMARY KEY NOT NULL, "name" varchar NOT NULL ); -- -- Table: "SerializeAll" -- CREATE TABLE "SerializeAll" ( "id" INTEGER PRIMARY KEY NOT NULL, "text_column" text NOT NULL ); -- -- Table: "Station" -- CREATE TABLE "Station" ( "id" INTEGER PRIMARY KEY NOT NULL, "name" varchar NOT NULL ); -- -- Table: "Bar" -- CREATE TABLE "Bar" ( "id" INTEGER PRIMARY KEY NOT NULL, "foo_id" integer NOT NULL, "test_flag" integer, FOREIGN KEY ("foo_id") REFERENCES "Foo"("id") ON DELETE CASCADE ON UPDATE CASCADE ); CREATE INDEX "Bar_idx_foo_id" ON "Bar" ("foo_id"); -- -- Table: "Foo" -- CREATE TABLE "Foo" ( "id" INTEGER PRIMARY KEY NOT NULL, "bar_id" integer NOT NULL, FOREIGN KEY ("bar_id") REFERENCES "Bar"("id") ON DELETE CASCADE ); CREATE INDEX "Foo_idx_bar_id" ON "Foo" ("bar_id"); -- -- Table: "Foo_Bar" -- CREATE TABLE "Foo_Bar" ( "foo_id" integer NOT NULL, "bar_id" integer(12) NOT NULL, PRIMARY KEY ("foo_id", "bar_id"), FOREIGN KEY ("bar_id") REFERENCES "Bar"("id"), FOREIGN KEY ("foo_id") REFERENCES "Foo"("id") ); CREATE INDEX "Foo_Bar_idx_bar_id" ON "Foo_Bar" ("bar_id"); CREATE INDEX "Foo_Bar_idx_foo_id" ON "Foo_Bar" ("foo_id"); -- -- Table: "Gnarly_Station" -- CREATE TABLE "Gnarly_Station" ( "gnarly_id" int NOT NULL, "station_id" int NOT NULL, PRIMARY KEY ("gnarly_id", "station_id"), FOREIGN KEY ("gnarly_id") REFERENCES "Gnarly"("id") ON DELETE CASCADE ON UPDATE CASCADE, FOREIGN KEY ("station_id") REFERENCES "Station"("id") ON DELETE CASCADE ON UPDATE CASCADE ); CREATE INDEX "Gnarly_Station_idx_gnarly_id" ON "Gnarly_Station" ("gnarly_id"); CREATE INDEX "Gnarly_Station_idx_station_id" ON "Gnarly_Station" ("station_id"); COMMIT; DBIx-Class-Helpers-2.035000/t/lib/TestSchema-0.001-Oracle.sql0000644000175000017500000000631113624003631021314 0ustar frewfrew-- -- Created by SQL::Translator::Producer::Oracle -- Created on Fri Feb 21 08:38:44 2020 -- -- -- Table: Bloaty --; DROP TABLE "Bloaty" CASCADE CONSTRAINTS; CREATE TABLE "Bloaty" ( "id" number NOT NULL, "name" varchar2(4000) NOT NULL, "literature" clob, "your_mom" blob, PRIMARY KEY ("id") ); -- -- Table: Gnarly --; DROP TABLE "Gnarly" CASCADE CONSTRAINTS; CREATE TABLE "Gnarly" ( "id" number NOT NULL, "name" varchar2(4000) NOT NULL, "literature" clob, "your_mom" blob, PRIMARY KEY ("id") ); -- -- Table: HasAccessor --; DROP TABLE "HasAccessor" CASCADE CONSTRAINTS; CREATE TABLE "HasAccessor" ( "id" number NOT NULL, "usable_column" varchar2(4000) NOT NULL, "unusable_column" varchar2(4000) NOT NULL, PRIMARY KEY ("id") ); -- -- Table: HasDateOps --; DROP TABLE "HasDateOps" CASCADE CONSTRAINTS; CREATE TABLE "HasDateOps" ( "id" number NOT NULL, "a_date" date NOT NULL, "b_date" date, PRIMARY KEY ("id") ); -- -- Table: Search --; DROP TABLE "Search" CASCADE CONSTRAINTS; CREATE TABLE "Search" ( "id" number NOT NULL, "name" varchar2(4000) NOT NULL, PRIMARY KEY ("id") ); -- -- Table: SerializeAll --; DROP TABLE "SerializeAll" CASCADE CONSTRAINTS; CREATE TABLE "SerializeAll" ( "id" number NOT NULL, "text_column" clob NOT NULL, PRIMARY KEY ("id") ); -- -- Table: Station --; DROP TABLE "Station" CASCADE CONSTRAINTS; CREATE TABLE "Station" ( "id" number NOT NULL, "name" varchar2(4000) NOT NULL, PRIMARY KEY ("id") ); -- -- Table: Bar --; DROP TABLE "Bar" CASCADE CONSTRAINTS; CREATE TABLE "Bar" ( "id" number(12) NOT NULL, "foo_id" number NOT NULL, "test_flag" number, PRIMARY KEY ("id") ); -- -- Table: Foo --; DROP TABLE "Foo" CASCADE CONSTRAINTS; CREATE TABLE "Foo" ( "id" number NOT NULL, "bar_id" number NOT NULL, PRIMARY KEY ("id") ); -- -- Table: Foo_Bar --; DROP TABLE "Foo_Bar" CASCADE CONSTRAINTS; CREATE TABLE "Foo_Bar" ( "foo_id" number NOT NULL, "bar_id" number(12) NOT NULL, PRIMARY KEY ("foo_id", "bar_id") ); -- -- Table: Gnarly_Station --; DROP TABLE "Gnarly_Station" CASCADE CONSTRAINTS; CREATE TABLE "Gnarly_Station" ( "gnarly_id" number NOT NULL, "station_id" number NOT NULL, PRIMARY KEY ("gnarly_id", "station_id") ); ALTER TABLE "Bar" ADD CONSTRAINT "Bar_foo_id_fk" FOREIGN KEY ("foo_id") REFERENCES "Foo" ("id") ON DELETE CASCADE; ALTER TABLE "Foo_Bar" ADD CONSTRAINT "Foo_Bar_bar_id_fk" FOREIGN KEY ("bar_id") REFERENCES "Bar" ("id"); ALTER TABLE "Foo_Bar" ADD CONSTRAINT "Foo_Bar_foo_id_fk" FOREIGN KEY ("foo_id") REFERENCES "Foo" ("id"); ALTER TABLE "Gnarly_Station" ADD CONSTRAINT "Gnarly_Station_gnarly_id_fk" FOREIGN KEY ("gnarly_id") REFERENCES "Gnarly" ("id") ON DELETE CASCADE; ALTER TABLE "Gnarly_Station" ADD CONSTRAINT "Gnarly_Station_station_id_fk" FOREIGN KEY ("station_id") REFERENCES "Station" ("id") ON DELETE CASCADE; CREATE INDEX "Bar_idx_foo_id" on "Bar" ("foo_id"); CREATE INDEX "Foo_idx_bar_id" on "Foo" ("bar_id"); CREATE INDEX "Foo_Bar_idx_bar_id" on "Foo_Bar" ("bar_id"); CREATE INDEX "Foo_Bar_idx_foo_id" on "Foo_Bar" ("foo_id"); CREATE INDEX "Gnarly_Station_idx_gnarly_id" on "Gnarly_Station" ("gnarly_id"); CREATE INDEX "Gnarly_Station_idx_station_id" on "Gnarly_Station" ("station_id"); DBIx-Class-Helpers-2.035000/t/lib/TestSchema-0.001-MySQL.sql0000644000175000017500000000610513624003631021055 0ustar frewfrew-- -- Created by SQL::Translator::Producer::MySQL -- Created on Fri Feb 21 08:38:44 2020 -- SET foreign_key_checks=0; DROP TABLE IF EXISTS `Bloaty`; -- -- Table: `Bloaty` -- CREATE TABLE `Bloaty` ( `id` integer NOT NULL, `name` varchar(255) NOT NULL, `literature` text NULL, `your_mom` blob NULL, PRIMARY KEY (`id`) ); DROP TABLE IF EXISTS `Gnarly`; -- -- Table: `Gnarly` -- CREATE TABLE `Gnarly` ( `id` integer NOT NULL, `name` varchar(255) NOT NULL, `literature` text NULL, `your_mom` blob NULL, PRIMARY KEY (`id`) ) ENGINE=InnoDB; DROP TABLE IF EXISTS `HasAccessor`; -- -- Table: `HasAccessor` -- CREATE TABLE `HasAccessor` ( `id` integer NOT NULL, `usable_column` varchar(255) NOT NULL, `unusable_column` varchar(255) NOT NULL, PRIMARY KEY (`id`) ); DROP TABLE IF EXISTS `HasDateOps`; -- -- Table: `HasDateOps` -- CREATE TABLE `HasDateOps` ( `id` integer NOT NULL, `a_date` datetime NOT NULL, `b_date` datetime NULL, PRIMARY KEY (`id`) ); DROP TABLE IF EXISTS `Search`; -- -- Table: `Search` -- CREATE TABLE `Search` ( `id` integer NOT NULL, `name` varchar(255) NOT NULL, PRIMARY KEY (`id`) ); DROP TABLE IF EXISTS `SerializeAll`; -- -- Table: `SerializeAll` -- CREATE TABLE `SerializeAll` ( `id` integer NOT NULL, `text_column` text NOT NULL, PRIMARY KEY (`id`) ); DROP TABLE IF EXISTS `Station`; -- -- Table: `Station` -- CREATE TABLE `Station` ( `id` integer NOT NULL, `name` varchar(255) NOT NULL, PRIMARY KEY (`id`) ) ENGINE=InnoDB; DROP TABLE IF EXISTS `Bar`; -- -- Table: `Bar` -- CREATE TABLE `Bar` ( `id` integer(12) NOT NULL, `foo_id` integer NOT NULL, `test_flag` integer NULL, INDEX `Bar_idx_foo_id` (`foo_id`), PRIMARY KEY (`id`), CONSTRAINT `Bar_fk_foo_id` FOREIGN KEY (`foo_id`) REFERENCES `Foo` (`id`) ON DELETE CASCADE ON UPDATE CASCADE ) ENGINE=InnoDB; DROP TABLE IF EXISTS `Foo`; -- -- Table: `Foo` -- CREATE TABLE `Foo` ( `id` integer NOT NULL, `bar_id` integer NOT NULL, INDEX `Foo_idx_bar_id` (`bar_id`), PRIMARY KEY (`id`) ) ENGINE=InnoDB; DROP TABLE IF EXISTS `Foo_Bar`; -- -- Table: `Foo_Bar` -- CREATE TABLE `Foo_Bar` ( `foo_id` integer NOT NULL, `bar_id` integer(12) NOT NULL, INDEX `Foo_Bar_idx_bar_id` (`bar_id`), INDEX `Foo_Bar_idx_foo_id` (`foo_id`), PRIMARY KEY (`foo_id`, `bar_id`), CONSTRAINT `Foo_Bar_fk_bar_id` FOREIGN KEY (`bar_id`) REFERENCES `Bar` (`id`), CONSTRAINT `Foo_Bar_fk_foo_id` FOREIGN KEY (`foo_id`) REFERENCES `Foo` (`id`) ) ENGINE=InnoDB; DROP TABLE IF EXISTS `Gnarly_Station`; -- -- Table: `Gnarly_Station` -- CREATE TABLE `Gnarly_Station` ( `gnarly_id` integer NOT NULL, `station_id` integer NOT NULL, INDEX `Gnarly_Station_idx_gnarly_id` (`gnarly_id`), INDEX `Gnarly_Station_idx_station_id` (`station_id`), PRIMARY KEY (`gnarly_id`, `station_id`), CONSTRAINT `Gnarly_Station_fk_gnarly_id` FOREIGN KEY (`gnarly_id`) REFERENCES `Gnarly` (`id`) ON DELETE CASCADE ON UPDATE CASCADE, CONSTRAINT `Gnarly_Station_fk_station_id` FOREIGN KEY (`station_id`) REFERENCES `Station` (`id`) ON DELETE CASCADE ON UPDATE CASCADE ) ENGINE=InnoDB; SET foreign_key_checks=1; DBIx-Class-Helpers-2.035000/t/lib/VerifySchema/0000775000175000017500000000000013624003631017262 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/VerifySchema/ResultSet/0000775000175000017500000000000013624003631021214 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/VerifySchema/ResultSet/B.pm0000644000175000017500000000013613624003631021731 0ustar frewfrewpackage VerifySchema::ResultSet::B; use DBIx::Class::Candy::ResultSet; use base 'Herp'; 1; DBIx-Class-Helpers-2.035000/t/lib/VerifySchema/ResultSet/A.pm0000644000175000017500000000013613624003631021730 0ustar frewfrewpackage VerifySchema::ResultSet::A; use DBIx::Class::Candy::ResultSet; use base 'Herp'; 1; DBIx-Class-Helpers-2.035000/t/lib/VerifySchema/Result/0000775000175000017500000000000013624003631020540 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/VerifySchema/Result/B.pm0000644000175000017500000000026713624003631021262 0ustar frewfrewpackage VerifySchema::Result::B; use DBIx::Class::Candy -base => 'DBIx::Class::Core'; table 'B'; column id => { data_type => 'integer', size => 12, }; primary_key 'id'; 1; DBIx-Class-Helpers-2.035000/t/lib/VerifySchema/Result/A.pm0000644000175000017500000000026713624003631021261 0ustar frewfrewpackage VerifySchema::Result::A; use DBIx::Class::Candy -base => 'DBIx::Class::Core'; table 'A'; column id => { data_type => 'integer', size => 12, }; primary_key 'id'; 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/0000775000175000017500000000000013624003631016735 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/TestSchema/ResultSet/0000775000175000017500000000000013624003631020667 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/TestSchema/ResultSet/HasAccessor.pm0000644000175000017500000000022013624003631023413 0ustar frewfrewpackage TestSchema::ResultSet::HasAccessor; use strict; use warnings; use parent 'TestSchema::ResultSet'; __PACKAGE__->load_components(); 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/ResultSet/HasDateOps.pm0000644000175000017500000000026713624003631023223 0ustar frewfrewpackage TestSchema::ResultSet::HasDateOps; use strict; use warnings; use parent 'TestSchema::ResultSet'; __PACKAGE__->load_components(qw{ Helper::ResultSet::DateMethods1 }); 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/ResultSet/Station.pm0000644000175000017500000000023413624003631022643 0ustar frewfrewpackage TestSchema::ResultSet::Station; use strict; use warnings; # intentionally not using TestSchema::ResultSet use parent 'DBIx::Class::ResultSet'; 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/ResultSet/Gnarly.pm0000644000175000017500000000143013624003631022455 0ustar frewfrewpackage TestSchema::ResultSet::Gnarly; use strict; use warnings; # intentionally not using TestSchema::ResultSet use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw{ Helper::ResultSet::CorrelateRelationship Helper::ResultSet::Errors Helper::ResultSet::Explain Helper::ResultSet::Me Helper::ResultSet::NoColumns Helper::ResultSet::OneRow Helper::ResultSet::ResultClassDWIM Helper::ResultSet::SearchOr }); sub with_id_plus_one { my $self = shift; my $id = $self->me . 'id'; $self->search(undef, { '+columns' => { id_plus_one => \"$id + 1", }, }) } sub id_plus_two { my $self = shift; my $id = $self->me . 'id'; $self->search(undef, { '+columns' => { plus2 => \"$id + 2", }, }) } 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/ResultSet/Search.pm0000644000175000017500000000034513624003631022432 0ustar frewfrewpackage TestSchema::ResultSet::Search; use strict; use warnings; # intentionally not using TestSchema::ResultSet use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw{ Helper::ResultSet::Shortcut::Search }); 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/ResultSet/Bloaty.pm0000644000175000017500000000045013624003631022454 0ustar frewfrewpackage TestSchema::ResultSet::Bloaty; use strict; use warnings; use parent 'TestSchema::ResultSet'; __PACKAGE__->load_components(qw{ Helper::ResultSet::AutoRemoveColumns }); our @stuff; sub update { my ($self, $rest) = @_; push @stuff, $rest; $self->next::method($rest); } 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/ResultSet/Foo.pm0000644000175000017500000000051213624003631021744 0ustar frewfrewpackage TestSchema::ResultSet::Foo; use strict; use warnings; use parent 'TestSchema::ResultSet'; __PACKAGE__->load_components(qw{ Helper::ResultSet::Bare Helper::ResultSet::RemoveColumns Helper::ResultSet::Union Helper::ResultSet::Random Helper::ResultSet::ResultClassDWIM Helper::ResultSet::Shortcut }); 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/0000775000175000017500000000000013624003631020213 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/Gnarly_Station.pm0000644000175000017500000000074513624003631023512 0ustar frewfrewpackage TestSchema::Result::Gnarly_Station; use DBIx::Class::Candy -components => ['Helper::Row::JoinTable']; my $config = { left_class => 'Gnarly', left_method => 'gnarly', left_method_plural => 'gnarlies', right_class => 'Station', right_method => 'station', right_method_plural => 'stations', self_method => 'gnarly_stations', }; join_table $config; generate_has_manys $config; generate_many_to_manys $config; 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/SerializeAll.pm0000644000175000017500000000043113624003631023125 0ustar frewfrewpackage TestSchema::Result::SerializeAll; use DBIx::Class::Candy -components => [qw( Helper::Row::ToJSON )]; table 'SerializeAll'; primary_column id => { data_type => 'int' };; column text_column => { data_type => 'text' }; sub unserializable_data_types { {} } 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/HasAccessor.pm0000644000175000017500000000052213624003631022744 0ustar frewfrewpackage TestSchema::Result::HasAccessor; use DBIx::Class::Candy -components => [qw( Helper::Row::ToJSON )]; table 'HasAccessor'; primary_column id => { data_type => 'int' };; column usable_column => { data_type => 'varchar' }; column unusable_column => { data_type => 'varchar', accessor => 'alternate_name', }; 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/HasDateOps.pm0000644000175000017500000000037613624003631022550 0ustar frewfrewpackage TestSchema::Result::HasDateOps; use DBIx::Class::Candy; table 'HasDateOps'; primary_column id => { data_type => 'int' };; column a_date => { data_type => 'datetime' }; column b_date => { data_type => 'datetime', is_nullable => 1, }; 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/Station.pm0000644000175000017500000000025513624003631022172 0ustar frewfrewpackage TestSchema::Result::Station; use DBIx::Class::Candy; table 'Station'; primary_column id => { data_type => 'int' }; column name => { data_type => 'varchar' }; 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/Foo_Bar.pm0000644000175000017500000000037713624003631022065 0ustar frewfrewpackage TestSchema::Result::Foo_Bar; use DBIx::Class::Candy -components => [ 'Helper::Row::JoinTable', 'Helper::Row::SelfResultSet', ]; join_table({ left_class => 'Foo', right_class => 'Bar', right_method => 'bar', }); 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/Gnarly.pm0000644000175000017500000000124713624003631022007 0ustar frewfrewpackage TestSchema::Result::Gnarly; use DBIx::Class::Candy -components => [qw( Helper::Row::ToJSON Helper::Row::ProxyResultSetMethod Helper::Row::OnColumnMissing )]; table 'Gnarly'; primary_column id => { data_type => 'int' }; column name => { data_type => 'varchar' }; column literature => { data_type => 'text', is_nullable => 1, }; column your_mom => { data_type => 'blob', is_nullable => 1, is_serializable => 1, }; proxy_resultset_method 'id_plus_one'; proxy_resultset_method id_plus_two => { resultset_method => 'id_plus_two', slot => 'plus2', }; our $MISSING = 'warn'; sub on_column_missing { $MISSING } 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/Search.pm0000644000175000017500000000025313624003631021754 0ustar frewfrewpackage TestSchema::Result::Search; use DBIx::Class::Candy; table 'Search'; primary_column id => { data_type => 'int' }; column name => { data_type => 'varchar' }; 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/Bloaty.pm0000644000175000017500000000072113624003631022001 0ustar frewfrewpackage TestSchema::Result::Bloaty; use DBIx::Class::Candy -components => [ 'Helper::Row::ProxyResultSetUpdate', 'Helper::Row::ProxyResultSetMethod', ]; table 'Bloaty'; primary_column id => { data_type => 'int' }; column name => { data_type => 'varchar', remove_column => 1, }; column literature => { data_type => 'text', is_nullable => 1, }; column your_mom => { data_type => 'blob', is_nullable => 1, is_serializable => 1, }; 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/Bar.pm0000644000175000017500000000103113624003631021246 0ustar frewfrewpackage TestSchema::Result::Bar; use DBIx::Class::Candy -base => 'ParentSchema::Result::Bar', -components => [qw( Helper::Row::ToJSON Helper::Row::SubClass Helper::Row::OnColumnChange Helper::Row::SelfResultSet Helper::Row::CleanResultSet )]; __PACKAGE__->mk_group_accessors(inherited => 'on_column_change_allow_override_args'); our @events; subclass; before_column_change(foo_id => { method => 'before_foo_id', }); sub before_foo_id { push @events, [before_foo_id => $_[1], $_[2]] } 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/Result/Foo.pm0000644000175000017500000000036713624003631021300 0ustar frewfrewpackage TestSchema::Result::Foo; use DBIx::Class::Candy -base => 'ParentSchema::Result::Foo', -components => [qw( Helper::Row::NumifyGet Helper::Row::SubClass Helper::Row::OnColumnChange )]; subclass; 1; DBIx-Class-Helpers-2.035000/t/lib/TestSchema/ResultSet.pm0000644000175000017500000000025213624003631021222 0ustar frewfrewpackage TestSchema::ResultSet; use strict; use warnings; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components('Helper::ResultSet::IgnoreWantarray'); 1; DBIx-Class-Helpers-2.035000/t/lib/ParentSchema/0000775000175000017500000000000013624003631017247 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/ParentSchema/Result/0000775000175000017500000000000013624003631020525 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/ParentSchema/Result/Bar.pm0000644000175000017500000000102713624003631021565 0ustar frewfrewpackage ParentSchema::Result::Bar; use DBIx::Class::Candy -base => 'ParentSchema::Result'; table 'Bar'; column id => { data_type => 'integer', size => 12, }; column foo_id => { data_type => 'integer', keep_storage_value => 1, }; column test_flag => { keep_storage_value => 1, data_type => 'integer', is_nullable => 1, }; primary_key 'id'; belongs_to foo => '::Foo', 'foo_id'; has_many foos => '::Foo', 'bar_id'; might_have might_have_foo => '::Foo', 'bar_id'; has_one has_one_foo => '::Foo', 'bar_id'; 1; DBIx-Class-Helpers-2.035000/t/lib/ParentSchema/Result/Foo.pm0000644000175000017500000000051113624003631021601 0ustar frewfrewpackage ParentSchema::Result::Foo; use DBIx::Class::Candy; table 'Foo'; column id => { data_type => 'integer', is_numeric => 1, }; column bar_id => { data_type => 'integer' }; primary_key 'id'; belongs_to bar => 'ParentSchema::Result::Bar', 'bar_id'; has_many bars => 'ParentSchema::Result::Bar', 'foo_id'; 1; DBIx-Class-Helpers-2.035000/t/lib/ParentSchema/Result.pm0000644000175000017500000000027413624003631021064 0ustar frewfrewpackage ParentSchema::Result; use parent 'DBIx::Class::Core'; __PACKAGE__->load_components('Helper::Row::RelationshipDWIM'); sub default_result_namespace { 'ParentSchema::Result' } 1; DBIx-Class-Helpers-2.035000/t/lib/VerifySchema.pm0000644000175000017500000000125113624003631017615 0ustar frewfrewpackage VerifySchema; use strict; use warnings; use MRO::Compat; use mro 'c3'; use parent 'DBIx::Class::Schema'; # ensure that we can see both errors for a single check sub result_verifiers { (sub { my ($s, $result, $set) = @_; die "Derp: $set" if $set->isa('Herp'); }, sub { my ($s, $result, $set) = @_; die "Herp: $set" if $set->isa('Herp'); }, shift->next::method) } __PACKAGE__->load_components(qw( Helper::Schema::Verifier Helper::Schema::Verifier::Parent )); # so ::Verifier::load_classes gets tested too __PACKAGE__->load_classes({ ParentSchema => [qw/ Result::Foo Result::Bar /], }); __PACKAGE__->load_namespaces; 'zomg'; DBIx-Class-Helpers-2.035000/t/lib/ParentSchema.pm0000644000175000017500000000015213624003631017601 0ustar frewfrewpackage ParentSchema; use parent 'DBIx::Class::Schema'; __PACKAGE__->load_namespaces(); 'kitten eater'; DBIx-Class-Helpers-2.035000/t/lib/TestSchema.pm0000644000175000017500000000526013624003631017274 0ustar frewfrewpackage TestSchema; use strict; use warnings; use File::Spec; our $VERSION = 0.001; use parent 'DBIx::Class::Schema'; __PACKAGE__->load_namespaces( default_resultset_class => 'ResultSet', ); __PACKAGE__->load_components(qw( Helper::Schema::LintContents Helper::Schema::QuoteNames Helper::Schema::DidYouMean )); sub upgrade_directory { './t/lib' } sub ddl_filename { my $self = shift; $_[2] = $self->upgrade_directory; $self->next::method(@_) } sub deploy_or_connect { my $self = shift; my $schema = $self->connect(@_); $schema->deploy(); return $schema; } sub connection { my $self = shift; if (@_) { return $self->next::method(@_); } else { return $self->next::method('dbi:SQLite::memory:'); } } sub generate_ddl { my $self = shift; my $schema = $self->connect; $schema->create_ddl_dir( $_, $schema->schema_version, undef, undef, { ($_ ne 'SQLite' ? ( add_drop_table => 1, filters => [ sub { #remove circular dependency. Not used for #non-sqlite tests my $foo = shift->get_table('Foo'); my @constraints = map { $_->name } $foo->get_constraints; $foo->drop_constraint($_) for grep { /bar/ } @constraints; } ] ) : ( add_drop_table => 0 ) ) }, ) for qw(SQLite MySQL PostgreSQL SQLServer Oracle); } sub prepopulate { my $self = shift; $self->resultset($_)->delete for qw{Bar Foo Gnarly_Station Bloaty Gnarly Station HasAccessor}; $self->populate( Gnarly => [ [qw{id name}], [1,'frew'], [2,'frioux'], [3,'frooh'], ]); $self->populate( Station => [ [qw{id name}], [1,'frew'], [2,'frioux'], [3,'frooh'], ]); $self->populate( Gnarly_Station => [ [qw{gnarly_id station_id}], [1,1], [1,3], [2,1], [3,1], ]); $self->populate(Bloaty => [ [qw{id name}], [1,1], [2,2], [3,3], [4,4], [5,5], ]); $self->populate(Foo => [ [qw{id bar_id}], [1,1], [2,2], [3,3], [4,4], [5,5], ]); $self->populate(Bar => [ [qw{id foo_id}], [1,1], [2,2], [3,3], [4,4], [5,5], ]); $self->populate( HasAccessor => [ [qw{id usable_column unusable_column}], [1,'aa','bb'], [2,'cc','dd'], [3,'ee','ff'], ]); $self->populate(SerializeAll => [ [qw{id text_column}], [1,'frew'], [2,'frioux'], [3,'frooh'], ]); } 'kitten eater'; DBIx-Class-Helpers-2.035000/t/lib/ParentRS.pm0000644000175000017500000000020113624003631016720 0ustar frewfrewpackage ParentRS; use parent 'DBIx::Class::ResultSet'; __PACKAGE__->load_components(qw/ Helper::ResultSet::Shortcut /); 1; DBIx-Class-Helpers-2.035000/t/lib/A/0000775000175000017500000000000013624003631015055 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/A/ResultSet/0000775000175000017500000000000013624003631017007 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/A/ResultSet/DateMethods1.pm0000644000175000017500000004163213624003631021633 0ustar frewfrewpackage A::ResultSet::DateMethods1; use Test::Roo; use Test::Deep 'cmp_deeply', 'bag'; use DateTime; use Test::Fatal; with 'A::Role::TestConnect'; use lib 't/lib'; sub _dt { DateTime->new( time_zone => 'UTC', year => shift(@_), month => shift(@_), day => shift(@_), ) } has [qw( add_sql_by_part_skip add_sql_by_part_result subtract_sql_by_part_skip subtract_sql_by_part_result pluck_sql_by_part_skip pluck_sql_by_part_result )] => ( is => 'ro', default => sub { {} }, ); has [map "${_}_sql_by_part", qw(pluck add subtract)] => ( is => 'ro', default => sub { {} }, ); has _skip_msg_once => ( is => 'rw' ); sub skip_reason { return '(see above)' if $_[0]->_skip_msg_once; $_[0]->_skip_msg_once(1); 'set ' . join(q<, >, shift->env_vars) . ' to run these tests' } has [qw( utc_now stringified_date add_sql_prefix subtract_sql_prefix sub_sql pluck_sql_prefix )] => (is => 'ro'); has plucked_minute => ( is => 'ro', default => 9, ); has plucked_second => ( is => 'ro', default => 8, ); sub _merged_pluck_sql_by_part_result { my $self = shift; my %base = ( year => 2012, month => 1, day_of_month => 2, hour => 3, day_of_year => 2, minute => 4, second => 5, day_of_week => 1, week => 1, quarter => 1, ); my %results = %{$self->pluck_sql_by_part_result}; my @overrides = grep { $base{$_} } sort keys %results; note join(q(, ), @overrides) . ' overridden' if @overrides; return +{ %base, %results }; } sub _merged_add_sql_by_part_result { my $self = shift; return +{ day => '2012-12-13 00:00:00', hour => '2012-12-12 02:00:00', minute => '2012-12-12 00:03:00', month => '2013-04-12 00:00:00', second => '2012-12-12 00:00:05', year => '2018-12-12 00:00:00', %{$self->add_sql_by_part_result}, } } sub _merged_subtract_sql_by_part_result { my $self = shift; return +{ day => '2012-12-11 00:00:00', hour => '2012-12-11 22:00:00', minute => '2012-12-11 23:57:00', month => '2012-08-12 00:00:00', second => '2012-12-11 23:59:55', year => '2006-12-12 00:00:00', %{$self->subtract_sql_by_part_result}, } } sub rs { shift->schema->resultset('HasDateOps') } sub pop_rs_1 { my $self = shift; $self->rs->delete; $self->rs->populate([ [qw(id a_date)], [1, $self->format_datetime(_dt(2012, 12, 12)), ], [2, $self->format_datetime(_dt(2012, 12, 13)), ], [3, $self->format_datetime(_dt(2012, 12, 14)), ], ]) } sub pop_rs_2 { my $self = shift; my $dt1 = $self->format_datetime(_dt(2012, 12, 12)); my $dt2 = $self->format_datetime(_dt(2012, 12, 13)); $self->rs->delete; $self->rs->populate([ [qw(id a_date b_date)], [1, $dt1, $dt2], [2, $dt1, $dt1], [3, $dt2, $dt1], ]) } sub format_datetime { shift->schema ->storage ->datetime_parser ->format_datetime(shift @_) } sub parse_datetime { shift->schema ->storage ->datetime_parser ->parse_datetime(shift @_) } test basic => sub { my $self = shift; is(${$self->rs->utc_now}, $self->utc_now, 'utc_now'); like(exception { $self->rs->utc(DateTime->new(year => 1985, month => 1, day => 1)) }, qr/floating dates are not allowed/, 'no floating dates'); SKIP: { skip $self->skip_reason, 1 unless $self->connected; my $central_date = DateTime->new( year => 2014, month => 2, day => 7, hour => 22, minute => 43, time_zone => 'America/Chicago', ); is( $self->rs->utc($central_date), $self->stringified_date, 'datetime correctly UTC and stringified' ); my $local_dt = DateTime->now( time_zone => 'UTC' ); $self->rs->delete; $self->rs->create({ id => 1, a_date => $self->rs->utc_now }); my $remote_dt = $self->parse_datetime($self->rs->next->a_date); ok( $local_dt->subtract_datetime_absolute($remote_dt)->seconds < 60, 'UTC works! (and clock is correct)', ); } }; sub _comparisons { my ($self, $l, $r, $n) = @_; subtest $n => sub { cmp_deeply( [$self->rs->dt_before($l => $r)->get_column('id')->all], [1], 'before', ); cmp_deeply( [$self->rs->dt_on_or_before($l, $r)->get_column('id')->all], bag(1, 2), 'on_or_before', ); cmp_deeply( [$self->rs->dt_on_or_after($l, $r)->get_column('id')->all], bag(2, 3), 'on_or_after', ); cmp_deeply( [$self->rs->dt_after($l, $r)->get_column('id')->all], [3], 'after', ); }; } sub _middle_comparisons { my ($self, $r) = @_; $self->_comparisons({ -ident => 'a_date' } => $r, 'no prefix'); $self->_comparisons({ -ident => '.a_date' } => $r, 'auto prefix'); $self->_comparisons( { -ident => $self->rs->current_source_alias . '.a_date' } => $r, 'manual prefix' ) } test comparisons => sub { my $self = shift; SKIP: { skip $self->skip_reason, 1 unless $self->connected; $self->pop_rs_1; my $dt = _dt(2012, 12, 13); subtest 'datetime object' => sub { $self->_middle_comparisons($dt) }; subtest 'datetime literal'=> sub { $self->_middle_comparisons($self->format_datetime($dt)) }; subtest subquery => sub { $self->_middle_comparisons( $self->rs->search({ id => 2})->get_column('a_date')->as_query ) }; subtest 'both columns' => sub { $self->pop_rs_2; $self->_middle_comparisons({ -ident => '.b_date' }, 'auto prefix'); $self->_middle_comparisons({ -ident => 'b_date' }, 'no prefix'); $self->_middle_comparisons( { -ident => $self->rs->current_source_alias . '.b_date' }, 'manual prefix', ); }; subtest 'literal SQL' => sub { cmp_deeply( [$self->rs->dt_before( { -ident => '.b_date' }, $self->rs->utc_now )->get_column('id')->all], [1, 2, 3], 'literal SQL compared (and db clock correct)', ); }; } }; test add => sub { my $self = shift; $self->pop_rs_1 if $self->connected; SKIP: { skip $self->engine . q(doesn't set add_sql_prefix) unless $self->add_sql_prefix; my %offset = ( day => 1, hour => 2, minute => 3, month => 4, second => 5, year => 6, ); my $i = 1 + scalar keys %offset; for my $part (sort keys %{$self->add_sql_by_part}) { my $query = $self->rs->dt_SQL_add( { -ident => 'a_date' }, $part, $offset{$part} || $i++, ); SKIP: { skip $self->skip_reason, 1 unless $self->connected; skip $self->add_sql_by_part_skip->{$part}, 1 if $self->add_sql_by_part_skip->{$part}; my $v; my $e = exception { $v = $self->rs->search({ id => 1 }, { columns => { v => $query }, })->get_column('v')->next; }; ok !$e, "live $part" or diag "exception: $e"; my $expected = $self->_merged_add_sql_by_part_result->{$part}; if (ref $expected && ref $expected eq 'Regexp') { like($v, $expected, "suspected $part"); } else { is($v, $expected, "suspected $part"); } } cmp_deeply( $query, $self->add_sql_by_part->{$part}, "unit: $part", ); } cmp_deeply( $self->rs->dt_SQL_add({ -ident => '.a_date' }, 'second', 1), $self->add_sql_prefix, 'vanilla add', ); } SKIP: { skip $self->skip_reason, 1 unless $self->connected; my $dt = DateTime->new( time_zone => 'UTC', year => 2013, month => 12, day => 11, hour => 10, minute => 9, second => 8, ); $self->rs->delete; $self->rs->create({ id => 1, a_date => $self->rs->utc($dt) }); subtest column => sub { my $added = $self->rs->search(undef, { rows => 1, columns => { foo => $self->rs->dt_SQL_add( $self->rs->dt_SQL_add( $self->rs->dt_SQL_add({ -ident => '.a_date' }, 'minute', 2), second => 4, ), hour => 1, ), }, result_class => 'DBIx::Class::ResultClass::HashRefInflator', })->first->{foo}; $added = $self->parse_datetime($added); is($added->year => 2013, 'added year'); is($added->month => 12, 'added month'); is($added->day => 11, 'added day'); is($added->hour => 11, 'added hour'); is($added->minute => 11, 'added minute'); is($added->second => 12, 'added second'); }; subtest bindarg => sub { my $added = $self->rs->search(undef, { rows => 1, columns => { foo => $self->rs->dt_SQL_add( $self->rs->dt_SQL_add( $self->rs->dt_SQL_add($dt, 'minute', 2), second => 4, ), hour => 1, ), }, result_class => 'DBIx::Class::ResultClass::HashRefInflator', })->first->{foo}; $added = $self->parse_datetime($added); is($added->year => 2013, 'added year'); is($added->month => 12, 'added month'); is($added->day => 11, 'added day'); is($added->hour => 11, 'added hour'); is($added->minute => 11, 'added minute'); is($added->second => 12, 'added second'); }; } }; test subtract => sub { my $self = shift; $self->pop_rs_1 if $self->connected; SKIP: { skip $self->engine . q(doesn't set subtract_sql_prefix) unless $self->subtract_sql_prefix; my %offset = ( day => 1, hour => 2, minute => 3, month => 4, second => 5, year => 6, ); my $i = 1 + scalar keys %offset; for my $part (sort keys %{$self->subtract_sql_by_part}) { my $query = $self->rs->dt_SQL_subtract( { -ident => 'a_date' }, $part, $offset{$part} || $i++, ); SKIP: { skip $self->skip_reason, 1 unless $self->connected; skip $self->subtract_sql_by_part_skip->{$part}, 1 if $self->subtract_sql_by_part_skip->{$part}; my $v; my $e = exception { $v = $self->rs->search({ id => 1 }, { columns => { v => $query }, })->get_column('v')->next; }; ok !$e, "live $part" or diag "exception: $e"; my $expected = $self->_merged_subtract_sql_by_part_result->{$part}; if (ref $expected && ref $expected eq 'Regexp') { like($v, $expected, "suspected $part"); } else { is($v, $expected, "suspected $part"); } } cmp_deeply( $query, $self->subtract_sql_by_part->{$part}, "unit: $part", ); } cmp_deeply( $self->rs->dt_SQL_subtract({ -ident => '.a_date' }, 'second', 1), $self->subtract_sql_prefix, 'vanilla subtract', ); } SKIP: { skip $self->skip_reason, 1 unless $self->connected; my $dt = DateTime->new( time_zone => 'UTC', year => 2013, month => 12, day => 11, hour => 10, minute => 9, second => 8, ); $self->rs->delete; $self->rs->create({ id => 1, a_date => $self->rs->utc($dt) }); subtest column => sub { my $subtracted = $self->rs->search(undef, { rows => 1, columns => { foo => $self->rs->dt_SQL_subtract( $self->rs->dt_SQL_subtract( $self->rs->dt_SQL_subtract({ -ident => '.a_date' }, 'minute', 2), second => 4, ), hour => 1, ), }, result_class => 'DBIx::Class::ResultClass::HashRefInflator', })->first->{foo}; $subtracted = $self->parse_datetime($subtracted); is($subtracted->year => 2013, 'subtracted year'); is($subtracted->month => 12, 'subtracted month'); is($subtracted->day => 11, 'subtracted day'); is($subtracted->hour => 9, 'subtracted hour'); is($subtracted->minute => 7, 'subtracted minute'); is($subtracted->second => 4, 'subtracted second'); }; subtest bindarg => sub { my $subtracted = $self->rs->search(undef, { rows => 1, columns => { foo => $self->rs->dt_SQL_subtract( $self->rs->dt_SQL_subtract( $self->rs->dt_SQL_subtract($dt, 'minute', 2), second => 4, ), hour => 1, ), }, result_class => 'DBIx::Class::ResultClass::HashRefInflator', })->first->{foo}; $subtracted = $self->parse_datetime($subtracted); is($subtracted->year => 2013, 'subtracted year'); is($subtracted->month => 12, 'subtracted month'); is($subtracted->day => 11, 'subtracted day'); is($subtracted->hour => 9, 'subtracted hour'); is($subtracted->minute => 7, 'subtracted minute'); is($subtracted->second => 4, 'subtracted second'); }; } }; test pluck => sub { my $self = shift; if ($self->connected) { $self->rs->delete; $self->rs->populate([ [qw(id a_date)], [1, $self->format_datetime( DateTime->new( year => 2012, month => 1, day => 2, hour => 3, minute => 4, second => 5, ) ) ], ]) } my $i = 1; for my $part (sort keys %{$self->pluck_sql_by_part}) { SKIP: { skip $self->skip_reason, 1 unless $self->connected; skip $self->pluck_sql_by_part_skip->{$part}, 1 if $self->pluck_sql_by_part_skip->{$part}; my $res; my $e = exception { $res = $self->rs->search({ id => 1 }, { columns => { a_date => 'a_date', v => $self->rs->dt_SQL_pluck({ -ident => 'a_date' }, $part) }, result_class => 'DBIx::Class::ResultClass::HashRefInflator', })->next; }; my $v = $res->{v}; my $date = $res->{a_date}; ok !$e, "live $part" or diag "exception: $e"; is( $v, $self->_merged_pluck_sql_by_part_result->{$part}, "suspected $part" ) or diag "for date $date"; } cmp_deeply( $self->rs->dt_SQL_pluck({ -ident => 'a_date' }, $part), $self->pluck_sql_by_part->{$part}, "unit $part", ); } cmp_deeply( $self->rs->dt_SQL_pluck({ -ident => '.a_date' }, 'second'), $self->pluck_sql_prefix, 'vanilla pluck', ); SKIP: { skip $self->skip_reason, 1 unless $self->connected; my $dt = DateTime->new( time_zone => 'UTC', year => 2013, month => 12, day => 11, hour => 10, minute => 9, second => 8, ); $self->rs->delete; $self->rs->create({ id => 1, a_date => $self->rs->utc($dt) }); my @parts = qw(year month day_of_month hour minute second); { my $plucked = $self->rs->search(undef, { rows => 1, select => [map $self->rs->dt_SQL_pluck({ -ident => '.a_date' }, $_), @parts], as => \@parts, result_class => 'DBIx::Class::ResultClass::HashRefInflator', })->first; cmp_deeply($plucked, { year => 2013, month => 12, day_of_month => 11, hour => 10, minute => $self->plucked_minute, second => $self->plucked_second, }, 'live pluck works from column'); } { my $plucked = $self->rs->search(undef, { rows => 1, select => [map $self->rs->dt_SQL_pluck($dt, $_), @parts], as => \@parts, result_class => 'DBIx::Class::ResultClass::HashRefInflator', })->first; cmp_deeply($plucked, { year => 2013, month => 12, day_of_month => 11, hour => 10, minute => $self->plucked_minute, second => $self->plucked_second, }, 'live pluck works from bindarg'); } } }; 1; DBIx-Class-Helpers-2.035000/t/lib/A/Role/0000775000175000017500000000000013624003631015756 5ustar frewfrewDBIx-Class-Helpers-2.035000/t/lib/A/Role/TestConnect.pm0000644000175000017500000000127713624003631020552 0ustar frewfrewpackage A::Role::TestConnect; use Moo::Role; use TestSchema; use A::Util; has [qw(on_connect_call engine)] => ( is => 'ro' ); has storage_type => ( is => 'ro', lazy => 1, default => sub { shift->engine } ); sub connected { A::Util::connected($_[0]->engine, $_[0]->on_connect_call) } has connect_info => ( is => 'ro', lazy => 1, default => sub { my $self = shift; A::Util::connect_info($self->engine, $self->on_connect_call) }, ); sub env_vars { A::Util::env(shift->engine) } has schema => ( is => 'ro', lazy => 1, builder => sub { my $self = shift; A::Util::connect($self->engine, $self->storage_type, $self->on_connect_call) }, ); 1; DBIx-Class-Helpers-2.035000/t/lib/A/Util.pm0000644000175000017500000000203613624003631016327 0ustar frewfrewpackage A::Util; use strict; use warnings; use TestSchema; sub connect { my ($engine, $storage_type, $on_connect_call) = @_; my $schema = 'TestSchema'; $schema->storage_type('DBIx::Class::Storage::DBI'); # class methods: THE WORST $schema->storage_type('DBIx::Class::Storage::DBI::' . $storage_type) if $storage_type && !connected($engine, $on_connect_call); $schema = TestSchema->connect(@{connect_info($engine, $on_connect_call)}); $schema->deploy if connected($engine, $on_connect_call); $schema->storage->dbh->{private_dbii_driver} = $engine; $schema } sub env { my $engine = shift; my $p = 'DBIITEST_' . uc($engine); $p . '_DSN', $p . '_USER', $p . '_PASSWORD'; } sub connect_info { my ($engine, $on_connect_call) = @_; my @connect_info = grep $_, map $ENV{$_}, env($engine); push @connect_info, { on_connect_call => $on_connect_call } if @connect_info && $on_connect_call; return \@connect_info; } sub connected { return 1 if $_[0] eq 'SQLite'; !!@{connect_info(@_)} } 1; DBIx-Class-Helpers-2.035000/t/lib/Lolbot.pm0000644000175000017500000000016013624003631016461 0ustar frewfrewpackage Lolbot; use DBIx::Class::Candy; table 'harrison'; column 'id'; column 'name'; primary_key 'id'; 1; DBIx-Class-Helpers-2.035000/t/lib/Herp.pm0000644000175000017500000000004013624003631016121 0ustar frewfrewpackage Herp; sub noise {} 1; DBIx-Class-Helpers-2.035000/t/lib/RS.pm0000644000175000017500000000014413624003631015554 0ustar frewfrewpackage RS; use parent 'ParentRS'; __PACKAGE__->load_components('Helper::ResultSet::Random'); 1; DBIx-Class-Helpers-2.035000/t/bug-1.t0000644000175000017500000000013613624003631015225 0ustar frewfrewuse strict; use warnings; use Test::More; use lib 't/lib'; use_ok 'RS'; done_testing; 1; DBIx-Class-Helpers-2.035000/MANIFEST0000644000175000017500000001474413624003631015025 0ustar frewfrew# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.010. CONTRIBUTING.md Changes LICENSE MANIFEST META.json META.yml Makefile.PL README cpanfile dist.ini inc/Dist/Zilla/Plugin/DBICSgen.pm lib/DBIx/Class/Helper/IgnoreWantarray.pm lib/DBIx/Class/Helper/JoinTable.pm lib/DBIx/Class/Helper/Random.pm lib/DBIx/Class/Helper/ResultClass/Tee.pm lib/DBIx/Class/Helper/ResultSet.pm lib/DBIx/Class/Helper/ResultSet/AutoRemoveColumns.pm lib/DBIx/Class/Helper/ResultSet/Bare.pm lib/DBIx/Class/Helper/ResultSet/CorrelateRelationship.pm lib/DBIx/Class/Helper/ResultSet/DateMethods1.pm lib/DBIx/Class/Helper/ResultSet/DateMethods1/Announcement.pod lib/DBIx/Class/Helper/ResultSet/Errors.pm lib/DBIx/Class/Helper/ResultSet/Explain.pm lib/DBIx/Class/Helper/ResultSet/IgnoreWantarray.pm lib/DBIx/Class/Helper/ResultSet/Me.pm lib/DBIx/Class/Helper/ResultSet/NoColumns.pm lib/DBIx/Class/Helper/ResultSet/OneRow.pm lib/DBIx/Class/Helper/ResultSet/Random.pm lib/DBIx/Class/Helper/ResultSet/RemoveColumns.pm lib/DBIx/Class/Helper/ResultSet/ResultClassDWIM.pm lib/DBIx/Class/Helper/ResultSet/SearchOr.pm lib/DBIx/Class/Helper/ResultSet/SetOperations.pm lib/DBIx/Class/Helper/ResultSet/Shortcut.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/AddColumns.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Columns.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Distinct.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/GroupBy.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/HRI.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/HasRows.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Limit.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/LimitedPage.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/OrderBy.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/OrderByMagic.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Page.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Prefetch.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/RemoveColumns.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/ResultsExist.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Rows.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Search.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Search/Base.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Search/Like.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Search/NotLike.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Search/NotNull.pm lib/DBIx/Class/Helper/ResultSet/Shortcut/Search/Null.pm lib/DBIx/Class/Helper/ResultSet/Union.pm lib/DBIx/Class/Helper/ResultSet/Util.pm lib/DBIx/Class/Helper/ResultSet/VirtualView.pm lib/DBIx/Class/Helper/Row/CleanResultSet.pm lib/DBIx/Class/Helper/Row/JoinTable.pm lib/DBIx/Class/Helper/Row/NumifyGet.pm lib/DBIx/Class/Helper/Row/OnColumnChange.pm lib/DBIx/Class/Helper/Row/OnColumnMissing.pm lib/DBIx/Class/Helper/Row/ProxyResultSetMethod.pm lib/DBIx/Class/Helper/Row/ProxyResultSetUpdate.pm lib/DBIx/Class/Helper/Row/RelationshipDWIM.pm lib/DBIx/Class/Helper/Row/SelfResultSet.pm lib/DBIx/Class/Helper/Row/StorageValues.pm lib/DBIx/Class/Helper/Row/SubClass.pm lib/DBIx/Class/Helper/Row/ToJSON.pm lib/DBIx/Class/Helper/Schema/DateTime.pm lib/DBIx/Class/Helper/Schema/DidYouMean.pm lib/DBIx/Class/Helper/Schema/GenerateSource.pm lib/DBIx/Class/Helper/Schema/LintContents.pm lib/DBIx/Class/Helper/Schema/QuoteNames.pm lib/DBIx/Class/Helper/Schema/Verifier.pm lib/DBIx/Class/Helper/Schema/Verifier/C3.pm lib/DBIx/Class/Helper/Schema/Verifier/ColumnInfo.pm lib/DBIx/Class/Helper/Schema/Verifier/Parent.pm lib/DBIx/Class/Helper/Schema/Verifier/RelationshipColumnName.pm lib/DBIx/Class/Helper/SubClass.pm lib/DBIx/Class/Helper/VirtualView.pm lib/DBIx/Class/Helpers.pm lib/DBIx/Class/Helpers/Util.pm t/ResultClass/Tee.t t/ResultSet/Bare.t t/ResultSet/CorrelateRelationship.t t/ResultSet/DateMethods1/bugs.t t/ResultSet/DateMethods1/mssql.t t/ResultSet/DateMethods1/mysql.t t/ResultSet/DateMethods1/oracle.t t/ResultSet/DateMethods1/pg.t t/ResultSet/DateMethods1/sqlite.t t/ResultSet/Errors.t t/ResultSet/Explain.t t/ResultSet/IgnoreWantarray.t t/ResultSet/Me.t t/ResultSet/NoColumns.t t/ResultSet/OneRow.t t/ResultSet/Random.t t/ResultSet/RemoveColumns.t t/ResultSet/RemoveColumns/_resolved_attrs.t t/ResultSet/ResultClassDWIM.t t/ResultSet/SearchOr.t t/ResultSet/SetOperations.t t/ResultSet/Shortcut/AddColumns.t t/ResultSet/Shortcut/Columns.t t/ResultSet/Shortcut/Distinct.t t/ResultSet/Shortcut/GroupBy.t t/ResultSet/Shortcut/HRI.t t/ResultSet/Shortcut/HasRows.t t/ResultSet/Shortcut/Limit.t t/ResultSet/Shortcut/LimitedPage.t t/ResultSet/Shortcut/OrderBy.t t/ResultSet/Shortcut/OrderByMagic.t t/ResultSet/Shortcut/Prefetch.t t/ResultSet/Shortcut/RemoveColumns.t t/ResultSet/Shortcut/ResultsExist.t t/ResultSet/Shortcut/Rows.t t/ResultSet/Shortcut/Search/Base.t t/ResultSet/Shortcut/Search/Like.t t/ResultSet/Shortcut/Search/NotLike.t t/ResultSet/Shortcut/Search/NotNull.t t/ResultSet/Shortcut/Search/Null.t t/Row/CleanResultSet.t t/Row/JoinTable.t t/Row/NumifyGet.t t/Row/OnColumnChange.t t/Row/OnColumnMissing.t t/Row/ProxyResultSetMethod.t t/Row/ProxyResultSetUpdate.t t/Row/RelationshipDWIM.t t/Row/SelfResultSet.t t/Row/StorageValues.t t/Row/SubClass.t t/Row/ToJSON.t t/Schema/DateTime.t t/Schema/DidYouMean.t t/Schema/GenerateSource.t t/Schema/LintContents.t t/Schema/Verifier.t t/Schema/Verifier/C3.t t/Schema/Verifier/ColumnInfo.t t/Schema/Verifier/Parent.t t/Schema/Verifier/RelationshipColumnName.t t/author-pod-syntax.t t/bug-1.t t/lib/A/ResultSet/DateMethods1.pm t/lib/A/Role/TestConnect.pm t/lib/A/Util.pm t/lib/Herp.pm t/lib/Lolbot.pm t/lib/ParentRS.pm t/lib/ParentSchema.pm t/lib/ParentSchema/Result.pm t/lib/ParentSchema/Result/Bar.pm t/lib/ParentSchema/Result/Foo.pm t/lib/RS.pm t/lib/TestSchema-0.001-MySQL.sql t/lib/TestSchema-0.001-Oracle.sql t/lib/TestSchema-0.001-PostgreSQL.sql t/lib/TestSchema-0.001-SQLServer.sql t/lib/TestSchema-0.001-SQLite.sql t/lib/TestSchema.pm t/lib/TestSchema/Result/Bar.pm t/lib/TestSchema/Result/Bloaty.pm t/lib/TestSchema/Result/Foo.pm t/lib/TestSchema/Result/Foo_Bar.pm t/lib/TestSchema/Result/Gnarly.pm t/lib/TestSchema/Result/Gnarly_Station.pm t/lib/TestSchema/Result/HasAccessor.pm t/lib/TestSchema/Result/HasDateOps.pm t/lib/TestSchema/Result/Search.pm t/lib/TestSchema/Result/SerializeAll.pm t/lib/TestSchema/Result/Station.pm t/lib/TestSchema/ResultSet.pm t/lib/TestSchema/ResultSet/Bloaty.pm t/lib/TestSchema/ResultSet/Foo.pm t/lib/TestSchema/ResultSet/Gnarly.pm t/lib/TestSchema/ResultSet/HasAccessor.pm t/lib/TestSchema/ResultSet/HasDateOps.pm t/lib/TestSchema/ResultSet/Search.pm t/lib/TestSchema/ResultSet/Station.pm t/lib/VerifySchema.pm t/lib/VerifySchema/Result/A.pm t/lib/VerifySchema/Result/B.pm t/lib/VerifySchema/ResultSet/A.pm t/lib/VerifySchema/ResultSet/B.pm t/utilities.t weaver.ini DBIx-Class-Helpers-2.035000/META.yml0000644000175000017500000000223013624003631015130 0ustar frewfrew--- abstract: 'Simplify the common case stuff for DBIx::Class.' author: - 'Arthur Axel "fREW" Schmidt ' build_requires: DBD::SQLite: '0' DateTime::Format::SQLite: '0' Test::Deep: '0' Test::Fatal: '0.006' Test::More: '0.94' Test::Roo: '1.003' aliased: '0.34' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.010, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: DBIx-Class-Helpers requires: Carp::Clan: '6.04' DBIx::Class: '0.0826' DBIx::Class::Candy: '0.003001' DBIx::Introspector: '0.001002' Lingua::EN::Inflect: '0' List::Util: '0' Module::Runtime: '0' Moo: '2' Safe::Isa: '0' Sub::Exporter::Progressive: '0.001006' Text::Brew: '0' Try::Tiny: '0' namespace::clean: '0.23' parent: '0' resources: bugtracker: https://github.com/frioux/DBIx-Class-Helpers/issues homepage: https://github.com/frioux/DBIx-Class-Helpers repository: https://github.com/frioux/DBIx-Class-Helpers.git version: '2.035000' x_serialization_backend: 'YAML::Tiny version 1.70' DBIx-Class-Helpers-2.035000/cpanfile0000644000175000017500000000130513624003631015365 0ustar frewfrewrequires 'DBIx::Class' => 0.08260; requires 'Carp::Clan' => 6.04; requires 'Sub::Exporter::Progressive' => 0.001006; requires 'Lingua::EN::Inflect' => 0; requires 'parent' => 0; requires 'namespace::clean' => 0.23; requires 'List::Util' => 0; requires 'DBIx::Class::Candy' => 0.003001; requires 'DBIx::Introspector' => 0.001002; requires 'Module::Runtime'; requires 'Try::Tiny'; requires 'Safe::Isa'; requires 'Text::Brew'; requires 'Moo' => 2; on test => sub { requires 'Test::More' => 0.94; requires 'Test::Deep' => 0; requires 'Test::Roo' => 1.003; requires 'DBD::SQLite' => 0; requires 'Test::Fatal' => 0.006; requires 'DateTime::Format::SQLite' => 0; requires 'aliased' => 0.34; }; DBIx-Class-Helpers-2.035000/dist.ini0000644000175000017500000000073313624003631015331 0ustar frewfrewname = DBIx-Class-Helpers author = Arthur Axel "fREW" Schmidt license = Perl_5 copyright_holder = Arthur Axel "fREW" Schmidt version = 2.035000 ; authordep Pod::Weaver::Plugin::Exec [NextRelease] [@Git] [@Basic] [GithubMeta] issues = 1 [MetaJSON] [PodWeaver] [PkgVersion] [ReadmeFromPod] [PodSyntaxTests] [PruneFiles] match = ^maint/ [DBICSgen] schema = TestSchema lib = lib,t/lib [Prereqs::FromCPANfile] DBIx-Class-Helpers-2.035000/LICENSE0000644000175000017500000004372713624003631014704 0ustar frewfrewThis software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2020 by Arthur Axel "fREW" Schmidt. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End DBIx-Class-Helpers-2.035000/Changes0000644000175000017500000003665713624003631015176 0ustar frewfrewRevision history for DBIx-Class-Helpers 2.035000 2020-02-21 08:38:42-08:00 America/Los_Angeles - add remove_columns shortcut (Karen Etheridge, GH#100) 2.034002 2019-12-29 06:57:56-08:00 America/Los_Angeles - Fix results_exist again (Thanks Veesh Goldman!) 2.034001 2019-11-02 07:45:22-07:00 America/Los_Angeles - Fix results_exist (Thanks Peter Rabbitson!) (closes #54) 2.034000 2019-08-02 10:45:04-07:00 America/Los_Angeles - Added dt_SQL_subtract to ::DateMethods1 (Thanks Thomas Klausner!) (closes GH#96) 2.033004 2018-01-26 09:33:20-08:00 America/Los_Angeles - Fix ::RemoveColumns and ::AutoRemoveColumns to not wreak havoc when select/as is used (Thanks Vladimir Melnik for test and ribasushi for hint at fix!) - Allow easily subclassing types to be skipped in ::ToJSON (Thanks Paul Williams!) (closes GH#79 and GH#80) 2.033003 2017-03-12 12:14:51-07:00 America/Los_Angeles - Stop depending on String::CamelCase (closes GH#81) 2.033002 2016-10-31 16:03:23-07:00 America/Los_Angeles - Fix ::ProxyResultSetMethod to work when calling ->update (Thanks for the report Ryan Voots!) - Fix a number of warnings induced by upcoming DBIC (Thanks ribasushi!) 2.033001 2016-08-22 22:09:34-07:00 America/Los_Angeles - Fix a strictness error in a deprecated module (Thanks Niko Tyni!) 2.033000 2016-07-03 22:02:03-07:00 America/Los_Angeles - Add ::Schema::Verifier::ColumnInfo (Thanks Wes Malone!) (Closes GH#67) - Uninserted rows do not set their storage value anymore (Thanks for the report Wes Malone!) (Closes GH#69) 2.032002 2016-05-24 10:00:16-07:00 America/Los_Angeles - Fix variation in list context when using ::OnColumnMissing (Thanks to David Farrell for the bug report!) (Closes GH#63) 2.032001 2016-04-13 22:01:03-07:00 America/Los_Angeles - Fix simple deletion and updates for ::DateMethods1 (Thanks for the report Wes Malone and Erland Injerd, and the help to fix the actual bug ribasushi!) 2.032000 2015-11-07 10:34:14-08:00 America/Los_Angeles - Add ::ResultClass::Tee 2.031000 2015-07-25 01:20:40-07:00 America/Los_Angeles - Add ::ResultSet::Bare (Closes GH#53) 2.030002 2015-07-14 13:43:47-07:00 America/Los_Angeles - Clarify docs for ::ResultSet::OneRow (Thanks for the tips Aran Deltac!) (Closes GH#48) - Add abstract to ::Row::JoinTable (Thanks Gregor Herrmann!) (Closes GH#49) 2.030001 2015-07-10 22:38:58-07:00 America/Los_Angeles - Make ::Schema::Verifier aggregate errors instead of dying on first one 2.030000 2015-07-01 10:11:42-07:00 America/Los_Angeles - Add ::Row::OnColumnMissing (Thanks ZipRecruiter!) 2.029000 2015-06-27 14:16:31-07:00 America/Los_Angeles - Add ::ResultSet::OneRow (Thanks Aran Deltac!) 2.028000 2015-05-30 17:06:01-05:00 America/Chicago - Add ::Verifier::RelationshipColumnName (Thanks for the idea mcsnolte!) - Add ::ResultSet::Shortcut::Search (Closes GH#44 and GH#47) (Thanks moltar!) 2.027001 2015-05-16 11:47:15-05:00 America/Chicago - Fix missing POD in ::ResultSet::Explain 2.027000 2015-05-08 19:35:13-05:00 America/Chicago - Add ::Verifier::Parent 2.026000 2015-05-02 00:27:28-05:00 America/Chicago - Add new ::Schema::Verifier framework - ... including inaugural ::Verifier::C3 2.025003 2015-04-06 16:28:20-05:00 America/Chicago - Make ::OnColumnChange always allow mutating values before update - Fix documented args for `after_column_change` - Document ::OnColumnChange semantics a little bit more clearly 2.025002 2015-03-21 00:03:43-05:00 America/Chicago - Migrate ::RS::CorelateRelationship to an importable Util - Correctly set a parent class for all helpers 2.025001 2015-02-28 09:53:36-06:00 America/Chicago - fix ::RS::Errors test on Windows 2.025000 2015-02-20 22:50:47-06:00 America/Chicago - Add ::Helper::ResultSet::Errors to help when calling Result methods on an RS 2.024001 2014-11-25 19:16:41-06:00 America/Chicago - Fix ::DidYouMean to override source instead of resultset (Thanks ribasushi for the bug report!) 2.024000 2014-11-02 09:02:44-06:00 America/Chicago - Add ::Helper::Schema::DidYouMean to help with typos when calling ->resultset 2.023007 2014-09-16 19:48:34-05:00 America/Chicago - Fix ::Helper::ResultSet::DateMethods1 for Oracle (thanks Alexander Hartmaier!) - Fix yet another issue with ->copy and proxied ResultSet methods (thanks again moltar!) 2.023006 2014-09-03 17:44:34-05:00 America/Chicago - Fix a few ::DateMethods1 methods when using a bound date (vs a column) 2.023005 2014-08-10 11:05:27-05:00 America/Chicago - Fix ::Row::SelfResultSet to correctly include CSA (Thanks Steve Kleiman!) 2.023004 2014-08-01 18:27:54-05:00 America/Chicago - Fix implementation of ::Row::SelfResultSet (fixes GH#34, thanks ribasushi for the heads up!) 2.023003 2014-07-21 21:22:27-05:00 America/Chicago - Fix ToJSON to use accessors if it needs to (Thanks Kevin Benson!) - Fix silly typo in ::Explain (Good catch Jonathan W. Taylor!) 2.023002 2014-06-28 15:04:15-05:00 America/Chicago - Remove silly layer of subtesting (thanks to new features in Test::Roo) - Remove silly sub wrapper in Explain internals (should moderately increase performance) 2.023001 2014-06-14 12:39:08-05:00 America/Chicago - Add handy SYNOPSIS to ::DateMethods1 (thanks for asking rjbs!) 2.023000 2014-05-26 19:33:01-05:00 America/Chicago - Add ::Shortcut::Explain RS helper 2.022000 2014-05-03 10:39:30-05:00 CST6CDT - Add ::Shortcut::ResultsExist RS helper (Olaf Alders) - Add abstract to ::DateMethods1::Announcement (Gregor Herrmann) 2.021001 2014-04-06 11:43:36-05:00 America/Chicago - Fix ::RemoveColumns to work with a specified `columns` (Anthony DeRobertis) (Fixes GH#27) Also fixes RT#91977/GH#24) 2.021000 2014-04-01 20:12:40-05:00 America/Chicago - Create Shortcut::Page and Shortcut::LimitedPage ResultSet helpers (wreis) 2.020001 2014-03-05 10:33:46CST-0600 America/Chicago - Make ::DateMethods1 tests paralellizable (thanks Alexander Hartmaier!) - fix ::Helper::ResultSet::DateMethods1 for Oracle (thanks Alexander Hartmaier!) - fix ABSTRACT on ::Helper::ResultSet::DateMethods1 2.020000 2014-03-04 08:31:39-06:00 America/Chicago - Add ::Helper::ResultSet::DateMethods1 - Add abstract to ::Schema::LintContents 2.019004 2014-02-14 07:53:19 America/Chicago - Make IgnoreWantarray's search die in void context 2.019003 2014-02-07 22:21:47-06:00 America/Chicago - Fix ->copy on rows with proxied ResultSet methods (thanks moltar for the test!) (NOTE: This fix is what requires upgrading to DBIC 0.08260) 2.019002 2014-01-12 09:40:41 America/Chicago - Pick SQL for random row selection in a cleaner way - Stop using Class::MOP::load_class (RT#91035) - Really stop using RT 2.019001 2013-11-23 10:19:28 America/Chicago - Fix typo in ::CorrelateRelationship (Getty) 2.019000 2013-10-17 20:36:45 America/Chicago - Create clean_rs row shortcut (wreis) - Create DateTime schema helper (wreis) 2.018004 2013-10-07 15:23:39 America/Chicago - fix dep marked as test but actually runtime 2.018003 2013-09-26 08:06:03 America/Chicago - fix method shadowing with some helpers for ::Shortcut - ::OrderByMagic now correctly passes through arrayrefs (moltar) - ::OrderByMagic only prefixes with CSA when needed (moltar) 2.018002 2013-07-30 18:45:10 CST6CDT - ::Helper::ResultSet correctly uses all Helpers (reported by moltar) Note that some deprecated helpers were removed from ::ResultSet, so check your code to see if you use the as_virtual_view method. If you do, replace it with as_subselect_rs and you'll be fine. - Fix return precedence in test (Reini Urban) 2.018001 2013-07-02 20:40:18 CST6CDT - Fix bug related to inheriting from ::Shortcut 2.018000 2013-06-22 17:03:29 CST6CDT - Add ::ResultSet::Shortcut::OrderByMagic (moltar) - Add ::ResultSet::Shortcut::Prefetch (Wallas Reis) - Add ::ResultSet::Shortcut::HasRows (Wallas Reis) - Add ::ResultSet::Shortcut::Limit (Wallas Reis) - make ::ResultSet::Me more flexible (moltar) - Fix some warnings (when using deprecated modules) (good catch Bill Mosely) - Fix lots of docs (moltar, Gregor Herrmann, mauke) 2.017000 2013-04-20 10:37:04 CST6CDT - Add ::Schema::QuoteNames to force quote_names on - Add normalize_connect_info utilitiy 2.016006 2013-04-12 09:14:23 CST6CDT - Remove use of a private method, thus fixing Helpers on v0.08210 - Remove the last vestige of non-in-memory SQLite - Stop using RT for bugtracking 2.016005 2013-01-23 19:00:09 CST6CDT - Fix hash order dependency bug (Thanks Fitz Elliott!) 2.016004 2013-01-09 20:05:57 CST6CDT - Add more storages for ::ResultSet::Random (Thanks JosĂ© Diaz Seng!) 2.016003 2012-12-07 15:54:29 CST6CDT - Fix bug in dup_check_source_auto and fk_check_source_auto. If any of the broken things were multiple they explode in the hashref. The solution is to force the values to be resultsets, which is how the helper is documented anyway. (thanks MST for finding this) 2.016002 2012-11-17 15:31:12 CST6CDT - Put MetaYAML back in dist 2.016001 2012-11-02 17:52:43 CST6CDT - fix OnColumnChange to work with relationship based updates so $artist->update({ cd => $cd_obj }) now correctly triggers a change. Thanks David Schmidt for the test - validate number of arguments to _change_column (David Schmidt) - fix name of Helper::ResultSet::Shortcut in SYNOPSIS 2.016000 2012-10-25 21:35:05 CST6CDT - Add Helper::ResultSet::Shortcut (Wes Malone) 2.015001 2012-09-13 21:19:40 America/Chicago - Correctly dep on Sub::Exporter::Progressive 0.001006 2.015000 2012-08-01 18:00:31 America/Chicago - Add order_by_visitor ::Util 2.014003 2012-07-28 14:21:26 America/Chicago - Add EXAMPLES to CorrelateRelationship 2.014002 2012-07-10 21:41:17 America/Chicago - Tests are fully in memory for speed and parallelization 2.014001 2012-07-03 08:34:21 America/Chicago - Stop breaking ::IgnoreWantarray with ::CorrelatedRelationship 2.014000 2012-06-30 00:16:13 America/Chicago - Add ::Row::ProxyResultSetUpdate helper - fully qualify columns in ::SelfResultSet 2.013003 2012-06-28 08:04:13 America/Chicago - Redist due to broken release 2.013002 2012-06-17 22:22:45 America/Chicago - Lots of misc documentation cleanup 2.013001 2012-06-11 17:40:04 America/Chicago - fix Changes (left off only change in 2.013000) 2.013000 2012-06-07 20:41:13 America/Chicago - Add Helper::Row::ProxyResultSetMethod 2.012000 2012-06-05 21:23:16 America/Chicago - Add Helper::ResultSet::NoColumns 2.011000 2012-06-03 16:12:54 America/Chicago - Add Helper::Row::SelfResultSet 2.010001 2012-05-26 10:58:50 America/Chicago - Make ::Schema::LintContents marginally more useful in that it no longer needlessly limits your sources to one moniker only 2.010000 2012-05-17 21:26:47 America/Chicago - Add Helper::Schema::LintContents 2.009001 2012-05-11 11:00:51 America/Chicago - Stupid doc fix 2.009000 2012-05-11 10:45:15 America/Chicago - add Helper::ResultSet::SearchOr component to avoid Union when possible - Simplify implementation of CorrelatedRelationship to work with more versions of DBIx::Class 2.008000 2012-05-09 13:36:28 America/Chicago - Add Helper::ResultSet::CorrelatedRelationship for easy correlated subqueries 2.007004 2012-04-11 19:53:51 America/Chicago - Fix ::OnColumnChange to not obliviate args passed to update 2.007003 2012-02-29 19:56:57 CST6CDT - Fix ::Row::NumifyGet breaking when using select/as or columns 2.007002 2012-01-09 16:23:08 CST6CDT - Fix POD in AutoRemoveColumns (mattp) - Fix multiple level deep Result namespaces (Siddhartha Basu) 2.007001 2011-08-17 22:34:54 CST6CDT - Fix dependency (add Carp::Clan) 2.007000 2011-03-14 21:43:20 CST6CDT - Add Helper::Row::RelationshipDWIM for handy definition of relationships - Significantly simplify implementation of ResultSet::ResultClassDWIM (thanks ribasushi) 2.006000 2011-01-31 18:06:56 CST6CDT - Add ResultSet::ResultClassDWIM to allow ::HashRefInflator (or ::HRI) - Add Schema::GenerateSource for handy addition of subclassed results 2.005000 2010-10-13 19:39:56 CST6CDT - Add ResultSet::Me to define predefined searches a more nicely - Fix DBIx::Class::Helper::ResultSet::Random to not base off Union - Fix DBIx::Class::Helper::ResultSet::Random for MSSQL 2.004000 2010-07-29 21:06:58 CST6CDT - Add Row::StorageValues - Add Row::OnColumnChange - Add Candy exports 2.003002 2010-03-24 23:48:52 CST6CDT - Give up on generating test database; I need to test this out with development releases 2.003001 2010-03-23 18:41:04 CST6CDT - Try again to correctly generate test database 2.003000 2010-03-22 21:27:14 CST6CDT - Fix tests to correctly generate test database - Stop bundling sqlite database with distribution! - Change DBICH::Union into DBICH::SetOperations (nothingmuch) 2.002002 2010-03-14 20:18:59 CST6CDT - DBIx::Class::Helper::ResultSet::Random declared RAND() as the random function for PostgreSQL when Pg uses RANDOM(). This broke any use of that resultset on PostgreSQL. -avar 2.002001 2010-03-13 00:46:30 CST6CDT - Fix my silly Union code - Fix error message from Util for incorrectly design namespace - Fix SYNOPSES to point to correct Components - Change as_virtual_view to just pass through to the cored version, as_subselect_rs 2.00200 2010-02-05 14:15:06 CST6CDT - Allow multiple levels for result in namespace for get_namespace_parts (aka, Foo::Schema::Result::Baz::Biff) (for melo) - Add Helper::Row::ToJSON - Autopopulate is_numeric correcly with NumifyGet - Fix mssql Random to use RAND() (pldoh, #RT53885) 2.00102 2010-01-15 21:50:20 CST6CDT - Better performance for some cases in NumifyGet - _determine_driver is better than _ensure_connected ( Random ) 2.00101 2010-01-15 02:14:55 CST6CDT - fix bug in Random where if a user calls random and schema isn't connected yet we get false storage type (thanks jnap) - fix NumifyGet for nullable and autoinc columns 2.00100 2010-01-13 23:37:34 CST6CDT - fix 'me' in RS::Union - change order in RS::Union so Unioning RS is first instead of last - add Row::NumifyGet - add docs to RS::Union to clarify some of the awesomeness that can be had - fixed union because it didn't actually work before (!!!) 2.00000 2009-12-30 13:02:23 CST6CDT - No new changes since dev release 2.00000_2 2009-12-29 18:45:15 CST6CDT - note added to SubClass disambiguating it from DBIx::Class::DynamicSubclass (thanks jnap) - random_order_by is now private (_random_order_by) - Depend on String::CamelCase now that it's fixed 2.00000_1 2009-12-28 11:40:43 CST6CDT - No longer depend on SQLT - Switch to more user friendly versioning - Allow multiple random rows from Random - Add the most excellent Helper::ResultSet::Union - namespace helpers 1.093501 2009-12-16 16:32:55 CST6CDT - Fix deps list 1.093500 2009-12-16 16:12:00 CST6CDT - Add IgnoreWantarray helper - Pull column def information from foreign tables for JoinTable helper, see pod in helper for details 0.093270 Mon Nov 23 10:45 2009 - Add Random helper - Clean up as_virtual_view with recommendation from ijw and ribasushi 0.093140 Tue Nov 10 09:32 2009 - Fix DBIC version dep - Get rid of some warnings from the test suite 0.093071 Tue Nov 03 20:53 2009 - Fix package of VirtualView - Add test so that won't happen again 0.093070 Mon Nov 02 23:16 2009 - Add virtual view method to clean SQL namespace - Add methods to generate has_many and many_to_many for join tables - Hopefully fix deps for real 0.093000 Sat Oct 26 19:40 2009 - Add parent as a dependency - Super basic POD cleanup - Tighter Restrictions on the namespaces of parent classes 0.092970 Sat Oct 24 02:41 2009 - Initial Release DBIx-Class-Helpers-2.035000/README0000644000175000017500000000207313624003631014544 0ustar frewfrewSYNOPSIS package MyApp::Schema::Result::Foo_Bar; __PACKAGE__->load_components(qw{Helper::JoinTable Core}); __PACKAGE__->join_table({ left_class => 'Foo', left_method => 'foo', right_class => 'Bar', right_method => 'bar', }); # define parent class package ParentSchema::Result::Bar; use strict; use warnings; use parent 'DBIx::Class'; __PACKAGE__->load_components('Core'); __PACKAGE__->table('Bar'); __PACKAGE__->add_columns(qw/ id foo_id /); __PACKAGE__->set_primary_key('id'); __PACKAGE__->belongs_to( foo => 'ParentSchema::Result::Foo', 'foo_id' ); # define subclass package MySchema::Result::Bar; use strict; use warnings; use parent 'ParentSchema::Result::Bar'; __PACKAGE__->load_components(qw{Helper::SubClass Core}); __PACKAGE__->subclass; SEE ALSO DBIx::Class::Helper::Row::JoinTable, DBIx::Class::Helper::Row::SubClass, DBIx::Class::Helpers::Util