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
  91   return "Can't delete a tax class which has package tax overrides!"
  92     if qsearch( 'part_pkg_taxoverride', { 'taxclassnum' => $self->taxclassnum } );
  93
  94   local $SIG{HUP} = 'IGNORE';
  95   local $SIG{INT} = 'IGNORE';
  96   local $SIG{QUIT} = 'IGNORE';
  97   local $SIG{TERM} = 'IGNORE';
  98   local $SIG{TSTP} = 'IGNORE';
  99   local $SIG{PIPE} = 'IGNORE';
 100
 101   my $oldAutoCommit = $FS::UID::AutoCommit;
 102   local $FS::UID::AutoCommit = 0;
 103   my $dbh = dbh;
 104
 105   foreach my $tax_rate (
 106     qsearch( 'tax_rate', { taxclassnum=>$self->taxclassnum } )
 107   ) {
 108     my $error = $tax_rate->delete;
 109     if ( $error ) {
 110       $dbh->rollback if $oldAutoCommit;
 111       return $error;
 112     }
 113   }
 114
 115   foreach my $part_pkg_taxrate (
 116     qsearch( 'part_pkg_taxrate', { taxclassnum=>$self->taxclassnum } )
 117   ) {
 118     my $error = $part_pkg_taxrate->delete;
 119     if ( $error ) {
 120       $dbh->rollback if $oldAutoCommit;
 121       return $error;
 122     }
 123   }
 124
 125   my $error = $self->SUPER::delete(@_);
 126   if ( $error ) {
 127     $dbh->rollback if $oldAutoCommit;
 128     return $error;
 129   }
 130
 131   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 132
 133   '';
 134
 135 }
 136
 137 =item replace OLD_RECORD
 138
 139 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 140 returns the error, otherwise returns false.
 141
 142 =cut
 143
 144 =item check
 145
 146 Checks all fields to make sure this is a valid tax class.  If there is
 147 an error, returns the error, otherwise returns false.  Called by the insert
 148 and replace methods.
 149
 150 =cut
 151
 152 sub check {
 153   my $self = shift;
 154
 155   my $error =
 156     $self->ut_numbern('taxclassnum')
 157     || $self->ut_text('taxclass')
 158     || $self->ut_textn('data_vendor')
 159     || $self->ut_textn('description')
 160   ;
 161   return $error if $error;
 162
 163   $self->SUPER::check;
 164 }
 165
 166 =item batch_import
 167
 168 Loads part_pkg_taxrate records from an external CSV file.  If there is
 169 an error, returns the error, otherwise returns false.
 170
 171 =cut
 172
 173 sub batch_import {
 174   my ($param, $job) = @_;
 175
 176   my $fh = $param->{filehandle};
 177   my $format = $param->{'format'};
 178
 179   my @fields;
 180   my $hook;
 181   my $endhook;
 182   my $data = {};
 183   my $imported = 0;
 184   my $dbh = dbh;
 185
 186   my @column_lengths = ();
 187   my @column_callbacks = ();
 188   if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
 189     $format =~ s/-fixed//;
 190     push @column_lengths, qw( 8 10 3 2 2 10 100 );
 191     push @column_lengths, 1 if $format eq 'cch-update';
 192   }
 193
 194   my $line;
 195   my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar
 196   if ( $job || scalar(@column_lengths) ) {
 197     my $error = csv_from_fixed(\$fh, \$count, \@column_lengths);
 198     return $error if $error;
 199   }
 200
 201   if ( $format eq 'cch' || $format eq 'cch-update' ) {
 202     @fields = qw( table name pos length number value description );
 203     push @fields, 'actionflag' if $format eq 'cch-update';
 204
 205     $hook = sub {
 206       my $hash = shift;
 207
 208       if ($hash->{'table'} eq 'DETAIL') {
 209         push @{$data->{'taxcat'}}, [ $hash->{'value'}, $hash->{'description'} ]
 210           if ($hash->{'name'} eq 'TAXCAT' &&
 211              (!exists($hash->{actionflag}) || $hash->{actionflag} eq 'I') );
 212
 213         push @{$data->{'taxtype'}}, [ $hash->{'value'}, $hash->{'description'} ]
 214           if ($hash->{'name'} eq 'TAXTYPE' &&
 215              (!exists($hash->{actionflag}) || $hash->{actionflag} eq 'I') );
 216
 217         if (exists($hash->{actionflag}) && $hash->{actionflag} eq 'D') {
 218           my $name = $hash->{'name'};
 219           my $value = $hash->{'value'};
 220           return "Bad value for $name: $value"
 221             unless $value =~ /^\d+$/;
 222
 223           if ($name eq 'TAXCAT' || $name eq 'TAXTYPE') {
 224             my @tax_class = qsearch( 'tax_class',
 225                                      { 'data_vendor' => 'cch' },
 226                                      '',
 227                                      "AND taxclass LIKE '".
 228                                        ($name eq 'TAXTYPE' ? $value : '%').":".
 229                                        ($name eq 'TAXCAT' ? $value : '%')."'",
 230                                    );
 231             foreach (@tax_class) {
 232               my $error = $_->delete;
 233               return $error if $error;
 234             }
 235           }
 236         }
 237
 238       }
 239
 240       delete($hash->{$_})
 241         for qw( data_vendor table name pos length number value description );
 242       delete($hash->{actionflag}) if exists($hash->{actionflag});
 243
 244       '';
 245
 246     };
 247
 248     $endhook = sub {
 249
 250       my $sql = "SELECT DISTINCT ".
 251          "substring(taxclass from 1 for position(':' in taxclass)-1),".
 252          "substring(description from 1 for position(':' in description)-1) ".
 253          "FROM tax_class WHERE data_vendor='cch'";
 254
 255       my $sth = $dbh->prepare($sql) or die $dbh->errstr;
 256       $sth->execute or die $sth->errstr;
 257       my @old_types = @{$sth->fetchall_arrayref};
 258
 259       $sql = "SELECT DISTINCT ".
 260          "substring(taxclass from position(':' in taxclass)+1),".
 261          "substring(description from position(':' in description)+1) ".
 262          "FROM tax_class WHERE data_vendor='cch'";
 263
 264       $sth = $dbh->prepare($sql) or die $dbh->errstr;
 265       $sth->execute or die $sth->errstr;
 266       my @old_cats = @{$sth->fetchall_arrayref};
 267
 268       my $catcount  = exists($data->{'taxcat'})  ? scalar(@{$data->{'taxcat'}})
 269                                                  : 0;
 270       my $typecount = exists($data->{'taxtype'}) ? scalar(@{$data->{'taxtype'}})
 271                                                  : 0;
 272
 273       my $count = scalar(@old_types) * $catcount
 274                 + $typecount * (scalar(@old_cats) + $catcount);
 275
 276       $imported = 1 if $format eq 'cch-update';  #empty file ok
 277
 278       foreach my $type (@old_types) {
 279         foreach my $cat (@{$data->{'taxcat'}}) {
 280
 281           if ( $job ) {  # progress bar
 282             if ( time - $min_sec > $last ) {
 283               my $error = $job->update_statustext(
 284                 int( 100 * $imported / $count ). ",Importing tax classes"
 285               );
 286               die $error if $error;
 287               $last = time;
 288             }
 289           }
 290
 291           my %hash = ( 'data_vendor' => 'cch',
 292                        'taxclass'    => $type->[0].':'.$cat->[0],
 293                        'description' => $type->[1].':'.$cat->[1],
 294                      );
 295           unless ( qsearchs('tax_class', \%hash) ) {
 296             my $tax_class = new FS::tax_class \%hash;
 297             my $error = $tax_class->insert;
 298
 299             return "can't insert tax_class for ".
 300                    " old TAXTYPE ". $type->[0].':'.$type->[1].
 301                    " and new TAXCAT ". $cat->[0].':'. $cat->[1].
 302                    " : $error"
 303               if $error;
 304           }
 305
 306           $imported++;
 307
 308         }
 309       }
 310
 311       foreach my $type (@{$data->{'taxtype'}}) {
 312         foreach my $cat (@old_cats, @{$data->{'taxcat'}}) {
 313
 314           if ( $job ) {  # progress bar
 315             if ( time - $min_sec > $last ) {
 316               my $error = $job->update_statustext(
 317                 int( 100 * $imported / $count ). ",Importing tax classes"
 318               );
 319               die $error if $error;
 320               $last = time;
 321             }
 322           }
 323
 324           my $tax_class =
 325             new FS::tax_class( { 'data_vendor' => 'cch',
 326                                  'taxclass'    => $type->[0].':'.$cat->[0],
 327                                  'description' => $type->[1].':'.$cat->[1],
 328                              } );
 329           my $error = $tax_class->insert;
 330           return "can't insert tax_class for new TAXTYPE $type and TAXCAT $cat: $error" if $error;
 331           $imported++;
 332         }
 333       }
 334
 335       '';
 336     };
 337
 338   } elsif ( $format eq 'extended' ) {
 339     die "unimplemented\n";
 340     @fields = qw( );
 341     $hook = sub {};
 342   } else {
 343     die "unknown format $format";
 344   }
 345
 346   eval "use Text::CSV_XS;";
 347   die $@ if $@;
 348
 349   my $csv = new Text::CSV_XS;
 350
 351   local $SIG{HUP} = 'IGNORE';
 352   local $SIG{INT} = 'IGNORE';
 353   local $SIG{QUIT} = 'IGNORE';
 354   local $SIG{TERM} = 'IGNORE';
 355   local $SIG{TSTP} = 'IGNORE';
 356   local $SIG{PIPE} = 'IGNORE';
 357
 358   my $oldAutoCommit = $FS::UID::AutoCommit;
 359   local $FS::UID::AutoCommit = 0;
 360
 361   while ( defined($line=<$fh>) ) {
 362
 363     if ( $job ) {  # progress bar
 364       if ( time - $min_sec > $last ) {
 365         my $error = $job->update_statustext(
 366           int( 100 * $imported / $count ). ",Importing tax classes"
 367         );
 368         die $error if $error;
 369         $last = time;
 370       }
 371     }
 372
 373     $csv->parse($line) or do {
 374       $dbh->rollback if $oldAutoCommit;
 375       return "can't parse: ". $csv->error_input();
 376     };
 377
 378     my @columns = $csv->fields();
 379
 380     my %tax_class = ( 'data_vendor' => $format );
 381     foreach my $field ( @fields ) {
 382       $tax_class{$field} = shift @columns;
 383     }
 384     if ( scalar( @columns ) ) {
 385       $dbh->rollback if $oldAutoCommit;
 386       return "Unexpected trailing columns in line (wrong format?) importing tax_class: $line";
 387     }
 388
 389     my $error = &{$hook}(\%tax_class);
 390     if ( $error ) {
 391       $dbh->rollback if $oldAutoCommit;
 392       return $error;
 393     }
 394
 395     next unless scalar(keys %tax_class);
 396
 397     my $tax_class = new FS::tax_class( \%tax_class );
 398     $error = $tax_class->insert;
 399     if ( $error ) {
 400       $dbh->rollback if $oldAutoCommit;
 401       return "can't insert tax_class for $line: $error";
 402     }
 403
 404     $imported++;
 405   }
 406
 407   my $error = &{$endhook}();
 408   if ( $error ) {
 409     $dbh->rollback if $oldAutoCommit;
 410     return "can't run end hook: $error";
 411   }
 412
 413   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 414
 415   return "Empty File!" unless ($imported || $format eq 'cch-update');
 416
 417   ''; #no error
 418
 419 }
 420
 421 =back
 422
 423 =head1 BUGS
 424
 425 =head1 SEE ALSO
 426
 427 L<FS::Record>, schema.html from the base documentation.
 428
 429 =cut
 430
 431 1;
 432
 433