SL/DB/Part.pm

   1 package SL::DB::Part;
   2
   3 use strict;
   4
   5 use Carp;
   6 use List::MoreUtils qw(any);
   7 use Rose::DB::Object::Helpers qw(as_tree);
   8
   9 use SL::DBUtils;
  10 use SL::DB::MetaSetup::Part;
  11 use SL::DB::Manager::Part;
  12 use SL::DB::Chart;
  13 use SL::DB::Helper::AttrHTML;
  14 use SL::DB::Helper::TransNumberGenerator;
  15 use SL::DB::Helper::CustomVariables (
  16   module      => 'IC',
  17   cvars_alias => 1,
  18 );
  19 use List::Util qw(sum);
  20
  21 __PACKAGE__->meta->add_relationships(
  22   assemblies                     => {
  23     type         => 'one to many',
  24     class        => 'SL::DB::Assembly',
  25     manager_args => { sort_by => 'position, oid' },
  26     column_map   => { id => 'id' },
  27   },
  28   prices         => {
  29     type         => 'one to many',
  30     class        => 'SL::DB::Price',
  31     column_map   => { id => 'parts_id' },
  32     manager_args => { with_objects => [ 'pricegroup' ] }
  33   },
  34   makemodels     => {
  35     type         => 'one to many',
  36     class        => 'SL::DB::MakeModel',
  37     manager_args => { sort_by => 'sortorder' },
  38     column_map   => { id => 'parts_id' },
  39   },
  40   translations   => {
  41     type         => 'one to many',
  42     class        => 'SL::DB::Translation',
  43     column_map   => { id => 'parts_id' },
  44   },
  45   assortment_items => {
  46     type         => 'one to many',
  47     class        => 'SL::DB::AssortmentItem',
  48     column_map   => { id => 'assortment_id' },
  49   },
  50   history_entries   => {
  51     type            => 'one to many',
  52     class           => 'SL::DB::History',
  53     column_map      => { id => 'trans_id' },
  54     query_args      => [ what_done => 'part' ],
  55     manager_args    => { sort_by => 'itime' },
  56   },
  57   shop_parts     => {
  58     type         => 'one to many',
  59     class        => 'SL::DB::ShopPart',
  60     column_map   => { id => 'part_id' },
  61     manager_args => { with_objects => [ 'shop' ] },
  62   },
  63 );
  64
  65 __PACKAGE__->meta->initialize;
  66
  67 __PACKAGE__->attr_html('notes');
  68
  69 __PACKAGE__->before_save('_before_save_set_partnumber');
  70
  71 sub _before_save_set_partnumber {
  72   my ($self) = @_;
  73
  74   $self->create_trans_number if !$self->partnumber;
  75   return 1;
  76 }
  77
  78 sub items {
  79   my ($self) = @_;
  80
  81   if ( $self->part_type eq 'assembly' ) {
  82     return $self->assemblies;
  83   } elsif ( $self->part_type eq 'assortment' ) {
  84     return $self->assortment_items;
  85   } else {
  86     return undef;
  87   }
  88 }
  89
  90 sub items_checksum {
  91   my ($self) = @_;
  92
  93   # for detecting if the items of an (orphaned) assembly or assortment have
  94   # changed when saving
  95
  96   return join(' ', sort map { $_->part->id } @{$self->items});
  97 };
  98
  99 sub validate {
 100   my ($self) = @_;
 101
 102   my @errors;
 103   push @errors, $::locale->text('The partnumber is missing.')     if $self->id and !$self->partnumber;
 104   push @errors, $::locale->text('The unit is missing.')           unless $self->unit;
 105   push @errors, $::locale->text('The buchungsgruppe is missing.') unless $self->buchungsgruppen_id or $self->buchungsgruppe;
 106
 107   unless ( $self->id ) {
 108     push @errors, $::locale->text('The partnumber already exists.') if SL::DB::Manager::Part->get_all_count(where => [ partnumber => $self->partnumber ]);
 109   };
 110
 111   if ($self->is_assortment && $self->orphaned && scalar @{$self->assortment_items} == 0) {
 112     # when assortment isn't orphaned form doesn't contain any items
 113     push @errors, $::locale->text('The assortment doesn\'t have any items.');
 114   }
 115
 116   if ($self->is_assembly && scalar @{$self->assemblies} == 0) {
 117     push @errors, $::locale->text('The assembly doesn\'t have any items.');
 118   }
 119
 120   return @errors;
 121 }
 122
 123 sub is_type {
 124   my $self = shift;
 125   my $type  = lc(shift || '');
 126   die 'invalid type' unless $type =~ /^(?:part|service|assembly|assortment)$/;
 127
 128   return $self->type eq $type ? 1 : 0;
 129 }
 130
 131 sub is_part       { $_[0]->part_type eq 'part'       }
 132 sub is_assembly   { $_[0]->part_type eq 'assembly'   }
 133 sub is_service    { $_[0]->part_type eq 'service'    }
 134 sub is_assortment { $_[0]->part_type eq 'assortment' }
 135
 136 sub type {
 137   return $_[0]->part_type;
 138   # my ($self, $type) = @_;
 139   # if (@_ > 1) {
 140   #   die 'invalid type' unless $type =~ /^(?:part|service|assembly)$/;
 141   #   $self->assembly(          $type eq 'assembly' ? 1 : 0);
 142   #   $self->inventory_accno_id($type ne 'service'  ? 1 : undef);
 143   # }
 144
 145   # return 'assembly' if $self->assembly;
 146   # return 'part'     if $self->inventory_accno_id;
 147   # return 'service';
 148 }
 149
 150 sub new_part {
 151   my ($class, %params) = @_;
 152   $class->new(%params, part_type => 'part');
 153 }
 154
 155 sub new_assembly {
 156   my ($class, %params) = @_;
 157   $class->new(%params, part_type => 'assembly');
 158 }
 159
 160 sub new_service {
 161   my ($class, %params) = @_;
 162   $class->new(%params, part_type => 'service');
 163 }
 164
 165 sub new_assortment {
 166   my ($class, %params) = @_;
 167   $class->new(%params, part_type => 'assortment');
 168 }
 169
 170 sub last_modification {
 171   my ($self) = @_;
 172   return $self->mtime // $self->itime;
 173 };
 174
 175 sub used_in_record {
 176   my ($self) = @_;
 177   die 'not an accessor' if @_ > 1;
 178
 179   return 1 unless $self->id;
 180
 181   my @relations = qw(
 182     SL::DB::InvoiceItem
 183     SL::DB::OrderItem
 184     SL::DB::DeliveryOrderItem
 185   );
 186
 187   for my $class (@relations) {
 188     eval "require $class";
 189     return 1 if $class->_get_manager_class->get_all_count(query => [ parts_id => $self->id ]);
 190   }
 191   return 0;
 192 }
 193 sub orphaned {
 194   my ($self) = @_;
 195   die 'not an accessor' if @_ > 1;
 196
 197   return 1 unless $self->id;
 198
 199   my @relations = qw(
 200     SL::DB::InvoiceItem
 201     SL::DB::OrderItem
 202     SL::DB::DeliveryOrderItem
 203     SL::DB::Inventory
 204     SL::DB::AssortmentItem
 205   );
 206
 207   for my $class (@relations) {
 208     eval "require $class";
 209     return 0 if $class->_get_manager_class->get_all_count(query => [ parts_id => $self->id ]);
 210   }
 211   return 1;
 212 }
 213
 214 sub get_sellprice_info {
 215   my $self   = shift;
 216   my %params = @_;
 217
 218   confess "Missing part id" unless $self->id;
 219
 220   my $object = $self->load;
 221
 222   return { sellprice       => $object->sellprice,
 223            price_factor_id => $object->price_factor_id };
 224 }
 225
 226 sub get_ordered_qty {
 227   my $self   = shift;
 228   my %result = SL::DB::Manager::Part->get_ordered_qty($self->id);
 229
 230   return $result{ $self->id };
 231 }
 232
 233 sub available_units {
 234   shift->unit_obj->convertible_units;
 235 }
 236
 237 # autogenerated accessor is slightly off...
 238 sub buchungsgruppe {
 239   shift->buchungsgruppen(@_);
 240 }
 241
 242 sub get_taxkey {
 243   my ($self, %params) = @_;
 244
 245   my $date     = $params{date} || DateTime->today_local;
 246   my $is_sales = !!$params{is_sales};
 247   my $taxzone  = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
 248   my $tk_info  = $::request->cache('get_taxkey');
 249
 250   $tk_info->{$self->id}                                      //= {};
 251   $tk_info->{$self->id}->{$taxzone}                          //= { };
 252   my $cache = $tk_info->{$self->id}->{$taxzone}->{$is_sales} //= { };
 253
 254   if (!exists $cache->{$date}) {
 255     $cache->{$date} =
 256       $self->get_chart(type => $is_sales ? 'income' : 'expense', taxzone => $taxzone)
 257       ->get_active_taxkey($date);
 258   }
 259
 260   return $cache->{$date};
 261 }
 262
 263 sub get_chart {
 264   my ($self, %params) = @_;
 265
 266   my $type    = (any { $_ eq $params{type} } qw(income expense inventory)) ? $params{type} : croak("Invalid 'type' parameter '$params{type}'");
 267   my $taxzone = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
 268
 269   my $charts     = $::request->cache('get_chart_id/by_part_id_and_taxzone')->{$self->id} //= {};
 270   my $all_charts = $::request->cache('get_chart_id/by_id');
 271
 272   $charts->{$taxzone} ||= { };
 273
 274   if (!exists $charts->{$taxzone}->{$type}) {
 275     require SL::DB::Buchungsgruppe;
 276     my $bugru    = SL::DB::Buchungsgruppe->load_cached($self->buchungsgruppen_id);
 277     my $chart_id = ($type eq 'inventory') ? ($self->is_part ? $bugru->inventory_accno_id : undef)
 278                  :                          $bugru->call_sub("${type}_accno_id", $taxzone);
 279
 280     if ($chart_id) {
 281       my $chart                    = $all_charts->{$chart_id} // SL::DB::Chart->load_cached($chart_id)->load;
 282       $all_charts->{$chart_id}     = $chart;
 283       $charts->{$taxzone}->{$type} = $chart;
 284     }
 285   }
 286
 287   return $charts->{$taxzone}->{$type};
 288 }
 289
 290 sub get_stock {
 291   my ($self, %params) = @_;
 292
 293   return undef unless $self->id;
 294
 295   my $query = 'SELECT SUM(qty) FROM inventory WHERE parts_id = ?';
 296   my @values = ($self->id);
 297
 298   if ( $params{bin_id} ) {
 299     $query .= ' AND bin_id = ?';
 300     push(@values, $params{bin_id});
 301   }
 302
 303   if ( $params{warehouse_id} ) {
 304     $query .= ' AND warehouse_id = ?';
 305     push(@values, $params{warehouse_id});
 306   }
 307
 308   if ( $params{shippingdate} ) {
 309     die unless ref($params{shippingdate}) eq 'DateTime';
 310     $query .= ' AND shippingdate <= ?';
 311     push(@values, $params{shippingdate});
 312   }
 313
 314   my ($stock) = selectrow_query($::form, $self->db->dbh, $query, @values);
 315
 316   return $stock || 0; # never return undef
 317 };
 318
 319
 320 # this is designed to ignore chargenumbers, expiration dates and just give a list of how much <-> where
 321 sub get_simple_stock {
 322   my ($self, %params) = @_;
 323
 324   return [] unless $self->id;
 325
 326   my $query = <<'';
 327     SELECT sum(qty), warehouse_id, bin_id FROM inventory WHERE parts_id = ?
 328     GROUP BY warehouse_id, bin_id
 329
 330   my $stock_info = selectall_hashref_query($::form, $::form->get_standard_dbh, $query, $self->id);
 331   [ map { bless $_, 'SL::DB::Part::SimpleStock'} @$stock_info ];
 332 }
 333 # helper class to have bin/warehouse accessors in stock result
 334 { package SL::DB::Part::SimpleStock;
 335   sub warehouse { require SL::DB::Warehouse; SL::DB::Manager::Warehouse->find_by_or_create(id => $_[0]->{warehouse_id}) }
 336   sub bin       { require SL::DB::Bin;       SL::DB::Manager::Bin      ->find_by_or_create(id => $_[0]->{bin_id}) }
 337 }
 338
 339 sub displayable_name {
 340   join ' ', grep $_, map $_[0]->$_, qw(partnumber description);
 341 }
 342
 343 sub clone_and_reset_deep {
 344   my ($self) = @_;
 345
 346   my $clone = $self->clone_and_reset; # resets id and partnumber (primary key and unique constraint)
 347   $clone->makemodels(   map { $_->clone_and_reset } @{$self->makemodels}   ) if @{$self->makemodels};
 348   $clone->translations( map { $_->clone_and_reset } @{$self->translations} ) if @{$self->translations};
 349
 350   if ( $self->is_assortment ) {
 351     # use clone rather than reset_and_clone because the unique constraint would also remove parts_id
 352     $clone->assortment_items( map { $_->clone } @{$self->assortment_items} );
 353     $_->assortment_id(undef) foreach @{ $clone->assortment_items }
 354   };
 355
 356   if ( $self->is_assembly ) {
 357     $clone->assemblies( map { $_->clone_and_reset } @{$self->assemblies});
 358   };
 359
 360   if ( $self->prices ) {
 361     $clone->prices( map { $_->clone } @{$self->prices}); # pricegroup_id gets reset here because it is part of a unique contraint
 362     if ( $clone->prices ) {
 363       foreach my $price ( @{$clone->prices} ) {
 364         $price->id(undef);
 365         $price->parts_id(undef);
 366       };
 367     };
 368   };
 369
 370   return $clone;
 371 }
 372
 373 sub item_diffs {
 374   my ($self, $comparison_part) = @_;
 375
 376   die "item_diffs needs a part object" unless ref($comparison_part) eq 'SL::DB::Part';
 377   die "part and comparison_part need to be of the same part_type" unless
 378         ( $self->part_type eq 'assembly' or $self->part_type eq 'assortment' )
 379     and ( $comparison_part->part_type eq 'assembly' or $comparison_part->part_type eq 'assortment' )
 380     and $self->part_type eq $comparison_part->part_type;
 381
 382   # return [], [] if $self->items_checksum eq $comparison_part->items_checksum;
 383   my @self_part_ids       = map { $_->parts_id } $self->items;
 384   my @comparison_part_ids = map { $_->parts_id } $comparison_part->items;
 385
 386   my %orig       = map{ $_ => 1 } @self_part_ids;
 387   my %comparison = map{ $_ => 1 } @comparison_part_ids;
 388   my (@additions, @removals);
 389   @additions = grep { !exists( $orig{$_}       ) } @comparison_part_ids if @comparison_part_ids;
 390   @removals  = grep { !exists( $comparison{$_} ) } @self_part_ids       if @self_part_ids;
 391
 392   return \@additions, \@removals;
 393 };
 394
 395 sub items_sellprice_sum {
 396   my ($self, %params) = @_;
 397
 398   return unless $self->is_assortment or $self->is_assembly;
 399   return unless $self->items;
 400
 401   if ($self->is_assembly) {
 402     return sum map { $_->linetotal_sellprice          } @{$self->items};
 403   } else {
 404     return sum map { $_->linetotal_sellprice(%params) } grep { $_->charge } @{$self->items};
 405   }
 406 }
 407
 408 sub items_lastcost_sum {
 409   my ($self) = @_;
 410
 411   return unless $self->is_assortment or $self->is_assembly;
 412   return unless $self->items;
 413   sum map { $_->linetotal_lastcost } @{$self->items};
 414 };
 415
 416 1;
 417
 418 __END__
 419
 420 =pod
 421
 422 =encoding utf-8
 423
 424 =head1 NAME
 425
 426 SL::DB::Part: Model for the 'parts' table
 427
 428 =head1 SYNOPSIS
 429
 430 This is a standard Rose::DB::Object based model and can be used as one.
 431
 432 =head1 TYPES
 433
 434 Although the base class is called C<Part> we usually talk about C<Articles> if
 435 we mean instances of this class. This is because articles come in three
 436 flavours called:
 437
 438 =over 4
 439
 440 =item Part     - a single part
 441
 442 =item Service  - a part without onhand, and without inventory accounting
 443
 444 =item Assembly - a collection of both parts and services
 445
 446 =item Assortment - a collection of items (parts or assemblies)
 447
 448 =back
 449
 450 These types are sadly represented by data inside the class and cannot be
 451 migrated into a flag. To work around this, each C<Part> object knows what type
 452 it currently is. Since the type is data driven, there ist no explicit setting
 453 method for it, but you can construct them explicitly with C<new_part>,
 454 C<new_service>, C<new_assembly> and C<new_assortment>. A Buchungsgruppe should be supplied in this
 455 case, but it will use the default Buchungsgruppe if you don't.
 456
 457 Matching these there are assorted helper methods dealing with types,
 458 e.g.  L</new_part>, L</new_service>, L</new_assembly>, L</type>,
 459 L</is_type> and others.
 460
 461 =head1 FUNCTIONS
 462
 463 =over 4
 464
 465 =item C<new_part %PARAMS>
 466
 467 =item C<new_service %PARAMS>
 468
 469 =item C<new_assembly %PARAMS>
 470
 471 Will set the appropriate data fields so that the resulting instance will be of
 472 the requested type. Since accounting targets are part of the distinction,
 473 providing a C<Buchungsgruppe> is recommended. If none is given the constructor
 474 will load a default one and set the accounting targets from it.
 475
 476 =item C<type>
 477
 478 Returns the type as a string. Can be one of C<part>, C<service>, C<assembly>.
 479
 480 =item C<is_type $TYPE>
 481
 482 Tests if the current object is a part, a service or an
 483 assembly. C<$type> must be one of the words 'part', 'service' or
 484 'assembly' (their plurals are ok, too).
 485
 486 Returns 1 if the requested type matches, 0 if it doesn't and
 487 C<confess>es if an unknown C<$type> parameter is encountered.
 488
 489 =item C<is_part>
 490
 491 =item C<is_service>
 492
 493 =item C<is_assembly>
 494
 495 Shorthand for C<is_type('part')> etc.
 496
 497 =item C<get_sellprice_info %params>
 498
 499 Retrieves the C<sellprice> and C<price_factor_id> for a part under
 500 different conditions and returns a hash reference with those two keys.
 501
 502 If C<%params> contains a key C<project_id> then a project price list
 503 will be consulted if one exists for that project. In this case the
 504 parameter C<country_id> is evaluated as well: if a price list entry
 505 has been created for this country then it will be used. Otherwise an
 506 entry without a country set will be used.
 507
 508 If none of the above conditions is met then the information from
 509 C<$self> is used.
 510
 511 =item C<get_ordered_qty %params>
 512
 513 Retrieves the quantity that has been ordered from a vendor but that
 514 has not been delivered yet. Only open purchase orders are considered.
 515
 516 =item C<get_taxkey %params>
 517
 518 Retrieves and returns a taxkey object valid for the given date
 519 C<$params{date}> and tax zone C<$params{taxzone}>
 520 (C<$params{taxzone_id}> is also recognized). The date defaults to the
 521 current date if undefined.
 522
 523 This function looks up the income (for trueish values of
 524 C<$params{is_sales}>) or expense (for falsish values of
 525 C<$params{is_sales}>) account for the current part. It uses the part's
 526 associated buchungsgruppe and uses the fields belonging to the tax
 527 zone given by C<$params{taxzone}>.
 528
 529 The information retrieved by the function is cached.
 530
 531 =item C<get_chart %params>
 532
 533 Retrieves and returns a chart object valid for the given type
 534 C<$params{type}> and tax zone C<$params{taxzone}>
 535 (C<$params{taxzone_id}> is also recognized). The type must be one of
 536 the three key words C<income>, C<expense> and C<inventory>.
 537
 538 This function uses the part's associated buchungsgruppe and uses the
 539 fields belonging to the tax zone given by C<$params{taxzone}>.
 540
 541 The information retrieved by the function is cached.
 542
 543 =item C<used_in_record>
 544
 545 Checks if this article has been used in orders, invoices or delivery orders.
 546
 547 =item C<orphaned>
 548
 549 Checks if this article is used in orders, invoices, delivery orders or
 550 assemblies.
 551
 552 =item C<buchungsgruppe BUCHUNGSGRUPPE>
 553
 554 Used to set the accounting information from a L<SL:DB::Buchungsgruppe> object.
 555 Please note, that this is a write only accessor, the original Buchungsgruppe can
 556 not be retrieved from an article once set.
 557
 558 =item C<items_lastcost_sum>
 559
 560 Non-recursive lastcost sum of all the items in an assembly or assortment.
 561
 562 =item C<get_stock %params>
 563
 564 Fetches stock qty in the default unit for a part.
 565
 566 bin_id and warehouse_id may be passed as params. If only a bin_id is passed,
 567 the stock qty for that bin is returned. If only a warehouse_id is passed, the
 568 stock qty for all bins in that warehouse is returned.  If a shippingdate is
 569 passed the stock qty for that date is returned.
 570
 571 Examples:
 572  my $qty = $part->get_stock(bin_id => 52);
 573
 574  $part->get_stock(shippingdate => DateTime->today->add(days => -5));
 575
 576 =back
 577
 578 =head1 AUTHORS
 579
 580 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 581 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 582
 583 =cut