package FS::svc_domain;
use strict;
-use vars qw(@ISA @EXPORT_OK $whois_hack $conf $mydomain $smtpmachine
+use vars qw( @ISA $whois_hack $conf $mydomain $smtpmachine
$tech_contact $from $to @nameservers @nameserver_ips @template
);
-use Exporter;
use Carp;
use Mail::Internet;
use Mail::Header;
use Date::Format;
use FS::Record qw(fields qsearch qsearchs);
-use FS::cust_svc;
use FS::Conf;
+use FS::svc_Common;
+use FS::cust_svc;
+use FS::svc_acct;
+use FS::cust_pkg;
+use FS::cust_main;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::svc_Common );
#ask FS::UID to run this stuff for us later
$FS::UID::callback{'FS::domain'} = sub {
use FS::svc_domain;
- $record = create FS::svc_domain \%hash;
- $record = create FS::svc_domain { 'column' => 'value' };
+ $record = new FS::svc_domain \%hash;
+ $record = new FS::svc_domain { 'column' => 'value' };
$error = $record->insert;
=head1 DESCRIPTION
An FS::svc_domain object represents a domain. FS::svc_domain inherits from
-FS::Record. The following fields are currently supported:
+FS::svc_Common. The following fields are currently supported:
=over 4
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new domain. To add the domain to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_domain')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_domain',$hashref);
-
-}
+sub table { 'svc_domain'; }
=item insert
=cut
sub insert {
- my($self)=@_;
- my($error);
+ my $self = shift;
+ my $error;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
- $error=$self->check;
+ $error = $self->check;
return $error if $error;
return "Domain in use (here)"
- if qsearchs('svc_domain',{'domain'=> $self->domain } );
+ if qsearchs( 'svc_domain', { 'domain' => $self->domain } );
- my($whois)=(($self->_whois)[0]);
+ my $whois = ($self->_whois)[0];
return "Domain in use (see whois)"
if ( $self->action eq "N" && $whois !~ /^No match for/ );
return "Domain not found (see whois)"
if ( $self->action eq "M" && $whois =~ /^No match for/ );
- my($svcnum)=$self->getfield('svcnum');
- my($cust_svc);
- unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
- 'svcnum' => $svcnum,
- 'pkgnum' => $self->getfield('pkgnum'),
- 'svcpart' => $self->getfield('svcpart'),
- } );
- my($error) = $cust_svc->insert;
- return $error if $error;
- $svcnum = $self->setfield('svcnum',$cust_svc->getfield('svcnum'));
- }
-
- $error = $self->add;
- if ($error) {
- $cust_svc->del if $cust_svc;
- return $error;
- }
+ $error = $self->SUPER::insert;
+ return $error if $error;
$self->submit_internic unless $whois_hack;
The corresponding FS::cust_svc record will be deleted as well.
-=cut
-
-sub delete {
- my($self)=@_;
- my($error);
-
- my($svcnum)=$self->getfield('svcnum');
-
- $error = $self->del;
- return $error if $error;
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
- return $error if $error;
-
- '';
-}
-
=item replace OLD_RECORD
Replaces OLD_RECORD with this one in the database. If there is an error,
=cut
sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_domain record!" unless $old->table eq "svc_domain";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
+ my ( $new, $old ) = ( shift, shift );
+ my $error;
return "Can't change domain - reorder."
if $old->getfield('domain') ne $new->getfield('domain');
- $error=$new->check;
- return $error if $error;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error = $new->rep($old);
- return $error if $error;
-
- '';
+ $new->SUPER::replace($old);
}
Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-=cut
-
-sub suspend {
- ''; #no error (stub)
-}
-
=item unsuspend
Just returns false (no error) for now.
Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-=cut
-
-sub unsuspend {
- ''; #no error (stub)
-}
-
=item cancel
Just returns false (no error) for now.
Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-=cut
-
-sub cancel {
- ''; #no error (stub)
-}
-
=item check
Checks all fields to make sure this is a valid domain. If there is an error,
=cut
sub check {
- my($self)=@_;
- return "Not a svc_domain record!" unless $self->table eq "svc_domain";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
-
- #get part_svc (and pkgnum)
- my($svcpart,$pkgnum);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- $pkgnum=$cust_svc->pkgnum;
+ my $self = shift;
+ my $error;
+
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ my $part_svc = $x;
+
+ #hmm
+ my $pkgnum;
+ if ( $self->svcnum ) {
+ my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
+ $pkgnum = $cust_svc->pkgnum;
} else {
- $svcpart=$self->svcpart;
- $pkgnum=$self->pkgnum;
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_domain__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_domain__'. $field) );
- }
+ $pkgnum = $self->pkgnum;
}
+ my($recref) = $self->hashref;
+
unless ( $whois_hack ) {
unless ( $self->email ) { #find out an email address
- my(@svc_acct);
- foreach ( qsearch('cust_svc',{'pkgnum'=>$pkgnum}) ) {
- my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$_->svcnum});
+ my @svc_acct;
+ foreach ( qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } ) ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $_->svcnum } );
push @svc_acct, $svc_acct if $svc_acct;
}
=cut
sub _whois {
- my($self)=@_;
- my($domain)=$self->domain;
+ my $self = shift;
+ my $domain = $self->domain;
return ( "No match for domain \"$domain\"." ) if $whois_hack;
- open(WHOIS,"whois do $domain |");
+ open(WHOIS, "whois do $domain |");
return <WHOIS>;
}
=cut
sub submit_internic {
- my($self)=@_;
+ my $self = shift;
- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$self->pkgnum});
+ my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
return unless $cust_pkg;
- my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum});
+ my $cust_main = qsearchs( 'cust_main', { 'custnum' => $cust_pkg->custnum } );
return unless $cust_main;
- my(%subs)=(
+ my %subs = (
'action' => $self->action,
'purpose' => $self->purpose,
'domain' => $self->domain,
);
#yuck
- my(@xtemplate)=@template;
- my(@body);
- my($line);
- OLOOP: while ( defined($line = shift @xtemplate) ) {
+ my @xtemplate = @template;
+ my @body;
+ my $line;
+ OLOOP: while ( defined( $line = shift @xtemplate ) ) {
if ( $line =~ /^###LOOP###$/ ) {
my(@buffer);
- LOADBUF: while ( defined($line = shift @xtemplate) ) {
+ LOADBUF: while ( defined( $line = shift @xtemplate ) ) {
last LOADBUF if ( $line =~ /^###ENDLOOP###$/ );
push @buffer, $line;
}
- my(%lubs)=(
+ my %lubs = (
'address' => $cust_main->address2
? [ $cust_main->address1, $cust_main->address2 ]
: [ $cust_main->address1 ]
'secondary_ip' => [ @nameserver_ips ],
);
LOOP: while (1) {
- my(@xbuffer)=@buffer;
- SUBLOOP: while ( defined($line = shift @xbuffer) ) {
+ my @xbuffer = @buffer;
+ SUBLOOP: while ( defined( $line = shift @xbuffer ) ) {
if ( $line =~ /###(\w+)###/ ) {
#last LOOP unless my($lub)=shift@{$lubs{$1}};
next OLOOP unless my $lub = shift @{$lubs{$1}};
} #OLOOP
- my($subject);
+ my $subject;
if ( $self->action eq "M" ) {
$subject = "MODIFY DOMAIN ". $self->domain;
- } elsif ($self->action eq "N" ) {
+ } elsif ( $self->action eq "N" ) {
$subject = "NEW DOMAIN ". $self->domain;
} else {
croak "submit_internic called with action ". $self->action;
}
- $ENV{SMTPHOSTS}=$smtpmachine;
- $ENV{MAILADDRESS}=$from;
- my($header)=Mail::Header->new( [
+ $ENV{SMTPHOSTS} = $smtpmachine;
+ $ENV{MAILADDRESS} = $from;
+ my $header = Mail::Header->new( [
"From: $from",
"To: $to",
"Sender: $from",
"Reply-To: $from",
- "Date: ". time2str("%a, %d %b %Y %X %z",time),
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
"Subject: $subject",
] );
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: svc_domain.pm,v 1.7 1999-04-07 14:40:15 ivan Exp $
+
+=head1 BUGS
All BIND/DNS fields should be included (and exported).
-All registries should be supported.
+Delete doesn't send a registration template.
-Not all configuration access is through FS::Conf!
+All registries should be supported.
Should change action to a real field.
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
-L<FS::SSH>, L<ssh>, L<dot-qmail>, schema.html from the base documentation,
-config.html from the base documentation.
+The $recref stuff in sub check should be cleaned up.
-=head1 VERSION
+=head1 SEE ALSO
-$Id: svc_domain.pm,v 1.3 1998-11-13 09:56:57 ivan Exp $
+L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
+L<FS::part_svc>, L<FS::cust_pkg>, L<FS::SSH>, L<ssh>, L<dot-qmail>, schema.html from the base documentation, config.html from the base documentation.
=head1 HISTORY
pod, some FS::Conf (not complete) ivan@sisd.com 98-sep-23
$Log: svc_domain.pm,v $
-Revision 1.3 1998-11-13 09:56:57 ivan
+Revision 1.7 1999-04-07 14:40:15 ivan
+use all stuff that's qsearch'ed to avoid warnings
+
+Revision 1.6 1999/01/25 12:26:17 ivan
+yet more mod_perl stuff
+
+Revision 1.5 1998/12/30 00:30:47 ivan
+svc_ stuff is more properly OO - has a common superclass FS::svc_Common
+
+Revision 1.3 1998/11/13 09:56:57 ivan
change configuration file layout to support multiple distinct databases (with
own set of config files, export, etc.)
projects / freeside.git / blobdiff