| File | /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Relationship/ManyToMany.pm | Statements Executed | 89 | Total Time | 0.00159 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine | |
|---|---|---|---|---|---|---|
| 4 | 4 | 3 | 0.00027 | 0.00067 | DBIx::Class::Relationship::ManyToMany:: | many_to_many |
| 0 | 0 | 0 | 0 | 0 | DBIx::Class::Relationship::ManyToMany:: | BEGIN |
| 0 | 0 | 0 | 0 | 0 | DBIx::Class::Relationship::ManyToMany:: | __ANON__[:103] |
| 0 | 0 | 0 | 0 | 0 | DBIx::Class::Relationship::ManyToMany:: | __ANON__[:44] |
| 0 | 0 | 0 | 0 | 0 | DBIx::Class::Relationship::ManyToMany:: | __ANON__[:50] |
| 0 | 0 | 0 | 0 | 0 | DBIx::Class::Relationship::ManyToMany:: | __ANON__[:80] |
| 0 | 0 | 0 | 0 | 0 | DBIx::Class::Relationship::ManyToMany:: | __ANON__[:90] |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package # hide from PAUSE | |||
| 2 | DBIx::Class::Relationship::ManyToMany; | |||
| 3 | ||||
| 4 | 3 | 2.9e-5 | 9.7e-6 | use strict; # spent 9µs making 1 call to strict::import |
| 5 | 3 | 7.1e-5 | 2.4e-5 | use warnings; # spent 27µs making 1 call to warnings::import |
| 6 | ||||
| 7 | # spent 670µs (275+395) within DBIx::Class::Relationship::ManyToMany::many_to_many which was called 4 times, avg 168µs/call:
# once (78µs+104µs) at line 81 of /wise/base/deliv/dev/lib/perl/WISE/DB/FrameIndex/Frame.pm
# once (72µs+96µs) at line 18 of /wise/base/deliv/dev/lib/perl/WISE/DB/FrameIndex/HouseKeeping.pm
# once (68µs+99µs) at line 17 of /wise/base/deliv/dev/lib/perl/WISE/DB/FrameIndex/MissionPlan.pm
# once (57µs+96µs) at line 82 of /wise/base/deliv/dev/lib/perl/WISE/DB/FrameIndex/Frame.pm | |||
| 8 | 16 | 3.3e-5 | 2.1e-6 | my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_; |
| 9 | ||||
| 10 | $class->throw_exception( | |||
| 11 | "missing relation in many-to-many" | |||
| 12 | ) unless $rel; | |||
| 13 | ||||
| 14 | $class->throw_exception( | |||
| 15 | "missing foreign relation in many-to-many" | |||
| 16 | ) unless $f_rel; | |||
| 17 | ||||
| 18 | { | |||
| 19 | 3 | 2.7e-5 | 9.0e-6 | no strict 'refs'; # spent 23µs making 1 call to strict::unimport |
| 20 | 3 | 0.00081 | 0.00027 | no warnings 'redefine'; # spent 22µs making 1 call to warnings::unimport |
| 21 | ||||
| 22 | 44 | 0.00019 | 4.2e-6 | my $add_meth = "add_to_${meth}"; |
| 23 | my $remove_meth = "remove_from_${meth}"; | |||
| 24 | my $set_meth = "set_${meth}"; | |||
| 25 | my $rs_meth = "${meth}_rs"; | |||
| 26 | ||||
| 27 | for ($add_meth, $remove_meth, $set_meth, $rs_meth) { | |||
| 28 | 16 | 0.00043 | 2.7e-5 | warn "***************************************************************************\n". # spent 395µs making 16 calls to UNIVERSAL::can, avg 25µs/call |
| 29 | "The many-to-many relationship $meth is trying to create a utility method called $_. This will overwrite the existing method on $class. You almost certainly want to rename your method or the many-to-many relationship, as your method will not be callable (it will use the one from the relationship instead.) YOU HAVE BEEN WARNED\n". | |||
| 30 | "***************************************************************************\n" | |||
| 31 | if $class->can($_); | |||
| 32 | } | |||
| 33 | ||||
| 34 | $rel_attrs->{alias} ||= $f_rel; | |||
| 35 | ||||
| 36 | *{"${class}::${meth}_rs"} = sub { | |||
| 37 | my $self = shift; | |||
| 38 | my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}; | |||
| 39 | my @args = ($f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs }); | |||
| 40 | my $rs = $self->search_related($rel)->search_related( | |||
| 41 | $f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs } | |||
| 42 | ); | |||
| 43 | return $rs; | |||
| 44 | }; | |||
| 45 | ||||
| 46 | *{"${class}::${meth}"} = sub { | |||
| 47 | my $self = shift; | |||
| 48 | my $rs = $self->$rs_meth( @_ ); | |||
| 49 | return (wantarray ? $rs->all : $rs); | |||
| 50 | }; | |||
| 51 | ||||
| 52 | *{"${class}::${add_meth}"} = sub { | |||
| 53 | my $self = shift; | |||
| 54 | @_ > 0 or $self->throw_exception( | |||
| 55 | "${add_meth} needs an object or hashref" | |||
| 56 | ); | |||
| 57 | my $source = $self->result_source; | |||
| 58 | my $schema = $source->schema; | |||
| 59 | my $rel_source_name = $source->relationship_info($rel)->{source}; | |||
| 60 | my $rel_source = $schema->resultset($rel_source_name)->result_source; | |||
| 61 | my $f_rel_source_name = $rel_source->relationship_info($f_rel)->{source}; | |||
| 62 | my $f_rel_rs = $schema->resultset($f_rel_source_name)->search({}, $rel_attrs||{}); | |||
| 63 | ||||
| 64 | my $obj; | |||
| 65 | if (ref $_[0]) { | |||
| 66 | if (ref $_[0] eq 'HASH') { | |||
| 67 | $obj = $f_rel_rs->create($_[0]); | |||
| 68 | } else { | |||
| 69 | $obj = $_[0]; | |||
| 70 | } | |||
| 71 | } else { | |||
| 72 | $obj = $f_rel_rs->create({@_}); | |||
| 73 | } | |||
| 74 | ||||
| 75 | my $link_vals = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}; | |||
| 76 | my $link = $self->search_related($rel)->new_result($link_vals); | |||
| 77 | $link->set_from_related($f_rel, $obj); | |||
| 78 | $link->insert(); | |||
| 79 | return $obj; | |||
| 80 | }; | |||
| 81 | ||||
| 82 | *{"${class}::${set_meth}"} = sub { | |||
| 83 | my $self = shift; | |||
| 84 | @_ > 0 or $self->throw_exception( | |||
| 85 | "{$set_meth} needs a list of objects or hashrefs" | |||
| 86 | ); | |||
| 87 | my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_); | |||
| 88 | $self->search_related($rel, {})->delete; | |||
| 89 | $self->$add_meth($_) for (@to_set); | |||
| 90 | }; | |||
| 91 | ||||
| 92 | *{"${class}::${remove_meth}"} = sub { | |||
| 93 | my $self = shift; | |||
| 94 | @_ > 0 && ref $_[0] ne 'HASH' | |||
| 95 | or $self->throw_exception("${remove_meth} needs an object"); | |||
| 96 | my $obj = shift; | |||
| 97 | my $rel_source = $self->search_related($rel)->result_source; | |||
| 98 | my $cond = $rel_source->relationship_info($f_rel)->{cond}; | |||
| 99 | my $link_cond = $rel_source->resolve_condition( | |||
| 100 | $cond, $obj, $f_rel | |||
| 101 | ); | |||
| 102 | $self->search_related($rel, $link_cond)->delete; | |||
| 103 | }; | |||
| 104 | ||||
| 105 | } | |||
| 106 | } | |||
| 107 | ||||
| 108 | 1 | 3.0e-6 | 3.0e-6 | 1; |