projects
/
freeside.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
add ticket creation to self-service API, RT#7007
[freeside.git]
/
FS
/
FS
/
svc_domain.pm
diff --git
a/FS/FS/svc_domain.pm
b/FS/FS/svc_domain.pm
index
803ebef
..
8ca30c2
100644
(file)
--- a/
FS/FS/svc_domain.pm
+++ b/
FS/FS/svc_domain.pm
@@
-6,8
+6,10
@@
use vars qw( @ISA $whois_hack $conf
$soarefresh $soaretry
);
use Carp;
$soarefresh $soaretry
);
use Carp;
+use Scalar::Util qw( blessed );
use Date::Format;
#use Net::Whois::Raw;
use Date::Format;
#use Net::Whois::Raw;
+use Net::Domain::TLD qw(tld_exists);
use FS::Record qw(fields qsearch qsearchs dbh);
use FS::Conf;
use FS::svc_Common;
use FS::Record qw(fields qsearch qsearchs dbh);
use FS::Conf;
use FS::svc_Common;
@@
-138,8
+140,8
@@
otherwise returns false.
The additional fields I<pkgnum> and I<svcpart> (see L<FS::cust_svc>) should be
defined. An FS::cust_svc record will be created and inserted.
The additional fields I<pkgnum> and I<svcpart> (see L<FS::cust_svc>) should be
defined. An FS::cust_svc record will be created and inserted.
-The additional field I<action> should be set to I<N> for new domains
or
I<M>
-for transfers.
+The additional field I<action> should be set to I<N> for new domains
,
I<M>
+for transfers
, or I<I> for no action (registered elsewhere)
.
A registration or transfer email will be submitted unless
$FS::svc_domain::whois_hack is true.
A registration or transfer email will be submitted unless
$FS::svc_domain::whois_hack is true.
@@
-179,13
+181,6
@@
sub insert {
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- $error = $self->check;
- return $error if $error;
-
- return "Domain in use (here)"
- if qsearchs( 'svc_domain', { 'domain' => $self->domain } );
-
-
$error = $self->SUPER::insert(@_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
$error = $self->SUPER::insert(@_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
@@
-288,16
+283,17
@@
returns the error, otherwise returns false.
=cut
sub replace {
=cut
sub replace {
- my
( $new, $old ) = ( shift, shift )
;
+ my
$new = shift
;
- # We absolutely have to have an old vs. new record to make this work.
- $old = $new->replace_old unless defined($old);
+ my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
+ ? shift
+ : $new->replace_old;
return "Can't change domain - reorder."
if $old->getfield('domain') ne $new->getfield('domain');
# Better to do it here than to force the caller to remember that svc_domain is weird.
return "Can't change domain - reorder."
if $old->getfield('domain') ne $new->getfield('domain');
# Better to do it here than to force the caller to remember that svc_domain is weird.
- $new->setfield(action => '
M
');
+ $new->setfield(action => '
I
');
my $error = $new->SUPER::replace($old, @_);
return $error if $error;
}
my $error = $new->SUPER::replace($old, @_);
return $error if $error;
}
@@
-361,11
+357,18
@@
sub check {
} elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)\.(\w+)$/ ) {
$recref->{domain} = "$1.$2";
# need to match a list of suffixes - no guarantee they're top-level..
} elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)\.(\w+)$/ ) {
$recref->{domain} = "$1.$2";
# need to match a list of suffixes - no guarantee they're top-level..
+ # http://wiki.mozilla.org/TLD_List
+ # but this will have to do for now...
+ $recref->{suffix} ||= $2;
} else {
return "Illegal domain ". $recref->{domain}.
" (or unknown registry - try \$whois_hack)";
}
} else {
return "Illegal domain ". $recref->{domain}.
" (or unknown registry - try \$whois_hack)";
}
+ $self->suffix =~ /(^|\.)(\w+)$/
+ or return "can't parse suffix for TLD: ". $self->suffix;
+ my $tld = $2;
+ return "No such TLD: .$tld" unless tld_exists($tld);
if ( $recref->{catchall} ne '' ) {
my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } );
if ( $recref->{catchall} ne '' ) {
my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } );
@@
-378,11
+381,22
@@
sub check {
or $self->ut_numbern('setup_date')
or $self->ut_numbern('renewal_interval')
or $self->ut_numbern('expiration_date')
or $self->ut_numbern('setup_date')
or $self->ut_numbern('renewal_interval')
or $self->ut_numbern('expiration_date')
- or $self->ut_textn('purpose')
or $self->SUPER::check;
}
or $self->SUPER::check;
}
+sub _check_duplicate {
+ my $self = shift;
+
+ $self->lock_table;
+
+ if ( qsearchs( 'svc_domain', { 'domain' => $self->domain } ) ) {
+ return "Domain in use (here)";
+ } else {
+ return '';
+ }
+}
+
=item domain_record
=cut
=item domain_record
=cut
@@
-445,27
+459,6
@@
sub whois {
#$whois_hack or die "whois_hack not set...\n";
}
#$whois_hack or die "whois_hack not set...\n";
}
-=item _whois
-
-Depriciated.
-
-=cut
-
-sub _whois {
- die "_whois depriciated";
-}
-
-=item submit_internic
-
-Submits a registration email for this domain.
-
-=cut
-
-sub submit_internic {
- #my $self = shift;
- carp "submit_internic depreciated";
-}
-
=back
=head1 BUGS
=back
=head1 BUGS