use strict;
use Data::Dumper;
package DB::IRCLogBot::Messages;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/PK::Auto ResultSetManager Core/);
__PACKAGE__->table('messages');
__PACKAGE__->add_columns(qw/id who body channel ircuser/);
__PACKAGE__->set_primary_key('id');
#__PACKAGE__->belongs_to('user' => 'DB::IRCLogBot::Users' ,
'ircuser');
# __PACKAGE__->belongs_to('channel' => 'DB::IRCLogBot::Channels' );
package DB::IRCLogBot::Users;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/PK::Auto ResultSetManager Core/);
__PACKAGE__->table('users');
__PACKAGE__->add_columns(qw/id name/);
__PACKAGE__->set_primary_key('id');
__PACKAGE__->has_many('messages' => 'DB::IRCLogBot::Messages' ,
'ircuser');
package DB::IRCLogBot::Channels;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/PK::Auto ResultSetManager Core/);
- Ignored:
__PACKAGE__->table('channels');
__PACKAGE__->add_columns(qw/id name/);
__PACKAGE__->set_primary_key('id');
__PACKAGE__->has_many('messages' => 'DB::IRCLogBot::Messages' ,
'channel');
package DB::IRCLogBot;
use base qw/DBIx::Class::Schema/;
__PACKAGE__->register_class( 'Channels' =>
'DB::IRCLogBot::Channels' );
__PACKAGE__->register_class( 'Users' =>
'DB::IRCLogBot::Users' );
__PACKAGE__->register_class( 'Messages' =>
'DB::IRCLogBot::Messages' );
package IRCLogBot;
use base qw/Bot::BasicBot/;
use DateTime;
sub init {
my $self = shift;
$self->{db} =
DB::IRCLogBot->connect(
'DBI:Pg:dbname=irclogbot;host=fab40;user=victori;password=cool123');
}
sub setup_insert_for_db {
my $self = shift;
my $message = shift;
my $dbchan =
$self->{db}->resultset('Channels')->search( name =>
$message->
{channel} )
->first();
$dbchan =
$self->{db}->resultset('Channels')->new( { name =>
$message->
{channel} } )
->insert()
unless defined $dbchan;
my $dbuser =
$self->{db}->resultset('Users')->search( name => $message->
{who} )
->first();
$dbuser =
$self->{db}->resultset('Users')->new( { name => $message->
{who} } )
->insert()
unless defined $dbuser;
return ( $dbchan, $dbuser );
}
sub said {
my $self = shift;
my $message = shift;
my $stamp = DateTime->now();
my $dbmsg = $self->{db}->resultset('Messages')->new( {} );
my ( $dbchan, $dbuser ) = $self->setup_insert_for_db
($message);
$dbmsg->who( $message->{who} );
$dbmsg->body( $message->{body} );
$dbmsg->ircuser($dbuser->id);
$dbmsg->channel($dbchan->id);
$dbmsg->insert();
#$self->reply($message,"hello world!");
return undef;
}
# with all known options
my $bot = IRCLogBot->new(
server => "irc.freenode.net",
port => "6667",
channels => ["#bottest"],
nick => "lamer0__",
alt_nicks => [ "lamer0___", "lamer0_" ],
username => "lamer0",
name => "Yet Another lamer0",
#ignore_list => [qw(dipsy dadadodo laotse)],
charset => "utf-8", # charset the bot assumes the
channel is
using
);
$bot->run();
Code in question - I placed it all in a single file so its easy
to read.
DBIx::Class chokes on the belongs_to ---
DBIx::Class::Relationship::BelongsTo::belongs_to(): Can't infer
join
condition for channel on DB::IRCLogBot::Messages; unable to load
DB::IRCLogBot::Channels: Can't locate object method
"primary_columns"
via package "DB::IRCLogBot::Channels" at /opt/local/lib/perl5/
site_perl/5.8.8/DBIx/Class/Relationship/BelongsTo.pm line 15.
primary_columns? only way I can get it to work if I
fully write out the channel/ircuser columns in my class like -
package DB::IRCLogBot::Messages;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/PK::Auto ResultSetManager Core/);
__PACKAGE__->table('messages');
__PACKAGE__->add_columns(
"id","who","body",
"channel",
{
data_type => 'integer',
default_value => undef,
is_nullable => 0,
},
"ircuser",
{
data_type => 'integer',
default_value => undef,
is_nullable => 0,
},
);
__PACKAGE__->set_primary_key('id');
__PACKAGE__->belongs_to('user' => 'DB::IRCLogBot::Users' , 'ircuser');
__PACKAGE__->belongs_to('channel' => 'DB::IRCLogBot::Channels',
'channel' );
_______________________________________________
List: http://lists.rawmode.org/cgi-bin/mailman/listinfo/dbix-class
Wiki: http://dbix-class.shadowcatsystems.co.uk/
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/trunk/DBIx-Class/
Searchable Archive: http://www.mail-archive.com/[email protected]/
