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