SL/DB/Part.pm

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