FS/FS/part_svc.pm

   1 package FS::part_svc;
   2
   3 use strict;
   4 use vars qw( @ISA );
   5 use FS::Record qw( qsearchs fields dbh );
   6 use FS::part_svc_column;
   7
   8 @ISA = qw(FS::Record);
   9
  10 =head1 NAME
  11
  12 FS::part_svc - Object methods for part_svc objects
  13
  14 =head1 SYNOPSIS
  15
  16   use FS::part_svc;
  17
  18   $record = new FS::part_svc \%hash
  19   $record = new FS::part_svc { 'column' => 'value' };
  20
  21   $error = $record->insert;
  22
  23   $error = $new_record->replace($old_record);
  24
  25   $error = $record->delete;
  26
  27   $error = $record->check;
  28
  29 =head1 DESCRIPTION
  30
  31 An FS::part_svc represents a service definition.  FS::part_svc inherits from
  32 FS::Record.  The following fields are currently supported:
  33
  34 =over 4
  35
  36 =item svcpart - primary key (assigned automatically for new service definitions)
  37
  38 =item svc - text name of this service definition
  39
  40 =item svcdb - table used for this service.  See L<FS::svc_acct>,
  41 L<FS::svc_domain>, and L<FS::svc_forward>, among others.
  42
  43 =item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
  44
  45 =item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed
  46
  47 =back
  48
  49 =head1 METHODS
  50
  51 =over 4
  52
  53 =item new HASHREF
  54
  55 Creates a new service definition.  To add the service definition to the
  56 database, see L<"insert">.
  57
  58 =cut
  59
  60 sub table { 'part_svc'; }
  61
  62 =item insert
  63
  64 Adds this service definition to the database.  If there is an error, returns
  65 the error, otherwise returns false.
  66 =item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
  67
  68 =item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed
  69
  70 =cut
  71
  72 sub insert {
  73   my $self = shift;
  74
  75   local $SIG{HUP} = 'IGNORE';
  76   local $SIG{INT} = 'IGNORE';
  77   local $SIG{QUIT} = 'IGNORE';
  78   local $SIG{TERM} = 'IGNORE';
  79   local $SIG{TSTP} = 'IGNORE';
  80   local $SIG{PIPE} = 'IGNORE';
  81
  82   my $oldAutoCommit = $FS::UID::AutoCommit;
  83   local $FS::UID::AutoCommit = 0;
  84   my $dbh = dbh;
  85
  86   my $error = $self->SUPER::insert;
  87   if ( $error ) {
  88     $dbh->rollback if $oldAutoCommit;
  89     return $error;
  90   }
  91
  92   my $svcdb = $self->svcdb;
  93 #  my @rows = map { /^${svcdb}__(.*)$/; $1 }
  94 #    grep ! /_flag$/,
  95 #      grep /^${svcdb}__/,
  96 #        fields('part_svc');
  97   foreach my $field (
  98     grep { $_ ne 'svcnum'
  99            && defined( $self->getfield($svcdb.'__'.$_.'_flag') )
 100          } fields($svcdb)
 101   ) {
 102     my $part_svc_column = $self->part_svc_column($field);
 103     my $previous = qsearchs('part_svc_column', {
 104       'svcpart'    => $self->svcpart,
 105       'columnname' => $field,
 106     } );
 107
 108     my $flag = $self->getfield($svcdb.'__'.$field.'_flag');
 109     if ( uc($flag) =~ /^([DF])$/ ) {
 110       $part_svc_column->setfield('columnflag', $1);
 111       $part_svc_column->setfield('columnvalue',
 112         $self->getfield($svcdb.'__'.$field)
 113       );
 114       if ( $previous ) {
 115         $error = $part_svc_column->replace($previous);
 116       } else {
 117         $error = $part_svc_column->insert;
 118       }
 119     } else {
 120       $error = $previous ? $previous->delete : '';
 121     }
 122     if ( $error ) {
 123       $dbh->rollback if $oldAutoCommit;
 124       return $error;
 125     }
 126
 127   }
 128
 129   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 130
 131   '';
 132 }
 133
 134 =item delete
 135
 136 Currently unimplemented.
 137
 138 =cut
 139
 140 sub delete {
 141   return "Can't (yet?) delete service definitions.";
 142 # check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)?
 143 }
 144
 145 =item replace OLD_RECORD
 146
 147 Replaces OLD_RECORD with this one in the database.  If there is an error,
 148 returns the error, otherwise returns false.
 149
 150 =cut
 151
 152 sub replace {
 153   my ( $new, $old ) = ( shift, shift );
 154
 155   return "Can't change svcdb for an existing service definition!"
 156     unless $old->svcdb eq $new->svcdb;
 157
 158   local $SIG{HUP} = 'IGNORE';
 159   local $SIG{INT} = 'IGNORE';
 160   local $SIG{QUIT} = 'IGNORE';
 161   local $SIG{TERM} = 'IGNORE';
 162   local $SIG{TSTP} = 'IGNORE';
 163   local $SIG{PIPE} = 'IGNORE';
 164
 165   my $oldAutoCommit = $FS::UID::AutoCommit;
 166   local $FS::UID::AutoCommit = 0;
 167   my $dbh = dbh;
 168
 169   my $error = $new->SUPER::replace( $old );
 170   if ( $error ) {
 171     $dbh->rollback if $oldAutoCommit;
 172     return $error;
 173   }
 174
 175   if ( @_ && $_[0] eq '1.3-COMPAT' ) {
 176     my $svcdb = $new->svcdb;
 177     foreach my $field (
 178       grep { $_ ne 'svcnum'
 179              && defined( $new->getfield($svcdb.'__'.$_.'_flag') )
 180            } fields($svcdb)
 181     ) {
 182       my $part_svc_column = $new->part_svc_column($field);
 183       my $previous = qsearchs('part_svc_column', {
 184         'svcpart'    => $new->svcpart,
 185         'columnname' => $field,
 186       } );
 187
 188       my $flag = $new->getfield($svcdb.'__'.$field.'_flag');
 189       if ( uc($flag) =~ /^([DF])$/ ) {
 190         $part_svc_column->setfield('columnflag', $1);
 191         $part_svc_column->setfield('columnvalue',
 192           $new->getfield($svcdb.'__'.$field)
 193         );
 194         if ( $previous ) {
 195           $error = $part_svc_column->replace($previous);
 196         } else {
 197           $error = $part_svc_column->insert;
 198         }
 199       } else {
 200         $error = $previous ? $previous->delete : '';
 201       }
 202       if ( $error ) {
 203         $dbh->rollback if $oldAutoCommit;
 204         return $error;
 205       }
 206     }
 207   } else {
 208     $dbh->rollback if $oldAutoCommit;
 209     return 'non-1.3-COMPAT interface not yet written';
 210     #not yet implemented
 211   }
 212
 213   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 214
 215   '';
 216 }
 217
 218 =item check
 219
 220 Checks all fields to make sure this is a valid service definition.  If there is
 221 an error, returns the error, otherwise returns false.  Called by the insert
 222 and replace methods.
 223
 224 =cut
 225
 226 sub check {
 227   my $self = shift;
 228   my $recref = $self->hashref;
 229
 230   my $error;
 231   $error=
 232     $self->ut_numbern('svcpart')
 233     || $self->ut_text('svc')
 234     || $self->ut_alpha('svcdb')
 235   ;
 236   return $error if $error;
 237
 238   my @fields = eval { fields( $recref->{svcdb} ) }; #might die
 239   return "Unknown svcdb!" unless @fields;
 240
 241 #  my $svcdb;
 242 #  foreach $svcdb ( qw(
 243 #    svc_acct svc_acct_sm svc_domain
 244 #  ) ) {
 245 #    my @rows = map { /^${svcdb}__(.*)$/; $1 }
 246 #      grep ! /_flag$/,
 247 #        grep /^${svcdb}__/,
 248 #          fields('part_svc');
 249 #    foreach my $row (@rows) {
 250 #      unless ( $svcdb eq $recref->{svcdb} ) {
 251 #        $recref->{$svcdb.'__'.$row}='';
 252 #        $recref->{$svcdb.'__'.$row.'_flag'}='';
 253 #        next;
 254 #      }
 255 #      $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/
 256 #        or return "Illegal flag for $svcdb $row";
 257 #      $recref->{$svcdb.'__'.$row.'_flag'} = $1;
 258 #
 259 #      my $error = $self->ut_anything($svcdb.'__'.$row);
 260 #      return $error if $error;
 261 #
 262 #    }
 263 #  }
 264
 265   ''; #no error
 266 }
 267
 268 =item part_svc_column COLUMNNAME
 269
 270 Returns the part_svc_column object (see L<FS::part_svc_column>) for the given
 271 COLUMNNAME, or a new part_svc_column object if none exists.
 272
 273 =cut
 274
 275 sub part_svc_column {
 276   my $self = shift;
 277   my $columnname = shift;
 278   qsearchs('part_svc_column',  {
 279                                  'svcpart'    => $self->svcpart,
 280                                  'columnname' => $columnname,
 281                                }
 282   ) or new FS::part_svc_column {
 283                                  'svcpart'    => $self->svcpart,
 284                                  'columnname' => $columnname,
 285                                };
 286 }
 287
 288 =back
 289
 290 =head1 VERSION
 291
 292 $Id: part_svc.pm,v 1.4 2001-09-11 00:08:18 ivan Exp $
 293
 294 =head1 BUGS
 295
 296 Delete is unimplemented.
 297
 298 The list of svc_* tables is hardcoded.  When svc_acct_pop is renamed, this
 299 should be fixed.
 300
 301 =head1 SEE ALSO
 302
 303 L<FS::Record>, L<FS::part_pkg>, L<FS::pkg_svc>, L<FS::cust_svc>,
 304 L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>, schema.html from the
 305 base documentation.
 306
 307 =cut
 308
 309 1;
 310