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