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 orphaned {
 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     SL::DB::Inventory
 179     SL::DB::AssortmentItem
 180   );
 181
 182   for my $class (@relations) {
 183     eval "require $class";
 184     return 0 if $class->_get_manager_class->get_all_count(query => [ parts_id => $self->id ]);
 185   }
 186   return 1;
 187 }
 188
 189 sub get_sellprice_info {
 190   my $self   = shift;
 191   my %params = @_;
 192
 193   confess "Missing part id" unless $self->id;
 194
 195   my $object = $self->load;
 196
 197   return { sellprice       => $object->sellprice,
 198            price_factor_id => $object->price_factor_id };
 199 }
 200
 201 sub get_ordered_qty {
 202   my $self   = shift;
 203   my %result = SL::DB::Manager::Part->get_ordered_qty($self->id);
 204
 205   return $result{ $self->id };
 206 }
 207
 208 sub available_units {
 209   shift->unit_obj->convertible_units;
 210 }
 211
 212 # autogenerated accessor is slightly off...
 213 sub buchungsgruppe {
 214   shift->buchungsgruppen(@_);
 215 }
 216
 217 sub get_taxkey {
 218   my ($self, %params) = @_;
 219
 220   my $date     = $params{date} || DateTime->today_local;
 221   my $is_sales = !!$params{is_sales};
 222   my $taxzone  = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
 223   my $tk_info  = $::request->cache('get_taxkey');
 224
 225   $tk_info->{$self->id}                                      //= {};
 226   $tk_info->{$self->id}->{$taxzone}                          //= { };
 227   my $cache = $tk_info->{$self->id}->{$taxzone}->{$is_sales} //= { };
 228
 229   if (!exists $cache->{$date}) {
 230     $cache->{$date} =
 231       $self->get_chart(type => $is_sales ? 'income' : 'expense', taxzone => $taxzone)
 232       ->get_active_taxkey($date);
 233   }
 234
 235   return $cache->{$date};
 236 }
 237
 238 sub get_chart {
 239   my ($self, %params) = @_;
 240
 241   my $type    = (any { $_ eq $params{type} } qw(income expense inventory)) ? $params{type} : croak("Invalid 'type' parameter '$params{type}'");
 242   my $taxzone = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
 243
 244   my $charts     = $::request->cache('get_chart_id/by_part_id_and_taxzone')->{$self->id} //= {};
 245   my $all_charts = $::request->cache('get_chart_id/by_id');
 246
 247   $charts->{$taxzone} ||= { };
 248
 249   if (!exists $charts->{$taxzone}->{$type}) {
 250     require SL::DB::Buchungsgruppe;
 251     my $bugru    = SL::DB::Buchungsgruppe->load_cached($self->buchungsgruppen_id);
 252     my $chart_id = ($type eq 'inventory') ? ($self->is_part ? $bugru->inventory_accno_id : undef)
 253                  :                          $bugru->call_sub("${type}_accno_id", $taxzone);
 254
 255     if ($chart_id) {
 256       my $chart                    = $all_charts->{$chart_id} // SL::DB::Chart->load_cached($chart_id)->load;
 257       $all_charts->{$chart_id}     = $chart;
 258       $charts->{$taxzone}->{$type} = $chart;
 259     }
 260   }
 261
 262   return $charts->{$taxzone}->{$type};
 263 }
 264
 265 sub get_stock {
 266   my ($self, %params) = @_;
 267
 268   return undef unless $self->id;
 269
 270   my $query = 'SELECT SUM(qty) FROM inventory WHERE parts_id = ?';
 271   my @values = ($self->id);
 272
 273   if ( $params{bin_id} ) {
 274     $query .= ' AND bin_id = ?';
 275     push(@values, $params{bin_id});
 276   }
 277
 278   if ( $params{warehouse_id} ) {
 279     $query .= ' AND warehouse_id = ?';
 280     push(@values, $params{warehouse_id});
 281   }
 282
 283   if ( $params{shippingdate} ) {
 284     die unless ref($params{shippingdate}) eq 'DateTime';
 285     $query .= ' AND shippingdate <= ?';
 286     push(@values, $params{shippingdate});
 287   }
 288
 289   my ($stock) = selectrow_query($::form, $self->db->dbh, $query, @values);
 290
 291   return $stock || 0; # never return undef
 292 };
 293
 294
 295 # this is designed to ignore chargenumbers, expiration dates and just give a list of how much <-> where
 296 sub get_simple_stock {
 297   my ($self, %params) = @_;
 298
 299   return [] unless $self->id;
 300
 301   my $query = <<'';
 302     SELECT sum(qty), warehouse_id, bin_id FROM inventory WHERE parts_id = ?
 303     GROUP BY warehouse_id, bin_id
 304
 305   my $stock_info = selectall_hashref_query($::form, $::form->get_standard_dbh, $query, $self->id);
 306   [ map { bless $_, 'SL::DB::Part::SimpleStock'} @$stock_info ];
 307 }
 308 # helper class to have bin/warehouse accessors in stock result
 309 { package SL::DB::Part::SimpleStock;
 310   sub warehouse { require SL::DB::Warehouse; SL::DB::Manager::Warehouse->find_by_or_create(id => $_[0]->{warehouse_id}) }
 311   sub bin       { require SL::DB::Bin;       SL::DB::Manager::Bin      ->find_by_or_create(id => $_[0]->{bin_id}) }
 312 }
 313
 314 sub displayable_name {
 315   join ' ', grep $_, map $_[0]->$_, qw(partnumber description);
 316 }
 317
 318 sub clone_and_reset_deep {
 319   my ($self) = @_;
 320
 321   my $clone = $self->clone_and_reset; # resets id and partnumber (primary key and unique constraint)
 322   $clone->makemodels(   map { $_->clone_and_reset } @{$self->makemodels}   ) if @{$self->makemodels};
 323   $clone->translations( map { $_->clone_and_reset } @{$self->translations} ) if @{$self->translations};
 324
 325   if ( $self->is_assortment ) {
 326     # use clone rather than reset_and_clone because the unique constraint would also remove parts_id
 327     $clone->assortment_items( map { $_->clone } @{$self->assortment_items} );
 328     $_->assortment_id(undef) foreach @{ $clone->assortment_items }
 329   };
 330
 331   if ( $self->is_assembly ) {
 332     $clone->assemblies( map { $_->clone_and_reset } @{$self->assemblies});
 333   };
 334
 335   if ( $self->prices ) {
 336     $clone->prices( map { $_->clone } @{$self->prices}); # pricegroup_id gets reset here because it is part of a unique contraint
 337     if ( $clone->prices ) {
 338       foreach my $price ( @{$clone->prices} ) {
 339         $price->id(undef);
 340         $price->parts_id(undef);
 341       };
 342     };
 343   };
 344
 345   return $clone;
 346 }
 347
 348 sub item_diffs {
 349   my ($self, $comparison_part) = @_;
 350
 351   die "item_diffs needs a part object" unless ref($comparison_part) eq 'SL::DB::Part';
 352   die "part and comparison_part need to be of the same part_type" unless
 353         ( $self->part_type eq 'assembly' or $self->part_type eq 'assortment' )
 354     and ( $comparison_part->part_type eq 'assembly' or $comparison_part->part_type eq 'assortment' )
 355     and $self->part_type eq $comparison_part->part_type;
 356
 357   # return [], [] if $self->items_checksum eq $comparison_part->items_checksum;
 358   my @self_part_ids       = map { $_->parts_id } $self->items;
 359   my @comparison_part_ids = map { $_->parts_id } $comparison_part->items;
 360
 361   my %orig       = map{ $_ => 1 } @self_part_ids;
 362   my %comparison = map{ $_ => 1 } @comparison_part_ids;
 363   my (@additions, @removals);
 364   @additions = grep { !exists( $orig{$_}       ) } @comparison_part_ids if @comparison_part_ids;
 365   @removals  = grep { !exists( $comparison{$_} ) } @self_part_ids       if @self_part_ids;
 366
 367   return \@additions, \@removals;
 368 };
 369
 370 sub items_sellprice_sum {
 371   my ($self, %params) = @_;
 372
 373   return unless $self->is_assortment or $self->is_assembly;
 374   return unless $self->items;
 375
 376   if ($self->is_assembly) {
 377     return sum map { $_->linetotal_sellprice          } @{$self->items};
 378   } else {
 379     return sum map { $_->linetotal_sellprice(%params) } grep { $_->charge } @{$self->items};
 380   }
 381 }
 382
 383 sub items_lastcost_sum {
 384   my ($self) = @_;
 385
 386   return unless $self->is_assortment or $self->is_assembly;
 387   return unless $self->items;
 388   sum map { $_->linetotal_lastcost } @{$self->items};
 389 };
 390
 391 sub assortment_lastcost_sum {
 392   my ($self) = @_;
 393
 394   return unless $self->is_assortment;
 395   sum map { $_->linetotal_lastcost } @{$self->assortment_items};
 396 };
 397
 398 1;
 399
 400 __END__
 401
 402 =pod
 403
 404 =encoding utf-8
 405
 406 =head1 NAME
 407
 408 SL::DB::Part: Model for the 'parts' table
 409
 410 =head1 SYNOPSIS
 411
 412 This is a standard Rose::DB::Object based model and can be used as one.
 413
 414 =head1 TYPES
 415
 416 Although the base class is called C<Part> we usually talk about C<Articles> if
 417 we mean instances of this class. This is because articles come in three
 418 flavours called:
 419
 420 =over 4
 421
 422 =item Part     - a single part
 423
 424 =item Service  - a part without onhand, and without inventory accounting
 425
 426 =item Assembly - a collection of both parts and services
 427
 428 =item Assortment - a collection of items (parts or assemblies)
 429
 430 =back
 431
 432 These types are sadly represented by data inside the class and cannot be
 433 migrated into a flag. To work around this, each C<Part> object knows what type
 434 it currently is. Since the type is data driven, there ist no explicit setting
 435 method for it, but you can construct them explicitly with C<new_part>,
 436 C<new_service>, C<new_assembly> and C<new_assortment>. A Buchungsgruppe should be supplied in this
 437 case, but it will use the default Buchungsgruppe if you don't.
 438
 439 Matching these there are assorted helper methods dealing with types,
 440 e.g.  L</new_part>, L</new_service>, L</new_assembly>, L</type>,
 441 L</is_type> and others.
 442
 443 =head1 FUNCTIONS
 444
 445 =over 4
 446
 447 =item C<new_part %PARAMS>
 448
 449 =item C<new_service %PARAMS>
 450
 451 =item C<new_assembly %PARAMS>
 452
 453 Will set the appropriate data fields so that the resulting instance will be of
 454 the requested type. Since accounting targets are part of the distinction,
 455 providing a C<Buchungsgruppe> is recommended. If none is given the constructor
 456 will load a default one and set the accounting targets from it.
 457
 458 =item C<type>
 459
 460 Returns the type as a string. Can be one of C<part>, C<service>, C<assembly>.
 461
 462 =item C<is_type $TYPE>
 463
 464 Tests if the current object is a part, a service or an
 465 assembly. C<$type> must be one of the words 'part', 'service' or
 466 'assembly' (their plurals are ok, too).
 467
 468 Returns 1 if the requested type matches, 0 if it doesn't and
 469 C<confess>es if an unknown C<$type> parameter is encountered.
 470
 471 =item C<is_part>
 472
 473 =item C<is_service>
 474
 475 =item C<is_assembly>
 476
 477 Shorthand for C<is_type('part')> etc.
 478
 479 =item C<get_sellprice_info %params>
 480
 481 Retrieves the C<sellprice> and C<price_factor_id> for a part under
 482 different conditions and returns a hash reference with those two keys.
 483
 484 If C<%params> contains a key C<project_id> then a project price list
 485 will be consulted if one exists for that project. In this case the
 486 parameter C<country_id> is evaluated as well: if a price list entry
 487 has been created for this country then it will be used. Otherwise an
 488 entry without a country set will be used.
 489
 490 If none of the above conditions is met then the information from
 491 C<$self> is used.
 492
 493 =item C<get_ordered_qty %params>
 494
 495 Retrieves the quantity that has been ordered from a vendor but that
 496 has not been delivered yet. Only open purchase orders are considered.
 497
 498 =item C<get_taxkey %params>
 499
 500 Retrieves and returns a taxkey object valid for the given date
 501 C<$params{date}> and tax zone C<$params{taxzone}>
 502 (C<$params{taxzone_id}> is also recognized). The date defaults to the
 503 current date if undefined.
 504
 505 This function looks up the income (for trueish values of
 506 C<$params{is_sales}>) or expense (for falsish values of
 507 C<$params{is_sales}>) account for the current part. It uses the part's
 508 associated buchungsgruppe and uses the fields belonging to the tax
 509 zone given by C<$params{taxzone}>.
 510
 511 The information retrieved by the function is cached.
 512
 513 =item C<get_chart %params>
 514
 515 Retrieves and returns a chart object valid for the given type
 516 C<$params{type}> and tax zone C<$params{taxzone}>
 517 (C<$params{taxzone_id}> is also recognized). The type must be one of
 518 the three key words C<income>, C<expense> and C<inventory>.
 519
 520 This function uses the part's associated buchungsgruppe and uses the
 521 fields belonging to the tax zone given by C<$params{taxzone}>.
 522
 523 The information retrieved by the function is cached.
 524
 525 =item C<orphaned>
 526
 527 Checks if this article is used in orders, invoices, delivery orders or
 528 assemblies.
 529
 530 =item C<buchungsgruppe BUCHUNGSGRUPPE>
 531
 532 Used to set the accounting information from a L<SL:DB::Buchungsgruppe> object.
 533 Please note, that this is a write only accessor, the original Buchungsgruppe can
 534 not be retrieved from an article once set.
 535
 536 =item C<assembly_sellprice_sum>
 537
 538 Non-recursive sellprice sum of all the assembly item sellprices.
 539
 540 =item C<assortment_sellprice_sum>
 541
 542 Non-recursive sellprice sum of all the assortment item sellprices.
 543
 544 =item C<assembly_lastcost_sum>
 545
 546 Non-recursive lastcost sum of all the assembly item lastcosts.
 547
 548 =item C<assortment_lastcost_sum>
 549
 550 Non-recursive lastcost sum of all the assortment item lastcosts.
 551
 552 =item C<get_stock %params>
 553
 554 Fetches stock qty in the default unit for a part.
 555
 556 bin_id and warehouse_id may be passed as params. If only a bin_id is passed,
 557 the stock qty for that bin is returned. If only a warehouse_id is passed, the
 558 stock qty for all bins in that warehouse is returned.  If a shippingdate is
 559 passed the stock qty for that date is returned.
 560
 561 Examples:
 562  my $qty = $part->get_stock(bin_id => 52);
 563
 564  $part->get_stock(shippingdate => DateTime->today->add(days => -5));
 565
 566 =back
 567
 568 =head1 AUTHORS
 569
 570 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 571 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 572
 573 =cut