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