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