SL/DB/Part.pm

   1 package SL::DB::Part;
   2
   3 use strict;
   4
   5 use Carp;
   6 use List::MoreUtils qw(any);
   7 use Rose::DB::Object::Helpers qw(as_tree);
   8
   9 use SL::DBUtils;
  10 use SL::DB::MetaSetup::Part;
  11 use SL::DB::Manager::Part;
  12 use SL::DB::Chart;
  13 use SL::DB::Helper::AttrHTML;
  14 use SL::DB::Helper::TransNumberGenerator;
  15 use SL::DB::Helper::CustomVariables (
  16   module      => 'IC',
  17   cvars_alias => 1,
  18 );
  19
  20 __PACKAGE__->meta->add_relationships(
  21   assemblies                     => {
  22     type         => 'one to many',
  23     class        => 'SL::DB::Assembly',
  24     column_map   => { id => 'id' },
  25   },
  26   prices         => {
  27     type         => 'one to many',
  28     class        => 'SL::DB::Price',
  29     column_map   => { id => 'parts_id' },
  30   },
  31   makemodels     => {
  32     type         => 'one to many',
  33     class        => 'SL::DB::MakeModel',
  34     column_map   => { id => 'parts_id' },
  35   },
  36   translations   => {
  37     type         => 'one to many',
  38     class        => 'SL::DB::Translation',
  39     column_map   => { id => 'parts_id' },
  40   },
  41 );
  42
  43 __PACKAGE__->meta->initialize;
  44
  45 __PACKAGE__->attr_html('notes');
  46
  47 __PACKAGE__->before_save('_before_save_set_partnumber');
  48
  49 sub _before_save_set_partnumber {
  50   my ($self) = @_;
  51
  52   $self->create_trans_number if !$self->partnumber;
  53   return 1;
  54 }
  55
  56 sub is_type {
  57   my $self = shift;
  58   my $type  = lc(shift || '');
  59   die 'invalid type' unless $type =~ /^(?:part|service|assembly)$/;
  60
  61   return $self->type eq $type ? 1 : 0;
  62 }
  63
  64 sub is_part     { $_[0]->part_type eq 'part' }
  65 sub is_assembly { $_[0]->part_type eq 'assembly' }
  66 sub is_service  { $_[0]->part_type eq 'service' }
  67
  68 sub type {
  69   return $_[0]->part_type;
  70   # my ($self, $type) = @_;
  71   # if (@_ > 1) {
  72   #   die 'invalid type' unless $type =~ /^(?:part|service|assembly)$/;
  73   #   $self->assembly(          $type eq 'assembly' ? 1 : 0);
  74   #   $self->inventory_accno_id($type ne 'service'  ? 1 : undef);
  75   # }
  76
  77   # return 'assembly' if $self->assembly;
  78   # return 'part'     if $self->inventory_accno_id;
  79   # return 'service';
  80 }
  81
  82 sub new_part {
  83   my ($class, %params) = @_;
  84   $class->new(%params, part_type => 'part');
  85 }
  86
  87 sub new_assembly {
  88   my ($class, %params) = @_;
  89   $class->new(%params, part_type => 'assembly');
  90 }
  91
  92 sub new_service {
  93   my ($class, %params) = @_;
  94   $class->new(%params, part_type => 'service');
  95 }
  96
  97 sub orphaned {
  98   my ($self) = @_;
  99   die 'not an accessor' if @_ > 1;
 100
 101   my @relations = qw(
 102     SL::DB::InvoiceItem
 103     SL::DB::OrderItem
 104     SL::DB::Inventory
 105   );
 106
 107   for my $class (@relations) {
 108     eval "require $class";
 109     return 0 if $class->_get_manager_class->get_all_count(query => [ parts_id => $self->id ]);
 110   }
 111   return 1;
 112 }
 113
 114 sub get_sellprice_info {
 115   my $self   = shift;
 116   my %params = @_;
 117
 118   confess "Missing part id" unless $self->id;
 119
 120   my $object = $self->load;
 121
 122   return { sellprice       => $object->sellprice,
 123            price_factor_id => $object->price_factor_id };
 124 }
 125
 126 sub get_ordered_qty {
 127   my $self   = shift;
 128   my %result = SL::DB::Manager::Part->get_ordered_qty($self->id);
 129
 130   return $result{ $self->id };
 131 }
 132
 133 sub available_units {
 134   shift->unit_obj->convertible_units;
 135 }
 136
 137 # autogenerated accessor is slightly off...
 138 sub buchungsgruppe {
 139   shift->buchungsgruppen(@_);
 140 }
 141
 142 sub get_taxkey {
 143   my ($self, %params) = @_;
 144
 145   my $date     = $params{date} || DateTime->today_local;
 146   my $is_sales = !!$params{is_sales};
 147   my $taxzone  = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
 148   my $tk_info  = $::request->cache('get_taxkey');
 149
 150   $tk_info->{$self->id}                                      //= {};
 151   $tk_info->{$self->id}->{$taxzone}                          //= { };
 152   my $cache = $tk_info->{$self->id}->{$taxzone}->{$is_sales} //= { };
 153
 154   if (!exists $cache->{$date}) {
 155     $cache->{$date} =
 156       $self->get_chart(type => $is_sales ? 'income' : 'expense', taxzone => $taxzone)
 157       ->get_active_taxkey($date);
 158   }
 159
 160   return $cache->{$date};
 161 }
 162
 163 sub get_chart {
 164   my ($self, %params) = @_;
 165
 166   my $type    = (any { $_ eq $params{type} } qw(income expense inventory)) ? $params{type} : croak("Invalid 'type' parameter '$params{type}'");
 167   my $taxzone = $params{ defined($params{taxzone}) ? 'taxzone' : 'taxzone_id' } * 1;
 168
 169   my $charts     = $::request->cache('get_chart_id/by_part_id_and_taxzone')->{$self->id} //= {};
 170   my $all_charts = $::request->cache('get_chart_id/by_id');
 171
 172   $charts->{$taxzone} ||= { };
 173
 174   if (!exists $charts->{$taxzone}->{$type}) {
 175     require SL::DB::Buchungsgruppe;
 176     my $bugru    = SL::DB::Buchungsgruppe->load_cached($self->buchungsgruppen_id);
 177     my $chart_id = ($type eq 'inventory') ? ($self->inventory_accno_id ? $bugru->inventory_accno_id : undef)
 178                  :                          $bugru->call_sub("${type}_accno_id", $taxzone);
 179
 180     if ($chart_id) {
 181       my $chart                    = $all_charts->{$chart_id} // SL::DB::Chart->load_cached($chart_id)->load;
 182       $all_charts->{$chart_id}     = $chart;
 183       $charts->{$taxzone}->{$type} = $chart;
 184     }
 185   }
 186
 187   return $charts->{$taxzone}->{$type};
 188 }
 189
 190 # this is designed to ignore chargenumbers, expiration dates and just give a list of how much <-> where
 191 sub get_simple_stock {
 192   my ($self, %params) = @_;
 193
 194   return [] unless $self->id;
 195
 196   my $query = <<'';
 197     SELECT sum(qty), warehouse_id, bin_id FROM inventory WHERE parts_id = ?
 198     GROUP BY warehouse_id, bin_id
 199
 200   my $stock_info = selectall_hashref_query($::form, $::form->get_standard_dbh, $query, $self->id);
 201   [ map { bless $_, 'SL::DB::Part::SimpleStock'} @$stock_info ];
 202 }
 203 # helper class to have bin/warehouse accessors in stock result
 204 { package SL::DB::Part::SimpleStock;
 205   sub warehouse { require SL::DB::Warehouse; SL::DB::Manager::Warehouse->find_by_or_create(id => $_[0]->{warehouse_id}) }
 206   sub bin       { require SL::DB::Bin;       SL::DB::Manager::Bin      ->find_by_or_create(id => $_[0]->{bin_id}) }
 207 }
 208
 209 sub displayable_name {
 210   join ' ', grep $_, map $_[0]->$_, qw(partnumber description);
 211 }
 212
 213 1;
 214
 215 __END__
 216
 217 =pod
 218
 219 =encoding utf-8
 220
 221 =head1 NAME
 222
 223 SL::DB::Part: Model for the 'parts' table
 224
 225 =head1 SYNOPSIS
 226
 227 This is a standard Rose::DB::Object based model and can be used as one.
 228
 229 =head1 TYPES
 230
 231 Although the base class is called C<Part> we usually talk about C<Articles> if
 232 we mean instances of this class. This is because articles come in three
 233 flavours called:
 234
 235 =over 4
 236
 237 =item Part     - a single part
 238
 239 =item Service  - a part without onhand, and without inventory accounting
 240
 241 =item Assembly - a collection of both parts and services
 242
 243 =back
 244
 245 These types are sadly represented by data inside the class and cannot be
 246 migrated into a flag. To work around this, each C<Part> object knows what type
 247 it currently is. Since the type is data driven, there ist no explicit setting
 248 method for it, but you can construct them explicitly with C<new_part>,
 249 C<new_service>, and C<new_assembly>. A Buchungsgruppe should be supplied in this
 250 case, but it will use the default Buchungsgruppe if you don't.
 251
 252 Matching these there are assorted helper methods dealing with types,
 253 e.g.  L</new_part>, L</new_service>, L</new_assembly>, L</type>,
 254 L</is_type> and others.
 255
 256 =head1 FUNCTIONS
 257
 258 =over 4
 259
 260 =item C<new_part %PARAMS>
 261
 262 =item C<new_service %PARAMS>
 263
 264 =item C<new_assembly %PARAMS>
 265
 266 Will set the appropriate data fields so that the resulting instance will be of
 267 the requested type. Since accounting targets are part of the distinction,
 268 providing a C<Buchungsgruppe> is recommended. If none is given the constructor
 269 will load a default one and set the accounting targets from it.
 270
 271 =item C<type>
 272
 273 Returns the type as a string. Can be one of C<part>, C<service>, C<assembly>.
 274
 275 =item C<is_type $TYPE>
 276
 277 Tests if the current object is a part, a service or an
 278 assembly. C<$type> must be one of the words 'part', 'service' or
 279 'assembly' (their plurals are ok, too).
 280
 281 Returns 1 if the requested type matches, 0 if it doesn't and
 282 C<confess>es if an unknown C<$type> parameter is encountered.
 283
 284 =item C<is_part>
 285
 286 =item C<is_service>
 287
 288 =item C<is_assembly>
 289
 290 Shorthand for C<is_type('part')> etc.
 291
 292 =item C<get_sellprice_info %params>
 293
 294 Retrieves the C<sellprice> and C<price_factor_id> for a part under
 295 different conditions and returns a hash reference with those two keys.
 296
 297 If C<%params> contains a key C<project_id> then a project price list
 298 will be consulted if one exists for that project. In this case the
 299 parameter C<country_id> is evaluated as well: if a price list entry
 300 has been created for this country then it will be used. Otherwise an
 301 entry without a country set will be used.
 302
 303 If none of the above conditions is met then the information from
 304 C<$self> is used.
 305
 306 =item C<get_ordered_qty %params>
 307
 308 Retrieves the quantity that has been ordered from a vendor but that
 309 has not been delivered yet. Only open purchase orders are considered.
 310
 311 =item C<get_taxkey %params>
 312
 313 Retrieves and returns a taxkey object valid for the given date
 314 C<$params{date}> and tax zone C<$params{taxzone}>
 315 (C<$params{taxzone_id}> is also recognized). The date defaults to the
 316 current date if undefined.
 317
 318 This function looks up the income (for trueish values of
 319 C<$params{is_sales}>) or expense (for falsish values of
 320 C<$params{is_sales}>) account for the current part. It uses the part's
 321 associated buchungsgruppe and uses the fields belonging to the tax
 322 zone given by C<$params{taxzone}>.
 323
 324 The information retrieved by the function is cached.
 325
 326 =item C<get_chart %params>
 327
 328 Retrieves and returns a chart object valid for the given type
 329 C<$params{type}> and tax zone C<$params{taxzone}>
 330 (C<$params{taxzone_id}> is also recognized). The type must be one of
 331 the three key words C<income>, C<expense> and C<inventory>.
 332
 333 This function uses the part's associated buchungsgruppe and uses the
 334 fields belonging to the tax zone given by C<$params{taxzone}>.
 335
 336 The information retrieved by the function is cached.
 337
 338 =item C<orphaned>
 339
 340 Checks if this article is used in orders, invoices, delivery orders or
 341 assemblies.
 342
 343 =item C<buchungsgruppe BUCHUNGSGRUPPE>
 344
 345 Used to set the accounting information from a L<SL:DB::Buchungsgruppe> object.
 346 Please note, that this is a write only accessor, the original Buchungsgruppe can
 347 not be retrieved from an article once set.
 348
 349 =back
 350
 351 =head1 AUTHORS
 352
 353 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 354 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 355
 356 =cut