FS/FS/tax_class.pm

   1 package FS::tax_class;
   2
   3 use strict;
   4 use vars qw( @ISA );
   5 use FS::UID qw(dbh);
   6 use FS::Record qw( qsearch qsearchs );
   7 use FS::Misc qw( csv_from_fixed );
   8 use FS::part_pkg_taxrate;
   9 use FS::part_pkg_taxoverride;
  10
  11 @ISA = qw(FS::Record);
  12
  13 =head1 NAME
  14
  15 FS::tax_class - Object methods for tax_class records
  16
  17 =head1 SYNOPSIS
  18
  19   use FS::tax_class;
  20
  21   $record = new FS::tax_class \%hash;
  22   $record = new FS::tax_class { 'column' => 'value' };
  23
  24   $error = $record->insert;
  25
  26   $error = $new_record->replace($old_record);
  27
  28   $error = $record->delete;
  29
  30   $error = $record->check;
  31
  32 =head1 DESCRIPTION
  33
  34 An FS::tax_class object represents a tax class.  FS::tax_class
  35 inherits from FS::Record.  The following fields are currently supported:
  36
  37 =over 4
  38
  39 =item taxclassnum
  40
  41 Primary key
  42
  43 =item data_vendor
  44
  45 Vendor of the tax data
  46
  47 =item taxclass
  48
  49 Tax class
  50
  51 =item description
  52
  53 Human readable description of the tax class
  54
  55 =back
  56
  57 =head1 METHODS
  58
  59 =over 4
  60
  61 =item new HASHREF
  62
  63 Creates a new tax class.  To add the tax class to the database, see L<"insert">.
  64
  65 Note that this stores the hash reference, not a distinct copy of the hash it
  66 points to.  You can ask the object for a copy with the I<hash> method.
  67
  68 =cut
  69
  70 sub table { 'tax_class'; }
  71
  72 =item insert
  73
  74 Adds this record to the database.  If there is an error, returns the error,
  75 otherwise returns false.
  76
  77 =cut
  78
  79 =item delete
  80
  81 Delete this record from the database.
  82
  83 =cut
  84
  85 sub delete {
  86   my $self = shift;
  87
  88   #return "Can't delete a tax class which has package tax rates!"
  89   #if qsearch( 'part_pkg_taxrate', { 'taxclassnumtaxed' => $self->taxclassnum
  90   # If this tax class is manually assigned to a package,
  91   # then return a useful error message instead of just having a conniption.
  92   my @overrides = qsearch( 'part_pkg_taxoverride', {
  93                     'taxclassnum' => $self->taxclassnum
  94                   } );
  95   if (@overrides) {
  96     return "Tried to delete tax class " . $self->taxclass .
  97       ", which is assigned to package definition " .
  98       join(', ', map { '#'.$_->pkgpart} @overrides) .
  99       ".";
 100   }
 101
 102   # part_pkg_taxrate.taxclass identifies taxes belonging to this taxclass.
 103   # part_pkg_taxrate.taxclassnumtaxed identifies taxes applying to this
 104   # taxclass.
 105   # If this taxclass goes away, remove all of them. (CCH upgrade CAN'T
 106   # remove them, because it removes the tax_class first and then doesn't
 107   # know what the taxclassnum was. Yeah, I know. So it will just skip
 108   # over them at the TXMATRIX stage.)
 109   my @part_pkg_taxrate = (
 110     qsearch('part_pkg_taxrate', { 'taxclassnum' => $self->taxclassnum }),
 111     qsearch('part_pkg_taxrate', { 'taxclassnumtaxed' => $self->taxclassnum })
 112   );
 113   foreach (@part_pkg_taxrate) {
 114     my $error = $_->delete;
 115     return "when deleting taxclass ".$self->taxclass.": $error"
 116       if $error;
 117   }
 118
 119   $self->SUPER::delete(@_);
 120
 121 }
 122
 123 =item replace OLD_RECORD
 124
 125 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 126 returns the error, otherwise returns false.
 127
 128 =cut
 129
 130 =item check
 131
 132 Checks all fields to make sure this is a valid tax class.  If there is
 133 an error, returns the error, otherwise returns false.  Called by the insert
 134 and replace methods.
 135
 136 =cut
 137
 138 sub check {
 139   my $self = shift;
 140
 141   my $error =
 142     $self->ut_numbern('taxclassnum')
 143     || $self->ut_text('taxclass')
 144     || $self->ut_textn('data_vendor')
 145     || $self->ut_textn('description')
 146   ;
 147   return $error if $error;
 148
 149   $self->SUPER::check;
 150 }
 151
 152 =item batch_import
 153
 154 Loads part_pkg_taxrate records from an external CSV file.  If there is
 155 an error, returns the error, otherwise returns false.
 156
 157 =cut
 158
 159 sub batch_import {
 160   my ($param, $job) = @_;
 161
 162   my $fh = $param->{filehandle};
 163   my $format = $param->{'format'};
 164
 165   my @fields;
 166   my $hook;
 167   my $endhook;
 168   my $data = {};
 169   my $imported = 0;
 170   my $dbh = dbh;
 171
 172   my @column_lengths = ();
 173   my @column_callbacks = ();
 174   if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
 175     $format =~ s/-fixed//;
 176     push @column_lengths, qw( 8 10 3 2 2 10 100 );
 177     push @column_lengths, 1 if $format eq 'cch-update';
 178   }
 179
 180   my $line;
 181   my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar
 182   if ( $job || scalar(@column_lengths) ) {
 183     my $error = csv_from_fixed(\$fh, \$count, \@column_lengths);
 184     return $error if $error;
 185   }
 186
 187   if ( $format eq 'cch' || $format eq 'cch-update' ) {
 188     @fields = qw( table name pos length number value description );
 189     push @fields, 'actionflag' if $format eq 'cch-update';
 190
 191     $hook = sub {
 192       my $hash = shift;
 193
 194       if ($hash->{'table'} eq 'DETAIL') {
 195         push @{$data->{'taxcat'}}, [ $hash->{'value'}, $hash->{'description'} ]
 196           if ($hash->{'name'} eq 'TAXCAT' &&
 197              (!exists($hash->{actionflag}) || $hash->{actionflag} eq 'I') );
 198
 199         push @{$data->{'taxtype'}}, [ $hash->{'value'}, $hash->{'description'} ]
 200           if ($hash->{'name'} eq 'TAXTYPE' &&
 201              (!exists($hash->{actionflag}) || $hash->{actionflag} eq 'I') );
 202
 203         if (exists($hash->{actionflag}) && $hash->{actionflag} eq 'D') {
 204           my $name = $hash->{'name'};
 205           my $value = $hash->{'value'};
 206           return "Bad value for $name: $value"
 207             unless $value =~ /^\d+$/;
 208
 209           if ($name eq 'TAXCAT' || $name eq 'TAXTYPE') {
 210             my @tax_class = qsearch( 'tax_class',
 211                                      { 'data_vendor' => 'cch' },
 212                                      '',
 213                                      "AND taxclass LIKE '".
 214                                        ($name eq 'TAXTYPE' ? $value : '%').":".
 215                                        ($name eq 'TAXCAT' ? $value : '%')."'",
 216                                    );
 217             foreach (@tax_class) {
 218               my $error = $_->delete;
 219               return $error if $error;
 220             }
 221           }
 222         }
 223
 224       }
 225
 226       delete($hash->{$_})
 227         for qw( data_vendor table name pos length number value description );
 228       delete($hash->{actionflag}) if exists($hash->{actionflag});
 229
 230       '';
 231
 232     };
 233
 234     $endhook = sub {
 235
 236       my $sql = "SELECT DISTINCT ".
 237          "substring(taxclass from 1 for position(':' in taxclass)-1),".
 238          "substring(description from 1 for position(':' in description)-1) ".
 239          "FROM tax_class WHERE data_vendor='cch'";
 240
 241       my $sth = $dbh->prepare($sql) or die $dbh->errstr;
 242       $sth->execute or die $sth->errstr;
 243       my @old_types = @{$sth->fetchall_arrayref};
 244
 245       $sql = "SELECT DISTINCT ".
 246          "substring(taxclass from position(':' in taxclass)+1),".
 247          "substring(description from position(':' in description)+1) ".
 248          "FROM tax_class WHERE data_vendor='cch'";
 249
 250       $sth = $dbh->prepare($sql) or die $dbh->errstr;
 251       $sth->execute or die $sth->errstr;
 252       my @old_cats = @{$sth->fetchall_arrayref};
 253
 254       my $catcount  = exists($data->{'taxcat'})  ? scalar(@{$data->{'taxcat'}})
 255                                                  : 0;
 256       my $typecount = exists($data->{'taxtype'}) ? scalar(@{$data->{'taxtype'}})
 257                                                  : 0;
 258
 259       my $count = scalar(@old_types) * $catcount
 260                 + $typecount * (scalar(@old_cats) + $catcount);
 261
 262       $imported = 1 if $format eq 'cch-update';  #empty file ok
 263
 264       foreach my $type (@old_types) {
 265         foreach my $cat (@{$data->{'taxcat'}}) {
 266
 267           if ( $job ) {  # progress bar
 268             if ( time - $min_sec > $last ) {
 269               my $error = $job->update_statustext(
 270                 int( 100 * $imported / $count ). ",Importing tax classes"
 271               );
 272               die $error if $error;
 273               $last = time;
 274             }
 275           }
 276
 277           my %hash = ( 'data_vendor' => 'cch',
 278                        'taxclass'    => $type->[0].':'.$cat->[0],
 279                        'description' => $type->[1].':'.$cat->[1],
 280                      );
 281           unless ( qsearchs('tax_class', \%hash) ) {
 282             my $tax_class = new FS::tax_class \%hash;
 283             my $error = $tax_class->insert;
 284
 285             return "can't insert tax_class for ".
 286                    " old TAXTYPE ". $type->[0].':'.$type->[1].
 287                    " and new TAXCAT ". $cat->[0].':'. $cat->[1].
 288                    " : $error"
 289               if $error;
 290           }
 291
 292           $imported++;
 293
 294         }
 295       }
 296
 297       foreach my $type (@{$data->{'taxtype'}}) {
 298         foreach my $cat (@old_cats, @{$data->{'taxcat'}}) {
 299
 300           if ( $job ) {  # progress bar
 301             if ( time - $min_sec > $last ) {
 302               my $error = $job->update_statustext(
 303                 int( 100 * $imported / $count ). ",Importing tax classes"
 304               );
 305               die $error if $error;
 306               $last = time;
 307             }
 308           }
 309
 310           my $tax_class =
 311             new FS::tax_class( { 'data_vendor' => 'cch',
 312                                  'taxclass'    => $type->[0].':'.$cat->[0],
 313                                  'description' => $type->[1].':'.$cat->[1],
 314                              } );
 315           my $error = $tax_class->insert;
 316           return "can't insert tax_class for new TAXTYPE $type and TAXCAT $cat: $error" if $error;
 317           $imported++;
 318         }
 319       }
 320
 321       '';
 322     };
 323
 324   } elsif ( $format eq 'extended' ) {
 325     die "unimplemented\n";
 326     @fields = qw( );
 327     $hook = sub {};
 328   } else {
 329     die "unknown format $format";
 330   }
 331
 332   eval "use Text::CSV_XS;";
 333   die $@ if $@;
 334
 335   my $csv = new Text::CSV_XS;
 336
 337   local $SIG{HUP} = 'IGNORE';
 338   local $SIG{INT} = 'IGNORE';
 339   local $SIG{QUIT} = 'IGNORE';
 340   local $SIG{TERM} = 'IGNORE';
 341   local $SIG{TSTP} = 'IGNORE';
 342   local $SIG{PIPE} = 'IGNORE';
 343
 344   my $oldAutoCommit = $FS::UID::AutoCommit;
 345   local $FS::UID::AutoCommit = 0;
 346
 347   while ( defined($line=<$fh>) ) {
 348
 349     if ( $job ) {  # progress bar
 350       if ( time - $min_sec > $last ) {
 351         my $error = $job->update_statustext(
 352           int( 100 * $imported / $count ). ",Importing tax classes"
 353         );
 354         die $error if $error;
 355         $last = time;
 356       }
 357     }
 358
 359     $csv->parse($line) or do {
 360       $dbh->rollback if $oldAutoCommit;
 361       return "can't parse: ". $csv->error_input();
 362     };
 363
 364     my @columns = $csv->fields();
 365
 366     my %tax_class = ( 'data_vendor' => $format );
 367     foreach my $field ( @fields ) {
 368       $tax_class{$field} = shift @columns;
 369     }
 370     if ( scalar( @columns ) ) {
 371       $dbh->rollback if $oldAutoCommit;
 372       return "Unexpected trailing columns in line (wrong format?) importing tax_class: $line";
 373     }
 374
 375     my $error = &{$hook}(\%tax_class);
 376     if ( $error ) {
 377       $dbh->rollback if $oldAutoCommit;
 378       return $error;
 379     }
 380
 381     next unless scalar(keys %tax_class);
 382
 383     my $tax_class = new FS::tax_class( \%tax_class );
 384     $error = $tax_class->insert;
 385     if ( $error ) {
 386       $dbh->rollback if $oldAutoCommit;
 387       return "can't insert tax_class for $line: $error";
 388     }
 389
 390     $imported++;
 391   }
 392
 393   my $error = &{$endhook}();
 394   if ( $error ) {
 395     $dbh->rollback if $oldAutoCommit;
 396     return "can't run end hook: $error";
 397   }
 398
 399   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 400
 401   return "Empty File!" unless ($imported || $format eq 'cch-update');
 402
 403   ''; #no error
 404
 405 }
 406
 407 =back
 408
 409 =head1 BUGS
 410
 411 =head1 SEE ALSO
 412
 413 L<FS::Record>, schema.html from the base documentation.
 414
 415 =cut
 416
 417 1;
 418
 419