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   },
  33   makemodels     => {
  34     type         => 'one to many',
  35     class        => 'SL::DB::MakeModel',
  36     manager_args => { sort_by => 'sortorder' },
  37     column_map   => { id => 'parts_id' },
  38   },
  39   translations   => {
  40     type         => 'one to many',
  41     class        => 'SL::DB::Translation',
  42     column_map   => { id => 'parts_id' },
  43   },
  44   assortment_items => {
  45     type         => 'one to many',
  46     class        => 'SL::DB::AssortmentItem',
  47     column_map   => { id => 'assortment_id' },
  48   },
  49   history_entries   => {
  50     type            => 'one to many',
  51     class           => 'SL::DB::History',
  52     column_map      => { id => 'trans_id' },
  53     query_args      => [ what_done => 'part' ],
  54     manager_args    => { sort_by => 'itime' },
  55   },
  56 );
  57
  58 __PACKAGE__->meta->initialize;
  59
  60 __PACKAGE__->attr_html('notes');
  61
  62 __PACKAGE__->before_save('_before_save_set_partnumber');
  63
  64 sub _before_save_set_partnumber {
  65   my ($self) = @_;
  66
  67   $self->create_trans_number if !$self->partnumber;
  68   return 1;
  69 }
  70
  71 sub items {
  72   my ($self) = @_;
  73
  74   if ( $self->part_type eq 'assembly' ) {
  75     return $self->assemblies;
  76   } elsif ( $self->part_type eq 'assortment' ) {
  77     return $self->assortment_items;
  78   } else {
  79     return undef;
  80   }
  81 }
  82
  83 sub items_checksum {
  84   my ($self) = @_;
  85
  86   # for detecting if the items of an (orphaned) assembly or assortment have
  87   # changed when saving
  88
  89   return join(' ', sort map { $_->part->id } @{$self->items});
  90 };
  91
  92 sub validate {
  93   my ($self) = @_;
  94
  95   my @errors;
  96   push @errors, $::locale->text('The partnumber is missing.')     if $self->id and !$self->partnumber;
  97   push @errors, $::locale->text('The unit is missing.')           unless $self->unit;
  98   push @errors, $::locale->text('The buchungsgruppe is missing.') unless $self->buchungsgruppen_id or $self->buchungsgruppe;
  99
 100   unless ( $self->id ) {
 101     push @errors, $::locale->text('The partnumber already exists.') if SL::DB::Manager::Part->get_all_count(where => [ partnumber => $self->partnumber ]);
 102   };
 103
 104   if ($self->is_assortment && $self->orphaned && scalar @{$self->assortment_items} == 0) {
 105     # when assortment isn't orphaned form doesn't contain any items
 106     push @errors, $::locale->text('The assortment doesn\'t have any items.');
 107   }
 108
 109   if ($self->is_assembly && scalar @{$self->assemblies} == 0) {
 110     push @errors, $::locale->text('The assembly doesn\'t have any items.');
 111   }
 112
 113   return @errors;
 114 }
 115
 116 sub is_type {
 117   my $self = shift;
 118   my $type  = lc(shift || '');
 119   die 'invalid type' unless $type =~ /^(?:part|service|assembly|assortment)$/;
 120
 121   return $self->type eq $type ? 1 : 0;
 122 }
 123
 124 sub is_part       { $_[0]->part_type eq 'part'       }
 125 sub is_assembly   { $_[0]->part_type eq 'assembly'   }
 126 sub is_service    { $_[0]->part_type eq 'service'    }
 127 sub is_assortment { $_[0]->part_type eq 'assortment' }
 128
 129 sub type {
 130   return $_[0]->part_type;
 131   # my ($self, $type) = @_;
 132   # if (@_ > 1) {
 133   #   die 'invalid type' unless $type =~ /^(?:part|service|assembly)$/;
 134   #   $self->assembly(          $type eq 'assembly' ? 1 : 0);
 135   #   $self->inventory_accno_id($type ne 'service'  ? 1 : undef);
 136   # }
 137
 138   # return 'assembly' if $self->assembly;
 139   # return 'part'     if $self->inventory_accno_id;
 140   # return 'service';
 141 }
 142
 143 sub new_part {
 144   my ($class, %params) = @_;
 145   $class->new(%params, part_type => 'part');
 146 }
 147
 148 sub new_assembly {
 149   my ($class, %params) = @_;
 150   $class->new(%params, part_type => 'assembly');
 151 }
 152
 153 sub new_service {
 154   my ($class, %params) = @_;
 155   $class->new(%params, part_type => 'service');
 156 }
 157
 158 sub new_assortment {
 159   my ($class, %params) = @_;
 160   $class->new(%params, part_type => 'assortment');
 161 }
 162
 163 sub last_modification {
 164   my ($self) = @_;
 165   return $self->mtime // $self->itime;
 166 };
 167
 168 sub used_in_record {
 169   my ($self) = @_;
 170   die 'not an accessor' if @_ > 1;
 171
 172   return 1 unless $self->id;
 173
 174   my @relations = qw(
 175     SL::DB::InvoiceItem
 176     SL::DB::OrderItem
 177     SL::DB::DeliveryOrderItem
 178   );
 179
 180   for my $class (@relations) {
 181     eval "require $class";
 182     return 1 if $class->_get_manager_class->get_all_count(query => [ parts_id => $self->id ]);
 183   }
 184   return 0;
 185 }
 186 sub orphaned {
 187   my ($self) = @_;
 188   die 'not an accessor' if @_ > 1;
 189
 190   return 1 unless $self->id;
 191
 192   my @relations = qw(
 193     SL::DB::InvoiceItem
 194     SL::DB::OrderItem
 195     SL::DB::DeliveryOrderItem
 196     SL::DB::Inventory
 197     SL::DB::AssortmentItem
 198   );
 199
 200   for my $class (@relations) {
 201     eval "require $class";
 202     return 0 if $class->_get_manager_class->get_all_count(query => [ parts_id => $self->id ]);
 203   }
 204   return 1;
 205 }
 206
 207 sub get_sellprice_info {
 208   my $self   = shift;
 209   my %params = @_;
 210
 211   confess "Missing part id" unless $self->id;
 212
 213   my $object = $self->load;
 214
 215   return { sellprice       => $object->sellprice,
 216            price_factor_id => $object->price_factor_id };
 217 }
 218
 219 sub get_ordered_qty {
 220   my $self   = shift;
 221   my %result = SL::DB::Manager::Part->get_ordered_qty($self->id);
 222
 223   return $result{ $self->id };
 224 }
 225
 226 sub available_units {
 227   shift->unit_obj->convertible_units;
 228 }
 229
 230 # autogenerated accessor is slightly off...
 231 sub buchungsgruppe {
 232   shift->buchungsgruppen(@_);
 233 }
 234
 235 sub get_taxkey {
 236   my ($self, %params) = @_;
 237
 238   my $date     = $params{date} || DateTime->today_local;
 239   my $is_sales = !!$params{is_sales};
 240   my $taxzone  = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
 241   my $tk_info  = $::request->cache('get_taxkey');
 242
 243   $tk_info->{$self->id}                                      //= {};
 244   $tk_info->{$self->id}->{$taxzone}                          //= { };
 245   my $cache = $tk_info->{$self->id}->{$taxzone}->{$is_sales} //= { };
 246
 247   if (!exists $cache->{$date}) {
 248     $cache->{$date} =
 249       $self->get_chart(type => $is_sales ? 'income' : 'expense', taxzone => $taxzone)
 250       ->get_active_taxkey($date);
 251   }
 252
 253   return $cache->{$date};
 254 }
 255
 256 sub get_chart {
 257   my ($self, %params) = @_;
 258
 259   my $type    = (any { $_ eq $params{type} } qw(income expense inventory)) ? $params{type} : croak("Invalid 'type' parameter '$params{type}'");
 260   my $taxzone = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
 261
 262   my $charts     = $::request->cache('get_chart_id/by_part_id_and_taxzone')->{$self->id} //= {};
 263   my $all_charts = $::request->cache('get_chart_id/by_id');
 264
 265   $charts->{$taxzone} ||= { };
 266
 267   if (!exists $charts->{$taxzone}->{$type}) {
 268     require SL::DB::Buchungsgruppe;
 269     my $bugru    = SL::DB::Buchungsgruppe->load_cached($self->buchungsgruppen_id);
 270     my $chart_id = ($type eq 'inventory') ? ($self->is_part ? $bugru->inventory_accno_id : undef)
 271                  :                          $bugru->call_sub("${type}_accno_id", $taxzone);
 272
 273     if ($chart_id) {
 274       my $chart                    = $all_charts->{$chart_id} // SL::DB::Chart->load_cached($chart_id)->load;
 275       $all_charts->{$chart_id}     = $chart;
 276       $charts->{$taxzone}->{$type} = $chart;
 277     }
 278   }
 279
 280   return $charts->{$taxzone}->{$type};
 281 }
 282
 283 sub get_stock {
 284   my ($self, %params) = @_;
 285
 286   return undef unless $self->id;
 287
 288   my $query = 'SELECT SUM(qty) FROM inventory WHERE parts_id = ?';
 289   my @values = ($self->id);
 290
 291   if ( $params{bin_id} ) {
 292     $query .= ' AND bin_id = ?';
 293     push(@values, $params{bin_id});
 294   }
 295
 296   if ( $params{warehouse_id} ) {
 297     $query .= ' AND warehouse_id = ?';
 298     push(@values, $params{warehouse_id});
 299   }
 300
 301   if ( $params{shippingdate} ) {
 302     die unless ref($params{shippingdate}) eq 'DateTime';
 303     $query .= ' AND shippingdate <= ?';
 304     push(@values, $params{shippingdate});
 305   }
 306
 307   my ($stock) = selectrow_query($::form, $self->db->dbh, $query, @values);
 308
 309   return $stock || 0; # never return undef
 310 };
 311
 312
 313 # this is designed to ignore chargenumbers, expiration dates and just give a list of how much <-> where
 314 sub get_simple_stock {
 315   my ($self, %params) = @_;
 316
 317   return [] unless $self->id;
 318
 319   my $query = <<'';
 320     SELECT sum(qty), warehouse_id, bin_id FROM inventory WHERE parts_id = ?
 321     GROUP BY warehouse_id, bin_id
 322
 323   my $stock_info = selectall_hashref_query($::form, $::form->get_standard_dbh, $query, $self->id);
 324   [ map { bless $_, 'SL::DB::Part::SimpleStock'} @$stock_info ];
 325 }
 326 # helper class to have bin/warehouse accessors in stock result
 327 { package SL::DB::Part::SimpleStock;
 328   sub warehouse { require SL::DB::Warehouse; SL::DB::Manager::Warehouse->find_by_or_create(id => $_[0]->{warehouse_id}) }
 329   sub bin       { require SL::DB::Bin;       SL::DB::Manager::Bin      ->find_by_or_create(id => $_[0]->{bin_id}) }
 330 }
 331
 332 sub displayable_name {
 333   join ' ', grep $_, map $_[0]->$_, qw(partnumber description);
 334 }
 335
 336 sub clone_and_reset_deep {
 337   my ($self) = @_;
 338
 339   my $clone = $self->clone_and_reset; # resets id and partnumber (primary key and unique constraint)
 340   $clone->makemodels(   map { $_->clone_and_reset } @{$self->makemodels}   ) if @{$self->makemodels};
 341   $clone->translations( map { $_->clone_and_reset } @{$self->translations} ) if @{$self->translations};
 342
 343   if ( $self->is_assortment ) {
 344     # use clone rather than reset_and_clone because the unique constraint would also remove parts_id
 345     $clone->assortment_items( map { $_->clone } @{$self->assortment_items} );
 346     $_->assortment_id(undef) foreach @{ $clone->assortment_items }
 347   };
 348
 349   if ( $self->is_assembly ) {
 350     $clone->assemblies( map { $_->clone_and_reset } @{$self->assemblies});
 351   };
 352
 353   if ( $self->prices ) {
 354     $clone->prices( map { $_->clone } @{$self->prices}); # pricegroup_id gets reset here because it is part of a unique contraint
 355     if ( $clone->prices ) {
 356       foreach my $price ( @{$clone->prices} ) {
 357         $price->id(undef);
 358         $price->parts_id(undef);
 359       };
 360     };
 361   };
 362
 363   return $clone;
 364 }
 365
 366 sub item_diffs {
 367   my ($self, $comparison_part) = @_;
 368
 369   die "item_diffs needs a part object" unless ref($comparison_part) eq 'SL::DB::Part';
 370   die "part and comparison_part need to be of the same part_type" unless
 371         ( $self->part_type eq 'assembly' or $self->part_type eq 'assortment' )
 372     and ( $comparison_part->part_type eq 'assembly' or $comparison_part->part_type eq 'assortment' )
 373     and $self->part_type eq $comparison_part->part_type;
 374
 375   # return [], [] if $self->items_checksum eq $comparison_part->items_checksum;
 376   my @self_part_ids       = map { $_->parts_id } $self->items;
 377   my @comparison_part_ids = map { $_->parts_id } $comparison_part->items;
 378
 379   my %orig       = map{ $_ => 1 } @self_part_ids;
 380   my %comparison = map{ $_ => 1 } @comparison_part_ids;
 381   my (@additions, @removals);
 382   @additions = grep { !exists( $orig{$_}       ) } @comparison_part_ids if @comparison_part_ids;
 383   @removals  = grep { !exists( $comparison{$_} ) } @self_part_ids       if @self_part_ids;
 384
 385   return \@additions, \@removals;
 386 };
 387
 388 sub items_sellprice_sum {
 389   my ($self, %params) = @_;
 390
 391   return unless $self->is_assortment or $self->is_assembly;
 392   return unless $self->items;
 393
 394   if ($self->is_assembly) {
 395     return sum map { $_->linetotal_sellprice          } @{$self->items};
 396   } else {
 397     return sum map { $_->linetotal_sellprice(%params) } grep { $_->charge } @{$self->items};
 398   }
 399 }
 400
 401 sub items_lastcost_sum {
 402   my ($self) = @_;
 403
 404   return unless $self->is_assortment or $self->is_assembly;
 405   return unless $self->items;
 406   sum map { $_->linetotal_lastcost } @{$self->items};
 407 };
 408
 409 sub assortment_lastcost_sum {
 410   my ($self) = @_;
 411
 412   return unless $self->is_assortment;
 413   sum map { $_->linetotal_lastcost } @{$self->assortment_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<assembly_sellprice_sum>
 559
 560 Non-recursive sellprice sum of all the assembly item sellprices.
 561
 562 =item C<assortment_sellprice_sum>
 563
 564 Non-recursive sellprice sum of all the assortment item sellprices.
 565
 566 =item C<assembly_lastcost_sum>
 567
 568 Non-recursive lastcost sum of all the assembly item lastcosts.
 569
 570 =item C<assortment_lastcost_sum>
 571
 572 Non-recursive lastcost sum of all the assortment item lastcosts.
 573
 574 =item C<get_stock %params>
 575
 576 Fetches stock qty in the default unit for a part.
 577
 578 bin_id and warehouse_id may be passed as params. If only a bin_id is passed,
 579 the stock qty for that bin is returned. If only a warehouse_id is passed, the
 580 stock qty for all bins in that warehouse is returned.  If a shippingdate is
 581 passed the stock qty for that date is returned.
 582
 583 Examples:
 584  my $qty = $part->get_stock(bin_id => 52);
 585
 586  $part->get_stock(shippingdate => DateTime->today->add(days => -5));
 587
 588 =back
 589
 590 =head1 AUTHORS
 591
 592 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 593 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 594
 595 =cut