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 sub assortment_lastcost_sum {
 417   my ($self) = @_;
 418
 419   return unless $self->is_assortment;
 420   sum map { $_->linetotal_lastcost } @{$self->assortment_items};
 421 };
 422
 423 1;
 424
 425 __END__
 426
 427 =pod
 428
 429 =encoding utf-8
 430
 431 =head1 NAME
 432
 433 SL::DB::Part: Model for the 'parts' table
 434
 435 =head1 SYNOPSIS
 436
 437 This is a standard Rose::DB::Object based model and can be used as one.
 438
 439 =head1 TYPES
 440
 441 Although the base class is called C<Part> we usually talk about C<Articles> if
 442 we mean instances of this class. This is because articles come in three
 443 flavours called:
 444
 445 =over 4
 446
 447 =item Part     - a single part
 448
 449 =item Service  - a part without onhand, and without inventory accounting
 450
 451 =item Assembly - a collection of both parts and services
 452
 453 =item Assortment - a collection of items (parts or assemblies)
 454
 455 =back
 456
 457 These types are sadly represented by data inside the class and cannot be
 458 migrated into a flag. To work around this, each C<Part> object knows what type
 459 it currently is. Since the type is data driven, there ist no explicit setting
 460 method for it, but you can construct them explicitly with C<new_part>,
 461 C<new_service>, C<new_assembly> and C<new_assortment>. A Buchungsgruppe should be supplied in this
 462 case, but it will use the default Buchungsgruppe if you don't.
 463
 464 Matching these there are assorted helper methods dealing with types,
 465 e.g.  L</new_part>, L</new_service>, L</new_assembly>, L</type>,
 466 L</is_type> and others.
 467
 468 =head1 FUNCTIONS
 469
 470 =over 4
 471
 472 =item C<new_part %PARAMS>
 473
 474 =item C<new_service %PARAMS>
 475
 476 =item C<new_assembly %PARAMS>
 477
 478 Will set the appropriate data fields so that the resulting instance will be of
 479 the requested type. Since accounting targets are part of the distinction,
 480 providing a C<Buchungsgruppe> is recommended. If none is given the constructor
 481 will load a default one and set the accounting targets from it.
 482
 483 =item C<type>
 484
 485 Returns the type as a string. Can be one of C<part>, C<service>, C<assembly>.
 486
 487 =item C<is_type $TYPE>
 488
 489 Tests if the current object is a part, a service or an
 490 assembly. C<$type> must be one of the words 'part', 'service' or
 491 'assembly' (their plurals are ok, too).
 492
 493 Returns 1 if the requested type matches, 0 if it doesn't and
 494 C<confess>es if an unknown C<$type> parameter is encountered.
 495
 496 =item C<is_part>
 497
 498 =item C<is_service>
 499
 500 =item C<is_assembly>
 501
 502 Shorthand for C<is_type('part')> etc.
 503
 504 =item C<get_sellprice_info %params>
 505
 506 Retrieves the C<sellprice> and C<price_factor_id> for a part under
 507 different conditions and returns a hash reference with those two keys.
 508
 509 If C<%params> contains a key C<project_id> then a project price list
 510 will be consulted if one exists for that project. In this case the
 511 parameter C<country_id> is evaluated as well: if a price list entry
 512 has been created for this country then it will be used. Otherwise an
 513 entry without a country set will be used.
 514
 515 If none of the above conditions is met then the information from
 516 C<$self> is used.
 517
 518 =item C<get_ordered_qty %params>
 519
 520 Retrieves the quantity that has been ordered from a vendor but that
 521 has not been delivered yet. Only open purchase orders are considered.
 522
 523 =item C<get_taxkey %params>
 524
 525 Retrieves and returns a taxkey object valid for the given date
 526 C<$params{date}> and tax zone C<$params{taxzone}>
 527 (C<$params{taxzone_id}> is also recognized). The date defaults to the
 528 current date if undefined.
 529
 530 This function looks up the income (for trueish values of
 531 C<$params{is_sales}>) or expense (for falsish values of
 532 C<$params{is_sales}>) account for the current part. It uses the part's
 533 associated buchungsgruppe and uses the fields belonging to the tax
 534 zone given by C<$params{taxzone}>.
 535
 536 The information retrieved by the function is cached.
 537
 538 =item C<get_chart %params>
 539
 540 Retrieves and returns a chart object valid for the given type
 541 C<$params{type}> and tax zone C<$params{taxzone}>
 542 (C<$params{taxzone_id}> is also recognized). The type must be one of
 543 the three key words C<income>, C<expense> and C<inventory>.
 544
 545 This function uses the part's associated buchungsgruppe and uses the
 546 fields belonging to the tax zone given by C<$params{taxzone}>.
 547
 548 The information retrieved by the function is cached.
 549
 550 =item C<used_in_record>
 551
 552 Checks if this article has been used in orders, invoices or delivery orders.
 553
 554 =item C<orphaned>
 555
 556 Checks if this article is used in orders, invoices, delivery orders or
 557 assemblies.
 558
 559 =item C<buchungsgruppe BUCHUNGSGRUPPE>
 560
 561 Used to set the accounting information from a L<SL:DB::Buchungsgruppe> object.
 562 Please note, that this is a write only accessor, the original Buchungsgruppe can
 563 not be retrieved from an article once set.
 564
 565 =item C<assembly_sellprice_sum>
 566
 567 Non-recursive sellprice sum of all the assembly item sellprices.
 568
 569 =item C<assortment_sellprice_sum>
 570
 571 Non-recursive sellprice sum of all the assortment item sellprices.
 572
 573 =item C<assembly_lastcost_sum>
 574
 575 Non-recursive lastcost sum of all the assembly item lastcosts.
 576
 577 =item C<assortment_lastcost_sum>
 578
 579 Non-recursive lastcost sum of all the assortment item lastcosts.
 580
 581 =item C<get_stock %params>
 582
 583 Fetches stock qty in the default unit for a part.
 584
 585 bin_id and warehouse_id may be passed as params. If only a bin_id is passed,
 586 the stock qty for that bin is returned. If only a warehouse_id is passed, the
 587 stock qty for all bins in that warehouse is returned.  If a shippingdate is
 588 passed the stock qty for that date is returned.
 589
 590 Examples:
 591  my $qty = $part->get_stock(bin_id => 52);
 592
 593  $part->get_stock(shippingdate => DateTime->today->add(days => -5));
 594
 595 =back
 596
 597 =head1 AUTHORS
 598
 599 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 600 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 601
 602 =cut