projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
in &invoicing_list, don't search if there's no custnum yet
[freeside.git] / site_perl / svc_domain.pm
diff --git a/site_perl/svc_domain.pm b/site_perl/svc_domain.pm
index 69b225e..76d666b 100644 (file)
--- a/site_perl/svc_domain.pm
+++ b/site_perl/svc_domain.pm
@@ -1,20 +1,19 @@
 package FS::svc_domain;
 
 use strict;
 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
 );
   $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 Carp;
 use Mail::Internet;
 use Mail::Header;
 use Date::Format;
 use FS::Record qw(fields qsearch qsearchs);
+use FS::svc_Common;
 use FS::cust_svc;
 use FS::Conf;
 
 use FS::cust_svc;
 use FS::Conf;
 
-@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 { 
 
 #ask FS::UID to run this stuff for us later
 $FS::UID::callback{'FS::domain'} = sub { 
@@ -50,8 +49,8 @@ FS::svc_domain - Object methods for svc_domain records
 
   use FS::svc_domain;
 
 
   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;
 
 
   $error = $record->insert;
 
@@ -70,7 +69,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
 =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
 
@@ -84,24 +83,13 @@ FS::Record.  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
 
 
 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
 
 
 =item insert
 
@@ -125,45 +113,30 @@ in the same package, it is automatically used.  Otherwise an error is returned.
 =cut
 
 sub 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{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)"
   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/ );
 
   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;
 
 
   $self->submit_internic unless $whois_hack;
 
@@ -177,24 +150,6 @@ error, otherwise returns false.
 
 The corresponding FS::cust_svc record will be deleted as well.
 
 
 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,
 =item replace OLD_RECORD
 
 Replaces OLD_RECORD with this one in the database.  If there is an error,
@@ -203,29 +158,13 @@ returns the error, otherwise returns false.
 =cut
 
 sub replace {
 =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'); 
 
 
   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);
 
 }
 
 
 }
 
@@ -235,36 +174,18 @@ Just returns false (no error) for now.
 
 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 
 
 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>).
 
 =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>).
 
 =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,
 =item check
 
 Checks all fields to make sure this is a valid domain.  If there is an error,
@@ -276,41 +197,29 @@ Sets any fixed values; see L<FS::part_svc>.
 =cut
 
 sub check {
 =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 {
   } 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
   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;
       }
 
         push @svc_acct, $svc_acct if $svc_acct;
       }
 
@@ -356,10 +265,10 @@ $FS::svc_domain::whois_hack is set true.)
 =cut
 
 sub _whois {
 =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;
   return ( "No match for domain \"$domain\"." ) if $whois_hack;
-  open(WHOIS,"whois do $domain |");
+  open(WHOIS, "whois do $domain |");
   return <WHOIS>;
 }
 
   return <WHOIS>;
 }
 
@@ -370,14 +279,14 @@ Submits a registration email for this domain.
 =cut
 
 sub submit_internic {
 =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;
   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;
 
   return unless $cust_main;
 
-  my(%subs)=(
+  my %subs = (
     'action'       => $self->action,
     'purpose'      => $self->purpose,
     'domain'       => $self->domain,
     'action'       => $self->action,
     'purpose'      => $self->purpose,
     'domain'       => $self->domain,
@@ -400,18 +309,18 @@ sub submit_internic {
   );
 
   #yuck
   );
 
   #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);
 
     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;
       }
         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 ]
         'address'      => $cust_main->address2 
                             ? [ $cust_main->address1, $cust_main->address2 ]
                             : [ $cust_main->address1 ]
@@ -420,8 +329,8 @@ sub submit_internic {
         'secondary_ip' => [ @nameserver_ips ],
       );
       LOOP: while (1) {
         '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}};
           if ( $line =~ /###(\w+)###/ ) {
             #last LOOP unless my($lub)=shift@{$lubs{$1}};
             next OLOOP unless my $lub = shift @{$lubs{$1}};
@@ -445,23 +354,23 @@ sub submit_internic {
 
   } #OLOOP
 
 
   } #OLOOP
 
-  my($subject);
+  my $subject;
   if ( $self->action eq "M" ) {
     $subject = "MODIFY DOMAIN ". $self->domain;
   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;
   }
 
     $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",
     "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",
   ] );
 
     "Subject: $subject",
   ] );
 
@@ -476,27 +385,26 @@ sub submit_internic {
 
 =back
 
 
 =back
 
-=head1 BUGS
+=head1 VERSION
 
 
-It doesn't properly override FS::Record yet.
+$Id: svc_domain.pm,v 1.6 1999-01-25 12:26:17 ivan Exp $
+
+=head1 BUGS
 
 All BIND/DNS fields should be included (and exported).
 
 
 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.
 
 
 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
 
 
 =head1 HISTORY
 
@@ -515,7 +423,13 @@ ivan@sisd.com 98-jul-17-19
 pod, some FS::Conf (not complete) ivan@sisd.com 98-sep-23
 
 $Log: svc_domain.pm,v $
 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.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.)
 
 change configuration file layout to support multiple distinct databases (with
 own set of config files, export, etc.)
 
Freeside billing, trouble ticketing, network monitoring and provisioning