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   );
 218   my $from_to = (grep { $_->{from} eq $source->type && $_->{to} eq $destination_type} @from_tos)[0];
 219   croak("Cannot convert from '" . $source->type . "' to '" . $destination_type . "'") if !$from_to;
 220
 221   my ($item_parent_id_column, $item_parent_column);
 222
 223   if (ref($source) eq 'SL::DB::Order') {
 224     $item_parent_id_column = 'trans_id';
 225     $item_parent_column    = 'order';
 226   }
 227
 228   my %args = ( map({ ( $_ => $source->$_ ) } qw(amount cp_id currency_id cusordnumber customer_id delivery_customer_id delivery_term_id delivery_vendor_id
 229                                                 department_id employee_id globalproject_id intnotes marge_percent marge_total language_id netamount notes
 230                                                 ordnumber payment_id quonumber reqdate salesman_id shippingpoint shipvia taxincluded taxzone_id
 231                                                 transaction_description vendor_id
 232                                              )),
 233                quotation => !!($destination_type =~ m{quotation$}),
 234                closed    => 0,
 235                delivered => 0,
 236                transdate => DateTime->today_local,
 237             );
 238
 239   # Custom shipto addresses (the ones specific to the sales/purchase
 240   # record and not to the customer/vendor) are only linked from
 241   # shipto → order. Meaning order.shipto_id
 242   # will not be filled in that case.
 243   if (!$source->shipto_id && $source->id) {
 244     $args{custom_shipto} = $source->custom_shipto->clone($class) if $source->can('custom_shipto') && $source->custom_shipto;
 245
 246   } else {
 247     $args{shipto_id} = $source->shipto_id;
 248   }
 249
 250   my $order = $class->new(%args);
 251   $order->assign_attributes(%{ $params{attributes} }) if $params{attributes};
 252   my $items = delete($params{items}) || $source->items_sorted;
 253   my %item_parents;
 254
 255   my @items = map {
 256     my $source_item      = $_;
 257     my $source_item_id   = $_->$item_parent_id_column;
 258     my @custom_variables = map { _clone_orderitem_cvar($_) } @{ $source_item->custom_variables };
 259
 260     $item_parents{$source_item_id} ||= $source_item->$item_parent_column;
 261     my $item_parent                  = $item_parents{$source_item_id};
 262
 263     my $current_oe_item = SL::DB::OrderItem->new(map({ ( $_ => $source_item->$_ ) }
 264                                                      qw(active_discount_source active_price_source base_qty cusordnumber
 265                                                         description discount lastcost longdescription
 266                                                         marge_percent marge_price_factor marge_total
 267                                                         ordnumber parts_id price_factor price_factor_id pricegroup_id
 268                                                         project_id qty reqdate sellprice serialnumber ship subtotal transdate unit
 269                                                      )),
 270                                                  custom_variables => \@custom_variables,
 271     );
 272     $current_oe_item->{"converted_from_orderitems_id"} = $_->{id} if ref($item_parent) eq 'SL::DB::Order';
 273     $current_oe_item;
 274   } @{ $items };
 275
 276   @items = grep { $params{item_filter}->($_) } @items if $params{item_filter};
 277   @items = grep { $_->qty * 1 } @items if $params{skip_items_zero_qty};
 278   @items = grep { $_->qty >=0 } @items if $params{skip_items_negative_qty};
 279
 280   $order->items(\@items);
 281
 282   return $order;
 283 }
 284
 285 sub number {
 286   my $self = shift;
 287
 288   return if !$self->type;
 289
 290   my %number_method = (
 291     sales_order       => 'ordnumber',
 292     sales_quotation   => 'quonumber',
 293     purchase_order    => 'ordnumber',
 294     request_quotation => 'quonumber',
 295   );
 296
 297   return $self->${ \ $number_method{$self->type} }(@_);
 298 }
 299
 300 sub customervendor {
 301   $_[0]->is_sales ? $_[0]->customer : $_[0]->vendor;
 302 }
 303
 304 sub date {
 305   goto &transdate;
 306 }
 307
 308 sub digest {
 309   my ($self) = @_;
 310
 311   sprintf "%s %s %s (%s)",
 312     $self->number,
 313     $self->customervendor->name,
 314     $self->amount_as_number,
 315     $self->date->to_kivitendo;
 316 }
 317
 318 1;
 319
 320 __END__
 321
 322 =pod
 323
 324 =encoding utf8
 325
 326 =head1 NAME
 327
 328 SL::DB::Order - Order Datenbank Objekt.
 329
 330 =head1 FUNCTIONS
 331
 332 =head2 C<type>
 333
 334 Returns one of the following string types:
 335
 336 =over 4
 337
 338 =item sales_order
 339
 340 =item purchase_order
 341
 342 =item sales_quotation
 343
 344 =item request_quotation
 345
 346 =back
 347
 348 =head2 C<is_type TYPE>
 349
 350 Returns true if the order is of the given type.
 351
 352 =head2 C<convert_to_delivery_order %params>
 353
 354 Creates a new delivery order with C<$self> as the basis by calling
 355 L<SL::DB::DeliveryOrder::new_from>. That delivery order is saved, and
 356 C<$self> is linked to the new invoice via
 357 L<SL::DB::RecordLink>. C<$self>'s C<delivered> attribute is set to
 358 C<true>, and C<$self> is saved.
 359
 360 The arguments in C<%params> are passed to
 361 L<SL::DB::DeliveryOrder::new_from>.
 362
 363 Returns C<undef> on failure. Otherwise the new delivery order will be
 364 returned.
 365
 366 =head2 C<convert_to_invoice %params>
 367
 368 Creates a new invoice with C<$self> as the basis by calling
 369 L<SL::DB::Invoice::new_from>. That invoice is posted, and C<$self> is
 370 linked to the new invoice via L<SL::DB::RecordLink>. C<$self>'s
 371 C<closed> attribute is set to C<true>, and C<$self> is saved.
 372
 373 The arguments in C<%params> are passed to L<SL::DB::Invoice::post>.
 374
 375 Returns the new invoice instance on success and C<undef> on
 376 failure. The whole process is run inside a transaction. On failure
 377 nothing is created or changed in the database.
 378
 379 At the moment only sales quotations and sales orders can be converted.
 380
 381 =head2 C<new_from $source, %params>
 382
 383 Creates a new C<SL::DB::Order> instance and copies as much
 384 information from C<$source> as possible. At the moment only records with the
 385 same destination type as the source type and sales orders from
 386 sales quotations and purchase orders from requests for quotations can be
 387 created.
 388
 389 The C<transdate> field will be set to the current date.
 390
 391 The conversion copies the order items as well.
 392
 393 Returns the new order instance. The object returned is not
 394 saved.
 395
 396 C<%params> can include the following options
 397 (C<destination_type> is mandatory):
 398
 399 =over 4
 400
 401 =item C<destination_type>
 402
 403 (mandatory)
 404 The type of the newly created object. Can be C<sales_quotation>,
 405 C<sales_order>, C<purchase_quotation> or C<purchase_order> for now.
 406
 407 =item C<items>
 408
 409 An optional array reference of RDBO instances for the items to use. If
 410 missing then the method C<items_sorted> will be called on
 411 C<$source>. This option can be used to override the sorting, to
 412 exclude certain positions or to add additional ones.
 413
 414 =item C<skip_items_negative_qty>
 415
 416 If trueish then items with a negative quantity are skipped. Items with
 417 a quantity of 0 are not affected by this option.
 418
 419 =item C<skip_items_zero_qty>
 420
 421 If trueish then items with a quantity of 0 are skipped.
 422
 423 =item C<item_filter>
 424
 425 An optional code reference that is called for each item with the item
 426 as its sole parameter. Items for which the code reference returns a
 427 falsish value will be skipped.
 428
 429 =item C<attributes>
 430
 431 An optional hash reference. If it exists then it is passed to C<new>
 432 allowing the caller to set certain attributes for the new delivery
 433 order.
 434
 435 =back
 436
 437 =head2 C<create_sales_process>
 438
 439 Creates and saves a new sales process. Can only be called for sales
 440 orders.
 441
 442 The newly created process will be linked bidirectionally to both
 443 C<$self> and to all sales quotations that are linked to C<$self>.
 444
 445 Returns the newly created process instance.
 446
 447 =head1 BUGS
 448
 449 Nothing here yet.
 450
 451 =head1 AUTHOR
 452
 453 Sven Schöling <s.schoeling@linet-services.de>
 454
 455 =cut