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