SL/DB/Order.pm

   1 package SL::DB::Order;
   2
   3 use utf8;
   4 use strict;
   5
   6 use Carp;
   7 use DateTime;
   8 use List::Util qw(max);
   9 use List::MoreUtils qw(any);
  10
  11 use SL::DB::MetaSetup::Order;
  12 use SL::DB::Manager::Order;
  13 use SL::DB::Helper::AttrHTML;
  14 use SL::DB::Helper::AttrSorted;
  15 use SL::DB::Helper::FlattenToForm;
  16 use SL::DB::Helper::LinkedRecords;
  17 use SL::DB::Helper::PriceTaxCalculator;
  18 use SL::DB::Helper::PriceUpdater;
  19 use SL::DB::Helper::TransNumberGenerator;
  20 use SL::RecordLinks;
  21 use Rose::DB::Object::Helpers qw(as_tree);
  22
  23 __PACKAGE__->meta->add_relationship(
  24   orderitems => {
  25     type         => 'one to many',
  26     class        => 'SL::DB::OrderItem',
  27     column_map   => { id => 'trans_id' },
  28     manager_args => {
  29       with_objects => [ 'part' ]
  30     }
  31   },
  32   periodic_invoices_config => {
  33     type                   => 'one to one',
  34     class                  => 'SL::DB::PeriodicInvoicesConfig',
  35     column_map             => { id => 'oe_id' },
  36   },
  37   custom_shipto            => {
  38     type                   => 'one to one',
  39     class                  => 'SL::DB::Shipto',
  40     column_map             => { id => 'trans_id' },
  41     query_args             => [ module => 'OE' ],
  42   },
  43 );
  44
  45 __PACKAGE__->meta->initialize;
  46
  47 __PACKAGE__->attr_html('notes');
  48 __PACKAGE__->attr_sorted('items');
  49
  50 __PACKAGE__->before_save('_before_save_set_ord_quo_number');
  51
  52 # hooks
  53
  54 sub _before_save_set_ord_quo_number {
  55   my ($self) = @_;
  56
  57   # ordnumber is 'NOT NULL'. Therefore make sure it's always set to at
  58   # least an empty string, even if we're saving a quotation.
  59   $self->ordnumber('') if !$self->ordnumber;
  60
  61   my $field = $self->quotation ? 'quonumber' : 'ordnumber';
  62   $self->create_trans_number if !$self->$field;
  63
  64   return 1;
  65 }
  66
  67 # methods
  68
  69 sub items { goto &orderitems; }
  70 sub add_items { goto &add_orderitems; }
  71 sub record_number { goto &number; }
  72
  73 sub type {
  74   my $self = shift;
  75
  76   return 'sales_order'       if $self->customer_id && ! $self->quotation;
  77   return 'purchase_order'    if $self->vendor_id   && ! $self->quotation;
  78   return 'sales_quotation'   if $self->customer_id &&   $self->quotation;
  79   return 'request_quotation' if $self->vendor_id   &&   $self->quotation;
  80
  81   return;
  82 }
  83
  84 sub is_type {
  85   return shift->type eq shift;
  86 }
  87
  88 sub displayable_type {
  89   my $type = shift->type;
  90
  91   return $::locale->text('Sales quotation')   if $type eq 'sales_quotation';
  92   return $::locale->text('Request quotation') if $type eq 'request_quotation';
  93   return $::locale->text('Sales Order')       if $type eq 'sales_order';
  94   return $::locale->text('Purchase Order')    if $type eq 'purchase_order';
  95
  96   die 'invalid type';
  97 }
  98
  99 sub displayable_name {
 100   join ' ', grep $_, map $_[0]->$_, qw(displayable_type record_number);
 101 };
 102
 103 sub is_sales {
 104   croak 'not an accessor' if @_ > 1;
 105   return !!shift->customer_id;
 106 }
 107
 108 sub invoices {
 109   my $self   = shift;
 110   my %params = @_;
 111
 112   if ($self->quotation) {
 113     return [];
 114   } else {
 115     require SL::DB::Invoice;
 116     return SL::DB::Manager::Invoice->get_all(
 117       query => [
 118         ordnumber => $self->ordnumber,
 119         @{ $params{query} || [] },
 120       ]
 121     );
 122   }
 123 }
 124
 125 sub displayable_state {
 126   my ($self) = @_;
 127
 128   return $self->closed ? $::locale->text('closed') : $::locale->text('open');
 129 }
 130
 131 sub abschlag_invoices {
 132   return shift()->invoices(query => [ abschlag => 1 ]);
 133 }
 134
 135 sub end_invoice {
 136   return shift()->invoices(query => [ abschlag => 0 ]);
 137 }
 138
 139 sub convert_to_invoice {
 140   my ($self, %params) = @_;
 141
 142   croak("Conversion to invoices is only supported for sales records") unless $self->customer_id;
 143
 144   my $invoice;
 145   if (!$self->db->with_transaction(sub {
 146     require SL::DB::Invoice;
 147     $invoice = SL::DB::Invoice->new_from($self)->post(%params) || die;
 148     $self->link_to_record($invoice);
 149     $self->update_attributes(closed => 1);
 150     1;
 151   })) {
 152     return undef;
 153   }
 154
 155   return $invoice;
 156 }
 157
 158 sub convert_to_delivery_order {
 159   my ($self, @args) = @_;
 160
 161   my $delivery_order;
 162   if (!$self->db->with_transaction(sub {
 163     require SL::DB::DeliveryOrder;
 164     $delivery_order = SL::DB::DeliveryOrder->new_from($self, @args);
 165     $delivery_order->save;
 166     $self->link_to_record($delivery_order);
 167     # TODO extend link_to_record for items, otherwise long-term no d.r.y.
 168     foreach my $item (@{ $delivery_order->items }) {
 169       foreach (qw(orderitems)) {    # expand if needed (delivery_order_items)
 170         if ($item->{"converted_from_${_}_id"}) {
 171           die unless $item->{id};
 172           RecordLinks->create_links('dbh'        => $self->db->dbh,
 173                                     'mode'       => 'ids',
 174                                     'from_table' => $_,
 175                                     'from_ids'   => $item->{"converted_from_${_}_id"},
 176                                     'to_table'   => 'delivery_order_items',
 177                                     'to_id'      => $item->{id},
 178           ) || die;
 179           delete $item->{"converted_from_${_}_id"};
 180         }
 181       }
 182     }
 183
 184     $self->update_attributes(delivered => 1);
 185     1;
 186   })) {
 187     return undef;
 188   }
 189
 190   return $delivery_order;
 191 }
 192
 193 sub _clone_orderitem_cvar {
 194   my ($cvar) = @_;
 195
 196   my $cloned = $_->clone_and_reset;
 197   $cloned->sub_module('orderitems');
 198
 199   return $cloned;
 200 }
 201
 202 sub new_from {
 203   my ($class, $source, %params) = @_;
 204
 205   croak("Unsupported source object type '" . ref($source) . "'") unless ref($source) eq 'SL::DB::Order';
 206   croak("A destination type must be given as parameter")         unless $params{destination_type};
 207
 208   my $destination_type  = delete $params{destination_type};
 209
 210   my @from_tos = (
 211     { from => 'sales_quotation',   to => 'sales_order',       abbr => 'sqso' },
 212     { from => 'request_quotation', to => 'purchase_order',    abbr => 'rqpo' },
 213     { from => 'sales_quotation',   to => 'sales_quotation',   abbr => 'sqsq' },
 214     { from => 'sales_order',       to => 'sales_order',       abbr => 'soso' },
 215     { from => 'request_quotation', to => 'request_quotation', abbr => 'rqrq' },
 216     { from => 'purchase_order',    to => 'purchase_order',    abbr => 'popo' },
 217     { from => 'sales_order',       to => 'purchase_order',    abbr => 'sopo' },
 218     { from => 'purchase_order',    to => 'sales_order',       abbr => 'poso' },
 219   );
 220   my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
 221   croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
 222
 223   my $is_abbr_any = sub {
 224     # foreach my $abbr (@_) {
 225     #   croak "no such abbreviation: '$abbr'" if !grep { $_->{abbr} eq $abbr } @from_tos;
 226     # }
 227     any { $from_to->{abbr} eq $_ } @_;
 228   };
 229
 230   my ($item_parent_id_column, $item_parent_column);
 231
 232   if (ref($source) eq 'SL::DB::Order') {
 233     $item_parent_id_column = 'trans_id';
 234     $item_parent_column    = 'order';
 235   }
 236
 237   my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
 238                                                 department_id employee_id globalproject_id intnotes marge_percent marge_total language_id netamount notes
 239                                                 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
 240                                                 transaction_description vendor_id
 241                                              )),
 242                quotation => !!($destination_type =~ m{quotation$}),
 243                closed    => 0,
 244                delivered => 0,
 245                transdate => DateTime->today_local,
 246             );
 247
 248   if ( $is_abbr_any->(qw(sopo poso)) ) {
 249     $args{ordnumber} = undef;
 250     $args{reqdate}   = DateTime->today_local->next_workday();
 251     $args{employee}  = SL::DB::Manager::Employee->current;
 252   }
 253   if ( $is_abbr_any->(qw(sopo)) ) {
 254     $args{customer_id}      = undef;
 255     $args{salesman_id}      = undef;
 256     $args{payment_id}       = undef;
 257     $args{delivery_term_id} = undef;
 258   }
 259   if ( $is_abbr_any->(qw(poso)) ) {
 260     $args{vendor_id} = undef;
 261   }
 262   if ( $is_abbr_any->(qw(soso)) ) {
 263     $args{periodic_invoices_config} = $source->periodic_invoices_config->clone_and_reset if $source->periodic_invoices_config;
 264   }
 265
 266   # Custom shipto addresses (the ones specific to the sales/purchase
 267   # record and not to the customer/vendor) are only linked from
 268   # shipto → order. Meaning order.shipto_id
 269   # will not be filled in that case.
 270   if (!$source->shipto_id && $source->id) {
 271     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
 272
 273   } else {
 274     $args{shipto_id} = $source->shipto_id;
 275   }
 276
 277   my $order = $class->new(%args);
 278   $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 279   my $items = delete($params{items}) || $source->items_sorted;
 280   my %item_parents;
 281
 282   my @items = map {
 283     my $source_item      = $_;
 284     my $source_item_id   = $_->$item_parent_id_column;
 285     my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
 286
 287     $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
 288     my $item_parent                  = $item_parents{$source_item_id};
 289
 290     my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
 291                                                      qw(active_discount_source active_price_source base_qty cusordnumber
 292                                                         description discount lastcost longdescription
 293                                                         marge_percent marge_price_factor marge_total
 294                                                         ordnumber parts_id price_factor price_factor_id pricegroup_id
 295                                                         project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
 296                                                      )),
 297                                                  custom_variables => \@custom_variables,
 298     );
 299     if ( $is_abbr_any->(qw(sopo)) ) {
 300       $current_oe_item->sellprice($source_item->lastcost);
 301       $current_oe_item->discount(0);
 302     }
 303     if ( $is_abbr_any->(qw(poso)) ) {
 304       $current_oe_item->lastcost($source_item->sellprice);
 305     }
 306     $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
 307     $current_oe_item;
 308   } @{ $items };
 309
 310   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
 311   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
 312   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
 313
 314   $order->items(\@items);
 315
 316   return $order;
 317 }
 318
 319 sub number {
 320   my $self = shift;
 321
 322   return if !$self->type;
 323
 324   my %number_method = (
 325     sales_order       => 'ordnumber',
 326     sales_quotation   => 'quonumber',
 327     purchase_order    => 'ordnumber',
 328     request_quotation => 'quonumber',
 329   );
 330
 331   return $self->${ \ $number_method{$self->type} }(@_);
 332 }
 333
 334 sub customervendor {
 335   $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
 336 }
 337
 338 sub date {
 339   goto &transdate;
 340 }
 341
 342 sub digest {
 343   my ($self) = @_;
 344
 345   sprintf "%s %s %s (%s)",
 346     $self->number,
 347     $self->customervendor->name,
 348     $self->amount_as_number,
 349     $self->date->to_kivitendo;
 350 }
 351
 352 1;
 353
 354 __END__
 355
 356 =pod
 357
 358 =encoding utf8
 359
 360 =head1 NAME
 361
 362 SL::DB::Order - Order Datenbank Objekt.
 363
 364 =head1 FUNCTIONS
 365
 366 =head2 C<type>
 367
 368 Returns one of the following string types:
 369
 370 =over 4
 371
 372 =item sales_order
 373
 374 =item purchase_order
 375
 376 =item sales_quotation
 377
 378 =item request_quotation
 379
 380 =back
 381
 382 =head2 C<is_type TYPE>
 383
 384 Returns true if the order is of the given type.
 385
 386 =head2 C<convert_to_delivery_order %params>
 387
 388 Creates a new delivery order with C<$self> as the basis by calling
 389 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
 390 C<$self> is linked to the new invoice via
 391 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
 392 C<true>, and C<$self> is saved.
 393
 394 The arguments in C<%params> are passed to
 395 L<SL::DB::DeliveryOrder::new_from>.
 396
 397 Returns C<undef> on failure. Otherwise the new delivery order will be
 398 returned.
 399
 400 =head2 C<convert_to_invoice %params>
 401
 402 Creates a new invoice with C<$self> as the basis by calling
 403 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 404 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 405 C<closed> attribute is set to C<true>, and C<$self> is saved.
 406
 407 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
 408
 409 Returns the new invoice instance on success and C<undef> on
 410 failure. The whole process is run inside a transaction. On failure
 411 nothing is created or changed in the database.
 412
 413 At the moment only sales quotations and sales orders can be converted.
 414
 415 =head2 C<new_from $source, %params>
 416
 417 Creates a new C<SL::DB::Order> instance and copies as much
 418 information from C<$source> as possible. At the moment only records with the
 419 same destination type as the source type and sales orders from
 420 sales quotations and purchase orders from requests for quotations can be
 421 created.
 422
 423 The C<transdate> field will be set to the current date.
 424
 425 The conversion copies the order items as well.
 426
 427 Returns the new order instance. The object returned is not
 428 saved.
 429
 430 C<%params> can include the following options
 431 (C<destination_type> is mandatory):
 432
 433 =over 4
 434
 435 =item C<destination_type>
 436
 437 (mandatory)
 438 The type of the newly created object. Can be C<sales_quotation>,
 439 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
 440
 441 =item C<items>
 442
 443 An optional array reference of RDBO instances for the items to use. If
 444 missing then the method C<items_sorted> will be called on
 445 C<$source>. This option can be used to override the sorting, to
 446 exclude certain positions or to add additional ones.
 447
 448 =item C<skip_items_negative_qty>
 449
 450 If trueish then items with a negative quantity are skipped. Items with
 451 a quantity of 0 are not affected by this option.
 452
 453 =item C<skip_items_zero_qty>
 454
 455 If trueish then items with a quantity of 0 are skipped.
 456
 457 =item C<item_filter>
 458
 459 An optional code reference that is called for each item with the item
 460 as its sole parameter. Items for which the code reference returns a
 461 falsish value will be skipped.
 462
 463 =item C<attributes>
 464
 465 An optional hash reference. If it exists then it is passed to C<new>
 466 allowing the caller to set certain attributes for the new delivery
 467 order.
 468
 469 =back
 470
 471 =head2 C<create_sales_process>
 472
 473 Creates and saves a new sales process. Can only be called for sales
 474 orders.
 475
 476 The newly created process will be linked bidirectionally to both
 477 C<$self> and to all sales quotations that are linked to C<$self>.
 478
 479 Returns the newly created process instance.
 480
 481 =head1 BUGS
 482
 483 Nothing here yet.
 484
 485 =head1 AUTHOR
 486
 487 Sven Schöling <s.schoeling@linet-services.de>
 488
 489 =cut