summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
Diffstat (limited to 'FS')
-rw-r--r--FS/FS.pm11
-rw-r--r--FS/FS/UID.pm4
-rw-r--r--FS/FS/part_svc.pm144
-rw-r--r--FS/FS/svc_Common.pm10
-rw-r--r--FS/FS/svc_acct.pm8
-rw-r--r--FS/FS/svc_acct_sm.pm4
-rw-r--r--FS/FS/svc_domain.pm4
-rw-r--r--FS/FS/svc_forward.pm4
-rw-r--r--FS/FS/svc_www.pm4
-rw-r--r--FS/MANIFEST2
-rw-r--r--FS/t/part_svc_column.t5
11 files changed, 152 insertions, 48 deletions
diff --git a/FS/FS.pm b/FS/FS.pm
index 652e458aa..cd11e96d2 100644
--- a/FS/FS.pm
+++ b/FS/FS.pm
@@ -46,12 +46,16 @@ L<FS::svc_domain> - Domain class
L<FS::domain_record> - DNS zone entries
-L<FS::svc_acct_sm> - Vitual mail alias class
+L<FS::svc_forward> - Mail forwarding class
+
+L<FS::svc_acct_sm> - (Depreciated) Vitual mail alias class
L<FS::svc_www> - Web virtual host class.
L<FS::part_svc> - Service definition class
+L<FS::part_svc_column> - Column constraint class
+
L<FS::part_pkg> - Package (billing item) definition class
L<FS::pkg_svc> - Class linking package (billing item)
@@ -117,6 +121,9 @@ To quote perl(1), "If you're intending to read these straight through for the
first time, the suggested order will tend to reduce the number of forward
references."
+If you've never used OO modules before,
+http://www.cpan.org/doc/FMTEYEWTK/easy_objects.html might help you out.
+
=head1 DESCRIPTION
Freeside is a billing and administration package for Internet Service
@@ -128,7 +135,7 @@ The main documentation is in htdocs/docs.
=head1 VERSION
-$Id: FS.pm,v 1.6 2001-09-02 04:25:55 ivan Exp $
+$Id: FS.pm,v 1.7 2001-09-06 20:41:59 ivan Exp $
=head1 SUPPORT
diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm
index 3e71f09f1..f80156e97 100644
--- a/FS/FS/UID.pm
+++ b/FS/FS/UID.pm
@@ -118,7 +118,7 @@ Returns the CGI (see L<CGI>) object.
=cut
sub cgi {
- carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
+ #carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
$cgi;
}
@@ -249,7 +249,7 @@ coderef into the hash %FS::UID::callback :
=head1 VERSION
-$Id: UID.pm,v 1.8 2001-08-21 09:34:13 ivan Exp $
+$Id: UID.pm,v 1.9 2001-09-06 20:41:59 ivan Exp $
=head1 BUGS
diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm
index ccf0413b3..e64f09a70 100644
--- a/FS/FS/part_svc.pm
+++ b/FS/FS/part_svc.pm
@@ -2,7 +2,8 @@ package FS::part_svc;
use strict;
use vars qw( @ISA );
-use FS::Record qw( fields );
+use FS::Record qw( qsearchs fields dbh );
+use FS::part_svc_column;
@ISA = qw(FS::Record);
@@ -14,8 +15,8 @@ FS::part_svc - Object methods for part_svc objects
use FS::part_svc;
- $record = new FS::part_referral \%hash
- $record = new FS::part_referral { 'column' => 'value' };
+ $record = new FS::part_svc \%hash
+ $record = new FS::part_svc { 'column' => 'value' };
$error = $record->insert;
@@ -37,7 +38,7 @@ FS::Record. The following fields are currently supported:
=item svc - text name of this service definition
=item svcdb - table used for this service. See L<FS::svc_acct>,
-L<FS::svc_domain>, and L<FS::svc_acct_sm>, among others.
+L<FS::svc_domain>, and L<FS::svc_forward>, among others.
=item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
@@ -62,6 +63,73 @@ sub table { 'part_svc'; }
Adds this service definition to the database. If there is an error, returns
the error, otherwise returns false.
+=item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
+
+=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ my $svcdb = $self->svcdb;
+# my @rows = map { /^${svcdb}__(.*)$/; $1 }
+# grep ! /_flag$/,
+# grep /^${svcdb}__/,
+# fields('part_svc');
+ foreach my $field (
+ grep { $_ ne 'svcnum'
+ && defined( $self->getfield($svcdb.'__'.$_.'_flag') )
+ } fields($svcdb)
+ ) {
+ my $part_svc_column = $self->part_svc_column($field);
+ my $previous = qsearchs('part_svc_column', {
+ 'svcpart' => $self->svcpart,
+ 'columnname' => $field,
+ } );
+
+ my $flag = $self->getfield($svcdb.'__'.$field.'_flag');
+ if ( uc($flag) =~ /^([DF])$/ ) {
+ $part_svc_column->setfield('columnflag', $1);
+ $part_svc_column->setfield('columnvalue',
+ $self->getfield($svcdb.'__'.$field)
+ );
+ if ( $previous ) {
+ $error = $part_svc_column->replace($previous);
+ } else {
+ $error = $part_svc_column->insert;
+ }
+ } else {
+ $error = $part_svc_column->delete;
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+}
=item delete
@@ -113,38 +181,58 @@ sub check {
my @fields = eval { fields( $recref->{svcdb} ) }; #might die
return "Unknown svcdb!" unless @fields;
- my $svcdb;
- foreach $svcdb ( qw(
- svc_acct svc_acct_sm svc_domain
- ) ) {
- my @rows = map { /^${svcdb}__(.*)$/; $1 }
- grep ! /_flag$/,
- grep /^${svcdb}__/,
- fields('part_svc');
- foreach my $row (@rows) {
- unless ( $svcdb eq $recref->{svcdb} ) {
- $recref->{$svcdb.'__'.$row}='';
- $recref->{$svcdb.'__'.$row.'_flag'}='';
- next;
- }
- $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/
- or return "Illegal flag for $svcdb $row";
- $recref->{$svcdb.'__'.$row.'_flag'} = $1;
+# my $svcdb;
+# foreach $svcdb ( qw(
+# svc_acct svc_acct_sm svc_domain
+# ) ) {
+# my @rows = map { /^${svcdb}__(.*)$/; $1 }
+# grep ! /_flag$/,
+# grep /^${svcdb}__/,
+# fields('part_svc');
+# foreach my $row (@rows) {
+# unless ( $svcdb eq $recref->{svcdb} ) {
+# $recref->{$svcdb.'__'.$row}='';
+# $recref->{$svcdb.'__'.$row.'_flag'}='';
+# next;
+# }
+# $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/
+# or return "Illegal flag for $svcdb $row";
+# $recref->{$svcdb.'__'.$row.'_flag'} = $1;
+#
+# my $error = $self->ut_anything($svcdb.'__'.$row);
+# return $error if $error;
+#
+# }
+# }
+
+ ''; #no error
+}
- my $error = $self->ut_anything($svcdb.'__'.$row);
- return $error if $error;
+=item part_svc_column COLUMNNAME
- }
- }
+Returns the part_svc_column object (see L<FS::part_svc_column>) for the given
+COLUMNNAME, or a new part_svc_column object if none exists.
- ''; #no error
+=cut
+
+sub part_svc_column {
+ my $self = shift;
+ my $columnname = shift;
+ qsearchs('part_svc_column', {
+ 'svcpart' => $self->svcpart,
+ 'columnname' => $columnname,
+ }
+ ) or new FS::part_svc_column {
+ 'svcpart' => $self->svcpart,
+ 'columnname' => $columnname,
+ };
}
=back
=head1 VERSION
-$Id: part_svc.pm,v 1.2 2001-08-11 05:51:24 ivan Exp $
+$Id: part_svc.pm,v 1.3 2001-09-06 20:41:59 ivan Exp $
=head1 BUGS
@@ -156,7 +244,7 @@ should be fixed.
=head1 SEE ALSO
L<FS::Record>, L<FS::part_pkg>, L<FS::pkg_svc>, L<FS::cust_svc>,
-L<FS::svc_acct>, L<FS::svc_acct_sm>, L<FS::svc_domain>, schema.html from the
+L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>, schema.html from the
base documentation.
=cut
diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm
index bc5b75640..c47cdbf8f 100644
--- a/FS/FS/svc_Common.pm
+++ b/FS/FS/svc_Common.pm
@@ -164,9 +164,11 @@ sub setx {
return "Unkonwn svcpart" unless $part_svc;
#set default/fixed/whatever fields from part_svc
- foreach my $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq $x ) {
- $self->setfield( $field, $part_svc->getfield('svc_acct__'. $field) );
+ my $table = $self->table;
+ foreach my $field ( grep { $_ ne 'svcnum' } fields($table) ) {
+ my $part_svc_column = $part_svc->part_svc_column($field);
+ if ( $part_svc_column->columnflag eq $x ) {
+ $self->setfield( $field, $part_svc_column->columnvalue );
}
}
@@ -193,7 +195,7 @@ sub cancel { ''; }
=head1 VERSION
-$Id: svc_Common.pm,v 1.4 2001-04-22 00:49:30 ivan Exp $
+$Id: svc_Common.pm,v 1.5 2001-09-06 20:41:59 ivan Exp $
=head1 BUGS
diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 7e27fd859..a4ce3f7c9 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -185,7 +185,7 @@ sub insert {
my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
return "Unknown svcpart" unless $part_svc;
return "uid in use"
- if $part_svc->svc_acct__uid_flag ne 'F'
+ if $part_svc->part_svc_column('uid')->columnflag ne 'F'
&& qsearchs( 'svc_acct', { 'uid' => $self->uid } )
&& $self->username !~ /^(hyla)?fax$/
;
@@ -456,7 +456,7 @@ sub check {
! $recref->{popnum} ||
qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
- unless ( $part_svc->getfield('svc_acct__uid_flag') eq 'F' ) {
+ unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
$recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
$recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
@@ -506,7 +506,7 @@ sub check {
return "Can't have quota without uid" : ( $recref->{quota}='' );
}
- unless ( $part_svc->getfield('svc_acct__slipip_flag') eq 'F' ) {
+ unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
unless ( $recref->{slipip} eq '0e0' ) {
$recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
or return "Illegal slipip". $self->slipip;
@@ -633,7 +633,7 @@ sub email {
=head1 VERSION
-$Id: svc_acct.pm,v 1.29 2001-09-02 04:51:11 ivan Exp $
+$Id: svc_acct.pm,v 1.30 2001-09-06 20:41:59 ivan Exp $
=head1 BUGS
diff --git a/FS/FS/svc_acct_sm.pm b/FS/FS/svc_acct_sm.pm
index 7615c211d..c92f1421f 100644
--- a/FS/FS/svc_acct_sm.pm
+++ b/FS/FS/svc_acct_sm.pm
@@ -211,7 +211,7 @@ sub check {
my $x = $self->setfixed;
return $x unless ref($x);
- my $part_svc = $x;
+ #my $part_svc = $x;
my($recref) = $self->hashref;
@@ -238,7 +238,7 @@ sub check {
=head1 VERSION
-$Id: svc_acct_sm.pm,v 1.4 2001-08-20 09:41:52 ivan Exp $
+$Id: svc_acct_sm.pm,v 1.5 2001-09-06 20:41:59 ivan Exp $
=head1 BUGS
diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm
index 4d652f8d3..58c6423c3 100644
--- a/FS/FS/svc_domain.pm
+++ b/FS/FS/svc_domain.pm
@@ -338,7 +338,7 @@ sub check {
my $x = $self->setfixed;
return $x unless ref($x);
- my $part_svc = $x;
+ #my $part_svc = $x;
my $error = $self->ut_numbern('svcnum')
|| $self->ut_numbern('catchall')
@@ -533,7 +533,7 @@ sub submit_internic {
=head1 VERSION
-$Id: svc_domain.pm,v 1.19 2001-08-21 00:39:07 ivan Exp $
+$Id: svc_domain.pm,v 1.20 2001-09-06 20:41:59 ivan Exp $
=head1 BUGS
diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm
index 288ab3408..6ee1d5b85 100644
--- a/FS/FS/svc_forward.pm
+++ b/FS/FS/svc_forward.pm
@@ -263,7 +263,7 @@ sub check {
my $x = $self->setfixed;
return $x unless ref($x);
- my $part_svc = $x;
+ #my $part_svc = $x;
my $error = $self->ut_numbern('svcnum')
|| $self->ut_number('srcsvc')
@@ -299,7 +299,7 @@ sub check {
=head1 VERSION
-$Id: svc_forward.pm,v 1.6 2001-08-21 00:39:07 ivan Exp $
+$Id: svc_forward.pm,v 1.7 2001-09-06 20:41:59 ivan Exp $
=head1 BUGS
diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm
index 44d7487da..d4e398810 100644
--- a/FS/FS/svc_www.pm
+++ b/FS/FS/svc_www.pm
@@ -198,7 +198,7 @@ sub check {
my $x = $self->setfixed;
return $x unless ref($x);
- my $part_svc = $x;
+ #my $part_svc = $x;
my $error =
$self->ut_numbern('svcnum')
@@ -220,7 +220,7 @@ sub check {
=head1 VERSION
-$Id: svc_www.pm,v 1.5 2001-08-21 02:44:47 ivan Exp $
+$Id: svc_www.pm,v 1.6 2001-09-06 20:41:59 ivan Exp $
=head1 BUGS
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 209c93a10..2db053d44 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -34,6 +34,7 @@ FS/cust_svc.pm
FS/part_pkg.pm
FS/part_referral.pm
FS/part_svc.pm
+FS/part_svc_column.pm
FS/pkg_svc.pm
FS/svc_Common.pm
FS/svc_acct.pm
@@ -73,6 +74,7 @@ t/nas.t
t/part_pkg.t
t/part_referral.t
t/part_svc.t
+t/part_svc_column.t
t/pkg_svc.t
t/port.t
t/prepay_credit.t
diff --git a/FS/t/part_svc_column.t b/FS/t/part_svc_column.t
new file mode 100644
index 000000000..467025c1e
--- /dev/null
+++ b/FS/t/part_svc_column.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_svc_column;
+$loaded=1;
+print "ok 1\n";
generated by cgit v1.2.1 (git 2.18.0) at 2025-01-10 13:48:35 +0000