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