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