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