event refactor, landing on HEAD!
[freeside.git] / 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_info {
76   {
77     'name' => 'Hosting',
78     'name_plural' => 'Virtual hosting services',
79     'display_weight' => 40,
80     'cancel_weight'  => 20,
81     'fields' => {
82     },
83   };
84 };
85
86 sub table { 'svc_www'; }
87
88 =item label [ END_TIMESTAMP [ START_TIMESTAMP ] ]
89
90 Returns the zone name for this virtual host.
91
92 END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
93 history records.
94
95 =cut
96
97 sub label {
98   my $self = shift;
99   $self->domain_record(@_)->zone;
100 }
101
102 =item insert [ , OPTION => VALUE ... ]
103
104 Adds this record to the database.  If there is an error, returns the error,
105 otherwise returns false.
106
107 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be 
108 defined.  An FS::cust_svc record will be created and inserted.
109
110 Currently available options are: I<depend_jobnum>
111
112 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
113 jobnums), all provisioning jobs will have a dependancy on the supplied
114 jobnum(s) (they will not run until the specific job(s) complete(s)).
115
116
117 =cut
118
119 sub insert {
120   my $self = shift;
121
122   my $error = $self->check;
123   return $error if $error;
124
125   local $SIG{HUP} = 'IGNORE';
126   local $SIG{INT} = 'IGNORE';
127   local $SIG{QUIT} = 'IGNORE';
128   local $SIG{TERM} = 'IGNORE';
129   local $SIG{TSTP} = 'IGNORE';
130   local $SIG{PIPE} = 'IGNORE';
131
132   my $oldAutoCommit = $FS::UID::AutoCommit;
133   local $FS::UID::AutoCommit = 0;
134   my $dbh = dbh;
135
136   #if ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) {
137   if ( $self->recnum =~ /^([\w\-]+|\@)\.(\d+)$/ ) {
138     my( $reczone, $domain_svcnum ) = ( $1, $2 );
139     unless ( $apacheip ) {
140       $dbh->rollback if $oldAutoCommit;
141       return "Configuration option apacheip not set; can't autocreate A record";
142              #"for $reczone". $svc_domain->domain;
143     }
144     my $domain_record = new FS::domain_record {
145       'svcnum'  => $domain_svcnum,
146       'reczone' => $reczone,
147       'recaf'   => 'IN',
148       'rectype' => 'A',
149       'recdata' => $apacheip,
150     };
151     $error = $domain_record->insert;
152     if ( $error ) {
153       $dbh->rollback if $oldAutoCommit;
154       return $error;
155     }
156     $self->recnum($domain_record->recnum);
157   }
158
159   $error = $self->SUPER::insert(@_);
160   if ( $error ) {
161     $dbh->rollback if $oldAutoCommit;
162     return $error;
163   }
164
165   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
166   '';
167 }
168
169 =item delete
170
171 Delete this record from the database.
172
173 =cut
174
175 sub delete {
176   my $self = shift;
177   my $error;
178
179   $error = $self->SUPER::delete(@_);
180   return $error if $error;
181
182   '';
183 }
184
185 =item replace OLD_RECORD
186
187 Replaces the OLD_RECORD with this one in the database.  If there is an error,
188 returns the error, otherwise returns false.
189
190 =cut
191
192 sub replace {
193   my ( $new, $old ) = ( shift, shift );
194   my $error;
195
196   $error = $new->SUPER::replace($old, @_);
197   return $error if $error;
198
199   '';
200 }
201
202 =item suspend
203
204 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
205
206 =item unsuspend
207
208 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
209
210 =item cancel
211
212 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
213
214 =item check
215
216 Checks all fields to make sure this is a valid web virtual host.  If there is
217 an error, returns the error, otherwise returns false.  Called by the insert
218 and replace methods.
219
220 =cut
221
222 sub check {
223   my $self = shift;
224
225   my $x = $self->setfixed;
226   return $x unless ref($x);
227   #my $part_svc = $x;
228
229   my $error =
230     $self->ut_numbern('svcnum')
231 #    || $self->ut_number('recnum')
232     || $self->ut_numbern('usersvc')
233     || $self->ut_anything('config')
234   ;
235   return $error if $error;
236
237   if ( $self->recnum =~ /^(\d+)$/ ) {
238   
239     $self->recnum($1);
240     return "Unknown recnum: ". $self->recnum
241       unless qsearchs('domain_record', { 'recnum' => $self->recnum } );
242
243   } elsif ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) {
244
245     my( $reczone, $domain ) = ( $1, $2 );
246
247     my $svc_domain = qsearchs( 'svc_domain', { 'domain' => $domain } )
248       or return "unknown domain $domain (recnum $1.$2)";
249
250     my $domain_record = qsearchs( 'domain_record', {
251       'reczone' => $reczone,
252       'svcnum' => $svc_domain->svcnum,
253     });
254
255     if ( $domain_record ) {
256       $self->recnum($domain_record->recnum);
257     } else {
258       #insert will create it
259       #$self->recnum("$reczone.$domain");
260       $self->recnum("$reczone.". $svc_domain->svcnum);
261     }
262
263   } else {
264     return "Illegal recnum: ". $self->recnum;
265   }
266
267   if ( $self->usersvc ) {
268     return "Unknown usersvc0 (svc_acct.svcnum): ". $self->usersvc
269       unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
270   }
271
272   $self->SUPER::check;
273
274 }
275
276 =item domain_record
277
278 Returns the FS::domain_record record for this web virtual host's zone (see
279 L<FS::domain_record>).
280
281 =cut
282
283 sub domain_record {
284   my $self = shift;
285   qsearchs('domain_record', { 'recnum' => $self->recnum } );
286 }
287
288 =item svc_acct
289
290 Returns the FS::svc_acct record for this web virtual host's owner (see
291 L<FS::svc_acct>).
292
293 =cut
294
295 sub svc_acct {
296   my $self = shift;
297   qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
298 }
299
300 =back
301
302 =head1 BUGS
303
304 =head1 SEE ALSO
305
306 L<FS::svc_Common>, L<FS::Record>, L<FS::domain_record>, L<FS::cust_svc>,
307 L<FS::part_svc>, L<FS::cust_pkg>, schema.html from the base documentation.
308
309 =cut
310
311 1;
312