use SL::Common;
use SL::DBUtils;
+use Data::Dumper;
+use List::Util qw(reduce);
+
+use strict;
sub create_links {
$main::lxdebug->enter_sub();
my $self = shift;
my %params = @_;
- Common::check_params(\%params, qw(links));
+ if ($params{mode} && ($params{mode} eq 'ids')) {
+ Common::check_params_x(\%params, [ qw(from_ids to_ids) ]);
+
+ } else {
+ Common::check_params(\%params, qw(links));
+
+ }
+
+ my @links;
+
+ if ($params{mode} && ($params{mode} eq 'ids')) {
+ my ($from_to, $to_from) = $params{from_ids} ? qw(from to) : qw(to from);
+ my %ids;
- if (!scalar @{ $params{links} }) {
+ if ('ARRAY' eq ref $params{"${from_to}_ids"}) {
+ $ids{$from_to} = $params{"${from_to}_ids"};
+ } else {
+ $ids{$from_to} = [ grep { $_ } map { $_ * 1 } split m/\s+/, $params{"${from_to}_ids"} ];
+ }
+
+ if (my $num = scalar @{ $ids{$from_to} }) {
+ $ids{$to_from} = [ ($params{"${to_from}_id"}) x $num ];
+ @links = map { { 'from_table' => $params{from_table},
+ 'from_id' => $ids{from}->[$_],
+ 'to_table' => $params{to_table},
+ 'to_id' => $ids{to}->[$_], } } (0 .. $num - 1);
+ }
+
+ } else {
+ @links = @{ $params{links} };
+ }
+
+ if (!scalar @links) {
$main::lxdebug->leave_sub();
return;
}
my $query = qq|INSERT INTO record_links (from_table, from_id, to_table, to_id) VALUES (?, ?, ?, ?)|;
my $sth = prepare_query($form, $dbh, $query);
- foreach my $link (@{ $params{links} }) {
+ foreach my $link (@links) {
next if ('HASH' ne ref $link);
next if (!$link->{from_table} || !$link->{from_id} || !$link->{to_table} || !$link->{to_id});
return wantarray ? @{ $links } : $links;
}
+sub get_links_via {
+ $main::lxdebug->enter_sub();
+
+ use SL::MoreCommon;
+ use Data::Dumper;
+
+ my $self = shift;
+ my %params = @_;
+
+ Common::check_params(\%params, [ qw(from_table from_id to_table to_id) ]);
+ Common::check_params(\%params, "via");
+
+ my @hops = ref $params{via} eq 'ARRAY'
+ ? @{ $params{via} }
+ : $params{via};
+ unshift @hops, +{ table => $params{from_table}, id => $params{from_id} };
+ push @hops, +{ table => $params{to_table}, id => $params{to_id} };
+
+ my $myconfig = \%main::myconfig;
+ my $form = $main::form;
+
+ my $last_hop = shift @hops;
+ my @links;
+ for my $hop (@hops) {
+
+ my @temp_links = $self->get_links(
+ from_table => $last_hop->{table},
+ from_id => $last_hop->{id},
+ to_table => $hop->{table},
+ to_id => $hop->{id},
+ );
+
+ # short circuit if any of these are empty
+ return wantarray ? () : [] unless scalar @temp_links;
+
+ push @links, \@temp_links;
+ $last_hop = $hop;
+ }
+
+ my $result = reduce {
+ [
+ grep { $_ }
+ cross {
+ if ( $a->{to_table} eq $b->{from_table}
+ && $a->{to_id} eq $b->{from_id} ) {
+ +{ from_table => $a->{from_table},
+ from_id => $a->{from_id},
+ to_table => $b->{to_table},
+ to_id => $b->{to_id} }
+ }
+ } @{ $a }, @{ $b }
+ ]
+ } @links;
+
+ $main::lxdebug->leave_sub();
+
+ return wantarray ? @{ $result } : $result;
+}
+
+sub delete {
+ $main::lxdebug->enter_sub();
+
+ my $self = shift;
+ my %params = @_;
+
+ Common::check_params(\%params, [ qw(from_table from_id to_table to_id) ]);
+
+ my $myconfig = \%main::myconfig;
+ my $form = $main::form;
+
+ my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
+
+ # content
+ my (@where_tokens, @where_values);
+
+ for my $col (qw(from_table from_id to_table to_id)) {
+ add_token(\@where_tokens, \@where_values, col => $col, val => $params{$col}) if $params{$col};
+ }
+
+ my $where = "WHERE ". join ' AND ', map { "($_)" } @where_tokens if scalar @where_tokens;
+ my $query = "DELETE FROM record_links $where";
+
+ do_query($form, $dbh, $query, @where_values);
+
+ $dbh->commit() unless ($params{dbh});
+
+ $main::lxdebug->leave_sub();
+}
+
1;