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