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