SL/RecordLinks.pm

   1 package RecordLinks;
   2
   3 use SL::Common;
   4 use SL::DBUtils;
   5 use Data::Dumper;
   6 use List::Util qw(reduce);
   7
   8 sub create_links {
   9   $main::lxdebug->enter_sub();
  10
  11   my $self     = shift;
  12   my %params   = @_;
  13
  14   if ($params{mode} && ($params{mode} eq 'ids')) {
  15     Common::check_params_x(\%params, [ qw(from_ids to_ids) ]);
  16
  17   } else {
  18     Common::check_params(\%params, qw(links));
  19
  20   }
  21
  22   my @links;
  23
  24   if ($params{mode} && ($params{mode} eq 'ids')) {
  25     my ($from_to, $to_from) = $params{from_ids} ? qw(from to) : qw(to from);
  26     my %ids;
  27
  28     if ('ARRAY' eq ref $params{"${from_to}_ids"}) {
  29       $ids{$from_to} = $params{"${from_to}_ids"};
  30     } else {
  31       $ids{$from_to} = [ grep { $_ } map { $_ * 1 } split m/\s+/, $params{"${from_to}_ids"} ];
  32     }
  33
  34     if (my $num = scalar @{ $ids{$from_to} }) {
  35       $ids{$to_from} = [ ($params{"${to_from}_id"}) x $num ];
  36       @links         = map { { 'from_table' => $params{from_table},
  37                                'from_id'    => $ids{from}->[$_],
  38                                'to_table'   => $params{to_table},
  39                                'to_id'      => $ids{to}->[$_],      } } (0 .. $num - 1);
  40     }
  41
  42   } else {
  43     @links = @{ $params{links} };
  44   }
  45
  46   if (!scalar @links) {
  47     $main::lxdebug->leave_sub();
  48     return;
  49   }
  50
  51   my $myconfig = \%main::myconfig;
  52   my $form     = $main::form;
  53
  54   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
  55
  56   my $query    = qq|INSERT INTO record_links (from_table, from_id, to_table, to_id) VALUES (?, ?, ?, ?)|;
  57   my $sth      = prepare_query($form, $dbh, $query);
  58
  59   foreach my $link (@links) {
  60     next if ('HASH' ne ref $link);
  61     next if (!$link->{from_table} || !$link->{from_id} || !$link->{to_table} || !$link->{to_id});
  62
  63     do_statement($form, $sth, $query, $link->{from_table}, conv_i($link->{from_id}), $link->{to_table}, conv_i($link->{to_id}));
  64   }
  65
  66   $dbh->commit() unless ($params{dbh});
  67
  68   $main::lxdebug->leave_sub();
  69 }
  70
  71 sub get_links {
  72   $main::lxdebug->enter_sub();
  73
  74   my $self     = shift;
  75   my %params   = @_;
  76
  77   Common::check_params(\%params, [ qw(from_table from_id to_table to_id) ]);
  78
  79   my $myconfig   = \%main::myconfig;
  80   my $form       = $main::form;
  81
  82   my $dbh        = $params{dbh} || $form->get_standard_dbh($myconfig);
  83
  84   my @conditions = ();
  85   my @values     = ();
  86
  87   foreach my $col (qw(from_table from_id to_table to_id)) {
  88     next unless ($params{$col});
  89
  90     if ('ARRAY' eq ref $params{$col}) {
  91       push @conditions, "$col IN (" . join(', ', ('?') x scalar(@{ $params{$col} })) . ")";
  92       push @values,     $col =~ m/table/ ? @{ $params{$col} } : map { conv_i($_) } @{ $params{$col} };
  93
  94     } else {
  95       push @conditions, "$col = ?";
  96       push @values,     $col =~ m/table/ ? $params{$col} : conv_i($params{$col});
  97     }
  98   }
  99
 100   my $query = qq|SELECT from_table, from_id, to_table, to_id
 101                  FROM record_links|;
 102
 103   if (scalar @conditions) {
 104     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @conditions);
 105   }
 106
 107   my $links = selectall_hashref_query($form, $dbh, $query, @values);
 108
 109   $main::lxdebug->leave_sub();
 110
 111   return wantarray ? @{ $links } : $links;
 112 }
 113
 114 sub get_links_via {
 115   $main::lxdebug->enter_sub();
 116
 117   use SL::MoreCommon;
 118   use Data::Dumper;
 119
 120   my $self     = shift;
 121   my %params   = @_;
 122
 123   Common::check_params(\%params, [ qw(from_table from_id to_table to_id) ]);
 124   Common::check_params(\%params, "via");
 125
 126   my @hops = ref $params{via} eq 'ARRAY'
 127            ? @{ $params{via} }
 128            :    $params{via};
 129   unshift @hops, +{ table => $params{from_table}, id => $params{from_id} };
 130   push    @hops, +{ table => $params{to_table},   id => $params{to_id} };
 131
 132   my $myconfig   = \%main::myconfig;
 133   my $form       = $main::form;
 134
 135   my $last_hop   = shift @hops;
 136   my @links;
 137   for my $hop (@hops) {
 138
 139     my @temp_links = $self->get_links(
 140       from_table => $last_hop->{table},
 141       from_id    => $last_hop->{id},
 142       to_table   => $hop->{table},
 143       to_id      => $hop->{id},
 144     );
 145
 146     # short circuit if any of these are empty
 147     return wantarray ? () : [] unless scalar @temp_links;
 148
 149     push @links, \@temp_links;
 150     $last_hop  =  $hop;
 151   }
 152
 153   my $result = reduce {
 154     [
 155       grep { $_ }
 156       cross {
 157         if (   $a->{to_table} eq $b->{from_table}
 158             && $a->{to_id}    eq $b->{from_id} ) {
 159           +{ from_table => $a->{from_table},
 160              from_id    => $a->{from_id},
 161              to_table   => $b->{to_table},
 162              to_id      => $b->{to_id} }
 163           }
 164         } @{ $a }, @{ $b }
 165     ]
 166   } @links;
 167
 168   $main::lxdebug->leave_sub();
 169
 170   return wantarray ? @{ $result } : $result;
 171 }
 172
 173 sub delete {
 174   $main::lxdebug->enter_sub();
 175
 176   my $self     = shift;
 177   my %params   = @_;
 178
 179   Common::check_params(\%params, [ qw(from_table from_id to_table to_id) ]);
 180
 181   my $myconfig   = \%main::myconfig;
 182   my $form       = $main::form;
 183
 184   my $dbh        = $params{dbh} || $form->get_standard_dbh($myconfig);
 185
 186   # content
 187   my (@where_tokens, @where_values);
 188
 189   for my $col (qw(from_table from_id to_table to_id)) {
 190     add_token(\@where_tokens, \@where_values, col => $col, val => $params{$col}) if $params{$col};
 191   }
 192
 193   my $where = "WHERE ". join ' AND ', map { "($_)" } @where_tokens if scalar @where_tokens;
 194   my $query = "DELETE FROM record_links $where";
 195
 196   do_query($form, $dbh, $query, @where_values);
 197
 198   $dbh->commit() unless ($params{dbh});
 199
 200   $main::lxdebug->leave_sub();
 201 }
 202
 203 1;