[freeside-commits] freeside/FS/FS cust_svc.pm, 1.65,
1.66 part_svc.pm, 1.29, 1.30 svc_broadband.pm, 1.8,
1.9 svc_Common.pm, 1.38, 1.39 svc_domain.pm, 1.46,
1.47 svc_External_Common.pm, NONE, 1.1 svc_external.pm, 1.4,
1.5 svc_Parent_Mixin.pm, NONE, 1.1 svc_forward.pm, 1.19,
1.20 svc_phone.pm, 1.1, 1.2 svc_www.pm, 1.13, 1.14 Record.pm,
1.129, 1.130 cust_main.pm, 1.258, 1.259 registrar.pm, NONE,
1.1 svc_acct.pm, 1.209, 1.210 Schema.pm, 1.39,
1.40 cust_pkg.pm, 1.68, 1.69 pkg_svc.pm, 1.6, 1.7
Ivan,,,
ivan at wavetail.420.am
Fri Dec 29 00:51:34 PST 2006
- Previous message: [freeside-commits] freeside/httemplate/edit part_svc.cgi, 1.53,
1.54 svc_acct.cgi, 1.43, 1.44 svc_broadband.cgi, 1.12,
1.13 svc_Common.html, NONE, 1.1 svc_domain.cgi, 1.13,
1.14 svc_external.cgi, 1.3, 1.4 svc_forward.cgi, 1.18,
1.19 svc_www.cgi, 1.18, 1.19
- Next message: [freeside-commits] freeside/httemplate/edit/process/elements
process.html, 1.6, 1.7
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail:/tmp/cvs-serv4384/FS/FS
Modified Files:
cust_svc.pm part_svc.pm svc_broadband.pm svc_Common.pm
svc_domain.pm svc_external.pm svc_forward.pm svc_phone.pm
svc_www.pm Record.pm cust_main.pm svc_acct.pm Schema.pm
cust_pkg.pm pkg_svc.pm
Added Files:
svc_External_Common.pm svc_Parent_Mixin.pm registrar.pm
Log Message:
service refactor!
Index: svc_forward.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_forward.pm,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- svc_forward.pm 14 Apr 2006 11:55:58 -0000 1.19
+++ svc_forward.pm 29 Dec 2006 08:51:32 -0000 1.20
@@ -66,8 +66,67 @@
=cut
+
+sub table_info {
+ {
+ 'name' => 'Forward',
+ 'name_plural' => 'Mail forwards',
+ 'display_weight' => 30,
+ 'cancel_weight' => 30,
+ 'fields' => {
+ 'srcsvc' => 'service from which mail is to be forwarded',
+ 'dstsvc' => 'service to which mail is to be forwarded',
+ 'dst' => 'someone at another.domain.com to use when dstsvc is 0',
+ },
+ };
+}
+
sub table { 'svc_forward'; }
+=item search_sql STRING
+
+Class method which returns an SQL fragment to search for the given string.
+
+=cut
+
+sub search_sql {
+ my( $class, $string ) = @_;
+ $class->search_sql_field('src', $string);
+}
+
+=item label [ END_TIMESTAMP [ START_TIMESTAMP ] ]
+
+Returns a text string representing this forward.
+
+END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
+history records.
+
+=cut
+
+sub label {
+ my $self = shift;
+ my $tag = '';
+
+ if ( $self->srcsvc ) {
+ my $svc_acct = $self->srcsvc_acct(@_);
+ $tag = $svc_acct->email(@_);
+ } else {
+ $tag = $self->src;
+ }
+
+ $tag .= ' -> ';
+
+ if ( $self->dstsvc ) {
+ my $svc_acct = $self->dstsvc_acct(@_);
+ $tag .= $svc_acct->email(@_);
+ } else {
+ $tag .= $self->dst;
+ }
+
+ $tag;
+}
+
+
=item insert [ , OPTION => VALUE ... ]
Adds this mail forwarding alias to the database. If there is an error, returns
Index: svc_Common.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_Common.pm,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -d -r1.38 -r1.39
--- svc_Common.pm 29 Dec 2006 08:25:19 -0000 1.38
+++ svc_Common.pm 29 Dec 2006 08:51:32 -0000 1.39
@@ -2,7 +2,7 @@
use strict;
use vars qw( @ISA $noexport_hack $DEBUG $me );
-use Carp;
+use Carp qw( cluck carp croak ); #specify cluck have to specify them all..
use FS::Record qw( qsearch qsearchs fields dbh );
use FS::cust_main_Mixin;
use FS::cust_svc;
@@ -36,6 +36,27 @@
=over 4
+=item search_sql_field FIELD STRING
+
+Class method which returns an SQL fragment to search for STRING in FIELD.
+
+=cut
+
+sub search_sql_field {
+ my( $class, $field, $string ) = @_;
+ my $table = $class->table;
+ my $q_string = dbh->quote($string);
+ "$table.$field = $q_string";
+}
+
+#fallback for services that don't provide a search...
+sub search_sql {
+ #my( $class, $string ) = @_;
+ '1 = 0'; #false
+}
+
+=item new
+
=cut
sub new {
@@ -114,6 +135,19 @@
return ();
}
+=item label
+
+svc_Common provides a fallback label subroutine that just returns the svcnum.
+
+=cut
+
+sub label {
+ my $self = shift;
+ cluck "warning: ". ref($self). " not loaded or missing label method; ".
+ "using svcnum";
+ $self->svcnum;
+}
+
=item check
Checks the validity of fields in this record.
@@ -300,35 +334,15 @@
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
- my $svcnum = $self->svcnum;
-
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- $error = $self->SUPER::delete;
- return $error if $error;
-
- #new-style exports!
- unless ( $noexport_hack ) {
- foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
- $error = $part_export->export_delete($self);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "exporting to ". $part_export->exporttype.
- " (transaction rolled back): $error";
- }
- }
- }
-
- $error = $self->return_inventory;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error returning inventory: $error";
- }
-
- my $cust_svc = $self->cust_svc;
- $error = $cust_svc->delete;
+ $error = $self->SUPER::delete
+ || $self->export('delete')
+ || $self->return_inventory
+ || $self->cust_svc->delete
+ ;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
@@ -361,18 +375,7 @@
my $dbh = dbh;
# We absolutely have to have an old vs. new record to make this work.
- if ( !defined($old) ) {
- warn "[$me] replace called with no arguments; autoloading old record\n"
- if $DEBUG;
- my $primary_key = $new->dbdef_table->primary_key;
- if ( $primary_key ) {
- $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } )
- or croak "can't find ". $new->table. ".$primary_key ".
- $new->$primary_key();
- } else {
- croak $new->table. " has no primary key; pass old record as argument";
- }
- }
+ $old = $new->replace_old unless defined($old);
my $error = $new->set_auto_inventory;
if ( $error ) {
@@ -678,33 +681,7 @@
sub suspend {
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;
-
- #new-style exports!
- unless ( $noexport_hack ) {
- foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
- my $error = $part_export->export_suspend($self);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error exporting to ". $part_export->exporttype.
- " (transaction rolled back): $error";
- }
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
+ $self->export('suspend');
}
=item unsuspend
@@ -715,6 +692,19 @@
sub unsuspend {
my $self = shift;
+ $self->export('unsuspend');
+}
+
+=item export HOOK [ EXPORT_ARGS ]
+
+Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
+
+=cut
+
+sub export {
+ my( $self, $method ) = ( shift, shift );
+
+ $method = "export_$method" unless $method =~ /^export_/;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
@@ -730,10 +720,11 @@
#new-style exports!
unless ( $noexport_hack ) {
foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
- my $error = $part_export->export_unsuspend($self);
+ next unless $part_export->can($method);
+ my $error = $part_export->$method($self, @_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return "error exporting to ". $part_export->exporttype.
+ return "error exporting $method event to ". $part_export->exporttype.
" (transaction rolled back): $error";
}
}
@@ -787,6 +778,8 @@
The setfixed method return value.
+B<export> method isn't used by insert and replace methods yet.
+
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
Index: svc_domain.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_domain.pm,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -d -r1.46 -r1.47
--- svc_domain.pm 14 May 2006 16:47:31 -0000 1.46
+++ svc_domain.pm 29 Dec 2006 08:51:32 -0000 1.47
@@ -11,6 +11,7 @@
use FS::Record qw(fields qsearch qsearchs dbh);
use FS::Conf;
use FS::svc_Common;
+use FS::svc_Parent_Mixin;
use FS::cust_svc;
use FS::svc_acct;
use FS::cust_pkg;
@@ -18,7 +19,7 @@
use FS::domain_record;
use FS::queue;
- at ISA = qw( FS::svc_Common );
+ at ISA = qw( FS::svc_Parent_Mixin FS::svc_Common );
#ask FS::UID to run this stuff for us later
$FS::UID::callback{'FS::domain'} = sub {
@@ -72,6 +73,20 @@
=item catchall - optional svcnum of an svc_acct record, designating an email catchall account.
+=item suffix -
+
+=item parent_svcnum -
+
+=item registrarnum - Registrar (see L<FS::registrar>)
+
+=item registrarkey - Registrar key or password for this domain
+
+=item setup_date - UNIX timestamp
+
+=item renewal_interval - Number of days before expiration date to start renewal
+
+=item expiration_date - UNIX timestamp
+
=back
=head1 METHODS
@@ -84,8 +99,37 @@
=cut
+sub table_info {
+ {
+ 'name' => 'Domain',
+ 'sorts' => 'domain',
+ 'display_weight' => 20,
+ 'cancel_weight' => 60,
+ 'fields' => {
+ 'domain' => 'Domain',
+ },
+ };
+}
+
sub table { 'svc_domain'; }
+sub search_sql {
+ my($class, $string) = @_;
+ $class->search_sql_field('domain', $string);
+}
+
+
+=item label
+
+Returns the domain.
+
+=cut
+
+sub label {
+ my $self = shift;
+ $self->domain;
+}
+
=item insert [ , OPTION => VALUE ... ]
Adds this domain to the database. If there is an error, returns the error,
@@ -141,15 +185,6 @@
return "Domain in use (here)"
if qsearchs( 'svc_domain', { 'domain' => $self->domain } );
- my $whois = $self->whois;
- if ( $self->action eq "N" && ! $whois_hack && $whois ) {
- $dbh->rollback if $oldAutoCommit;
- return "Domain in use (see whois)";
- }
- if ( $self->action eq "M" && ! $whois ) {
- $dbh->rollback if $oldAutoCommit;
- return "Domain not found (see whois)";
- }
$error = $self->SUPER::insert(@_);
if ( $error ) {
@@ -157,8 +192,6 @@
return $error;
}
- $self->submit_internic unless $whois_hack;
-
if ( $soamachine ) {
my $soa = new FS::domain_record {
'svcnum' => $self->svcnum,
@@ -257,6 +290,9 @@
sub replace {
my ( $new, $old ) = ( shift, shift );
+ # We absolutely have to have an old vs. new record to make this work.
+ $old = $new->replace_old unless defined($old);
+
return "Can't change domain - reorder."
if $old->getfield('domain') ne $new->getfield('domain');
@@ -317,45 +353,32 @@
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 } );
- push @svc_acct, $svc_acct if $svc_acct;
- }
-
- if ( scalar(@svc_acct) == 0 ) {
- 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 {
- $self->email($svc_acct[0]->email );
- }
- }
- }
-
#if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) {
- if ( $recref->{domain} =~ /^([\w\-]{1,63})\.(com|net|org|edu)$/ ) {
+ if ( $recref->{domain} =~ /^([\w\-]{1,63})\.(com|net|org|edu|tv|info|biz)$/ ) {
$recref->{domain} = "$1.$2";
+ $recref->{suffix} ||= $2;
# hmmmmmmmm.
- } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)$/ ) {
- $recref->{domain} = $1;
+ } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)\.(\w+)$/ ) {
+ $recref->{domain} = "$1.$2";
+ # need to match a list of suffixes - no guarantee they're top-level..
} else {
return "Illegal domain ". $recref->{domain}.
" (or unknown registry - try \$whois_hack)";
}
- $recref->{action} =~ /^(M|N)$/
- or return "Illegal action: ". $recref->{action};
- $recref->{action} = $1;
if ( $recref->{catchall} ne '' ) {
my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } );
return "Unknown catchall" unless $svc_acct;
}
- $self->ut_textn('purpose')
+ $self->ut_alphan('suffix')
+ or $self->ut_foreign_keyn('registrarnum', 'registrar', 'registrarnum')
+ or $self->ut_textn('registrarkey')
+ 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;
}
@@ -402,7 +425,7 @@
sub whois {
#$whois_hack or new Net::Whois::Domain $_[0]->domain;
- $whois_hack or die "whois_hack not set...\n";
+ #$whois_hack or die "whois_hack not set...\n";
}
=item _whois
Index: pkg_svc.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/pkg_svc.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- pkg_svc.pm 2 Apr 2005 22:46:44 -0000 1.6
+++ pkg_svc.pm 29 Dec 2006 08:51:32 -0000 1.7
@@ -82,7 +82,9 @@
=cut
sub replace {
- my ( $new, $old ) = ( shift, shift );
+ my( $new, $old ) = ( shift, shift );
+
+ $old = $new->replace_old unless defined($old);
return "Can't change pkgpart!" if $old->pkgpart != $new->pkgpart;
return "Can't change svcpart!" if $old->svcpart != $new->svcpart;
Index: part_svc.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/part_svc.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -d -r1.29 -r1.30
--- part_svc.pm 25 Oct 2006 02:22:33 -0000 1.29
+++ part_svc.pm 29 Dec 2006 08:51:32 -0000 1.30
@@ -2,6 +2,7 @@
use strict;
use vars qw( @ISA $DEBUG );
+use Tie::IxHash;
use FS::Record qw( qsearch qsearchs fields dbh );
use FS::Schema qw( dbdef );
use FS::part_svc_column;
@@ -11,7 +12,7 @@
@ISA = qw(FS::Record);
-$DEBUG = 1;
+$DEBUG = 0;
=head1 NAME
@@ -500,6 +501,161 @@
map { $_->svc_x } $self->cust_svc;
}
+=back
+
+=head1 CLASS METHODS
+
+=over 4
+
+=cut
+
+my $svc_defs;
+sub _svc_defs {
+
+ return $svc_defs if $svc_defs; #cache
+
+ my $conf = new FS::Conf;
+
+ #false laziness w/part_pkg.pm::plan_info
+
+ my %info;
+ foreach my $INC ( @INC ) {
+ warn "globbing $INC/FS/svc_*.pm\n" if $DEBUG;
+ foreach my $file ( glob("$INC/FS/svc_*.pm") ) {
+
+ warn "attempting to load service table info from $file\n" if $DEBUG;
+ $file =~ /\/(\w+)\.pm$/ or do {
+ warn "unrecognized file in $INC/FS/: $file\n";
+ next;
+ };
+ my $mod = $1;
+
+ if ( $mod =~ /^svc_[A-Z]/ or $mod =~ /^svc_acct_pop$/ ) {
+ warn "skipping FS::$mod" if $DEBUG;
+ next;
+ }
+
+ eval "use FS::$mod;";
+ if ( $@ ) {
+ die "error using FS::$mod (skipping): $@\n" if $@;
+ next;
+ }
+ unless ( UNIVERSAL::can("FS::$mod", 'table_info') ) {
+ warn "FS::$mod has no table_info method; skipping";
+ next;
+ }
+
+ my $info = "FS::$mod"->table_info;
+ unless ( keys %$info ) {
+ warn "FS::$mod->table_info doesn't return info, skipping\n";
+ next;
+ }
+ warn "got info from FS::$mod: $info\n" if $DEBUG;
+ if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
+ warn "skipping disabled service FS::$mod" if $DEBUG;
+ next;
+ }
+ $info{$mod} = $info;
+ }
+ }
+
+ tie my %svc_defs, 'Tie::IxHash',
+ map { $_ => $info{$_}->{'fields'} }
+ sort { $info{$a}->{'display_weight'} <=> $info{$b}->{'display_weight'} }
+ keys %info,
+ ;
+
+ # yuck. maybe this won't be so bad when virtual fields become real fields
+ my %vfields;
+ foreach my $svcdb (grep dbdef->table($_), keys %svc_defs ) {
+ eval "use FS::$svcdb;";
+ my $self = "FS::$svcdb"->new;
+ $vfields{$svcdb} = {};
+ foreach my $field ($self->virtual_fields) { # svc_Common::virtual_fields with a null svcpart returns all of them
+ my $pvf = $self->pvf($field);
+ my @list = $pvf->list;
+ if (scalar @list) {
+ $svc_defs{$svcdb}->{$field} = { desc => $pvf->label,
+ type => 'select',
+ select_list => \@list };
+ } else {
+ $svc_defs{$svcdb}->{$field} = $pvf->label;
+ } #endif
+ $vfields{$svcdb}->{$field} = $pvf;
+ warn "\$vfields{$svcdb}->{$field} = $pvf"
+ if $DEBUG;
+ } #next $field
+ } #next $svcdb
+
+ $svc_defs = \%svc_defs; #cache
+
+}
+
+=item svc_tables
+
+Returns a list of all svc_ tables.
+
+=cut
+
+sub svc_tables {
+ my $class = shift;
+ my $svc_defs = $class->_svc_defs;
+ grep { defined( dbdef->table($_) ) } keys %$svc_defs;
+}
+
+=item svc_table_fields TABLE
+
+Given a table name, returns a hashref of field names. The field names
+returned are those with additional (service-definition related) information,
+not necessarily all database fields of the table. Pseudo-fields may also
+be returned (i.e. svc_acct.usergroup).
+
+Each value of the hashref is another hashref, which can have one or more of
+the following keys:
+
+=over 4
+
+=item label - Description of the field
+
+=item def_label - Optional description of the field in the context of service definitions
+
+=item type - Currently "text", "select", "disabled", or "radius_usergroup_selector"
+
+=item disable_default - This field should not allow a default value in service definitions
+
+=item disable_fixed - This field should not allow a fixed value in service definitions
+
+=item disable_inventory - This field should not allow inventory values in service definitions
+
+=item select_list - If type is "text", this can be a listref of possible values.
+
+=item select_table - An alternative to select_list, this defines a database table with the possible choices.
+
+=item select_key - Used with select_table, this is the field name of keys
+
+=item select_label - Used with select_table, this is the field name of labels
+
+=back
+
+=cut
+
+#maybe this should move and be a class method in svc_Common.pm
+sub svc_table_fields {
+ my($class, $table) = @_;
+ my $svc_defs = $class->_svc_defs;
+ my $def = $svc_defs->{$table};
+
+ foreach ( grep !ref($def->{$_}), keys %$def ) {
+
+ #normalize the shortcut in %info hash
+ $def->{$_} = { 'label' => $def->{$_} };
+
+ $def->{$_}{'type'} ||= 'text';
+
+ }
+
+ $def;
+}
=back
@@ -554,10 +710,7 @@
}
@fields;
- } grep defined( dbdef->table($_) ),
- qw( svc_acct svc_domain svc_forward svc_www svc_broadband
- svc_phone svc_external
- )
+ } FS::part_svc->svc_tables()
)
} );
@@ -651,8 +804,8 @@
Delete is unimplemented.
-The list of svc_* tables is hardcoded. When svc_acct_pop is renamed, this
-should be fixed.
+The list of svc_* tables is no longer hardcoded, but svc_acct_pop is skipped
+as a special case until it is renamed.
all_part_svc_column methods should be documented
Index: svc_phone.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_phone.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- svc_phone.pm 12 Jul 2006 00:20:21 -0000 1.1
+++ svc_phone.pm 29 Dec 2006 08:51:32 -0000 1.2
@@ -63,9 +63,51 @@
=cut
# the new method can be inherited from FS::Record, if a table method is defined
+#
+sub table_info {
+ {
+ 'name' => 'Phone number',
+ 'sorts' => 'phonenum',
+ 'display_weight' => 60,
+ 'cancel_weight' => 80,
+ 'fields' => {
+ 'countrycode' => { label => 'Country code',
+ type => 'text',
+ disable_inventory => 1,
+ },
+ 'phonenum' => 'Phone number',
+ 'pin' => { label => 'Personal Identification Number',
+ type => 'text',
+ disable_inventory => 1,
+ },
+ },
+ };
+}
sub table { 'svc_phone'; }
+=item search_sql STRING
+
+Class method which returns an SQL fragment to search for the given string.
+
+=cut
+
+sub search_sql {
+ my( $class, $string ) = @_;
+ $class->search_sql_field('phonenum', $string );
+}
+
+=item label
+
+Returns the phone number.
+
+=cut
+
+sub label {
+ my $self = shift;
+ $self->phonenum; #XXX format it better
+}
+
=item insert
Adds this record to the database. If there is an error, returns the error,
Index: svc_www.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_www.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- svc_www.pm 3 Oct 2006 15:59:06 -0000 1.13
+++ svc_www.pm 29 Dec 2006 08:51:32 -0000 1.14
@@ -72,8 +72,33 @@
=cut
+sub table_info {
+ {
+ 'name' => 'Hosting',
+ 'name_plural' => 'Virtual hosting services',
+ 'display_weight' => 40,
+ 'cancel_weight' => 20,
+ 'fields' => {
+ },
+ };
+};
+
sub table { 'svc_www'; }
+=item label [ END_TIMESTAMP [ START_TIMESTAMP ] ]
+
+Returns the zone name for this virtual host.
+
+END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
+history records.
+
+=cut
+
+sub label {
+ my $self = shift;
+ $self->domain_record(@_)->zone;
+}
+
=item insert [ , OPTION => VALUE ... ]
Adds this record to the database. If there is an error, returns the error,
Index: svc_acct.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_acct.pm,v
retrieving revision 1.209
retrieving revision 1.210
diff -u -d -r1.209 -r1.210
--- svc_acct.pm 8 Dec 2006 15:11:22 -0000 1.209
+++ svc_acct.pm 29 Dec 2006 08:51:32 -0000 1.210
@@ -210,6 +210,77 @@
=cut
+sub table_info {
+ {
+ 'name' => 'Account',
+ 'longname_plural' => 'Access accounts and mailboxes',
+ 'sorts' => [ 'username', 'uid', ],
+ 'display_weight' => 10,
+ 'cancel_weight' => 50,
+ 'fields' => {
+ 'dir' => 'Home directory',
+ 'uid' => {
+ label => 'UID',
+ def_label => 'UID (set to fixed and blank for no UIDs)',
+ type => 'text',
+ },
+ 'slipip' => 'IP address',
+ # 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!,
+ 'popnum' => {
+ label => 'Access number',
+ type => 'select',
+ select_table => 'svc_acct_pop',
+ select_key => 'popnum',
+ select_label => 'city',
+ },
+ 'username' => {
+ label => 'Username',
+ type => 'text',
+ disable_default => 1,
+ disable_fixed => 1,
+ },
+ 'quota' => {
+ label => 'Quota',
+ type => 'text',
+ disable_inventory => 1,
+ },
+ '_password' => 'Password',
+ 'gid' => {
+ label => 'GID',
+ def_label => 'GID (when blank, defaults to UID)',
+ type => 'text',
+ },
+ 'shell' => {
+ #desc =>'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file, set to blank for no shell tracking)',
+ label => 'Shell',
+ def_label=> 'Shell (set to blank for no shell tracking)',
+ type =>'select',
+ select_list => [ $conf->config('shells') ],
+ disable_inventory => 1,
+ },
+ 'finger' => 'Real name (GECOS)',
+ 'domsvc' => {
+ label => 'Domain',
+ def_label => 'svcnum from svc_domain',
+ type => 'select',
+ select_table => 'svc_domain',
+ select_key => 'svcnum',
+ select_label => 'domain',
+ disable_inventory => 1,
+ },
+ 'usergroup' => {
+ label => 'RADIUS groups',
+ type => 'radius_usergroup_selector',
+ disable_inventory => 1,
+ },
+ 'seconds' => { label => 'Seconds',
+ type => 'text',
+ disable_inventory => 1,
+ },
+ },
+ };
+}
+
sub table { 'svc_acct'; }
sub _fieldhandlers {
@@ -228,6 +299,52 @@
};
}
+=item search_sql STRING
+
+Class method which returns an SQL fragment to search for the given string.
+
+=cut
+
+sub search_sql {
+ my( $class, $string ) = @_;
+ if ( $string =~ /^([^@]+)@([^@]+)$/ ) {
+ my( $username, $domain ) = ( $1, $2 );
+ my $q_username = dbh->quote($username);
+ my @svc_domain = qsearch('svc_domain', { 'domain' => $domain } );
+ if ( @svc_domain ) {
+ "svc_acct.username = $q_username AND ( ".
+ join( ' OR ', map { "svc_acct.domsvc = ". $_->svcnum; } @svc_domain ).
+ " )";
+ } else {
+ '1 = 0'; #false
+ }
+ } elsif ( $string =~ /^(\d{1,3}\.){3}\d{1,3}$/ ) {
+ ' ( '.
+ $class->search_sql_field('slipip', $string ).
+ ' OR '.
+ $class->search_sql_field('username', $string ).
+ ' ) ';
+ } else {
+ $class->search_sql_field('username', $string);
+ }
+}
+
+=item label [ END_TIMESTAMP [ START_TIMESTAMP ] ]
+
+Returns the "username at domain" string for this account.
+
+END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
+history records.
+
+=cut
+
+sub label {
+ my $self = shift;
+ $self->email(@_);
+}
+
+=cut
+
=item insert [ , OPTION => VALUE ... ]
Adds this account to the database. If there is an error, returns the error,
@@ -1180,10 +1297,13 @@
}
-=item domain
+=item domain [ END_TIMESTAMP [ START_TIMESTAMP ] ]
Returns the domain associated with this account.
+END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
+history records.
+
=cut
sub domain {
@@ -1201,6 +1321,8 @@
=cut
+# FS::h_svc_acct has a history-aware svc_domain override
+
sub svc_domain {
my $self = shift;
$self->{'_domsvc'}
@@ -1216,10 +1338,13 @@
#inherited from svc_Common
-=item email
+=item email [ END_TIMESTAMP [ START_TIMESTAMP ] ]
Returns an email address associated with the account.
+END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
+history records.
+
=cut
sub email {
--- NEW FILE: svc_External_Common.pm ---
package FS::svc_External_Common;
use strict;
use vars qw(@ISA);
use FS::svc_Common;
@ISA = qw( FS::svc_Common );
=head1 NAME
FS::svc_external - Object methods for svc_external records
=head1 SYNOPSIS
use FS::svc_external;
$record = new FS::svc_external \%hash;
$record = new FS::svc_external { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
$error = $record->suspend;
$error = $record->unsuspend;
$error = $record->cancel;
=head1 DESCRIPTION
FS::svc_External_Common is intended as a base class for table-specific classes
to inherit from. FS::svc_External_Common is used for services which connect
to externally tracked services via "id" and "table" fields.
FS::svc_External_Common inherits from FS::svc_Common.
The following fields are currently supported:
=over 4
=item svcnum - primary key
=item id - unique number of external record
=item title - for invoice line items
=back
=head1 METHODS
=over 4
=item search_sql
Provides a default search_sql method which returns an SQL fragment to search
the B<title> field.
=cut
sub search_sql {
my($class, $string) = @_;
$class->search_sql_field('title', $string);
}
=item new HASHREF
Creates a new external service. To add the external service to the database,
see L<"insert">.
Note that this stores the hash reference, not a distinct copy of the hash it
points to. You can ask the object for a copy with the I<hash> method.
=cut
=item label
Returns a string identifying this external service in the form "id:title"
=cut
sub label {
my $self = shift;
$self->id. ':'. $self->title;
}
=item insert [ , OPTION => VALUE ... ]
Adds this external service to the database. If there is an error, returns the
error, otherwise returns false.
The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
defined. An FS::cust_svc record will be created and inserted.
Currently available options are: I<depend_jobnum>
If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
jobnums), all provisioning jobs will have a dependancy on the supplied
jobnum(s) (they will not run until the specific job(s) complete(s)).
=cut
#sub insert {
# my $self = shift;
# my $error;
#
# $error = $self->SUPER::insert(@_);
# return $error if $error;
#
# '';
#}
=item delete
Delete this record from the database.
=cut
#sub delete {
# my $self = shift;
# my $error;
#
# $error = $self->SUPER::delete;
# return $error if $error;
#
# '';
#}
=item replace OLD_RECORD
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
=cut
#sub replace {
# my ( $new, $old ) = ( shift, shift );
# my $error;
#
# $error = $new->SUPER::replace($old);
# return $error if $error;
#
# '';
#}
=item suspend
Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
=item unsuspend
Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
=item cancel
Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
=item check
Checks all fields to make sure this is a valid external service. If there is
an error, returns the error, otherwise returns false. Called by the insert
and replace methods.
=cut
sub check {
my $self = shift;
my $x = $self->setfixed;
return $x unless ref($x);
my $part_svc = $x;
my $error =
$self->ut_numbern('svcnum')
|| $self->ut_numbern('id')
|| $self->ut_textn('title')
;
$self->SUPER::check;
}
=back
=head1 BUGS
=head1 SEE ALSO
L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
L<FS::cust_pkg>, schema.html from the base documentation.
=cut
1;
Index: cust_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pkg.pm,v
retrieving revision 1.68
retrieving revision 1.69
diff -u -d -r1.68 -r1.69
--- cust_pkg.pm 7 Dec 2006 02:40:31 -0000 1.68
+++ cust_pkg.pm 29 Dec 2006 08:51:32 -0000 1.69
@@ -1,7 +1,7 @@
package FS::cust_pkg;
use strict;
-use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG);
+use vars qw(@ISA $disable_agentcheck $DEBUG);
use Tie::IxHash;
use FS::UID qw( getotaker dbh );
use FS::Misc qw( send_email );
@@ -15,6 +15,7 @@
use FS::cust_bill_pkg;
use FS::h_cust_svc;
use FS::reg_code;
+use FS::part_svc;
use FS::cust_pkg_reason;
# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
@@ -34,14 +35,6 @@
$disable_agentcheck = 0;
-# The order in which to unprovision services.
- at SVCDB_CANCEL_SEQ = qw( svc_external
- svc_www
- svc_forward
- svc_acct
- svc_domain
- svc_broadband );
-
sub _cache {
my $self = shift;
my ( $hashref, $cache ) = @_;
@@ -273,6 +266,10 @@
sub replace {
my( $new, $old, %options ) = @_;
+ # We absolutely have to have an old vs. new record to make this work.
+ if (!defined($old)) {
+ $old = qsearchs( 'cust_pkg', { 'pkgnum' => $new->pkgnum } );
+ }
#return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
return "Can't change otaker!" if $old->otaker ne $new->otaker;
@@ -452,19 +449,18 @@
my %svc;
foreach my $cust_svc (
- qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
+ #schwartz
+ map { $_->[0] }
+ sort { $a->[1] <=> $b->[1] }
+ map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
+ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
) {
- push @{ $svc{$cust_svc->part_svc->svcdb} }, $cust_svc;
- }
- foreach my $svcdb (@SVCDB_CANCEL_SEQ) {
- foreach my $cust_svc (@{ $svc{$svcdb} }) {
- my $error = $cust_svc->cancel;
+ my $error = $cust_svc->cancel;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error cancelling cust_svc: $error";
- }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error cancelling cust_svc: $error";
}
}
@@ -762,6 +758,17 @@
$self->part_pkg->calc_cancel($self, @_);
}
+=item cust_bill_pkg
+
+Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
+
+=cut
+
+sub cust_bill_pkg {
+ my $self = shift;
+ qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
+}
+
=item cust_svc [ SVCPART ]
Returns the services for this package, as FS::cust_svc objects (see
@@ -843,7 +850,7 @@
=item available_part_svc
-Returns a list FS::part_svc objects representing services included in this
+Returns a list of FS::part_svc objects representing services included in this
package but not yet provisioned. Each FS::part_svc object also has an extra
field, I<num_avail>, which specifies the number of available services.
@@ -861,6 +868,86 @@
$self->part_pkg->pkg_svc;
}
+=item
+
+Returns a list of FS::part_svc objects representing provisioned and available
+services included in this package. Each FS::part_svc object also has the
+following extra fields:
+
+=over 4
+
+=item num_cust_svc (count)
+
+=item num_avail (quantity - count)
+
+=item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
+
+svcnum
+label -> ($cust_svc->label)[1]
+
+=back
+
+=cut
+
+sub part_svc {
+ my $self = shift;
+
+ #XXX some sort of sort order besides numeric by svcpart...
+ my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
+ my $pkg_svc = $_;
+ my $part_svc = $pkg_svc->part_svc;
+ my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
+ $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
+ $part_svc->{'Hash'}{'num_avail'} = $pkg_svc->quantity - $num_cust_svc;
+ $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
+ $part_svc;
+ } $self->part_pkg->pkg_svc;
+
+ #extras
+ push @part_svc, map {
+ my $part_svc = $_;
+ my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
+ $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
+ $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
+ $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
+ $part_svc;
+ } $self->extra_part_svc;
+
+ @part_svc;
+
+}
+
+=item extra_part_svc
+
+Returns a list of FS::part_svc objects corresponding to services in this
+package which are still provisioned but not (any longer) available in the
+package definition.
+
+=cut
+
+sub extra_part_svc {
+ my $self = shift;
+
+ my $pkgnum = $self->pkgnum;
+ my $pkgpart = $self->pkgpart;
+
+ qsearch( {
+ 'table' => 'part_svc',
+ 'hashref' => {},
+ 'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
+ WHERE pkg_svc.svcpart = part_svc.svcpart
+ AND pkg_svc.pkgpart = $pkgpart
+ AND quantity > 0
+ )
+ AND 0 < ( SELECT count(*)
+ FROM cust_svc
+ LEFT JOIN cust_pkg using ( pkgnum )
+ WHERE cust_svc.svcpart = part_svc.svcpart
+ AND pkgnum = $pkgnum
+ )",
+ } );
+}
+
=item status
Returns a short status string for this package, currently:
--- NEW FILE: registrar.pm ---
package FS::registrar;
use strict;
use vars qw( @ISA );
use FS::Record qw( qsearch qsearchs );
@ISA = qw(FS::Record);
=head1 NAME
FS::registrar - Object methods for registrar records
=head1 SYNOPSIS
use FS::registrar;
$record = new FS::registrar \%hash;
$record = new FS::registrar { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
=head1 DESCRIPTION
An FS::registrar object represents a registrar. FS::registrar inherits from
FS::Record. The following fields are currently supported:
=over 4
=item registrarnum - primary key
=item registrarname -
=back
=head1 METHODS
=over 4
=item new HASHREF
Creates a new registrar. To add the registrar to the database, see L<"insert">.
Note that this stores the hash reference, not a distinct copy of the hash it
points to. You can ask the object for a copy with the I<hash> method.
=cut
# the new method can be inherited from FS::Record, if a table method is defined
sub table { 'registrar'; }
=item insert
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
=cut
# the insert method can be inherited from FS::Record
=item delete
Delete this record from the database.
=cut
# the delete method can be inherited from FS::Record
=item replace OLD_RECORD
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
=cut
# the replace method can be inherited from FS::Record
=item check
Checks all fields to make sure this is a valid registrar. If there is
an error, returns the error, otherwise returns false. Called by the insert
and replace methods.
=cut
# the check method should currently be supplied - FS::Record contains some
# data checking routines
sub check {
my $self = shift;
my $error =
$self->ut_numbern('registrarnum')
|| $self->ut_text('registrarname')
;
return $error if $error;
$self->SUPER::check;
}
=back
=head1 BUGS
=head1 SEE ALSO
L<FS::Record>, schema.html from the base documentation.
=cut
1;
--- NEW FILE: svc_Parent_Mixin.pm ---
package FS::svc_Parent_Mixin;
use strict;
use NEXT;
use FS::Record qw(qsearch qsearchs);
use FS::cust_svc;
=head1 NAME
FS::svc_Parent_Mixin - Mixin class for svc_ classes with a parent_svcnum field
=head1 SYNOPSIS
package FS::svc_table;
use vars qw(@ISA);
@ISA = qw( FS::svc_Parent_Mixin FS::svc_Common );
=head1 DESCRIPTION
This is a mixin class for svc_ classes that contain a parent_svcnum field.
=cut
=head1 METHODS
=over 4
=item parent_cust_svc
Returns the parent FS::cust_svc object.
=cut
sub parent_cust_svc {
my $self = shift;
qsearchs('cust_svc', { 'svcnum' => $self->parent_svcnum } );
}
=item parent_svc_x
Returns the corresponding parent FS::svc_ object.
=cut
sub parent_svc_x {
my $self = shift;
$self->parent_cust_svc->svc_x;
}
=item children_cust_svc
Returns a list of any child FS::cust_svc objects.
Note: This is not recursive; it only returns direct children.
=cut
sub children_cust_svc {
my $self = shift;
qsearch('cust_svc', { 'parent_svcnum' => $self->svcnum } );
}
=item children_svc_x
Returns the corresponding list of child FS::svc_ objects.
=cut
sub children_svc_x {
my $self = shift;
map { $_->svc_x } $self->children_cust_svc;
}
=item check
This class provides a check subroutine which takes care of checking the
parent_svcnum field. The svc_ class which uses it will call SUPER::check at
the end of its own checks, and this class will call NEXT::check to pass
the check "up the chain" (see L<NEXT>).
=cut
sub check {
my $self = shift;
$self->ut_foreign_keyn('parent_svcnum', 'cust_svc', 'svcnum')
|| $self->NEXT::check;
}
=back
=head1 BUGS
Do we need a recursive child finder for multi-layered children?
=head1 SEE ALSO
L<FS::svc_Common>, L<FS::Record>
=cut
1;
Index: cust_svc.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_svc.pm,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -d -r1.65 -r1.66
--- cust_svc.pm 6 Sep 2006 01:06:43 -0000 1.65
+++ cust_svc.pm 29 Dec 2006 08:51:32 -0000 1.66
@@ -2,24 +2,21 @@
use strict;
use vars qw( @ISA $DEBUG $me $ignore_quantity );
-use Carp qw( carp cluck );
+use Carp;
use FS::Conf;
use FS::Record qw( qsearch qsearchs dbh );
use FS::cust_pkg;
use FS::part_pkg;
use FS::part_svc;
use FS::pkg_svc;
-use FS::svc_acct;
-use FS::svc_domain;
-use FS::svc_forward;
-use FS::svc_broadband;
-use FS::svc_phone;
-use FS::svc_external;
use FS::domain_record;
use FS::part_export;
use FS::cdr;
- at ISA = qw( FS::Record );
+#most FS::svc_ classes are autoloaded in svc_x emthod
+use FS::svc_acct; #this one is used in the cache stuff
+
+ at ISA = qw( FS::cust_main_Mixin FS::Record );
$DEBUG = 0;
$me = '[cust_svc]';
@@ -289,54 +286,20 @@
my $self = shift;
carp "FS::cust_svc::label called on $self" if $DEBUG;
my $svc_x = $self->svc_x
- or die "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
+ or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
+
$self->_svc_label($svc_x);
}
sub _svc_label {
my( $self, $svc_x ) = ( shift, shift );
- my $svcdb = $self->part_svc->svcdb;
- my $tag;
- if ( $svcdb eq 'svc_acct' ) {
- $tag = $svc_x->email(@_);
- } elsif ( $svcdb eq 'svc_forward' ) {
- if ( $svc_x->srcsvc ) {
- my $svc_acct = $svc_x->srcsvc_acct(@_);
- $tag = $svc_acct->email(@_);
- } else {
- $tag = $svc_x->src;
- }
- $tag .= '->';
- if ( $svc_x->dstsvc ) {
- my $svc_acct = $svc_x->dstsvc_acct(@_);
- $tag .= $svc_acct->email(@_);
- } else {
- $tag .= $svc_x->dst;
- }
- } elsif ( $svcdb eq 'svc_domain' ) {
- $tag = $svc_x->getfield('domain');
- } elsif ( $svcdb eq 'svc_www' ) {
- my $domain_record = $svc_x->domain_record(@_);
- $tag = $domain_record->zone;
- } elsif ( $svcdb eq 'svc_broadband' ) {
- $tag = $svc_x->ip_addr;
- } elsif ( $svcdb eq 'svc_phone' ) {
- $tag = $svc_x->phonenum; #XXX format it better
- } elsif ( $svcdb eq 'svc_external' ) {
- my $conf = new FS::Conf;
- if ( $conf->config('svc_external-display_type') eq 'artera_turbo' ) {
- $tag = sprintf('%010d', $svc_x->id). '-'.
- substr('0000000000'.uc($svc_x->title), -10);
- } else {
- $tag = $svc_x->id. ': '. $svc_x->title;
- }
- } else {
- cluck "warning: asked for label of unsupported svcdb; using svcnum";
- $tag = $svc_x->getfield('svcnum');
- }
-
- $self->part_svc->svc, $tag, $svcdb, $self->svcnum;
+ (
+ $self->part_svc->svc,
+ $svc_x->label(@_),
+ $self->part_svc->svcdb,
+ $self->svcnum
+ );
}
@@ -353,7 +316,7 @@
if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
$self->{'_svc_acct'};
} else {
- #require "FS/$svcdb.pm";
+ require "FS/$svcdb.pm";
warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
if $DEBUG;
Index: cust_main.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main.pm,v
retrieving revision 1.258
retrieving revision 1.259
diff -u -d -r1.258 -r1.259
--- cust_main.pm 24 Dec 2006 01:28:37 -0000 1.258
+++ cust_main.pm 29 Dec 2006 08:51:32 -0000 1.259
@@ -1526,11 +1526,17 @@
sub all_pkgs {
my $self = shift;
+
+ return $self->num_pkgs unless wantarray;
+
+ my @cust_pkg = ();
if ( $self->{'_pkgnum'} ) {
- values %{ $self->{'_pkgnum'}->cache };
+ @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
} else {
- qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
+ @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
}
+
+ sort sort_packages @cust_pkg;
}
=item ncancelled_pkgs
@@ -1541,19 +1547,43 @@
sub ncancelled_pkgs {
my $self = shift;
+
+ return $self->num_ncancelled_pkgs unless wantarray;
+
+ my @cust_pkg = ();
if ( $self->{'_pkgnum'} ) {
- grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
+
+ @cust_pkg = grep { ! $_->getfield('cancel') }
+ values %{ $self->{'_pkgnum'}->cache };
+
} else {
- @{ [ # force list context
+
+ @cust_pkg =
qsearch( 'cust_pkg', {
- 'custnum' => $self->custnum,
- 'cancel' => '',
- }),
+ 'custnum' => $self->custnum,
+ 'cancel' => '',
+ });
+ push @cust_pkg,
qsearch( 'cust_pkg', {
- 'custnum' => $self->custnum,
- 'cancel' => 0,
- }),
- ] };
+ 'custnum' => $self->custnum,
+ 'cancel' => 0,
+ });
+ }
+
+ sort sort_packages @cust_pkg;
+
+}
+
+# This should be generalized to use config options to determine order.
+sub sort_packages {
+ if ( $a->get('cancel') and $b->get('cancel') ) {
+ $a->pkgnum <=> $b->pkgnum;
+ } elsif ( $a->get('cancel') or $b->get('cancel') ) {
+ return -1 if $b->get('cancel');
+ return 1 if $a->get('cancel');
+ return 0;
+ } else {
+ $a->pkgnum <=> $b->pkgnum;
}
}
@@ -1602,8 +1632,11 @@
=cut
sub num_cancelled_pkgs {
- my $self = shift;
- $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0");
+ shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
+}
+
+sub num_ncancelled_pkgs {
+ shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
}
sub num_pkgs {
@@ -1737,7 +1770,7 @@
{
'payby' => $payby2ban{$self->payby},
'payinfo' => md5_base64($self->payinfo),
- #'reason' =>
+ #don't ever *search* on reason! #'reason' =>
};
}
Index: Record.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Record.pm,v
retrieving revision 1.129
retrieving revision 1.130
diff -u -d -r1.129 -r1.130
--- Record.pm 23 Dec 2006 05:37:46 -0000 1.129
+++ Record.pm 29 Dec 2006 08:51:32 -0000 1.130
@@ -974,21 +974,9 @@
=cut
sub replace {
- my $new = shift;
- my $old = shift;
+ my ($new, $old) = (shift, shift);
- if (!defined($old)) {
- warn "[debug]$me replace called with no arguments; autoloading old record\n"
- if $DEBUG;
- my $primary_key = $new->dbdef_table->primary_key;
- if ( $primary_key ) {
- $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } )
- or croak "can't find ". $new->table. ".$primary_key ".
- $new->$primary_key();
- } else {
- croak $new->table. " has no primary key; pass old record as argument";
- }
- }
+ $old = $new->replace_old unless defined($old);
warn "[debug]$me $new ->replace $old\n" if $DEBUG;
@@ -1158,6 +1146,22 @@
}
+sub replace_old {
+ my( $self ) = shift;
+ warn "[$me] replace called with no arguments; autoloading old record\n"
+ if $DEBUG;
+
+ my $primary_key = $self->dbdef_table->primary_key;
+ if ( $primary_key ) {
+ $self->by_key( $self->$primary_key() ) #this is what's returned
+ or croak "can't find ". $self->table. ".$primary_key ".
+ $self->$primary_key();
+ } else {
+ croak $self->table. " has no primary key; pass old record as argument";
+ }
+
+}
+
=item rep
Depriciated (use replace instead).
Index: svc_external.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_external.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- svc_external.pm 3 Oct 2006 15:59:06 -0000 1.4
+++ svc_external.pm 29 Dec 2006 08:51:32 -0000 1.5
@@ -1,16 +1,11 @@
package FS::svc_external;
use strict;
-use vars qw(@ISA); # $conf
-use FS::UID;
-#use FS::Record qw( qsearch qsearchs dbh);
-use FS::svc_Common;
-
- at ISA = qw( FS::svc_Common );
+use vars qw(@ISA);
+use FS::Conf;
+use FS::svc_External_Common;
-#FS::UID::install_callback( sub {
-# $conf = new FS::Conf;
-#};
+ at ISA = qw( FS::svc_External_Common );
=head1 NAME
@@ -39,9 +34,9 @@
=head1 DESCRIPTION
-An FS::svc_external object represents a externally tracked service.
-FS::svc_external inherits from FS::svc_Common. The following fields are
-currently supported:
+An FS::svc_external object represents a generic externally tracked service.
+FS::svc_external inherits from FS::svc_External_Common (and FS::svc_Common).
+The following fields are currently supported:
=over 4
@@ -67,8 +62,31 @@
=cut
+sub table_info {
+ {
+ 'name' => 'External service',
+ 'sorts' => 'id',
+ 'display_weight' => 90,
+ 'cancel_weight' => 10,
+ 'fields' => {
+ },
+ };
+}
+
sub table { 'svc_external'; }
+# oh! this should be moved to svc_artera_turbo or something now
+sub label {
+ my $self = shift;
+ my $conf = new FS::Conf;
+ if ( $conf->config('svc_external-display_type') eq 'artera_turbo' ) {
+ sprintf('%010d', $self->id). '-'.
+ substr('0000000000'.uc($self->title), -10);
+ } else {
+ $self->SUPER::label;
+ }
+}
+
=item insert [ , OPTION => VALUE ... ]
Adds this external service to the database. If there is an error, returns the
@@ -149,21 +167,15 @@
=cut
-sub check {
- my $self = shift;
-
- my $x = $self->setfixed;
- return $x unless ref($x);
- my $part_svc = $x;
-
- my $error =
- $self->ut_numbern('svcnum')
- || $self->ut_numbern('id')
- || $self->ut_textn('title')
- ;
-
- $self->SUPER::check;
-}
+#sub check {
+# my $self = shift;
+# my $error;
+#
+# $error = $self->SUPER::delete;
+# return $error if $error;
+#
+# '';
+#}
=back
@@ -171,8 +183,8 @@
=head1 SEE ALSO
-L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
-L<FS::cust_pkg>, schema.html from the base documentation.
+L<FS::svc_External_Common>, L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>,
+L<FS::part_svc>, L<FS::cust_pkg>, schema.html from the base documentation.
=cut
Index: Schema.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Schema.pm,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -d -r1.39 -r1.40
--- Schema.pm 23 Dec 2006 05:37:46 -0000 1.39
+++ Schema.pm 29 Dec 2006 08:51:32 -0000 1.40
@@ -867,13 +867,20 @@
'svc_domain' => {
'columns' => [
- 'svcnum', 'int', '', '', '', '',
- 'domain', 'varchar', '', $char_d, '', '',
- 'catchall', 'int', 'NULL', '', '', '',
+ 'svcnum', 'int', '', '', '', '',
+ 'domain', 'varchar', '', $char_d, '', '',
+ 'suffix', 'varchar', 'NULL', $char_d, '', '',
+ 'catchall', 'int', 'NULL', '', '', '',
+ 'parent_svcnum', 'int', 'NULL', '', '', '',
+ 'registrarnum', 'int', 'NULL', '', '', '',
+ 'registrarkey', 'varchar', 'NULL', '', '', '',
+ 'setup_date', @date_type, '', '',
+ 'renewal_interval', 'int', 'NULL', '', '', '',
+ 'expiration_date', @date_type, '', '',
],
'primary_key' => 'svcnum',
- 'unique' => [ ['domain'] ],
- 'index' => [],
+ 'unique' => [ ],
+ 'index' => [ ['domain'] ],
},
'domain_record' => {
@@ -890,6 +897,16 @@
'index' => [ ['svcnum'] ],
},
+ 'registrar' => {
+ 'columns' => [
+ 'registrarnum', 'serial', '', '', '', '',
+ 'registrarname', 'varchar', '', $char_d, '', '',
+ ],
+ 'primary_key' => 'registrarnum',
+ 'unique' => [],
+ 'index' => [],
+ },
+
'svc_forward' => {
'columns' => [
'svcnum', 'int', '', '', '', '',
Index: svc_broadband.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_broadband.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- svc_broadband.pm 23 Dec 2006 05:37:46 -0000 1.8
+++ svc_broadband.pm 29 Dec 2006 08:51:32 -0000 1.9
@@ -85,8 +85,50 @@
=cut
+sub table_info {
+ {
+ 'name' => 'Broadband',
+ 'name_plural' => 'Broadband services',
+ 'longname_plural' => 'Fixed (username-less) broadband services',
+ 'display_weight' => 50,
+ 'cancel_weight' => 70,
+ 'fields' => {
+ 'speed_down' => 'Maximum download speed for this service in Kbps. 0 denotes unlimited.',
+ 'speed_up' => 'Maximum upload speed for this service in Kbps. 0 denotes unlimited.',
+ 'ip_addr' => 'IP address. Leave blank for automatic assignment.',
+ 'blocknum' => 'Address block.',
+ },
+ };
+}
+
sub table { 'svc_broadband'; }
+=item search_sql STRING
+
+Class method which returns an SQL fragment to search for the given string.
+
+=cut
+
+sub search_sql {
+ my( $class, $string ) = @_;
+ if ( $string =~ /^(\d{1,3}\.){3}\d{1,3}$/ ) {
+ $class->search_sql_field('ip_addr', $string );
+ } else {
+ '1 = 0'; #false
+ }
+}
+
+=item label
+
+Returns the IP address.
+
+=cut
+
+sub label {
+ my $self = shift;
+ $self->ip_addr;
+}
+
=item insert [ , OPTION => VALUE ... ]
Adds this record to the database. If there is an error, returns the error,
- Previous message: [freeside-commits] freeside/httemplate/edit part_svc.cgi, 1.53,
1.54 svc_acct.cgi, 1.43, 1.44 svc_broadband.cgi, 1.12,
1.13 svc_Common.html, NONE, 1.1 svc_domain.cgi, 1.13,
1.14 svc_external.cgi, 1.3, 1.4 svc_forward.cgi, 1.18,
1.19 svc_www.cgi, 1.18, 1.19
- Next message: [freeside-commits] freeside/httemplate/edit/process/elements
process.html, 1.6, 1.7
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the freeside-commits
mailing list