Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision c7cabbb2

Von Sven Schöling vor etwa 13 Jahren hinzugefügt

  • ID c7cabbb276bfc046b6855b4330538288bf33385d
  • Vorgänger 719696e4
  • Nachfolger 9d14fd7e

WH->transfer - Interface akzeptiert jetzt Rose Objekte.

Ausserdem transfer dokumentiert und Tests erweitert.

Unterschiede anzeigen:

SL/WH.pm
55 55
  require SL::DB::Part;
56 56
  require SL::DB::Employee;
57 57
  require SL::DB::Inventory;
58

  
58 59
  my $employee   = SL::DB::Manager::Employee->find_by(login => $::form->{login});
59 60
  my ($now)      = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT current_date|);
60 61
  my @directions = (undef, qw(out in transfer));
61
  my $db         = SL::DB->create(undef, 'LXOFFICE');
62

  
63
  for my $transfer (@args) {
64
    my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
65

  
66
    my $direction = 0;
67
    $direction |= 1 if ($transfer->{src_warehouse_id} && $transfer->{src_bin_id});
68
    $direction |= 2 if ($transfer->{dst_warehouse_id} && $transfer->{dst_bin_id});
69

  
70
    $transfer->{trans_type_id} = $transfer->{transfer_type_id} || SL::DB::Manager::TransferType->find_by(
71
      direction   => $directions[$direction],
72
      description => $transfer->{transfer_type},
73
    )->id;
74

  
75
    my %params = (
76
        shippingdate     => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date' ? $now : $transfer->{shippingdate},
77
        employee         => $employee,
78
        trans_id         => $trans_id,
79
        map { $_ => $transfer->{$_} } qw(
80
          parts_id chargenumber bestbefore oe_id orderitems_id project_id comment trans_type_id),
81
    );
62
  my $db         = SL::DB->create(undef, 'LXOFFICE'); # get handle for transaction
82 63

  
83
    my $qty = $transfer->{qty};
64
  my $objectify = sub {
65
    my ($transfer, $field, $class, @find_by) = @_;
84 66

  
85
    if ($transfer->{unit}) {
86
      my $part          = SL::DB::Manager::Part->find_by(id => $transfer->{parts_id});
87
      my $transfer_unit = SL::DB::Manager::Unit->find_by(name => $transfer->{unit});
67
    @find_by = (description => $transfer->{$field}) unless @find_by;
88 68

  
89
      $qty *= $transfer_unit->factor;
90
      $qty /= $part->unit_obj->factor || 1 if $part->unit;
69
    if ($transfer->{$field} || $transfer->{"${field}_id"}) {
70
      return ref $transfer->{$field} && $transfer->{$field}->isa($class) ? $transfer->{$field}
71
           : $transfer->{$field}    ? $class->_get_manager_class->find_by(@find_by)
72
           : $class->_get_manager_class->find_by(id => $transfer->{"${field}_id"});
91 73
    }
74
    return;
75
  };
76

  
77
  $db->begin_work;
78
  eval {
79

  
80
    for my $transfer (@args) {
81
      my ($trans_id) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT nextval('id')|);
82

  
83
      my $part          = $objectify->($transfer, 'parts',         'SL::DB::Part');
84
      my $unit          = $objectify->($transfer, 'unit',          'SL::DB::Unit',         unit => $transfer->{unit});
85
      my $qty           = $transfer->{qty};
86
      my $src_bin       = $objectify->($transfer, 'src_bin',       'SL::DB::Bin');
87
      my $dst_bin       = $objectify->($transfer, 'dst_bin',       'SL::DB::Bin');
88
      my $src_wh        = $objectify->($transfer, 'src_warehouse', 'SL::DB::Warehouse');
89
      my $dst_wh        = $objectify->($transfer, 'dst_warehouse', 'SL::DB::Warehouse');
90
      my $project       = $objectify->($transfer, 'project',       'SL::DB::Project');
91

  
92
      $src_wh ||= $src_bin->warehouse if $src_bin;
93
      $dst_wh ||= $dst_bin->warehouse if $dst_bin;
94

  
95
      my $direction = 0; # bit mask
96
      $direction |= 1 if $src_bin;
97
      $direction |= 2 if $dst_bin;
98

  
99
      my $transfer_type = $objectify->($transfer, 'transfer_type', 'SL::DB::TransferType', direction   => $directions[$direction],
100
                                                                                           description => $transfer->{transfer_type});
101

  
102
      my %params = (
103
          part             => $part,
104
          employee         => $employee,
105
          trans_type       => $transfer_type,
106
          project          => $project,
107
          trans_id         => $trans_id,
108
          shippingdate     => !$transfer->{shippingdate} || $transfer->{shippingdate} eq 'current_date'
109
                              ? $now : $transfer->{shippingdate},
110
          map { $_ => $transfer->{$_} } qw( chargenumber bestbefore oe_id orderitems_id comment),
111
      );
112

  
113
      if ($unit) {
114
        $qty *= $unit->factor;
115
        $qty /= $part->unit_obj->factor || 1 if $part->unit;
116
      }
92 117

  
93
    if ($direction & 1) {
94
      SL::DB::Inventory->new(
95
        %params,
96
        warehouse_id => $transfer->{src_warehouse_id},
97
        bin_id       => $transfer->{src_bin_id},
98
        qty          => $qty * -1
99
      )->save;
100
    }
118
      if ($direction & 1) {
119
        SL::DB::Inventory->new(
120
          %params,
121
          warehouse => $src_wh,
122
          bin       => $src_bin,
123
          qty       => $qty * -1,
124
        )->save;
125
      }
101 126

  
102
    if ($direction & 2) {
103
      SL::DB::Inventory->new(
104
        %params,
105
        warehouse_id => $transfer->{dst_warehouse_id},
106
        bin_id       => $transfer->{dst_bin_id},
107
        qty          => $qty
108
      )->save;
127
      if ($direction & 2) {
128
        SL::DB::Inventory->new(
129
          %params,
130
          warehouse => $dst_wh->id,
131
          bin       => $dst_bin->id,
132
          qty       => $qty,
133
        )->save;
134
      }
109 135
    }
110
  }
111 136

  
112
  $db->commit;
137
    $db->commit;
138

  
139
    1;
140
  } or do {
141
    $db->rollback;
142
    die $@; # rethrow
143
  };
113 144

  
114 145
  $::lxdebug->leave_sub;
115 146
}
......
871 902
}
872 903

  
873 904

  
905
1;
906

  
907
__END__
908

  
909
=head1 NAME
910

  
911
SL::WH - Warehouse backend
912

  
913
=head1 SYNOPSIS
914

  
915
  use SL::WH;
916
  WH->transfer(\%params);
917

  
918
=head1 DESCRIPTION
919

  
920
Backend for lx-office warehousing functions.
921

  
922
=head1 FUNCTIONS
923

  
924
=head2 transfer \%PARAMS, [ \%PARAMS, ... ]
925

  
926
This is the main function to manipulate warehouse contents. A typical transfer
927
is called like this:
928

  
929
  WH->transfer->({
930
    parts_id         => 6342,
931
    qty              => 12.45,
932
    transfer_type    => 'transfer',
933
    src_warehouse_id => 12,
934
    stc_bin_id       => 23,
935
    dst_warehouse_id => 25,
936
    dst_bin_id       => 167,
937
  });
938

  
939
It will generate an entry in inventory representing the transfer. Note that
940
parts_id, qty, and transfer_type are mandatory. Depending on the transfer_type
941
a destination or a src is mandatory.
942

  
943
transfer accepts more than one transaction parameter, each being a hash ref. If
944
more than one is supplied, it is guaranteed, that all are processed in the same
945
transaction.
946

  
947
Here is a full list of parameters. All "_id" parameters except oe and
948
orderitems can be called without id with RDB objects as well.
949

  
950
=over 4
951

  
952
=item parts_id
953

  
954
The id of the article transferred. Does not check if the article is a service.
955
Mandatory.
956

  
957
=item qty
958

  
959
Quantity of the transaction.  Mandatory.
960

  
961
=item unit
962

  
963
Unit of the transaction. Optional.
964

  
965
=item transfer_type
966

  
967
=item transfer_type_id
968

  
969
The type of transaction. The first version is a string describing the
970
transaction (the types 'transfer' 'in' 'out' and a few others are present on
971
every system), the id is the hard id of a transfer_type from the database.
972

  
973
Depending of the direction of the transfer_type, source and/or destination must
974
be specified.
975

  
976
One of transfer_type or transfer_type_id is mandatory.
977

  
978
=item src_warehouse_id
979

  
980
=item src_bin_id
981

  
982
Warehouse and bin from which to transfer. Mandatory in transfer and out
983
directions. Ignored in in directions.
984

  
985
=item dst_warehouse_id
986

  
987
=item dst_bin_id
988

  
989
Warehouse and bin to which to transfer. Mandatory in transfer and in
990
directions. Ignored in out directions.
991

  
992
=item chargenumber
993

  
994
If given, the transfer will transfer only articles with this chargenumber.
995
Optional.
996

  
997
=item orderitem_id
998

  
999
Reference to an orderitem for which this transfer happened. Optional
1000

  
1001
=item oe_id
1002

  
1003
Reference to an order for which this transfer happened. Optional
1004

  
1005
=item comment
1006

  
1007
An optional comment.
1008

  
1009
=item best_before
1010

  
1011
An expiration date. Note that this is not by default used by C<warehouse_report>.
1012

  
1013
=back
1014

  
1015
=head1 BUGS
1016

  
1017
=head1 AUTHOR
1018

  
1019
=cut
1020

  
874 1021
1;
t/wh/transfer.t
52 52

  
53 53
is $r1->{qty}, $r2->{qty} + 4, 'transfer one way';
54 54

  
55
#################################################
56

  
55 57
WH->transfer({
56 58
   transfer_type    => 'transfer',
57 59
   parts_id         => $part->id,
......
68 70

  
69 71
is $r2->{qty}, $r3->{qty} - 4, 'and back';
70 72

  
73
##############################################
74

  
75
use_ok 'SL::DB::TransferType';
76

  
77
# object interface test
78

  
79
WH->transfer({
80
   transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
81
   parts            => $part,
82
   src_bin          => $bin1,
83
   dst_bin          => $bin2,
84
   qty              => 6.2,
85
   chargenumber     => '',
86
});
87

  
88
my $r4 = $report->();
89

  
90
is $r3->{qty}, $r4->{qty} + 6.2, 'object transfer one way';
91

  
92
#############################################
93

  
94
WH->transfer({
95
   transfer_type    => SL::DB::Manager::TransferType->find_by(description => 'transfer'),
96
   parts            => $part,
97
   src_bin          => $bin2,
98
   src_warehouse    => $wh,
99
   dst_bin          => $bin1,
100
   dst_warehouse    => $wh,
101
   qty              => 6.2,
102
   chargenumber     => '',
103
});
104

  
105
my $r5 = $report->();
106

  
107
is $r4->{qty}, $r5->{qty} - 6.2, 'full object transfer back';
108

  
71 109
done_testing;
72 110

  
73 111

  

Auch abrufbar als: Unified diff