summaryrefslogtreecommitdiff
path: root/site_perl/svc_domain.pm
diff options
context:
space:
mode:
Diffstat (limited to 'site_perl/svc_domain.pm')
-rw-r--r--site_perl/svc_domain.pm339
1 files changed, 125 insertions, 214 deletions
diff --git a/site_perl/svc_domain.pm b/site_perl/svc_domain.pm
index 1ddd5b290..19aac3f88 100644
--- a/site_perl/svc_domain.pm
+++ b/site_perl/svc_domain.pm
@@ -1,73 +1,48 @@
package FS::svc_domain;
use strict;
-use vars qw(@ISA @EXPORT_OK $whois_hack $conf $mydomain $smtpmachine);
-use Exporter;
+use vars qw( @ISA $whois_hack $conf $mydomain $smtpmachine
+ $tech_contact $from $to @nameservers @nameserver_ips @template
+);
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;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-$conf = new FS::Conf;
-
-$mydomain = $conf->config('domain');
-$smtpmachine = $conf->config('smtpmachine');
-
-my($internic)="/var/spool/freeside/conf/registries/internic";
-my($conf_tech)="$internic/tech_contact";
-my($conf_from)="$internic/from";
-my($conf_to)="$internic/to";
-my($nameservers)="$internic/nameservers";
-my($template)="$internic/template";
-
-open(TECH_CONTACT,$conf_tech) or die "Can't open $conf_tech: $!";
-my($tech_contact)=map {
- /^(.*)$/ or die "Illegal line in $conf_tech!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <TECH_CONTACT>;
-close TECH_CONTACT;
-
-open(FROM,$conf_from) or die "Can't open $conf_from: $!";
-my($from)=map {
- /^(.*)$/ or die "Illegal line in $conf_from!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <FROM>;
-close FROM;
-
-open(TO,$conf_to) or die "Can't open $conf_to: $!";
-my($to)=map {
- /^(.*)$/ or die "Illegal line in $conf_to!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <TO>;
-close TO;
-
-open(NAMESERVERS,$nameservers) or die "Can't open $nameservers: $!";
-my(@nameservers)=map {
- /^\s*\d+\.\d+\.\d+\.\d+\s+([^\s]+)\s*$/
- or die "Illegal line in $nameservers!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <NAMESERVERS>;
-close NAMESERVERS;
-open(NAMESERVERS,$nameservers) or die "Can't open $nameservers: $!";
-my(@nameserver_ips)=map {
- /^\s*(\d+\.\d+\.\d+\.\d+)\s+([^\s]+)\s*$/
- or die "Illegal line in $nameservers!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <NAMESERVERS>;
-close NAMESERVERS;
-
-open(TEMPLATE,$template) or die "Can't open $template: $!";
-my(@template)=map {
- /^(.*)$/ or die "Illegal line in $to!"; #yes, we trust the file
- $1. "\n";
-} <TEMPLATE>;
-close TEMPLATE;
+use FS::svc_Common;
+use FS::cust_svc;
+use FS::svc_acct;
+use FS::cust_pkg;
+use FS::cust_main;
+
+@ISA = qw( FS::svc_Common );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::domain'} = sub {
+ $conf = new FS::Conf;
+
+ $mydomain = $conf->config('domain');
+ $smtpmachine = $conf->config('smtpmachine');
+
+ my($internic)="/registries/internic";
+ $tech_contact = $conf->config("$internic/tech_contact");
+ $from = $conf->config("$internic/from");
+ $to = $conf->config("$internic/to");
+ my(@ns) = $conf->config("$internic/nameservers");
+ @nameservers=map {
+ /^\s*\d+\.\d+\.\d+\.\d+\s+([^\s]+)\s*$/
+ or die "Illegal line in $internic/nameservers";
+ $1;
+ } @ns;
+ @nameserver_ips=map {
+ /^\s*(\d+\.\d+\.\d+\.\d+)\s+([^\s]+)\s*$/
+ or die "Illegal line in $internic/nameservers!";
+ $1;
+ } @ns;
+ @template = map { $_. "\n" } $conf->config("$internic/template");
+
+};
=head1 NAME
@@ -77,8 +52,8 @@ FS::svc_domain - Object methods for svc_domain records
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;
@@ -97,7 +72,7 @@ FS::svc_domain - Object methods for svc_domain records
=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
@@ -111,24 +86,13 @@ FS::Record. The following fields are currently supported:
=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
@@ -144,48 +108,38 @@ for transfers.
A registration or transfer email will be submitted unless
$FS::svc_domain::whois_hack is true.
+The additional field I<email> can be used to manually set the admin contact
+email address on this email. Otherwise, the svc_acct records for this package
+(see L<FS::cust_pkg>) are searched. If there is exactly one svc_acct record
+in the same package, it is automatically used. Otherwise an error is returned.
+
=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;
@@ -199,24 +153,6 @@ error, otherwise returns false.
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,
@@ -225,29 +161,13 @@ returns the error, otherwise returns false.
=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);
}
@@ -257,36 +177,18 @@ Just returns false (no error) for now.
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,
@@ -298,46 +200,34 @@ Sets any fixed values; see L<FS::part_svc>.
=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;
}
if ( scalar(@svc_acct) == 0 ) {
- return "Must order an account first";
+ return "Must order an account in package ". $pkgnum. " first";
} elsif ( scalar(@svc_acct) > 1 ) {
return "More than one account in package ". $pkgnum. ": specify admin contact email";
} else {
@@ -378,10 +268,10 @@ $FS::svc_domain::whois_hack is set true.)
=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>;
}
@@ -392,14 +282,14 @@ Submits a registration email for this domain.
=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,
@@ -422,18 +312,18 @@ sub submit_internic {
);
#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 ]
@@ -442,8 +332,8 @@ sub submit_internic {
'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}};
@@ -467,23 +357,23 @@ sub submit_internic {
} #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",
] );
@@ -498,23 +388,26 @@ sub submit_internic {
=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.
+The $recref stuff in sub check should be cleaned up.
+
=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.
+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
@@ -532,6 +425,24 @@ ivan@sisd.com 98-jul-17-19
pod, some FS::Conf (not complete) ivan@sisd.com 98-sep-23
+$Log: svc_domain.pm,v $
+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.)
+
+Revision 1.2 1998/10/14 08:18:21 ivan
+More informative error messages and better doc for admin contact email stuff
+
+
=cut
1;
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-14 09:23:57 +0000