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