A DBIC based library

[Zbigniew Lukasiak]

Hi,

I am trying to figure out how to package a DBIC Result as a library.
You can find more background in my blog post:
http://perlalchemy.blogspot.com/2009/06/packaging-cross-cutting-catalyst.html
.   What I tried is simply defining that Result class in a separate
package - and later subclassing it:

package CatalystX::Comments::DBICResult;

use strict;
use warnings;

use base 'DBIx::Class';

__PACKAGE__->load_components(qw/TimeStamp PK::Auto Core/);
__PACKAGE__->table('comment');
__PACKAGE__->add_columns(
  id =>  { data_type => 'integer', is_auto_increment => 1, is_nullable => 0 },
  item_id  =>  { data_type => 'integer', is_nullable => 0 },
  body => { data_type => 'text', default_value => undef, is_nullable => 1 },
  nick => { data_type => 'varchar', default_value => undef, is_nullable => 1 },
  email => { data_type => 'varchar', default_value => undef, is_nullable => 1 },
  web_site => { data_type => 'varchar', default_value => undef,
is_nullable => 1 },
  ip => { data_type => 'varchar', default_value => undef, is_nullable => 1 },
  t_created => { data_type => 'datetime', set_on_create => 1 },
  t_updated => { data_type => 'datetime', set_on_create => 1,
set_on_update => 1 },
);
__PACKAGE__->set_primary_key('id');

1;


And the subclass:

package PiraciDrogowi::DBSchema::Comment;

use strict;
use warnings;

use base 'CatalystX::Comments::DBICResult';

__PACKAGE__->belongs_to('incydent',
'PiraciDrogowi::DBSchema::Incydent', { id => 'item_id' });

1;


Obviously that was rather naive approach - but it was the first I thought up.
It nearly works:


use lib 'lib';

use PiraciDrogowi::DBSchema;

my $schema = PiraciDrogowi::DBSchema->connect( 'dbi:SQLite:dbname=piraci.db' );
my $rs = $schema->resultset('Comment');
print $rs->count, "\n";
my $comment = $rs->first;
print $comment->incydent->id;


This prints:
1
Can't locate object method "incydent" via package
"CatalystX::Comments::DBICResult" at a.pl line 9.

So it finds the record - but it does not see the relationships I added
in the subclass.


--
Zbigniew Lukasiak
http://brudnopis.blogspot.com/
http://perlalchemy.blogspot.com/

_______________________________________________
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/dbix-class@...

[Iain-4]

On Sat, 2009-06-06 at 11:27 +0200, Zbigniew Lukasiak wrote:

> Hi,
>
> I am trying to figure out how to package a DBIC Result as a library.
> You can find more background in my blog post:
> http://perlalchemy.blogspot.com/2009/06/packaging-cross-cutting-catalyst.html
> .   What I tried is simply defining that Result class in a separate
> package - and later subclassing it:
>
> package CatalystX::Comments::DBICResult;
>
> use strict;
> use warnings;
>
> use base 'DBIx::Class';
>
> __PACKAGE__->load_components(qw/TimeStamp PK::Auto Core/);
> __PACKAGE__->table('comment');
> __PACKAGE__->add_columns(
>   id =>  { data_type => 'integer', is_auto_increment => 1, is_nullable => 0 },
>   item_id  =>  { data_type => 'integer', is_nullable => 0 },
>   body => { data_type => 'text', default_value => undef, is_nullable => 1 },
>   nick => { data_type => 'varchar', default_value => undef, is_nullable => 1 },
>   email => { data_type => 'varchar', default_value => undef, is_nullable => 1 },
>   web_site => { data_type => 'varchar', default_value => undef,
> is_nullable => 1 },
>   ip => { data_type => 'varchar', default_value => undef, is_nullable => 1 },
>   t_created => { data_type => 'datetime', set_on_create => 1 },
>   t_updated => { data_type => 'datetime', set_on_create => 1,
> set_on_update => 1 },
> );
> __PACKAGE__->set_primary_key('id');
>
> 1;
>
>
> And the subclass:
>
> package PiraciDrogowi::DBSchema::Comment;
>
> use strict;
> use warnings;
>
> use base 'CatalystX::Comments::DBICResult';
>
> __PACKAGE__->belongs_to('incydent',
> 'PiraciDrogowi::DBSchema::Incydent', { id => 'item_id' });
>
> 1;
>
>
> Obviously that was rather naive approach - but it was the first I thought up.
> It nearly works:
>
>
> use lib 'lib';
>
> use PiraciDrogowi::DBSchema;
>
> my $schema = PiraciDrogowi::DBSchema->connect( 'dbi:SQLite:dbname=piraci.db' );
> my $rs = $schema->resultset('Comment');
> print $rs->count, "\n";
> my $comment = $rs->first;
> print $comment->incydent->id;
>
>
> This prints:
> 1
> Can't locate object method "incydent" via package
> "CatalystX::Comments::DBICResult" at a.pl line 9.
>
> So it finds the record - but it does not see the relationships I added
> in the subclass.
>

I too would be grateful for any advice on this.

For example say bugzilla used DBIC and I wanted to write an extension.
How could I add extra methods to the row object without modifying the
existing result source.

Iain.


_______________________________________________
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/dbix-class@...

[Ben. B.]

I'm not a DBIC support expert but I do have some experience trying to sub-class result classes and I think what you need to do is make a result source for this sub-class so that it is returned when you do: $schema->resultset('Comment');

This is an adaptation of what is in DBIx::Class::Manual::Cookbook "Arbitrary SQL through a custom ResultSource". The key components are that I cloned the result source of the module to be sub-classed, set its result_class to the sub-class, then registered it with the schema. Feel free to respond with a more correct answer but I figured this had gone a while without a reply so I'd give it a shot...

package PiraciDrogowi::DBSchema;
use strict;
use warnings;
use base qw(DBIx::Class::Schema);

#__PACKAGE__->load_namespaces();
__PACKAGE__->load_classes( {
    'CatalystX::Comments' => [ 'DBICResult', ],
    'PiraciDrogowi::DBSchema' => [ 'Comment',  'Incydent', ],
}, );

my $source = CatalystX::Comments::DBICResult->result_source_instance();
my $new_source = $source->new( $source );
# $new_source->source_name( 'Comment' ); # Not sure if this step is necessary.
$new_source->result_class( 'PiraciDrogowi::DBSchema::Comment' );

__PACKAGE__->register_extra_source( 'Comment' => $new_source );

1;


package PiraciDrogowi::DBSchema::Incydent;
use strict;
use warnings;
use base 'DBIx::Class';

__PACKAGE__->load_components(qw/TimeStamp PK::Auto Core/);
__PACKAGE__->table('incydent');
__PACKAGE__->add_columns(
    id =>  { data_type => 'integer', is_auto_increment => 1, is_nullable => 0 },
    item_id  =>  { data_type => 'integer', is_nullable => 0 },
);

__PACKAGE__->set_primary_key('id');

1;

######## test.pl
use strict;
use warnings;
use lib 'lib';

use PiraciDrogowi::DBSchema;

my $schema = PiraciDrogowi::DBSchema->connect( 'dbi:SQLite:dbname=piraci.db' );
my $rs = $schema->resultset( 'Comment' );
printf "count = %d\n", $rs->count;
my $comment = $rs->first;
printf "id = %d\n", $comment->incydent->id;


$ dbicdeploy -Ilib  PiraciDrogowi::DBSchema 'dbi:SQLite:dbname=piraci.db'
# After inserting some test rows
$ perl bin/test.pl
count = 1
id = 1

On Sat, Jun 6, 2009 at 5:27 AM, Zbigniew Lukasiak <[hidden email]> wrote:

Hi,

I am trying to figure out how to package a DBIC Result as a library.
You can find more background in my blog post:
http://perlalchemy.blogspot.com/2009/06/packaging-cross-cutting-catalyst.html
.   What I tried is simply defining that Result class in a separate
package - and later subclassing it:

package CatalystX::Comments::DBICResult;

use strict;
use warnings;

use base 'DBIx::Class';

__PACKAGE__->load_components(qw/TimeStamp PK::Auto Core/);
__PACKAGE__->table('comment');
__PACKAGE__->add_columns(
 id =>  { data_type => 'integer', is_auto_increment => 1, is_nullable => 0 },
 item_id  =>  { data_type => 'integer', is_nullable => 0 },
 body => { data_type => 'text', default_value => undef, is_nullable => 1 },
 nick => { data_type => 'varchar', default_value => undef, is_nullable => 1 },
 email => { data_type => 'varchar', default_value => undef, is_nullable => 1 },
 web_site => { data_type => 'varchar', default_value => undef,
is_nullable => 1 },
 ip => { data_type => 'varchar', default_value => undef, is_nullable => 1 },
 t_created => { data_type => 'datetime', set_on_create => 1 },
 t_updated => { data_type => 'datetime', set_on_create => 1,
set_on_update => 1 },
);
__PACKAGE__->set_primary_key('id');

1;


And the subclass:

package PiraciDrogowi::DBSchema::Comment;

use strict;
use warnings;

use base 'CatalystX::Comments::DBICResult';

__PACKAGE__->belongs_to('incydent',
'PiraciDrogowi::DBSchema::Incydent', { id => 'item_id' });

1;


Obviously that was rather naive approach - but it was the first I thought up.
It nearly works:


use lib 'lib';

use PiraciDrogowi::DBSchema;

my $schema = PiraciDrogowi::DBSchema->connect( 'dbi:SQLite:dbname=piraci.db' );
my $rs = $schema->resultset('Comment');
print $rs->count, "\n";
my $comment = $rs->first;
print $comment->incydent->id;


This prints:
1
Can't locate object method "incydent" via package
"CatalystX::Comments::DBICResult" at a.pl line 9.

So it finds the record - but it does not see the relationships I added
in the subclass.


--
Zbigniew Lukasiak
http://brudnopis.blogspot.com/
http://perlalchemy.blogspot.com/

_______________________________________________
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/dbix-class@...

_______________________________________________
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/dbix-class@...

[Amiri Barksdale]

Hi folks.

I was chatting with ribasushi on irc today about the way to get
relationships with
$schema->source($source)->relationships/relationship_info, so I can
create a series of statements like this:

    list_prefetch_allows    =>  [
        'cds', { cds => [qw/cd_to_producer tags tracks/] },
    ],  

or like this:

    list_prefetch_allows    =>  [
        'cd_to_producer', { cd_to_producer => [qw//] },
        'tags', { tags => [qw//] },
        'tracks', { tracks => [qw//] },
    ],  

For a Catalyst::Helper::Controller I am writing. Now, I am not sure how
to implement ribasushi's advice, so I am posting the code here to
solicit feedback. It seems clumsy to me, and like ribasushi said,
I am sure I am doing it wrong, but I don't know how else to do it.

In a loop through $schema->sources, I do this:

  for my $source ($schema->sources) {
      my @list_prefetch_allows =
_return_has_many_list($schema->source($source)->_relationships);

      @list_prefetch_allows = map {
          my $ref = $_;
          qq|'$ref->[0]', { |
          . $ref->[0]
          . qq| => [qw/|
          . join (' ', map { $_->[0] }
_return_has_many_list($schema->source($ref->[1])->_relationships))
          . qq|/] },\n\t\t|;
      } @list_prefetch_allows;

The subroutine _return_has_many_list is this:

sub _return_has_many_list {
    my ($relationships) = @_;
    return grep { $relationships->{$_->[0]}->{attrs}->{accessor} =~
/multi/ } map { [$_, $relationships->{$_}->{source} ] } sort keys
%$relationships;
}

All feedback welcome!

Amiri

_______________________________________________
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/dbix-class@...