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