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