SL/RecordLinks.pm

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