1package # hide from PAUSE 2 DBIx::Class::Relationship::HasMany; 3 4use strict; 5use warnings; 6use Try::Tiny; 7use namespace::clean; 8 9our %_pod_inherit_config = 10 ( 11 class_map => { 'DBIx::Class::Relationship::HasMany' => 'DBIx::Class::Relationship' } 12 ); 13 14sub has_many { 15 my ($class, $rel, $f_class, $cond, $attrs) = @_; 16 17 unless (ref $cond) { 18 19 my $pri = $class->result_source_instance->_single_pri_col_or_die; 20 21 my ($f_key,$guess); 22 if (defined $cond && length $cond) { 23 $f_key = $cond; 24 $guess = "caller specified foreign key '$f_key'"; 25 } else { 26 $class =~ /([^\:]+)$/; # match is safe - $class can't be '' 27 $f_key = lc $1; # go ahead and guess; best we can do 28 $guess = "using our class name '$class' as foreign key source"; 29 } 30 31# FIXME - this check needs to be moved to schema-composition time... 32# # only perform checks if the far side appears already loaded 33# if (my $f_rsrc = try { $f_class->result_source_instance } ) { 34# $class->throw_exception( 35# "No such column '$f_key' on foreign class ${f_class} ($guess)" 36# ) if !$f_rsrc->has_column($f_key); 37# } 38 39 $cond = { "foreign.${f_key}" => "self.${pri}" }; 40 } 41 42 my $default_cascade = ref $cond eq 'CODE' ? 0 : 1; 43 44 $class->add_relationship($rel, $f_class, $cond, { 45 accessor => 'multi', 46 join_type => 'LEFT', 47 cascade_delete => $default_cascade, 48 cascade_copy => $default_cascade, 49 is_depends_on => 0, 50 %{$attrs||{}} 51 }); 52} 53 541; 55