FS/FS/part_svc.pm

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