FS/FS/svc_www.pm

   1 package FS::svc_www;
   2
   3 use strict;
   4 use vars qw(@ISA $conf $apacheip);
   5 #use FS::Record qw( qsearch qsearchs );
   6 use FS::Record qw( qsearchs dbh );
   7 use FS::svc_Common;
   8 use FS::cust_svc;
   9 use FS::domain_record;
  10 use FS::svc_acct;
  11 use FS::svc_domain;
  12
  13 @ISA = qw( FS::svc_Common );
  14
  15 #ask FS::UID to run this stuff for us later
  16 $FS::UID::callback{'FS::svc_www'} = sub {
  17   $conf = new FS::Conf;
  18   $apacheip = $conf->config('apacheip');
  19 };
  20
  21 =head1 NAME
  22
  23 FS::svc_www - Object methods for svc_www records
  24
  25 =head1 SYNOPSIS
  26
  27   use FS::svc_www;
  28
  29   $record = new FS::svc_www \%hash;
  30   $record = new FS::svc_www { 'column' => 'value' };
  31
  32   $error = $record->insert;
  33
  34   $error = $new_record->replace($old_record);
  35
  36   $error = $record->delete;
  37
  38   $error = $record->check;
  39
  40   $error = $record->suspend;
  41
  42   $error = $record->unsuspend;
  43
  44   $error = $record->cancel;
  45
  46 =head1 DESCRIPTION
  47
  48 An FS::svc_www object represents an web virtual host.  FS::svc_www inherits
  49 from FS::svc_Common.  The following fields are currently supported:
  50
  51 =over 4
  52
  53 =item svcnum - primary key
  54
  55 =item recnum - DNS `A' record corresponding to this web virtual host. (see L<FS::domain_record>)
  56
  57 =item usersvc - account (see L<FS::svc_acct>) corresponding to this web virtual host.
  58
  59 =back
  60
  61 =head1 METHODS
  62
  63 =over 4
  64
  65 =item new HASHREF
  66
  67 Creates a new web virtual host.  To add the record to the database, see
  68 L<"insert">.
  69
  70 Note that this stores the hash reference, not a distinct copy of the hash it
  71 points to.  You can ask the object for a copy with the I<hash> method.
  72
  73 =cut
  74
  75 sub table { 'svc_www'; }
  76
  77 =item insert
  78
  79 Adds this record to the database.  If there is an error, returns the error,
  80 otherwise returns false.
  81
  82 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
  83 defined.  An FS::cust_svc record will be created and inserted.
  84
  85 =cut
  86
  87 sub insert {
  88   my $self = shift;
  89
  90   my $error = $self->check;
  91   return $error if $error;
  92
  93   local $SIG{HUP} = 'IGNORE';
  94   local $SIG{INT} = 'IGNORE';
  95   local $SIG{QUIT} = 'IGNORE';
  96   local $SIG{TERM} = 'IGNORE';
  97   local $SIG{TSTP} = 'IGNORE';
  98   local $SIG{PIPE} = 'IGNORE';
  99
 100   my $oldAutoCommit = $FS::UID::AutoCommit;
 101   local $FS::UID::AutoCommit = 0;
 102   my $dbh = dbh;
 103
 104   #if ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) {
 105   if ( $self->recnum =~ /^([\w\-]+|\@)\.(\d+)$/ ) {
 106     my( $reczone, $domain_svcnum ) = ( $1, $2 );
 107     unless ( $apacheip ) {
 108       $dbh->rollback if $oldAutoCommit;
 109       return "Configuration option apacheip not set; can't autocreate A record";
 110              #"for $reczone". $svc_domain->domain;
 111     }
 112     my $domain_record = new FS::domain_record {
 113       'svcnum'  => $domain_svcnum,
 114       'reczone' => $reczone,
 115       'recaf'   => 'IN',
 116       'rectype' => 'A',
 117       'recdata' => $apacheip,
 118     };
 119     $error = $domain_record->insert;
 120     if ( $error ) {
 121       $dbh->rollback if $oldAutoCommit;
 122       return $error;
 123     }
 124     $self->recnum($domain_record->recnum);
 125   }
 126
 127   $error = $self->SUPER::insert;
 128   if ( $error ) {
 129     $dbh->rollback if $oldAutoCommit;
 130     return $error;
 131   }
 132
 133   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 134   '';
 135 }
 136
 137 =item delete
 138
 139 Delete this record from the database.
 140
 141 =cut
 142
 143 sub delete {
 144   my $self = shift;
 145   my $error;
 146
 147   $error = $self->SUPER::delete;
 148   return $error if $error;
 149
 150   '';
 151 }
 152
 153 =item replace OLD_RECORD
 154
 155 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 156 returns the error, otherwise returns false.
 157
 158 =cut
 159
 160 sub replace {
 161   my ( $new, $old ) = ( shift, shift );
 162   my $error;
 163
 164   $error = $new->SUPER::replace($old);
 165   return $error if $error;
 166
 167   '';
 168 }
 169
 170 =item suspend
 171
 172 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 173
 174 =item unsuspend
 175
 176 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 177
 178 =item cancel
 179
 180 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 181
 182 =item check
 183
 184 Checks all fields to make sure this is a valid web virtual host.  If there is
 185 an error, returns the error, otherwise returns false.  Called by the insert
 186 and repalce methods.
 187
 188 =cut
 189
 190 sub check {
 191   my $self = shift;
 192
 193   my $x = $self->setfixed;
 194   return $x unless ref($x);
 195   #my $part_svc = $x;
 196
 197   my $error =
 198     $self->ut_numbern('svcnum')
 199 #    || $self->ut_number('recnum')
 200     || $self->ut_number('usersvc')
 201   ;
 202   return $error if $error;
 203
 204   if ( $self->recnum =~ /^(\d+)$/ ) {
 205
 206     $self->recnum($1);
 207     return "Unknown recnum: ". $self->recnum
 208       unless qsearchs('domain_record', { 'recnum' => $self->recnum } );
 209
 210   } elsif ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) {
 211
 212     my( $reczone, $domain ) = ( $1, $2 );
 213
 214     my $svc_domain = qsearchs( 'svc_domain', { 'domain' => $domain } )
 215       or return "unknown domain $domain (recnum $1.$2)";
 216
 217     my $domain_record = qsearchs( 'domain_record', {
 218       'reczone' => $reczone,
 219       'svcnum' => $svc_domain->svcnum,
 220     });
 221
 222     if ( $domain_record ) {
 223       $self->recnum($domain_record->recnum);
 224     } else {
 225       #insert will create it
 226       #$self->recnum("$reczone.$domain");
 227       $self->recnum("$reczone.". $svc_domain->svcnum);
 228     }
 229
 230   } else {
 231     return "Illegal recnum: ". $self->recnum;
 232   }
 233
 234   return "Unknown usersvc (svc_acct.svcnum): ". $self->usersvc
 235     unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
 236
 237   $self->SUPER::check;
 238
 239 }
 240
 241 =item domain_record
 242
 243 Returns the FS::domain_record record for this web virtual host's zone (see
 244 L<FS::domain_record>).
 245
 246 =cut
 247
 248 sub domain_record {
 249   my $self = shift;
 250   qsearchs('domain_record', { 'recnum' => $self->recnum } );
 251 }
 252
 253 =item svc_acct
 254
 255 Returns the FS::svc_acct record for this web virtual host's owner (see
 256 L<FS::svc_acct>).
 257
 258 =cut
 259
 260 sub svc_acct {
 261   my $self = shift;
 262   qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
 263 }
 264
 265 =back
 266
 267 =head1 BUGS
 268
 269 =head1 SEE ALSO
 270
 271 L<FS::svc_Common>, L<FS::Record>, L<FS::domain_record>, L<FS::cust_svc>,
 272 L<FS::part_svc>, L<FS::cust_pkg>, schema.html from the base documentation.
 273
 274 =cut
 275
 276 1;
 277