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