6 use List::MoreUtils qw(any uniq);
 
   7 use List::Util qw(sum);
 
   8 use Rose::DB::Object::Helpers qw(as_tree);
 
  10 use SL::Locale::String qw(t8);
 
  12 use SL::DB::MetaSetup::Part;
 
  13 use SL::DB::Manager::Part;
 
  15 use SL::DB::Helper::AttrHTML;
 
  16 use SL::DB::Helper::AttrSorted;
 
  17 use SL::DB::Helper::TransNumberGenerator;
 
  18 use SL::DB::Helper::CustomVariables (
 
  22 use SL::DB::Helper::DisplayableNamePreferences (
 
  23   title   => t8('Article'),
 
  24   options => [ {name => 'partnumber',  title => t8('Part Number')     },
 
  25                {name => 'description', title => t8('Description')    },
 
  26                {name => 'notes',       title => t8('Notes')},
 
  27                {name => 'ean',         title => t8('EAN')            }, ],
 
  31 __PACKAGE__->meta->add_relationships(
 
  33     type         => 'one to many',
 
  34     class        => 'SL::DB::Assembly',
 
  35     manager_args => { sort_by => 'position' },
 
  36     column_map   => { id => 'id' },
 
  39     type         => 'one to many',
 
  40     class        => 'SL::DB::Price',
 
  41     column_map   => { id => 'parts_id' },
 
  42     manager_args => { with_objects => [ 'pricegroup' ] }
 
  45     type         => 'one to many',
 
  46     class        => 'SL::DB::MakeModel',
 
  47     manager_args => { sort_by => 'sortorder' },
 
  48     column_map   => { id => 'parts_id' },
 
  51     type         => 'one to many',
 
  52     class        => 'SL::DB::PartCustomerPrice',
 
  53     column_map   => { id => 'parts_id' },
 
  56     type         => 'one to many',
 
  57     class        => 'SL::DB::Translation',
 
  58     column_map   => { id => 'parts_id' },
 
  61     type         => 'one to many',
 
  62     class        => 'SL::DB::AssortmentItem',
 
  63     column_map   => { id => 'assortment_id' },
 
  64     manager_args => { sort_by => 'position' },
 
  67     type            => 'one to many',
 
  68     class           => 'SL::DB::History',
 
  69     column_map      => { id => 'trans_id' },
 
  70     query_args      => [ what_done => 'part' ],
 
  71     manager_args    => { sort_by => 'itime' },
 
  74     type         => 'one to many',
 
  75     class        => 'SL::DB::ShopPart',
 
  76     column_map   => { id => 'part_id' },
 
  77     manager_args => { with_objects => [ 'shop' ] },
 
  79   last_price_update => {
 
  81     class        => 'SL::DB::PartsPriceHistory',
 
  82     column_map   => { id => 'part_id' },
 
  83     manager_args => { sort_by => 'valid_from DESC', limit => 1 },
 
  87 __PACKAGE__->meta->initialize;
 
  89 __PACKAGE__->attr_html('notes');
 
  90 __PACKAGE__->attr_sorted({ unsorted => 'makemodels',     position => 'sortorder' });
 
  91 __PACKAGE__->attr_sorted({ unsorted => 'customerprices', position => 'sortorder' });
 
  93 __PACKAGE__->before_save('_before_save_set_partnumber');
 
  94 __PACKAGE__->before_save('_before_save_set_assembly_weight');
 
  96 sub _before_save_set_partnumber {
 
  99   $self->create_trans_number if !$self->partnumber;
 
 103 sub _before_save_set_assembly_weight {
 
 106   if ( $self->part_type eq 'assembly' ) {
 
 107     my $weight_sum = $self->items_weight_sum;
 
 108     $self->weight($self->items_weight_sum) if $weight_sum;
 
 116   if ( $self->part_type eq 'assembly' ) {
 
 117     return $self->assemblies;
 
 118   } elsif ( $self->part_type eq 'assortment' ) {
 
 119     return $self->assortment_items;
 
 128   # for detecting if the items of an (orphaned) assembly or assortment have
 
 129   # changed when saving
 
 131   return join(' ', sort map { $_->part->id } @{$self->items});
 
 138   push @errors, $::locale->text('The partnumber is missing.')     if $self->id and !$self->partnumber;
 
 139   push @errors, $::locale->text('The unit is missing.')           unless $self->unit;
 
 140   push @errors, $::locale->text('The buchungsgruppe is missing.') unless $self->buchungsgruppen_id or $self->buchungsgruppe;
 
 142   unless ( $self->id ) {
 
 143     push @errors, $::locale->text('The partnumber already exists.') if SL::DB::Manager::Part->get_all_count(where => [ partnumber => $self->partnumber ]);
 
 146   if ($self->is_assortment && $self->orphaned && scalar @{$self->assortment_items} == 0) {
 
 147     # when assortment isn't orphaned form doesn't contain any items
 
 148     push @errors, $::locale->text('The assortment doesn\'t have any items.');
 
 151   if ($self->is_assembly && scalar @{$self->assemblies} == 0) {
 
 152     push @errors, $::locale->text('The assembly doesn\'t have any items.');
 
 160   my $type  = lc(shift || '');
 
 161   die 'invalid type' unless $type =~ /^(?:part|service|assembly|assortment)$/;
 
 163   return $self->type eq $type ? 1 : 0;
 
 166 sub is_part       { $_[0]->part_type eq 'part'       }
 
 167 sub is_assembly   { $_[0]->part_type eq 'assembly'   }
 
 168 sub is_service    { $_[0]->part_type eq 'service'    }
 
 169 sub is_assortment { $_[0]->part_type eq 'assortment' }
 
 172   return $_[0]->part_type;
 
 173   # my ($self, $type) = @_;
 
 175   #   die 'invalid type' unless $type =~ /^(?:part|service|assembly)$/;
 
 176   #   $self->assembly(          $type eq 'assembly' ? 1 : 0);
 
 177   #   $self->inventory_accno_id($type ne 'service'  ? 1 : undef);
 
 180   # return 'assembly' if $self->assembly;
 
 181   # return 'part'     if $self->inventory_accno_id;
 
 186   my ($class, %params) = @_;
 
 187   $class->new(%params, part_type => 'part');
 
 191   my ($class, %params) = @_;
 
 192   $class->new(%params, part_type => 'assembly');
 
 196   my ($class, %params) = @_;
 
 197   $class->new(%params, part_type => 'service');
 
 201   my ($class, %params) = @_;
 
 202   $class->new(%params, part_type => 'assortment');
 
 205 sub last_modification {
 
 207   return $self->mtime // $self->itime;
 
 212   die 'not an accessor' if @_ > 1;
 
 214   return 1 unless $self->id;
 
 219     SL::DB::DeliveryOrderItem
 
 222   for my $class (@relations) {
 
 223     eval "require $class";
 
 224     return 1 if $class->_get_manager_class->get_all_count(query => [ parts_id => $self->id ]);
 
 230   die 'not an accessor' if @_ > 1;
 
 232   return 1 unless $self->id;
 
 237     SL::DB::DeliveryOrderItem
 
 239     SL::DB::AssortmentItem
 
 242   for my $class (@relations) {
 
 243     eval "require $class";
 
 244     return 0 if $class->_get_manager_class->get_all_count(query => [ parts_id => $self->id ]);
 
 249 sub get_sellprice_info {
 
 253   confess "Missing part id" unless $self->id;
 
 255   my $object = $self->load;
 
 257   return { sellprice       => $object->sellprice,
 
 258            price_factor_id => $object->price_factor_id };
 
 261 sub get_ordered_qty {
 
 263   my %result = SL::DB::Manager::Part->get_ordered_qty($self->id);
 
 265   return $result{ $self->id };
 
 268 sub available_units {
 
 269   shift->unit_obj->convertible_units;
 
 272 # autogenerated accessor is slightly off...
 
 274   shift->buchungsgruppen(@_);
 
 278   my ($self, %params) = @_;
 
 280   my $date     = $params{date} || DateTime->today_local;
 
 281   my $is_sales = !!$params{is_sales};
 
 282   my $taxzone  = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
 
 283   my $tk_info  = $::request->cache('get_taxkey');
 
 285   $tk_info->{$self->id}                                      //= {};
 
 286   $tk_info->{$self->id}->{$taxzone}                          //= { };
 
 287   my $cache = $tk_info->{$self->id}->{$taxzone}->{$is_sales} //= { };
 
 289   if (!exists $cache->{$date}) {
 
 291       $self->get_chart(type => $is_sales ? 'income' : 'expense', taxzone => $taxzone)
 
 292       ->get_active_taxkey($date);
 
 295   return $cache->{$date};
 
 299   my ($self, %params) = @_;
 
 301   my $type    = (any { $_ eq $params{type} } qw(income expense inventory)) ? $params{type} : croak("Invalid 'type' parameter '$params{type}'");
 
 302   my $taxzone = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
 
 304   my $charts     = $::request->cache('get_chart_id/by_part_id_and_taxzone')->{$self->id} //= {};
 
 305   my $all_charts = $::request->cache('get_chart_id/by_id');
 
 307   $charts->{$taxzone} ||= { };
 
 309   if (!exists $charts->{$taxzone}->{$type}) {
 
 310     require SL::DB::Buchungsgruppe;
 
 311     my $bugru    = SL::DB::Buchungsgruppe->load_cached($self->buchungsgruppen_id);
 
 312     my $chart_id = ($type eq 'inventory') ? ($self->is_part ? $bugru->inventory_accno_id : undef)
 
 313                  :                          $bugru->call_sub("${type}_accno_id", $taxzone);
 
 316       my $chart                    = $all_charts->{$chart_id} // SL::DB::Chart->load_cached($chart_id)->load;
 
 317       $all_charts->{$chart_id}     = $chart;
 
 318       $charts->{$taxzone}->{$type} = $chart;
 
 322   return $charts->{$taxzone}->{$type};
 
 326   my ($self, %params) = @_;
 
 328   return undef unless $self->id;
 
 330   my $query = 'SELECT SUM(qty) FROM inventory WHERE parts_id = ?';
 
 331   my @values = ($self->id);
 
 333   if ( $params{bin_id} ) {
 
 334     $query .= ' AND bin_id = ?';
 
 335     push(@values, $params{bin_id});
 
 338   if ( $params{warehouse_id} ) {
 
 339     $query .= ' AND warehouse_id = ?';
 
 340     push(@values, $params{warehouse_id});
 
 343   if ( $params{shippingdate} ) {
 
 344     die unless ref($params{shippingdate}) eq 'DateTime';
 
 345     $query .= ' AND shippingdate <= ?';
 
 346     push(@values, $params{shippingdate});
 
 349   my ($stock) = selectrow_query($::form, $self->db->dbh, $query, @values);
 
 351   return $stock || 0; # never return undef
 
 355 # this is designed to ignore chargenumbers, expiration dates and just give a list of how much <-> where
 
 356 sub get_simple_stock {
 
 357   my ($self, %params) = @_;
 
 359   return [] unless $self->id;
 
 362     SELECT sum(qty), warehouse_id, bin_id FROM inventory WHERE parts_id = ?
 
 363     GROUP BY warehouse_id, bin_id
 
 365   my $stock_info = selectall_hashref_query($::form, $::form->get_standard_dbh, $query, $self->id);
 
 366   [ map { bless $_, 'SL::DB::Part::SimpleStock'} @$stock_info ];
 
 368 # helper class to have bin/warehouse accessors in stock result
 
 369 { package SL::DB::Part::SimpleStock;
 
 370   sub warehouse { require SL::DB::Warehouse; SL::DB::Manager::Warehouse->find_by_or_create(id => $_[0]->{warehouse_id}) }
 
 371   sub bin       { require SL::DB::Bin;       SL::DB::Manager::Bin      ->find_by_or_create(id => $_[0]->{bin_id}) }
 
 374 sub get_simple_stock_sql {
 
 375   my ($self, %params) = @_;
 
 377   return [] unless $self->id;
 
 380      SELECT w.description                         AS warehouse_description,
 
 381             b.description                         AS bin_description,
 
 383             SUM(i.qty * p.lastcost)               AS stock_value,
 
 385             LEAD(w.description)           OVER pt AS wh_lead,            -- to detect warehouse changes for subtotals in template
 
 386             SUM( SUM(i.qty) )             OVER pt AS run_qty,            -- running total of total qty
 
 387             SUM( SUM(i.qty) )             OVER wh AS wh_run_qty,         -- running total of warehouse qty
 
 388             SUM( SUM(i.qty * p.lastcost)) OVER pt AS run_stock_value,    -- running total of total stock_value
 
 389             SUM( SUM(i.qty * p.lastcost)) OVER wh AS wh_run_stock_value  -- running total of warehouse stock_value
 
 391             LEFT JOIN parts p     ON (p.id           = i.parts_id)
 
 392             LEFT JOIN warehouse w ON (i.warehouse_id = w.id)
 
 393             LEFT JOIN bin b       ON (i.bin_id       = b.id)
 
 395    GROUP BY w.description, w.sortkey, b.description, p.unit, i.parts_id
 
 397      WINDOW pt AS (PARTITION BY i.parts_id    ORDER BY w.sortkey, b.description, p.unit),
 
 398             wh AS (PARTITION by w.description ORDER BY w.sortkey, b.description, p.unit)
 
 399    ORDER BY w.sortkey, b.description, p.unit
 
 402   my $stock_info = selectall_hashref_query($::form, $self->db->dbh, $query, $self->id);
 
 406 sub get_mini_journal {
 
 409   # inventory ids of the most recent 10 inventory trans_ids
 
 411   # duplicate code copied from SL::Controller::Inventory mini_journal, except
 
 412   # for the added filter on parts_id
 
 414   my $parts_id = $self->id;
 
 416 with last_inventories as (
 
 421     where parts_id = $parts_id
 
 428      from last_inventories
 
 435  limit 20  -- so the planner knows how many ids to expect, the cte is an optimisation fence
 
 438   my $objs  = SL::DB::Manager::Inventory->get_all(
 
 439     query        => [ id => [ \"$query" ] ],                           # make emacs happy "
 
 440     with_objects => [ 'parts', 'trans_type', 'bin', 'bin.warehouse' ], # prevent lazy loading in template
 
 441     sort_by      => 'itime DESC',
 
 443   # remember order of trans_ids from query, for ordering hash later
 
 444   my @sorted_trans_ids = uniq map { $_->trans_id } @$objs;
 
 446   # at most 2 of them belong to a transaction and the qty determines in or out.
 
 449     $transactions{ $_->trans_id }{ $_->qty > 0 ? 'in' : 'out' } = $_;
 
 450     $transactions{ $_->trans_id }{base} = $_;
 
 453   # because the inventory transactions were built in a hash, we need to sort the
 
 454   # hash by using the original sort order of the trans_ids
 
 455   my @sorted = map { $transactions{$_} } @sorted_trans_ids;
 
 460 sub clone_and_reset_deep {
 
 463   my $clone = $self->clone_and_reset; # resets id and partnumber (primary key and unique constraint)
 
 464   $clone->makemodels(   map { $_->clone_and_reset } @{$self->makemodels}   ) if @{$self->makemodels};
 
 465   $clone->translations( map { $_->clone_and_reset } @{$self->translations} ) if @{$self->translations};
 
 467   if ( $self->is_assortment ) {
 
 468     # use clone rather than reset_and_clone because the unique constraint would also remove parts_id
 
 469     $clone->assortment_items( map { $_->clone } @{$self->assortment_items} );
 
 470     $_->assortment_id(undef) foreach @{ $clone->assortment_items }
 
 473   if ( $self->is_assembly ) {
 
 474     $clone->assemblies( map { $_->clone_and_reset } @{$self->assemblies});
 
 477   if ( $self->prices ) {
 
 478     $clone->prices( map { $_->clone } @{$self->prices}); # pricegroup_id gets reset here because it is part of a unique contraint
 
 479     if ( $clone->prices ) {
 
 480       foreach my $price ( @{$clone->prices} ) {
 
 482         $price->parts_id(undef);
 
 491   my ($self, $comparison_part) = @_;
 
 493   die "item_diffs needs a part object" unless ref($comparison_part) eq 'SL::DB::Part';
 
 494   die "part and comparison_part need to be of the same part_type" unless
 
 495         ( $self->part_type eq 'assembly' or $self->part_type eq 'assortment' )
 
 496     and ( $comparison_part->part_type eq 'assembly' or $comparison_part->part_type eq 'assortment' )
 
 497     and $self->part_type eq $comparison_part->part_type;
 
 499   # return [], [] if $self->items_checksum eq $comparison_part->items_checksum;
 
 500   my @self_part_ids       = map { $_->parts_id } $self->items;
 
 501   my @comparison_part_ids = map { $_->parts_id } $comparison_part->items;
 
 503   my %orig       = map{ $_ => 1 } @self_part_ids;
 
 504   my %comparison = map{ $_ => 1 } @comparison_part_ids;
 
 505   my (@additions, @removals);
 
 506   @additions = grep { !exists( $orig{$_}       ) } @comparison_part_ids if @comparison_part_ids;
 
 507   @removals  = grep { !exists( $comparison{$_} ) } @self_part_ids       if @self_part_ids;
 
 509   return \@additions, \@removals;
 
 512 sub items_sellprice_sum {
 
 513   my ($self, %params) = @_;
 
 515   return unless $self->is_assortment or $self->is_assembly;
 
 516   return unless $self->items;
 
 518   if ($self->is_assembly) {
 
 519     return sum map { $_->linetotal_sellprice          } @{$self->items};
 
 521     return sum map { $_->linetotal_sellprice(%params) } grep { $_->charge } @{$self->items};
 
 525 sub items_lastcost_sum {
 
 528   return unless $self->is_assortment or $self->is_assembly;
 
 529   return unless $self->items;
 
 530   sum map { $_->linetotal_lastcost } @{$self->items};
 
 533 sub items_weight_sum {
 
 536   return unless $self->is_assembly;
 
 537   return unless $self->items;
 
 538   sum map { $_->linetotal_weight} @{$self->items};
 
 551 SL::DB::Part: Model for the 'parts' table
 
 555 This is a standard Rose::DB::Object based model and can be used as one.
 
 559 Although the base class is called C<Part> we usually talk about C<Articles> if
 
 560 we mean instances of this class. This is because articles come in three
 
 565 =item Part     - a single part
 
 567 =item Service  - a part without onhand, and without inventory accounting
 
 569 =item Assembly - a collection of both parts and services
 
 571 =item Assortment - a collection of items (parts or assemblies)
 
 575 These types are sadly represented by data inside the class and cannot be
 
 576 migrated into a flag. To work around this, each C<Part> object knows what type
 
 577 it currently is. Since the type is data driven, there ist no explicit setting
 
 578 method for it, but you can construct them explicitly with C<new_part>,
 
 579 C<new_service>, C<new_assembly> and C<new_assortment>. A Buchungsgruppe should be supplied in this
 
 580 case, but it will use the default Buchungsgruppe if you don't.
 
 582 Matching these there are assorted helper methods dealing with types,
 
 583 e.g.  L</new_part>, L</new_service>, L</new_assembly>, L</type>,
 
 584 L</is_type> and others.
 
 590 =item C<new_part %PARAMS>
 
 592 =item C<new_service %PARAMS>
 
 594 =item C<new_assembly %PARAMS>
 
 596 Will set the appropriate data fields so that the resulting instance will be of
 
 597 the requested type. Since accounting targets are part of the distinction,
 
 598 providing a C<Buchungsgruppe> is recommended. If none is given the constructor
 
 599 will load a default one and set the accounting targets from it.
 
 603 Returns the type as a string. Can be one of C<part>, C<service>, C<assembly>.
 
 605 =item C<is_type $TYPE>
 
 607 Tests if the current object is a part, a service or an
 
 608 assembly. C<$type> must be one of the words 'part', 'service' or
 
 609 'assembly' (their plurals are ok, too).
 
 611 Returns 1 if the requested type matches, 0 if it doesn't and
 
 612 C<confess>es if an unknown C<$type> parameter is encountered.
 
 620 Shorthand for C<is_type('part')> etc.
 
 622 =item C<get_sellprice_info %params>
 
 624 Retrieves the C<sellprice> and C<price_factor_id> for a part under
 
 625 different conditions and returns a hash reference with those two keys.
 
 627 If C<%params> contains a key C<project_id> then a project price list
 
 628 will be consulted if one exists for that project. In this case the
 
 629 parameter C<country_id> is evaluated as well: if a price list entry
 
 630 has been created for this country then it will be used. Otherwise an
 
 631 entry without a country set will be used.
 
 633 If none of the above conditions is met then the information from
 
 636 =item C<get_ordered_qty %params>
 
 638 Retrieves the quantity that has been ordered from a vendor but that
 
 639 has not been delivered yet. Only open purchase orders are considered.
 
 641 =item C<get_taxkey %params>
 
 643 Retrieves and returns a taxkey object valid for the given date
 
 644 C<$params{date}> and tax zone C<$params{taxzone}>
 
 645 (C<$params{taxzone_id}> is also recognized). The date defaults to the
 
 646 current date if undefined.
 
 648 This function looks up the income (for trueish values of
 
 649 C<$params{is_sales}>) or expense (for falsish values of
 
 650 C<$params{is_sales}>) account for the current part. It uses the part's
 
 651 associated buchungsgruppe and uses the fields belonging to the tax
 
 652 zone given by C<$params{taxzone}>.
 
 654 The information retrieved by the function is cached.
 
 656 =item C<get_chart %params>
 
 658 Retrieves and returns a chart object valid for the given type
 
 659 C<$params{type}> and tax zone C<$params{taxzone}>
 
 660 (C<$params{taxzone_id}> is also recognized). The type must be one of
 
 661 the three key words C<income>, C<expense> and C<inventory>.
 
 663 This function uses the part's associated buchungsgruppe and uses the
 
 664 fields belonging to the tax zone given by C<$params{taxzone}>.
 
 666 The information retrieved by the function is cached.
 
 668 =item C<used_in_record>
 
 670 Checks if this article has been used in orders, invoices or delivery orders.
 
 674 Checks if this article is used in orders, invoices, delivery orders or
 
 677 =item C<buchungsgruppe BUCHUNGSGRUPPE>
 
 679 Used to set the accounting information from a L<SL:DB::Buchungsgruppe> object.
 
 680 Please note, that this is a write only accessor, the original Buchungsgruppe can
 
 681 not be retrieved from an article once set.
 
 683 =item C<get_simple_stock_sql>
 
 685 Fetches the qty and the stock value for the current part for each bin and
 
 686 warehouse where the part is in stock (or rather different from 0, might be
 
 689 Runs some additional window functions to add the running totals (total running
 
 690 total and total per warehouse) for qty and stock value to each line.
 
 692 Using the LEAD(w.description) the template can check if the warehouse
 
 693 description is about to change, i.e. the next line will contain numbers from a
 
 694 different warehouse, so that a subtotal line can be added.
 
 696 The last row will contain the running qty total (run_qty) and the running total
 
 697 stock value (run_stock_value) over all warehouses/bins and can be used to add a
 
 698 line for the grand totals.
 
 700 =item C<items_lastcost_sum>
 
 702 Non-recursive lastcost sum of all the items in an assembly or assortment.
 
 704 =item C<get_stock %params>
 
 706 Fetches stock qty in the default unit for a part.
 
 708 bin_id and warehouse_id may be passed as params. If only a bin_id is passed,
 
 709 the stock qty for that bin is returned. If only a warehouse_id is passed, the
 
 710 stock qty for all bins in that warehouse is returned.  If a shippingdate is
 
 711 passed the stock qty for that date is returned.
 
 714  my $qty = $part->get_stock(bin_id => 52);
 
 716  $part->get_stock(shippingdate => DateTime->today->add(days => -5));
 
 722 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 
 723 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>