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 use strict;
   9
  10 sub create_links {
  11   $main::lxdebug->enter_sub();
  12
  13   my $self     = shift;
  14   my %params   = @_;
  15
  16   if ($params{mode} && ($params{mode} eq 'ids')) {
  17     Common::check_params_x(\%params, [ qw(from_ids to_ids) ]);
  18
  19   } else {
  20     Common::check_params(\%params, qw(links));
  21
  22   }
  23
  24   my @links;
  25
  26   if ($params{mode} && ($params{mode} eq 'ids')) {
  27     my ($from_to, $to_from) = $params{from_ids} ? qw(from to) : qw(to from);
  28     my %ids;
  29
  30     if ('ARRAY' eq ref $params{"${from_to}_ids"}) {
  31       $ids{$from_to} = $params{"${from_to}_ids"};
  32     } else {
  33       $ids{$from_to} = [ grep { $_ } map { $_ * 1 } split m/\s+/, $params{"${from_to}_ids"} ];
  34     }
  35
  36     if (my $num = scalar @{ $ids{$from_to} }) {
  37       $ids{$to_from} = [ ($params{"${to_from}_id"}) x $num ];
  38       @links         = map { { 'from_table' => $params{from_table},
  39                                'from_id'    => $ids{from}->[$_],
  40                                'to_table'   => $params{to_table},
  41                                'to_id'      => $ids{to}->[$_],      } } (0 .. $num - 1);
  42     }
  43
  44   } else {
  45     @links = @{ $params{links} };
  46   }
  47
  48   if (!scalar @links) {
  49     $main::lxdebug->leave_sub();
  50     return;
  51   }
  52
  53   my $myconfig = \%main::myconfig;
  54   my $form     = $main::form;
  55
  56   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
  57
  58   my $query    = qq|INSERT INTO record_links (from_table, from_id, to_table, to_id) VALUES (?, ?, ?, ?)|;
  59   my $sth      = prepare_query($form, $dbh, $query);
  60
  61   foreach my $link (@links) {
  62     next if ('HASH' ne ref $link);
  63     next if (!$link->{from_table} || !$link->{from_id} || !$link->{to_table} || !$link->{to_id});
  64
  65     do_statement($form, $sth, $query, $link->{from_table}, conv_i($link->{from_id}), $link->{to_table}, conv_i($link->{to_id}));
  66   }
  67
  68   $dbh->commit() unless ($params{dbh});
  69
  70   $main::lxdebug->leave_sub();
  71 }
  72
  73 sub get_links {
  74   $main::lxdebug->enter_sub();
  75
  76   my $self     = shift;
  77   my %params   = @_;
  78
  79   Common::check_params(\%params, [ qw(from_table from_id to_table to_id) ]);
  80
  81   my $myconfig   = \%main::myconfig;
  82   my $form       = $main::form;
  83
  84   my $dbh        = $params{dbh} || $form->get_standard_dbh($myconfig);
  85
  86   my @conditions = ();
  87   my @values     = ();
  88
  89   foreach my $col (qw(from_table from_id to_table to_id)) {
  90     next unless ($params{$col});
  91
  92     if ('ARRAY' eq ref $params{$col}) {
  93       push @conditions, "$col IN (" . join(', ', ('?') x scalar(@{ $params{$col} })) . ")";
  94       push @values,     $col =~ m/table/ ? @{ $params{$col} } : map { conv_i($_) } @{ $params{$col} };
  95
  96     } else {
  97       push @conditions, "$col = ?";
  98       push @values,     $col =~ m/table/ ? $params{$col} : conv_i($params{$col});
  99     }
 100   }
 101
 102   my $query = qq|SELECT from_table, from_id, to_table, to_id
 103                  FROM record_links|;
 104
 105   if (scalar @conditions) {
 106     $query .= qq| WHERE | . join(' AND ', map { "($_)" } @conditions);
 107   }
 108
 109   my $links = selectall_hashref_query($form, $dbh, $query, @values);
 110
 111   $main::lxdebug->leave_sub();
 112
 113   return wantarray ? @{ $links } : $links;
 114 }
 115
 116 sub get_links_via {
 117   $main::lxdebug->enter_sub();
 118
 119   use SL::MoreCommon;
 120   use Data::Dumper;
 121
 122   my $self     = shift;
 123   my %params   = @_;
 124
 125   Common::check_params(\%params, [ qw(from_table from_id to_table to_id) ]);
 126   Common::check_params(\%params, "via");
 127
 128   my @hops = ref $params{via} eq 'ARRAY'
 129            ? @{ $params{via} }
 130            :    $params{via};
 131   unshift @hops, +{ table => $params{from_table}, id => $params{from_id} };
 132   push    @hops, +{ table => $params{to_table},   id => $params{to_id} };
 133
 134   my $myconfig   = \%main::myconfig;
 135   my $form       = $main::form;
 136
 137   my $last_hop   = shift @hops;
 138   my @links;
 139   for my $hop (@hops) {
 140
 141     my @temp_links = $self->get_links(
 142       from_table => $last_hop->{table},
 143       from_id    => $last_hop->{id},
 144       to_table   => $hop->{table},
 145       to_id      => $hop->{id},
 146     );
 147
 148     # short circuit if any of these are empty
 149     return wantarray ? () : [] unless scalar @temp_links;
 150
 151     push @links, \@temp_links;
 152     $last_hop  =  $hop;
 153   }
 154
 155   my $result = reduce {
 156     [
 157       grep { $_ }
 158       cross {
 159         if (   $a->{to_table} eq $b->{from_table}
 160             && $a->{to_id}    eq $b->{from_id} ) {
 161           +{ from_table => $a->{from_table},
 162              from_id    => $a->{from_id},
 163              to_table   => $b->{to_table},
 164              to_id      => $b->{to_id} }
 165           }
 166         } @{ $a }, @{ $b }
 167     ]
 168   } @links;
 169
 170   $main::lxdebug->leave_sub();
 171
 172   return wantarray ? @{ $result } : $result;
 173 }
 174
 175 sub delete {
 176   $main::lxdebug->enter_sub();
 177
 178   my $self     = shift;
 179   my %params   = @_;
 180
 181   Common::check_params(\%params, [ qw(from_table from_id to_table to_id) ]);
 182
 183   my $myconfig   = \%main::myconfig;
 184   my $form       = $main::form;
 185
 186   my $dbh        = $params{dbh} || $form->get_standard_dbh($myconfig);
 187
 188   # content
 189   my (@where_tokens, @where_values);
 190
 191   for my $col (qw(from_table from_id to_table to_id)) {
 192     add_token(\@where_tokens, \@where_values, col => $col, val => $params{$col}) if $params{$col};
 193   }
 194
 195   my $where = "WHERE ". join ' AND ', map { "($_)" } @where_tokens if scalar @where_tokens;
 196   my $query = "DELETE FROM record_links $where";
 197
 198   do_query($form, $dbh, $query, @where_values);
 199
 200   $dbh->commit() unless ($params{dbh});
 201
 202   $main::lxdebug->leave_sub();
 203 }
 204
 205 1;
 206
 207 __END__
 208
 209 =head1 NAME
 210
 211 SL::RecordLinks - Verlinkung von Lx-Office Objekten.
 212
 213 =head1 SYNOPSIS
 214
 215   use SL::RecordLinks;
 216
 217   my @links = RecordLinks->get_links(
 218     from_table => 'ar',
 219     from_id    => 2,
 220     to_table   => 'oe',
 221   );
 222   my @links = RecordLinks->get_links_via(
 223     from_table => 'oe',
 224     to_id      => '14',
 225     via        => [
 226       { id => 12 },
 227       { id => 13},
 228     ],
 229   );
 230
 231   RecordLinks->create_links(
 232     mode       => 'ids',
 233     from_table => 'ar',
 234     from_id    => 1,
 235     to_table   => 'oe',
 236     to_ids     => [4, 6, 9],
 237   )
 238   RecordLinks->create_links(@links);
 239
 240   delete
 241
 242 =head1 DESCRIPTION
 243
 244 =over 4
 245
 246 Transitive RecordLinks mit get_links_via.
 247
 248 get_links_via erwartet den zusätzlichen parameter via. via ist ein
 249 hashref mit den jeweils optionalen Einträgen table und id, die sich
 250 genauso verhalten wie die from/to_table/id werte der get_links funktion.
 251
 252 Alternativ kann via auch ein Array dieser Hashes sein:
 253
 254   get_links_via(
 255     from_table => 'oe',
 256     from_id    => 1,
 257     to_table   => 'ar',
 258     via        => {
 259       table      => 'delivery_orders'
 260     },
 261   )
 262
 263   get_links_via(
 264     from_table => 'oe',
 265     to_id      => '14',
 266     via        => [
 267       { id => 12 },
 268       { id => 13},
 269     ],
 270   )
 271
 272 Die Einträge in einem via-Array werden exakt in dieser Reihenfolge
 273 benutzt und sind nicht optional. Da obige Beispiel würde also die
 274 Verknüpfung:
 275
 276   oe:11 -> ar:12 -> is:13 -> do:14
 277
 278 finden, nicht aber:
 279
 280   oe:11 -> ar:13 -> do:14
 281
 282 =back
 283
 284 =cut