SL/DB/Part.pm

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