SL/DB/Reclamation.pm

   1 package SL::DB::Reclamation;
   2
   3 use utf8;
   4 use strict;
   5
   6 use Carp;
   7 use DateTime;
   8 use List::Util qw(max sum0);
   9 use List::MoreUtils qw(any);
  10
  11 use SL::DB::Order::TypeData qw(:types);
  12 use SL::DB::DeliveryOrder::TypeData qw(:types);
  13 use SL::DB::Reclamation::TypeData qw(:types);
  14 use SL::DB::MetaSetup::Reclamation;
  15 use SL::DB::Manager::Reclamation;
  16 use SL::DB::Helper::Attr;
  17 use SL::DB::Helper::AttrHTML;
  18 use SL::DB::Helper::AttrSorted;
  19 use SL::DB::Helper::FlattenToForm;
  20 use SL::DB::Helper::LinkedRecords;
  21 use SL::DB::Helper::PriceTaxCalculator;
  22 use SL::DB::Helper::PriceUpdater;
  23 use SL::DB::Helper::TypeDataProxy;
  24 use SL::DB::Helper::TransNumberGenerator;
  25 use SL::DB::Helper::RecordLink qw(RECORD_ID RECORD_TYPE_REF);
  26 use SL::Locale::String qw(t8);
  27 use SL::RecordLinks;
  28 use Rose::DB::Object::Helpers qw(as_tree strip);
  29 use SL::DB::Helper::LegacyPrinting qw(map_keys_to_arrays format_as_number);
  30
  31 __PACKAGE__->meta->add_relationship(
  32
  33   reclamation_items => {
  34     type         => 'one to many',
  35     class        => 'SL::DB::ReclamationItem',
  36     column_map   => { id => 'reclamation_id' },
  37     manager_args => {
  38       with_objects => [ 'part', 'reason' ]
  39     }
  40   },
  41   custom_shipto            => {
  42     type                   => 'one to one',
  43     class                  => 'SL::DB::Shipto',
  44     column_map             => { id => 'trans_id' },
  45     query_args             => [ module => 'Reclamation' ],
  46   },
  47   exchangerate_obj         => {
  48     type                   => 'one to one',
  49     class                  => 'SL::DB::Exchangerate',
  50     column_map             => { currency_id => 'currency_id', transdate => 'transdate' },
  51   },
  52 );
  53
  54 SL::DB::Helper::Attr::make(__PACKAGE__, daily_exchangerate => 'numeric');
  55
  56 __PACKAGE__->meta->initialize;
  57
  58 __PACKAGE__->attr_html('notes');
  59 __PACKAGE__->attr_sorted('items');
  60
  61 __PACKAGE__->before_save('_before_save_set_record_number');
  62 __PACKAGE__->before_save('_before_save_remove_empty_custom_shipto');
  63 __PACKAGE__->before_save('_before_save_set_custom_shipto_module');
  64 __PACKAGE__->after_save('_after_save_link_records');
  65
  66 # hooks
  67
  68 sub _before_save_set_record_number {
  69   my ($self) = @_;
  70
  71   $self->create_trans_number if !$self->record_number;
  72
  73   return 1;
  74 }
  75
  76 sub _before_save_remove_empty_custom_shipto {
  77   my ($self) = @_;
  78
  79   $self->custom_shipto(undef) if $self->custom_shipto && $self->custom_shipto->is_empty;
  80
  81   return 1;
  82 }
  83
  84 sub _before_save_set_custom_shipto_module {
  85   my ($self) = @_;
  86
  87   $self->custom_shipto->module('Reclamation') if $self->custom_shipto;
  88
  89   return 1;
  90 }
  91
  92 sub _after_save_link_records {
  93   my ($self) = @_;
  94
  95   my @allowed_record_sources = qw(SL::DB::Reclamation SL::DB::Order SL::DB::DeliveryOrder SL::DB::Invoice SL::DB::PurchaseInvoice);
  96   my @allowed_item_sources = qw(SL::DB::ReclamationItem SL::DB::OrderItem SL::DB::DeliveryOrderItem SL::DB::InvoiceItem);
  97
  98   SL::DB::Helper::RecordLink::link_records(
  99     $self,
 100     \@allowed_record_sources,
 101     \@allowed_item_sources,
 102   );
 103 }
 104
 105 # methods
 106
 107 sub items { goto &reclamation_items; }
 108 sub add_items { goto &add_reclamation_items; }
 109 sub record_items { goto &reclamation_items; }
 110
 111 sub type {
 112   my $self = shift;
 113   die "invalid type: " . $self->record_type if (!any { $self->record_type eq $_ } (
 114       SALES_RECLAMATION_TYPE(),
 115       PURCHASE_RECLAMATION_TYPE(),
 116     ));
 117   return $self->record_type;
 118 }
 119
 120 sub is_type {
 121   my ($self, $type) = @_;
 122   return $self->type eq $type;
 123 }
 124
 125 sub effective_tax_point {
 126   my ($self) = @_;
 127
 128   return $self->tax_point || $self->reqdate || $self->transdate;
 129 }
 130
 131 sub displayable_type {
 132   my ($self) = @_;
 133   return $self->type_data->text('type');
 134 }
 135
 136 sub displayable_name {
 137   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
 138 };
 139
 140 sub is_sales {
 141   croak 'not an accessor' if @_ > 1;
 142   $_[0]->type_data->properties('is_customer');
 143 }
 144
 145 sub daily_exchangerate {
 146   my ($self, $val) = @_;
 147
 148   return 1 if $self->currency_id == $::instance_conf->get_currency_id;
 149
 150   my $rate = (any { $self->is_type($_) } (SALES_RECLAMATION_TYPE()))    ? 'buy'
 151            : (any { $self->is_type($_) } (PURCHASE_RECLAMATION_TYPE())) ? 'sell'
 152            : undef;
 153   return if !$rate;
 154
 155   if (defined $val) {
 156     croak t8('exchange rate has to be positive') if $val <= 0;
 157     if (!$self->exchangerate_obj) {
 158       $self->exchangerate_obj(SL::DB::Exchangerate->new(
 159         currency_id => $self->currency_id,
 160         transdate   => $self->transdate,
 161         $rate       => $val,
 162       ));
 163     } elsif (!defined $self->exchangerate_obj->$rate) {
 164       $self->exchangerate_obj->$rate($val);
 165     } else {
 166       croak t8('exchange rate already exists, no update allowed');
 167     }
 168   }
 169   return $self->exchangerate_obj->$rate if $self->exchangerate_obj;
 170 }
 171
 172 sub taxes {
 173   my ($self) = @_;
 174   # add taxes to recalmation
 175   my %pat = $self->calculate_prices_and_taxes();
 176   my @taxes;
 177   foreach my $tax_id (keys %{ $pat{taxes_by_tax_id} }) {
 178     my $netamount = sum0 map { $pat{amounts}->{$_}->{amount} } grep { $pat{amounts}->{$_}->{tax_id} == $tax_id } keys %{ $pat{amounts} };
 179     push(@taxes, { amount    => $pat{taxes_by_tax_id}->{$tax_id},
 180                                 netamount => $netamount,
 181                                 tax       => SL::DB::Tax->new(id => $tax_id)->load });
 182   }
 183   return \@taxes;
 184 }
 185
 186 sub displayable_state {
 187   my ($self) = @_;
 188
 189   return $self->closed ? $::locale->text('closed') : $::locale->text('open');
 190 }
 191
 192 sub valid_reclamation_reasons {
 193   my ($self) = @_;
 194
 195   my $valid_for_type = ($self->type =~ m{sales} ? 'valid_for_sales' : 'valid_for_purchase');
 196   return SL::DB::Manager::ReclamationReason->get_all_sorted(
 197       where => [  $valid_for_type => 1 ]);
 198 }
 199
 200 sub convert_to_order {
 201   my ($self, %params) = @_;
 202
 203   my $order;
 204   $params{destination_type} = $self->is_sales ? SALES_ORDER_TYPE()
 205                                               : PURCHASE_ORDER_TYPE();
 206   if (!$self->db->with_transaction(sub {
 207     require SL::DB::Order;
 208     $order = SL::DB::Order->new_from($self, %params);
 209     $order->save;
 210
 211     1;
 212   })) {
 213     return undef, $self->db->error->db_error->db_error;
 214   }
 215
 216   return $order;
 217 }
 218
 219 sub convert_to_delivery_order {
 220   my ($self, %params) = @_;
 221
 222   my $delivery_order;
 223   if (!$self->db->with_transaction(sub {
 224     require SL::DB::DeliveryOrder;
 225     $delivery_order = SL::DB::DeliveryOrder->new_from($self, %params);
 226     $delivery_order->save;
 227
 228     $self->update_attributes(delivered => 1) unless $::instance_conf->get_shipped_qty_require_stock_out;
 229     1;
 230   })) {
 231     return undef, $self->db->error->db_error->db_error;
 232   }
 233
 234   return $delivery_order;
 235 }
 236
 237 sub add_legacy_template_arrays {
 238   my ($self, $print_form) = @_;
 239
 240   # for now using the keys that are used in the latex template: template/print/marei/sales_reclamation.tex
 241   # (nested keys: part.partnumber, reason.description)
 242   my @keys = qw( position part.partnumber description longdescription reqdate serialnumber projectnumber reason.description
 243     reason_description_ext qty_as_number unit sellprice_as_number discount_as_number discount_as_percent linetotal );
 244
 245   my @tax_keys = qw( tax.taxdescription amount );
 246
 247   my %template_arrays;
 248   map_keys_to_arrays($self->items_sorted, \@keys, \%template_arrays);
 249   map_keys_to_arrays($self->taxes, \@tax_keys, \%template_arrays);
 250
 251   format_as_number([ qw(linetotal) ], \%template_arrays);
 252   $print_form->{TEMPLATE_ARRAYS} = \%template_arrays;
 253 }
 254
 255 #TODO(Werner): überprüfen ob alle Felder richtig gestetzt werden
 256 sub new_from {
 257   my ($class, $source, %params) = @_;
 258   my %allowed_sources = map { $_ => 1 } qw(
 259     SL::DB::Reclamation
 260     SL::DB::Order
 261     SL::DB::DeliveryOrder
 262     SL::DB::Invoice
 263     SL::DB::PurchaseInvoice
 264   );
 265   unless( $allowed_sources{ref $source} ) {
 266     croak("Unsupported source object type '" . ref($source) . "'");
 267   }
 268   croak("A destination type must be given as parameter") unless $params{destination_type};
 269
 270   my $destination_type  = delete $params{destination_type};
 271
 272   my @from_tos = (
 273     #Reclamation
 274     { from => SALES_RECLAMATION_TYPE(),       to => SALES_RECLAMATION_TYPE(),    abbr => 'srsr', },
 275     { from => PURCHASE_RECLAMATION_TYPE(),    to => PURCHASE_RECLAMATION_TYPE(), abbr => 'prpr', },
 276     { from => SALES_RECLAMATION_TYPE(),       to => PURCHASE_RECLAMATION_TYPE(), abbr => 'srpr', },
 277     { from => PURCHASE_RECLAMATION_TYPE(),    to => SALES_RECLAMATION_TYPE(),    abbr => 'prsr', },
 278     #Order
 279     { from => SALES_ORDER_TYPE(),             to => SALES_RECLAMATION_TYPE(),    abbr => 'sosr', },
 280     { from => PURCHASE_ORDER_TYPE(),          to => PURCHASE_RECLAMATION_TYPE(), abbr => 'popr', },
 281     #Delivery Order
 282     { from => SALES_DELIVERY_ORDER_TYPE(),    to => SALES_RECLAMATION_TYPE(),    abbr => 'sdsr', },
 283     { from => PURCHASE_DELIVERY_ORDER_TYPE(), to => PURCHASE_RECLAMATION_TYPE(), abbr => 'pdpr', },
 284     #Invoice
 285     { from => 'invoice',                 to => SALES_RECLAMATION_TYPE(),    abbr => 'sisr', },
 286     { from => 'purchase_invoice',        to => PURCHASE_RECLAMATION_TYPE(), abbr => 'pipr', },
 287   );
 288   my $from_to = (grep { $_->{from} eq $source->record_type && $_->{to} eq $destination_type} @from_tos)[0];
 289   if (!$from_to) {
 290     croak("Cannot convert from '" . $source->record_type . "' to '" . $destination_type . "'");
 291   }
 292
 293   my $is_abbr_any = sub {
 294     any { $from_to->{abbr} eq $_ } @_;
 295   };
 296
 297   my %record_args = (
 298     record_number => undef,
 299     record_type   => $destination_type,
 300     employee => SL::DB::Manager::Employee->current,
 301     closed    => 0,
 302     delivered => 0,
 303     transdate => DateTime->today_local,
 304   );
 305   if ( $is_abbr_any->(qw(srsr prpr srpr prsr)) ) { #Reclamation
 306     map { $record_args{$_} = $source->$_ } # {{{ for vim folds
 307     qw(
 308       amount
 309       billing_address_id
 310       contact_id
 311       currency_id
 312       customer_id
 313       cv_record_number
 314       delivery_term_id
 315       department_id
 316       exchangerate
 317       globalproject_id
 318       intnotes
 319       language_id
 320       netamount
 321       notes
 322       payment_id
 323       reqdate
 324       salesman_id
 325       shippingpoint
 326       shipvia
 327       tax_point
 328       taxincluded
 329       taxzone_id
 330       transaction_description
 331       vendor_id
 332     ); # }}} for vim folds
 333   } elsif ( $is_abbr_any->(qw(sosr popr)) ) { #Order
 334     map { $record_args{$_} = $source->$_ } # {{{ for vim folds
 335     qw(
 336       amount
 337       billing_address_id
 338       currency_id
 339       customer_id
 340       delivery_term_id
 341       department_id
 342       exchangerate
 343       globalproject_id
 344       intnotes
 345       language_id
 346       netamount
 347       notes
 348       payment_id
 349       salesman_id
 350       shippingpoint
 351       shipvia
 352       tax_point
 353       taxincluded
 354       taxzone_id
 355       transaction_description
 356       vendor_id
 357     );
 358     $record_args{contact_id} = $source->cp_id;
 359     $record_args{cv_record_number} = $source->cusordnumber;
 360     # }}} for vim folds
 361   } elsif ( $is_abbr_any->(qw(sdsr pdpr)) ) { #DeliveryOrder
 362     map { $record_args{$_} = $source->$_ } # {{{ for vim folds
 363     qw(
 364       billing_address_id
 365       currency_id
 366       customer_id
 367       delivery_term_id
 368       department_id
 369       globalproject_id
 370       intnotes
 371       language_id
 372       notes
 373       payment_id
 374       salesman_id
 375       shippingpoint
 376       shipvia
 377       tax_point
 378       taxincluded
 379       taxzone_id
 380       transaction_description
 381       vendor_id
 382     );
 383     $record_args{contact_id} = $source->cp_id;
 384     $record_args{cv_record_number} = $source->cusordnumber;
 385     # }}} for vim folds
 386   } elsif ( $is_abbr_any->(qw(sisr)) ) { #Invoice(ar)
 387     map { $record_args{$_} = $source->$_ } # {{{ for vim folds
 388     qw(
 389       amount
 390       billing_address_id
 391       currency_id
 392       customer_id
 393       delivery_term_id
 394       department_id
 395       globalproject_id
 396       intnotes
 397       language_id
 398       netamount
 399       notes
 400       payment_id
 401       salesman_id
 402       shippingpoint
 403       shipvia
 404       tax_point
 405       taxincluded
 406       taxzone_id
 407       transaction_description
 408     );
 409     $record_args{contact_id} = $source->cp_id;
 410     $record_args{cv_record_number} = $source->cusordnumber;
 411     # }}} for vim folds
 412   } elsif ( $is_abbr_any->(qw(pipr)) ) { #Invoice(ap)
 413     map { $record_args{$_} = $source->$_ } # {{{ for vim folds
 414     qw(
 415       amount
 416       currency_id
 417       delivery_term_id
 418       department_id
 419       globalproject_id
 420       intnotes
 421       language_id
 422       netamount
 423       notes
 424       payment_id
 425       shipvia
 426       tax_point
 427       taxincluded
 428       taxzone_id
 429       transaction_description
 430       vendor_id
 431     );
 432     $record_args{contact_id} = $source->cp_id;
 433     # }}} for vim folds
 434   }
 435
 436   if ( ($from_to->{from} =~ m{sales}) && ($from_to->{to} =~ m{purchase}) ) {
 437     $record_args{customer_id}      = undef;
 438     $record_args{billing_address_id} = undef;
 439     $record_args{salesman_id}      = undef;
 440     $record_args{payment_id}       = undef;
 441     $record_args{delivery_term_id} = undef;
 442   }
 443   if ( ($from_to->{from} =~ m{purchase}) && ($from_to->{to} =~ m{sales}) ) {
 444     $record_args{vendor_id} = undef;
 445     $record_args{salesman_id} = undef;
 446     $record_args{payment_id} = undef;
 447     $record_args{delivery_term_id} = undef;
 448   }
 449
 450
 451   if ($source->can('shipto_id')) {
 452     # Custom shipto addresses (the ones specific to the sales/purchase record and
 453     # not to the customer/vendor) are only linked from shipto → record.
 454     # Meaning record.shipto_id will not be filled in that case.
 455     if (!$source->shipto_id && $source->id) {
 456       $record_args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
 457     } elsif ($source->shipto_id) {
 458       $record_args{shipto_id} = $source->shipto_id;
 459     }
 460   }
 461
 462   my $reclamation = $class->new(%record_args);
 463   $reclamation->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 464
 465   unless ($params{no_linked_records}) {
 466     $reclamation->{RECORD_TYPE_REF()} = ref($source);
 467     $reclamation->{RECORD_ID()} = $source->id;
 468   };
 469
 470   my $items = delete($params{items}) || $source->items;
 471
 472   my @items = map { SL::DB::ReclamationItem->new_from($_, $from_to->{to}, no_linked_records => $params{no_linked_records}); } @{ $items };
 473
 474   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
 475   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
 476   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
 477
 478   $reclamation->items(\@items);
 479   return $reclamation;
 480 }
 481
 482 sub customervendor {
 483   my ($reclamation) = @_;
 484   return $reclamation->is_sales ? $reclamation->customer : $reclamation->vendor;
 485 }
 486
 487 sub date {
 488   goto &transdate;
 489 }
 490
 491 sub digest {
 492   my ($self) = @_;
 493
 494   sprintf "%s %s %s (%s)",
 495     $self->record_number,
 496     $self->customervendor->name,
 497     $self->amount_as_number,
 498     $self->date->to_kivitendo;
 499 }
 500
 501 sub type_data {
 502   SL::DB::Helper::TypeDataProxy->new(ref $_[0], $_[0]->type);
 503 }
 504
 505
 506 1;
 507
 508 __END__
 509
 510 =pod
 511
 512 =encoding utf8
 513
 514 =head1 NAME
 515
 516 SL::DB::Reclamation - reclamation Datenbank Objekt.
 517
 518 =head1 FUNCTIONS
 519
 520 =head2 C<type>
 521
 522 Returns one of the following string types:
 523
 524 =over 4
 525
 526 =item sales_reclamation
 527
 528 =item purchase_reclamation
 529
 530 =item sales_quotation
 531
 532 =item request_quotation
 533
 534 =back
 535
 536 =head2 C<is_type TYPE>
 537
 538 Returns true if the reclamation is of the given type.
 539
 540 =head2 C<daily_exchangerate $val>
 541
 542 Gets or sets the exchangerate object's value. This is the value from the
 543 table C<exchangerate> depending on the reclamation's currency, the transdate and
 544 if it is a sales or purchase reclamation.
 545
 546 The reclamation object (respectively the table C<oe>) has an own column
 547 C<exchangerate> which can be get or set with the accessor C<exchangerate>.
 548
 549 The idea is to drop the legacy table C<exchangerate> in the future and to
 550 give all relevant tables it's own C<exchangerate> column.
 551
 552 So, this method is here if you need to access the "legacy" exchangerate via
 553 an reclamation object.
 554
 555 =over 4
 556
 557 =item C<$val>
 558
 559 (optional) If given, the exchangerate in the "legacy" table is set to this
 560 value, depending on currency, transdate and sales or purchase.
 561
 562 =back
 563
 564 =head2 C<convert_to_delivery_order %params>
 565
 566 Creates a new delivery reclamation with C<$self> as the basis by calling
 567 L<SL::DB::DeliveryReclamation::new_from>. That delivery reclamation is saved, and
 568 C<$self> is linked to the new invoice via
 569 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
 570 C<true>, and C<$self> is saved.
 571
 572 The arguments in C<%params> are passed to
 573 L<SL::DB::DeliveryReclamation::new_from>.
 574
 575 Returns C<undef> on failure. Otherwise the new delivery reclamation will be
 576 returned.
 577
 578 =head2 C<convert_to_invoice %params>
 579
 580 Creates a new invoice with C<$self> as the basis by calling
 581 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 582 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 583 C<closed> attribute is set to C<true>, and C<$self> is saved.
 584
 585 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
 586
 587 Returns the new invoice instance on success and C<undef> on
 588 failure. The whole process is run inside a transaction. On failure
 589 nothing is created or changed in the database.
 590
 591 At the moment only sales quotations and sales reclamations can be converted.
 592
 593 =head2 C<add_legacy_template_arrays $print_form>
 594
 595 For printing OpenDocument documents we need to extract loop variables (items and
 596 taxes) from the Rose DB object and add them to the form, in the format that the
 597 built-in template parser expects.
 598
 599 <$print_form> Print form used in the controller.
 600
 601 =head2 C<new_from $source, %params>
 602
 603 Creates a new C<SL::DB::Reclamation> instance and copies as much
 604 information from C<$source> as possible. At the moment only records with the
 605 same destination type as the source type and sales reclamations from
 606 sales quotations and purchase reclamations from requests for quotations can be
 607 created.
 608
 609 The C<transdate> field will be set to the current date.
 610
 611 The conversion copies the reclamation items as well.
 612
 613 Returns the new reclamation instance. The object returned is not
 614 saved.
 615
 616 C<%params> can include the following options
 617 (C<destination_type> is mandatory):
 618
 619 =over 4
 620
 621 =item C<destination_type>
 622
 623 (mandatory)
 624 The type of the newly created object. Can be C<sales_quotation>,
 625 C<sales_reclamation>, C<purchase_quotation> or C<purchase_reclamation> for now.
 626
 627 =item C<items>
 628
 629 An optional array reference of RDBO instances for the items to use. If
 630 missing then the method C<items_sorted> will be called on
 631 C<$source>. This option can be used to override the sorting, to
 632 exclude certain positions or to add additional ones.
 633
 634 =item C<skip_items_negative_qty>
 635
 636 If trueish then items with a negative quantity are skipped. Items with
 637 a quantity of 0 are not affected by this option.
 638
 639 =item C<skip_items_zero_qty>
 640
 641 If trueish then items with a quantity of 0 are skipped.
 642
 643 =item C<item_filter>
 644
 645 An optional code reference that is called for each item with the item
 646 as its sole parameter. Items for which the code reference returns a
 647 falsish value will be skipped.
 648
 649 =item C<attributes>
 650
 651 An optional hash reference. If it exists then it is passed to C<new>
 652 allowing the caller to set certain attributes for the new delivery
 653 reclamation.
 654
 655 =back
 656
 657 =head1 BUGS
 658
 659 Nothing here yet.
 660
 661 =head1 AUTHOR
 662
 663 Sven Schöling <s.schoeling@linet-services.de>
 664
 665 =cut