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