diff options
Diffstat (limited to 'FS')
42 files changed, 1182 insertions, 189 deletions
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index bad831a94..92cede6a5 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -310,6 +310,7 @@ tie my %rights, 'Tie::IxHash', 'Services: Mailing lists', 'Services: Alarm services', 'Services: Video', + 'Services: Circuits', 'Services: External services', 'Usage: RADIUS sessions', 'Usage: Call Detail Records (CDRs)', diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 900da1005..d3e45dfee 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -392,6 +392,10 @@ if ( -e $addl_handler_use_file ) { use FS::deploy_zone_vertex; use FS::TaxEngine; use FS::tax_status; + use FS::circuit_type; + use FS::circuit_provider; + use FS::circuit_termination; + use FS::svc_circuit; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm index e41ba5d76..dbc383a14 100644 --- a/FS/FS/Misc/Geo.pm +++ b/FS/FS/Misc/Geo.pm @@ -6,8 +6,7 @@ use vars qw( $DEBUG @EXPORT_OK $conf ); use LWP::UserAgent; use HTTP::Request; use HTTP::Request::Common qw( GET POST ); -use HTTP::Cookies; -use HTML::TokeParser; +use JSON; use URI::Escape 3.31; use Data::Dumper; use FS::Conf; @@ -29,7 +28,7 @@ FS::Misc::Geo - routines to fetch geographic information =over 4 -=item get_censustract LOCATION YEAR +=item get_censustract_ffiec LOCATION YEAR Given a location hash (see L<FS::location_Mixin>) and a census map year, returns a census tract code (consisting of state, county, and tract @@ -41,105 +40,65 @@ sub get_censustract_ffiec { my $class = shift; my $location = shift; my $year = shift; + $year ||= 2013; - warn Dumper($location, $year) if $DEBUG; + if ( length($location->{country}) and uc($location->{country}) ne 'US' ) { + return ''; + } - my $url = 'http://www.ffiec.gov/Geocode/default.aspx'; + warn Dumper($location, $year) if $DEBUG; - my $return = {}; - my $error = ''; + # the old FFIEC geocoding service was shut down December 1, 2014. + # welcome to the future. + my $url = 'https://geomap.ffiec.gov/FFIECGeocMap/GeocodeMap1.aspx/GetGeocodeData'; + # build the single-line query + my $single_line = join(', ', $location->{address1}, + $location->{city}, + $location->{state} + ); + my $hashref = { sSingleLine => $single_line, iCensusYear => $year }; + my $request = POST( $url, + 'Content-Type' => 'application/json; charset=utf-8', + 'Accept' => 'application/json', + 'Content' => encode_json($hashref) + ); - my $ua = new LWP::UserAgent('cookie_jar' => HTTP::Cookies->new); - my $res = $ua->request( GET( $url ) ); + my $ua = new LWP::UserAgent; + my $res = $ua->request( $request ); warn $res->as_string if $DEBUG > 2; if (!$res->is_success) { - $error = $res->message; - - } else { - - my $content = $res->content; - - my $p = new HTML::TokeParser \$content; - my $viewstate; - my $eventvalidation; - while (my $token = $p->get_tag('input') ) { - if ($token->[1]->{name} eq '__VIEWSTATE') { - $viewstate = $token->[1]->{value}; - } - if ($token->[1]->{name} eq '__EVENTVALIDATION') { - $eventvalidation = $token->[1]->{value}; - } - last if $viewstate && $eventvalidation; - } - - if (!$viewstate or !$eventvalidation ) { + die "Census tract lookup error: ".$res->message; - $error = "either no __VIEWSTATE or __EVENTVALIDATION found"; - - } else { - - my($zip5, $zip4) = split('-',$location->{zip}); - - $year ||= '2013'; - my @ffiec_args = ( - __VIEWSTATE => $viewstate, - __EVENTVALIDATION => $eventvalidation, - __VIEWSTATEENCRYPTED => '', - ddlbYear => $year, - txtAddress => $location->{address1}, - txtCity => $location->{city}, - ddlbState => $location->{state}, - txtZipCode => $zip5, - btnSearch => 'Search', - ); - warn join("\n", @ffiec_args ) - if $DEBUG > 1; - - push @{ $ua->requests_redirectable }, 'POST'; - $res = $ua->request( POST( $url, \@ffiec_args ) ); - warn $res->as_string - if $DEBUG > 2; - - unless ($res->code eq '200') { - - $error = $res->message; - - } else { - - my @id = qw( MSACode StateCode CountyCode TractCode ); - $content = $res->content; - warn $res->content if $DEBUG > 2; - $p = new HTML::TokeParser \$content; - my $prefix = 'UcGeoResult11_lb'; - my $compare = - sub { my $t=shift; scalar( grep { lc($t) eq lc("$prefix$_")} @id ) }; - - while (my $token = $p->get_tag('span') ) { - next unless ( $token->[1]->{id} && &$compare( $token->[1]->{id} ) ); - $token->[1]->{id} =~ /^$prefix(\w+)$/; - $return->{lc($1)} = $p->get_trimmed_text("/span"); - } - - unless ( $return->{tractcode} ) { - warn "$error: $content ". Dumper($return) if $DEBUG; - $error = "No census tract found"; - } - $return->{tractcode} .= ' ' - unless $error || $JSON::VERSION >= 2; #broken JSON 1 workaround + } - } #unless ($res->code eq '200') + local $@; + my $content = eval { decode_json($res->content) }; + die "Census tract JSON error: $@\n" if $@; - } #unless ($viewstate) + if ( !exists $content->{d}->{sStatus} ) { + die "Census tract response is missing a status indicator.\nThis is an FFIEC problem.\n"; + } + if ( $content->{d}->{sStatus} eq 'Y' ) { + # success + # this also contains the (partial) standardized address, correct zip + # code, coordinates, etc., and we could get all of them, but right now + # we only want the census tract + my $tract = join('', $content->{d}->{sStateCode}, + $content->{d}->{sCountyCode}, + $content->{d}->{sTractCode}); + return $tract; - } #unless ($res->code eq '200') + } else { - die "FFIEC Geocoding error: $error\n" if $error; + my $error = $content->{d}->{sMsg} + || 'FFIEC lookup failed, but with no status message.'; + die "$error\n"; - $return->{'statecode'} . $return->{'countycode'} . $return->{'tractcode'}; + } } #sub get_district_methods { diff --git a/FS/FS/Report/FCC_477.pm b/FS/FS/Report/FCC_477.pm index ff29d1953..f5d6a06ec 100644 --- a/FS/FS/Report/FCC_477.pm +++ b/FS/FS/Report/FCC_477.pm @@ -4,14 +4,13 @@ use base qw( FS::Report ); use strict; use vars qw( @upload @download @technology @part2aoption @part2boption %states - $DEBUG ); use FS::Record qw( dbh ); use Tie::IxHash; use Storable; -$DEBUG = 0; +our $DEBUG = 0; =head1 NAME @@ -305,6 +304,7 @@ sub report { unless $class->can($method); my $statement = $class->$method(%opt); + warn $statement if $DEBUG; my $sth = dbh->prepare($statement); $sth->execute or die $sth->errstr; $sth->fetchall_arrayref; diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 396c86622..91dfc5d97 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -5653,6 +5653,7 @@ sub tables_hashref { 'max_simultaneous', 'int', 'NULL', '', '', '', 'e911_class', 'char', 'NULL', 1, '', '', 'e911_type', 'char', 'NULL', 1, '', '', + 'circuit_svcnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'svcnum', 'unique' => [ [ 'sms_carrierid', 'sms_account'] ], @@ -5678,6 +5679,10 @@ sub tables_hashref { table => 'cdr_carrier', references => [ 'carrierid' ], }, + { columns => [ 'circuit_svcnum' ], + table => 'svc_circuit', + references => [ 'svcnum' ], + }, ], }, @@ -5881,6 +5886,7 @@ sub tables_hashref { 'disabled', 'char', 'NULL', 1, '', '', 'unsuspend_pkgpart', 'int', 'NULL', '', '', '', 'unsuspend_hold','char', 'NULL', 1, '', '', + 'unused_credit', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'reasonnum', 'unique' => [], @@ -6526,6 +6532,75 @@ sub tables_hashref { ], }, + 'circuit_type' => { + 'columns' => [ + 'typenum', 'serial', '', '', '', '', + 'typename', 'varchar', '', $char_d, '', '', + 'disabled', 'char', 'NULL', 1, '', '', + # speed? number of voice lines? anything else? + ], + 'primary_key' => 'typenum', + 'unique' => [ [ 'typename' ] ], + 'index' => [], + }, + + 'circuit_provider' => { + 'columns' => [ + 'providernum', 'serial', '', '', '', '', + 'provider', 'varchar', '', $char_d, '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'providernum', + 'unique' => [ [ 'provider' ], ], + 'index' => [], + }, + + 'circuit_termination' => { + 'columns' => [ + 'termnum', 'serial', '', '', '', '', + 'termination','varchar', '', $char_d, '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'termnum', + 'unique' => [ [ 'termination' ] ], + 'index' => [], + }, + + 'svc_circuit' => { + 'columns' => [ + 'svcnum', 'int', '', '', '', '', + 'typenum', 'int', '', '', '', '', + 'providernum', 'int', '', '', '', '', + 'termnum', 'int', '', '', '', '', + 'circuit_id', 'varchar', '', 64, '', '', + 'desired_due_date', 'int', 'NULL', '', '', '', + 'due_date', 'int', 'NULL', '', '', '', + 'vendor_order_id', 'varchar', 'NULL', $char_d, '', '', + 'vendor_qual_id', 'varchar', 'NULL', $char_d, '', '', + 'vendor_order_type', 'varchar', 'NULL', $char_d, '', '', + 'vendor_order_status', 'varchar', 'NULL', $char_d, '', '', + 'endpoint_ip_addr', 'varchar', 'NULL', 40, '', '', + 'endpoint_mac_addr', 'varchar', 'NULL', 12, '', '', + ], + 'primary_key' => 'svcnum', + 'unique' => [], + 'index' => [ [ 'providernum' ], [ 'typenum' ] ], + 'foreign_keys' => [ + { columns => [ 'svcnum' ], + table => 'cust_svc', + }, + { columns => [ 'typenum' ], + table => 'circuit_type', + }, + { columns => [ 'providernum' ], + table => 'circuit_provider', + }, + { columns => [ 'termnum' ], + table => 'circuit_termination', + }, + ], + }, + 'vend_main' => { 'columns' => [ 'vendnum', 'serial', '', '', '', '', diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index 5af5b270b..05972c0b7 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -2729,6 +2729,8 @@ sub _items_cust_bill_pkg { 'pkgnum' => $cust_bill_pkg->pkgpart, #so it displays in Ref 'description' => $description, 'amount' => sprintf("%.2f", $cust_bill_pkg->setup), + 'unit_amount' => sprintf("%.2f", $cust_bill_pkg->unitsetup), + 'quantity' => $cust_bill_pkg->quantity, 'preref_html' => ( $opt{preref_callback} ? &{ $opt{preref_callback} }( $cust_bill_pkg ) : '' @@ -2740,6 +2742,12 @@ sub _items_cust_bill_pkg { 'pkgnum' => $cust_bill_pkg->pkgpart, #so it displays in Ref 'description' => "$desc (". $cust_bill_pkg->part_pkg->freq_pretty.")", 'amount' => sprintf("%.2f", $cust_bill_pkg->recur), + 'unit_amount' => sprintf("%.2f", $cust_bill_pkg->unitrecur), + 'quantity' => $cust_bill_pkg->quantity, + 'preref_html' => ( $opt{preref_callback} + ? &{ $opt{preref_callback} }( $cust_bill_pkg ) + : '' + ), }; } diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index 99c35609e..e13869265 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -113,16 +113,16 @@ sub svc_url { if $DEBUG; if ( $opt{m}->interp->comp_exists("/$opt{action}/$svcdb.cgi") ) { $url = "$svcdb.cgi?"; + } elsif ( $opt{m}->interp->comp_exists("/$opt{action}/$svcdb.html") ) { + $url = "$svcdb.html?"; } else { - my $generic = $opt{action} eq 'search' ? 'cust_svc' : 'svc_Common'; $url = "$generic.html?svcdb=$svcdb;"; $url .= 'svcnum=' if $query =~ /^\d+(;|$)/ or $query eq ''; } - import FS::CGI 'rooturl'; #WTF! why is this necessary - my $return = rooturl(). "$opt{action}/$url$query"; + my $return = FS::CGI::rooturl(). "$opt{action}/$url$query"; $return = qq!<A HREF="$return">! if $opt{ahref}; @@ -574,6 +574,19 @@ sub cust_aligns { } } +=item cust_links + +Returns an array of links to view/cust_main.cgi, for use with cust_fields. + +=cut + +sub cust_links { + my $link = [ FS::CGI::rooturl().'view/cust_main.cgi?', 'custnum' ]; + + return map { $_ eq 'cust_status_label' ? '' : $link } + @cust_fields; +} + =item is_mobile Utility function to determine if the client is a mobile browser. diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm index 3e62a688b..ba0f61db1 100755 --- a/FS/FS/addr_block.pm +++ b/FS/FS/addr_block.pm @@ -388,6 +388,24 @@ sub label { ($router ? $router->routername : '(unallocated)'). ':'. $self->NetAddr; } +=item router + +Returns the router assigned to this block. + +=cut + +# necessary, because this can't be foreign keyed + +sub router { + my $self = shift; + my $routernum = $self->routernum; + if ( $routernum ) { + return FS::router->by_key($routernum); + } else { + return; + } +} + =back =head1 BUGS diff --git a/FS/FS/cdr/cx3.pm b/FS/FS/cdr/cx3.pm index e5b5f0350..8c848078a 100644 --- a/FS/FS/cdr/cx3.pm +++ b/FS/FS/cdr/cx3.pm @@ -43,6 +43,7 @@ sub { my ($cdr, $duration) = @_; }, #duration skip(1), # unknown 'disposition', # call status + 'accountcode', # AccountCode ], ); diff --git a/FS/FS/cdr/earthlink.pm b/FS/FS/cdr/earthlink.pm new file mode 100644 index 000000000..0421ef935 --- /dev/null +++ b/FS/FS/cdr/earthlink.pm @@ -0,0 +1,44 @@ +package FS::cdr::earthlink; + +use strict; +use vars qw( @ISA %info $date); +use Time::Local; +use FS::cdr qw(_cdr_date_parser_maker _cdr_min_parser_maker); +use Date::Parse; + +@ISA = qw(FS::cdr); + +%info = ( + 'name' => 'Earthlink', + 'weight' => 120, + 'header' => 1, + 'import_fields' => [ + + 'accountcode', #Account number + skip(2), #SERVICE LOC / BILL NUMBER + sub { my($cdr, $date) = @_; + + }, #date + sub { my($cdr, $time) = @_; + + my $datetime = $date. " ". $time; + $cdr->set('startdate', $datetime ); + }, #time + sub { my($cdr, $src) = @_; + $src =~ s/\D//g; + $cdr->set('src', $src); + }, #ORIG NUMBER + skip(2), #ORIG CITY/ORIGSTATE + sub { my($cdr, $dst) = @_; + $dst =~ s/\D//g; + $cdr->set('dst', $dst); + }, #TERM NUMBER + skip(2), #TERM CITY / TERM STATE + _cdr_min_parser_maker, #MINUTES + ], +); + +sub skip { map {''} (1..$_[0]) } + +1; + diff --git a/FS/FS/cdr/thinktel.pm b/FS/FS/cdr/thinktel.pm new file mode 100644 index 000000000..ddb2127a6 --- /dev/null +++ b/FS/FS/cdr/thinktel.pm @@ -0,0 +1,42 @@ +package FS::cdr::thinktel; + +use strict; +use base qw( FS::cdr ); +use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker ); + +our %info = ( + 'name' => 'Thinktel', + 'weight' => 541, + 'header' => 1, #0 default, set to 1 to ignore the first line, or + # to higher numbers to ignore that number of lines + 'type' => 'csv', #csv (default), fixedlength or xls + 'sep_char' => ',', #for csv, defaults to , + 'disabled' => 0, #0 default, set to 1 to disable + + #listref of what to do with each field from the CDR, in order + 'import_fields' => [ + 'charged_party', + 'src', + 'dst', + _cdr_date_parser_maker('startdate'), + 'billsec', # rounded call duration + 'dcontext', # Usage Type: 'Local', 'Canada', 'Incoming', ... + 'upstream_price', + 'upstream_src_regionname', + 'upstream_dst_regionname', + '', # upstream rate per minute + '', # "Label" + # raw seconds, to one decimal place + sub { my ($cdr, $sec) = @_; + $cdr->set('duration', sprintf('%.0f', $sec)); + }, + # newly added fields of unclear meaning: + # Subscription (UUID, seems to correspond to charged_party) + # Call Type (always "Normal" thus far) + # Carrier (always empty) + # Alt Destination Name (always empty) + ], +); + +1; + diff --git a/FS/FS/circuit_provider.pm b/FS/FS/circuit_provider.pm new file mode 100644 index 000000000..6cb784117 --- /dev/null +++ b/FS/FS/circuit_provider.pm @@ -0,0 +1,101 @@ +package FS::circuit_provider; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::circuit_provider - Object methods for circuit_provider records + +=head1 SYNOPSIS + + use FS::circuit_provider; + + $record = new FS::circuit_provider \%hash; + $record = new FS::circuit_provider { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::circuit_provider object represents a telecom carrier that provides +physical circuits (L<FS::svc_circuit>). FS::circuit_provider inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item providernum - primary key + +=item provider - provider name + +=item disabled - disabled + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +=cut + +sub table { 'circuit_provider'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=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. + +=item check + +Checks all fields to make sure this is a valid example. 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('providernum') + || $self->ut_text('provider') + || $self->ut_flag('disabled') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 SEE ALSO + +L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/circuit_termination.pm b/FS/FS/circuit_termination.pm new file mode 100644 index 000000000..3f0afc1f9 --- /dev/null +++ b/FS/FS/circuit_termination.pm @@ -0,0 +1,98 @@ +package FS::circuit_termination; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::circuit_termination - Object methods for circuit_termination records + +=head1 SYNOPSIS + + use FS::circuit_termination; + + $record = new FS::circuit_termination \%hash; + $record = new FS::circuit_termination { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::circuit_termination object represents a central office circuit +interface type. FS::circuit_termination inherits from FS::Record. The +following fields are currently supported: + +=over 4 + +=item termnum - primary key + +=item termination - description of the termination type + +=item disabled - 'Y' if this is disabled + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new example. To add the example to the database, see L<"insert">. + +=cut + +sub table { 'circuit_termination'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=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. + +=item check + +Checks all fields to make sure this is a valid example. 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 $error = + $self->ut_numbern('termnum') + || $self->ut_text('termination') + || $self->ut_flag('disabled') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 SEE ALSO + +L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/circuit_type.pm b/FS/FS/circuit_type.pm new file mode 100644 index 000000000..3b3653693 --- /dev/null +++ b/FS/FS/circuit_type.pm @@ -0,0 +1,98 @@ +package FS::circuit_type; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::circuit_type - Object methods for circuit_type records + +=head1 SYNOPSIS + + use FS::circuit_type; + + $record = new FS::circuit_type \%hash; + $record = new FS::circuit_type { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::circuit_type object represents a circuit type (such as "DS1" or "OC3"). +FS::circuit_type inherits from FS::Record. The following fields are currently +supported: + +=over 4 + +=item typenum - primary key + +=item typename - name of the circuit type + +=item disabled - 'Y' if this is disabled + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new example. To add the example to the database, see L<"insert">. + +=cut + +sub table { 'circuit_type'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=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. + +=item check + +Checks all fields to make sure this is a valid example. 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 $error = + $self->ut_numbern('typenum') + || $self->ut_text('typename') + || $self->ut_flag('disabled') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 SEE ALSO + +L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 156ba5fd6..212be7a37 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -679,11 +679,9 @@ Example: 'apply' => 1, #0 leaves the credit unapplied #the credit - 'newreasonnum' => scalar($cgi->param('newreasonnum')), - 'newreasonnum_type' => scalar($cgi->param('newreasonnumT')), map { $_ => scalar($cgi->param($_)) } #fields('cust_credit') - qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum + qw( custnum _date amount reasonnum addlinfo ), #pkgnum eventnum ); @@ -725,26 +723,11 @@ sub credit_lineitems { #}); my $error = ''; - if ($arg{reasonnum} == -1) { - - $error = 'Enter a new reason (or select an existing one)' - unless $arg{newreasonnum} !~ /^\s*$/; - my $reason = new FS::reason { - 'reason' => $arg{newreasonnum}, - 'reason_type' => $arg{newreasonnum_type}, - }; - $error ||= $reason->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error inserting reason: $error"; - } - $arg{reasonnum} = $reason->reasonnum; - } my $cust_credit = new FS::cust_credit ( { map { $_ => $arg{$_} } #fields('cust_credit') - qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum + qw( custnum _date amount reasonnum addlinfo ), #pkgnum eventnum } ); $error = $cust_credit->insert; if ( $error ) { diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index e8e202e3d..a810f5ab4 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1207,7 +1207,7 @@ Available options are: =over 4 -=item reason - can be set to a cancellation reason (see L<FS:reason>), +=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: - typenum - Reason type (see L<FS::reason_type> @@ -1297,6 +1297,16 @@ sub suspend { } } + # if a reasonnum was passed, get the actual reason object so we can check + # unused_credit + # (passing a reason hashref is still allowed, but it can't be used with + # the fancy behavioral options.) + + my $reason; + if ($options{'reason'} =~ /^\d+$/) { + $reason = FS::reason->by_key($options{'reason'}); + } + my %hash = $self->hash; if ( $date ) { $hash{'adjourn'} = $date; @@ -1321,9 +1331,15 @@ sub suspend { return $error; } - unless ( $date ) { + unless ( $date ) { # then we are suspending now + # credit remaining time if appropriate - if ( $self->part_pkg->option('unused_credit_suspend', 1) ) { + # (if required by the package def, or the suspend reason) + my $unused_credit = $self->part_pkg->option('unused_credit_suspend',1) + || ( defined($reason) && $reason->unused_credit ); + + if ( $unused_credit ) { + warn "crediting unused time on pkg#".$self->pkgnum."\n" if $DEBUG; my $error = $self->credit_remaining('suspend', $suspend_time); if ($error) { $dbh->rollback if $oldAutoCommit; @@ -3872,7 +3888,7 @@ sub insert_reason { $reasonnum = $reason->reasonnum; } else { - return "Unparsable reason: ". $options{'reason'}; + return "Unparseable reason: ". $options{'reason'}; } my $cust_pkg_reason = diff --git a/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm b/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm index cb61f1b77..488132a36 100644 --- a/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm +++ b/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm @@ -1,21 +1,16 @@ package FS::part_event::Action::Mixin::credit_agent_pkg_class; -use base qw( FS::part_event::Action::Mixin::credit_pkg ); + +# calculates a credit percentage on a specific package for use with +# credit_pkg or credit_bill, based on an agent's commission table use strict; use FS::Record qw(qsearchs); -sub option_fields { - my $class = shift; - my %option_fields = $class->SUPER::option_fields; - delete $option_fields{'percent'}; - %option_fields; -} - sub _calc_credit_percent { - my( $self, $cust_pkg ) = @_; + my( $self, $cust_pkg, $agent ) = @_; my $agent_pkg_class = qsearchs( 'agent_pkg_class', { - 'agentnum' => $self->cust_main($cust_pkg)->agentnum, + 'agentnum' => $agent->agentnum, 'classnum' => $cust_pkg->part_pkg->classnum, }); diff --git a/FS/FS/part_event/Action/Mixin/credit_bill.pm b/FS/FS/part_event/Action/Mixin/credit_bill.pm new file mode 100644 index 000000000..4930e35fb --- /dev/null +++ b/FS/FS/part_event/Action/Mixin/credit_bill.pm @@ -0,0 +1,95 @@ +package FS::part_event::Action::Mixin::credit_bill; + +use strict; + +# credit_bill: calculates a credit amount that is some percentage of each +# line item of an invoice + +sub eventtable_hashref { + { 'cust_bill' => 1 }; +} + +sub option_fields { + my $class = shift; + my @fields = ( + 'reasonnum' => { 'label' => 'Credit reason', + 'type' => 'select-reason', + 'reason_class' => 'R', + }, + 'percent' => { 'label' => 'Percent', + 'type' => 'input-percentage', + 'default' => '100', + }, + 'what' => { + 'label' => 'Of', + 'type' => 'select', + #add additional ways to specify in the package def + 'options' => [qw( setuprecur setup recur setuprecur_margin setup_margin recur_margin )], + 'labels' => { + 'setuprecur' => 'Amount charged', + 'setup' => 'Setup fee', + 'recur' => 'Recurring fee', + 'setuprecur_margin' => 'Amount charged minus total cost', + 'setup_margin' => 'Setup fee minus setup cost', + 'recur_margin' => 'Recurring fee minus recurring cost', + }, + }, + ); + if ($class->can('_calc_credit_percent')) { + splice @fields, 2, 2; #remove the percentage option + } + @fields; + +} + +our %part_pkg_cache; + +# arguments: +# 1. the line item +# 2. the recipient of the commission; may be FS::sales, FS::agent, +# FS::access_user, etc. Here we don't use it, but it will be passed through +# to _calc_credit_percent. + +sub _calc_credit { + my $self = shift; + my $cust_bill_pkg = shift; + + my $what = $self->option('what'); + my $margin = 1 if $what =~ s/_margin$//; + + my $pkgnum = $cust_bill_pkg->pkgnum; + my $cust_pkg = $cust_bill_pkg->cust_pkg; + + my $percent; + if ( $self->can('_calc_credit_percent') ) { + $percent = $self->_calc_credit_percent($cust_pkg, @_); + } else { + $percent = $self->option('percent') || 0; + } + + my $charge = 0; + if ( $what eq 'setup' ) { + $charge = $cust_bill_pkg->get('setup'); + } elsif ( $what eq 'recur' ) { + $charge = $cust_bill_pkg->get('recur'); + } elsif ( $what eq 'setuprecur' ) { + $charge = $cust_bill_pkg->get('setup') + $cust_bill_pkg->get('recur'); + } + if ( $margin ) { + my $pkgpart = $cust_bill_pkg->pkgpart_override || $cust_pkg->pkgpart; + my $part_pkg = $part_pkg_cache{$pkgpart} + ||= FS::part_pkg->by_key($pkgpart); + if ( $what eq 'setup' ) { + $charge -= $part_pkg->get('setup_cost'); + } elsif ( $what eq 'recur' ) { + $charge -= $part_pkg->get('recur_cost'); + } elsif ( $what eq 'setuprecur' ) { + $charge -= $part_pkg->get('setup_cost') + $part_pkg->get('recur_cost'); + } + } + + $charge = 0 if $charge < 0; # e.g. prorate + return ($percent * $charge / 100); +} + +1; diff --git a/FS/FS/part_event/Action/Mixin/credit_flat.pm b/FS/FS/part_event/Action/Mixin/credit_flat.pm new file mode 100644 index 000000000..374cf5d6b --- /dev/null +++ b/FS/FS/part_event/Action/Mixin/credit_flat.pm @@ -0,0 +1,25 @@ +package FS::part_event::Action::Mixin::credit_flat; + +# credit_flat: return a fixed amount for _calc_credit, specified in the +# options + +use strict; + +sub option_fields { + ( + 'reasonnum' => { 'label' => 'Credit reason', + 'type' => 'select-reason', + 'reason_class' => 'R', + }, + 'amount' => { 'label' => 'Credit amount', + 'type' => 'money', + }, + ); +} + +sub _calc_credit { + my $self = shift; + $self->option('amount'); +} + +1; diff --git a/FS/FS/part_event/Action/Mixin/credit_pkg.pm b/FS/FS/part_event/Action/Mixin/credit_pkg.pm index e586f8532..400ece97b 100644 --- a/FS/FS/part_event/Action/Mixin/credit_pkg.pm +++ b/FS/FS/part_event/Action/Mixin/credit_pkg.pm @@ -2,12 +2,19 @@ package FS::part_event::Action::Mixin::credit_pkg; use strict; +# credit_pkg: calculates a credit amount that is some percentage of the +# package charge / cost / margin / some other amount of a package +# +# also provides an option field for the percentage, unless the action knows +# how to calculate its own percentage somehow (has a _calc_credit_percent) + sub eventtable_hashref { { 'cust_pkg' => 1 }; } sub option_fields { - ( + my $class = shift; + my @fields = ( 'reasonnum' => { 'label' => 'Credit reason', 'type' => 'select-reason', 'reason_class' => 'R', @@ -36,12 +43,19 @@ sub option_fields { }, }, ); + if ($class->can('_calc_credit_percent')) { + splice @fields, 2, 2; #remove the percentage option + } + @fields; } -#my %no_cust_pkg = ( 'setup_cost' => 1 ); +# arguments: +# 1. cust_pkg +# 2. recipient of the credit (passed through to _calc_credit_percent) sub _calc_credit { - my( $self, $cust_pkg ) = @_; + my $self = shift; + my $cust_pkg = shift; my $cust_main = $self->cust_main($cust_pkg); @@ -59,18 +73,17 @@ sub _calc_credit { } } - my $percent = $self->_calc_credit_percent($cust_pkg); + my $percent; + if ( $self->can('_calc_credit_percent') ) { + $percent = $self->_calc_credit_percent($cust_pkg, @_); + } else { + $percent = $self->option('percent') || 0; + } - #my @arg = $no_cust_pkg{$what} ? () : ($cust_pkg); my @arg = ($what eq 'setup_cost') ? () : ($cust_pkg); sprintf('%.2f', $part_pkg->$what(@arg) * $percent / 100 ); } -sub _calc_credit_percent { - my( $self, $cust_pkg ) = @_; - $self->option('percent'); -} - 1; diff --git a/FS/FS/part_event/Action/Mixin/credit_sales_pkg_class.pm b/FS/FS/part_event/Action/Mixin/credit_sales_pkg_class.pm index 5c090ef54..61302aa27 100644 --- a/FS/FS/part_event/Action/Mixin/credit_sales_pkg_class.pm +++ b/FS/FS/part_event/Action/Mixin/credit_sales_pkg_class.pm @@ -1,30 +1,16 @@ package FS::part_event::Action::Mixin::credit_sales_pkg_class; -use base qw( FS::part_event::Action::Mixin::credit_pkg ); use strict; use FS::Record qw(qsearchs); use FS::sales_pkg_class; -sub option_fields { - my $class = shift; - my %option_fields = $class->SUPER::option_fields; - - delete $option_fields{'percent'}; - - %option_fields; -} - sub _calc_credit_percent { - my( $self, $cust_pkg ) = @_; - - my $salesnum = $cust_pkg->salesnum; - $salesnum ||= $self->cust_main($cust_pkg)->salesnum - if $self->option('cust_main_sales'); + my( $self, $cust_pkg, $sales ) = @_; - return 0 unless $salesnum; + die "sales record required" unless $sales; my $sales_pkg_class = qsearchs( 'sales_pkg_class', { - 'salesnum' => $salesnum, + 'salesnum' => $sales->salesnum, 'classnum' => $cust_pkg->part_pkg->classnum, }); diff --git a/FS/FS/part_event/Action/bill_sales_credit.pm b/FS/FS/part_event/Action/bill_sales_credit.pm new file mode 100644 index 000000000..3193a81ef --- /dev/null +++ b/FS/FS/part_event/Action/bill_sales_credit.pm @@ -0,0 +1,91 @@ +package FS::part_event::Action::bill_sales_credit; + +# in this order: +# - pkg_sales_credit invokes NEXT, then appends the 'cust_main_sales' param +# - credit_bill contains the core _calc_credit logic, and also defines other +# params + +use base qw( FS::part_event::Action::Mixin::pkg_sales_credit + FS::part_event::Action::Mixin::credit_bill + FS::part_event::Action ); +use FS::Record qw(qsearch qsearchs); +use FS::Conf; +use Date::Format qw(time2str); + +use strict; + +sub description { 'Credit the sales person based on the billed amount'; } + +sub eventtable_hashref { + { 'cust_bill' => 1 }; +} + +our $date_format; + +sub do_action { + my( $self, $cust_bill, $cust_event ) = @_; + + $date_format ||= FS::Conf->new->config('date_format') || '%x'; + + my $cust_main = $self->cust_main($cust_bill); + + my %salesnum_sales; # salesnum => FS::sales object + my %salesnum_amount; # salesnum => credit amount + my %pkgnum_pkg; # pkgnum => FS::cust_pkg + my %salesnum_pkgnums; # salesnum => [ pkgnum, ... ] + + my @items = qsearch('cust_bill_pkg', { invnum => $cust_bill->invnum, + pkgnum => { op => '>', value => '0' } + }); + + foreach my $cust_bill_pkg (@items) { + my $pkgnum = $cust_bill_pkg->pkgnum; + my $cust_pkg = $pkgnum_pkg{$pkgnum} ||= $cust_bill_pkg->cust_pkg; + + my $salesnum = $cust_pkg->salesnum; + $salesnum ||= $cust_main->salesnum + if $self->option('cust_main_sales'); + my $sales = $salesnum_sales{$salesnum} + ||= FS::sales->by_key($salesnum); + + next if !$sales; #no sales person, no credit + + my $amount = $self->_calc_credit($cust_bill_pkg, $sales); + + if ($amount > 0) { + $salesnum_amount{$salesnum} ||= 0; + $salesnum_amount{$salesnum} += $amount; + push @{ $salesnum_pkgnums{$salesnum} ||= [] }, $pkgnum; + } + } + + foreach my $salesnum (keys %salesnum_amount) { + my $amount = sprintf('%.2f', $salesnum_amount{$salesnum}); + next if $amount < 0.005; + + my $sales = $salesnum_sales{$salesnum}; + + my $sales_cust_main = $sales->sales_cust_main; + die "No customer record for sales person ". $sales->salesperson + unless $sales->sales_custnum; + + my $reasonnum = $self->option('reasonnum'); + + my $desc = 'from invoice #'. $cust_bill->display_invnum . + ' ('. time2str($date_format, $cust_bill->_date) . ')'; + # could also show custnum and pkgnums here? + my $error = $sales_cust_main->credit( + $amount, + \$reasonnum, + 'eventnum' => $cust_event->eventnum, + 'addlinfo' => $desc, + 'commission_salesnum' => $sales->salesnum, + ); + die "Error crediting customer ". $sales_cust_main->custnum. + " for sales commission: $error" + if $error; + } # foreach $salesnum + +} + +1; diff --git a/FS/FS/part_event/Action/bill_sales_credit_pkg_class.pm b/FS/FS/part_event/Action/bill_sales_credit_pkg_class.pm new file mode 100644 index 000000000..91442b9e4 --- /dev/null +++ b/FS/FS/part_event/Action/bill_sales_credit_pkg_class.pm @@ -0,0 +1,11 @@ +package FS::part_event::Action::bill_sales_credit_pkg_class; + +use base qw( FS::part_event::Action::Mixin::pkg_sales_credit + FS::part_event::Action::Mixin::credit_bill + FS::part_event::Action::Mixin::credit_sales_pkg_class + FS::part_event::Action::bill_sales_credit + ); + +sub description { "Credit the sales person based on their commission percentage for the package's class"; } + +1; diff --git a/FS/FS/part_event/Action/pkg_agent_credit.pm b/FS/FS/part_event/Action/pkg_agent_credit.pm index 494c40e3f..65f8c27d6 100644 --- a/FS/FS/part_event/Action/pkg_agent_credit.pm +++ b/FS/FS/part_event/Action/pkg_agent_credit.pm @@ -1,7 +1,8 @@ package FS::part_event::Action::pkg_agent_credit; use strict; -use base qw( FS::part_event::Action::pkg_referral_credit ); +use base qw( FS::part_event::Action::Mixin::credit_flat + FS::part_event::Action ); sub description { 'Credit the agent a specific amount'; } @@ -18,7 +19,7 @@ sub do_action { my $agent_cust_main = $agent->agent_cust_main; #? or return "No customer record for agent ". $agent->agent; - my $amount = $self->_calc_credit($cust_pkg); + my $amount = $self->_calc_credit($cust_pkg, $agent); return '' unless $amount > 0; my $reasonnum = $self->option('reasonnum'); diff --git a/FS/FS/part_event/Action/pkg_agent_credit_pkg_class.pm b/FS/FS/part_event/Action/pkg_agent_credit_pkg_class.pm index 3dcf668f9..92c155627 100644 --- a/FS/FS/part_event/Action/pkg_agent_credit_pkg_class.pm +++ b/FS/FS/part_event/Action/pkg_agent_credit_pkg_class.pm @@ -1,7 +1,8 @@ package FS::part_event::Action::pkg_agent_credit_pkg_class; use strict; -use base qw( FS::part_event::Action::Mixin::credit_agent_pkg_class +use base qw( FS::part_event::Action::Mixin::credit_pkg + FS::part_event::Action::Mixin::credit_agent_pkg_class FS::part_event::Action::pkg_agent_credit ); sub description { 'Credit the agent an amount based on their commission percentage for the referred package class'; } diff --git a/FS/FS/part_event/Action/pkg_employee_credit.pm b/FS/FS/part_event/Action/pkg_employee_credit.pm index 64dd8b2c5..6cbe9bc4e 100644 --- a/FS/FS/part_event/Action/pkg_employee_credit.pm +++ b/FS/FS/part_event/Action/pkg_employee_credit.pm @@ -1,7 +1,8 @@ package FS::part_event::Action::pkg_employee_credit; use strict; -use base qw( FS::part_event::Action::pkg_referral_credit ); +use base qw( FS::part_event::Action::Mixin::credit_flat + FS::part_event::Action ); sub description { 'Credit the ordering employee a specific amount'; } @@ -18,7 +19,7 @@ sub do_action { my $employee_cust_main = $employee->user_cust_main; #? or return "No customer record for employee ". $employee->username; - my $amount = $self->_calc_credit($cust_pkg); + my $amount = $self->_calc_credit($cust_pkg, $employee); return '' unless $amount > 0; my $reasonnum = $self->option('reasonnum'); diff --git a/FS/FS/part_event/Action/pkg_referral_credit.pm b/FS/FS/part_event/Action/pkg_referral_credit.pm index e7c92d650..9d7bbf8b3 100644 --- a/FS/FS/part_event/Action/pkg_referral_credit.pm +++ b/FS/FS/part_event/Action/pkg_referral_credit.pm @@ -1,7 +1,8 @@ package FS::part_event::Action::pkg_referral_credit; use strict; -use base qw( FS::part_event::Action ); +use base qw( FS::part_event::Action::Mixin::credit_flat + FS::part_event::Action ); sub description { 'Credit the referring customer a specific amount'; } @@ -9,19 +10,6 @@ sub eventtable_hashref { { 'cust_pkg' => 1 }; } -sub option_fields { - ( - 'reasonnum' => { 'label' => 'Credit reason', - 'type' => 'select-reason', - 'reason_class' => 'R', - }, - 'amount' => { 'label' => 'Credit amount', - 'type' => 'money', - }, - ); - -} - sub do_action { my( $self, $cust_pkg, $cust_event ) = @_; @@ -35,7 +23,7 @@ sub do_action { return 'Referring customer is cancelled' if $referring_cust_main->status eq 'cancelled'; - my $amount = $self->_calc_credit($cust_pkg); + my $amount = $self->_calc_credit($cust_pkg, $referring_cust_main); return '' unless $amount > 0; my $reasonnum = $self->option('reasonnum'); @@ -53,10 +41,4 @@ sub do_action { } -sub _calc_credit { - my( $self, $cust_pkg ) = @_; - - $self->option('amount'); -} - 1; diff --git a/FS/FS/part_event/Action/pkg_sales_credit.pm b/FS/FS/part_event/Action/pkg_sales_credit.pm index e7551cda9..3c569cada 100644 --- a/FS/FS/part_event/Action/pkg_sales_credit.pm +++ b/FS/FS/part_event/Action/pkg_sales_credit.pm @@ -1,12 +1,15 @@ package FS::part_event::Action::pkg_sales_credit; -use base qw( FS::part_event::Action::Mixin::pkg_sales_credit - FS::part_event::Action::pkg_referral_credit ); +use base qw( FS::part_event::Action::Mixin::credit_flat + FS::part_event::Action ); use strict; sub description { 'Credit the sales person a specific amount'; } -#a little false laziness w/pkg_referral_credit +sub eventtable_hashref { + { 'cust_pkg' => 1 }; +} + sub do_action { my( $self, $cust_pkg, $cust_event ) = @_; @@ -24,7 +27,7 @@ sub do_action { my $sales_cust_main = $sales->sales_cust_main; #? or return "No customer record for sales person ". $sales->salesperson; - my $amount = $self->_calc_credit($cust_pkg); + my $amount = $self->_calc_credit($cust_pkg, $sales); return '' unless $amount > 0; my $reasonnum = $self->option('reasonnum'); diff --git a/FS/FS/part_event/Action/pkg_sales_credit_pkg.pm b/FS/FS/part_event/Action/pkg_sales_credit_pkg.pm index 9b13cd872..bd165f1c8 100644 --- a/FS/FS/part_event/Action/pkg_sales_credit_pkg.pm +++ b/FS/FS/part_event/Action/pkg_sales_credit_pkg.pm @@ -1,4 +1,6 @@ package FS::part_event::Action::pkg_sales_credit_pkg; + +# yes, they must be in this order use base qw( FS::part_event::Action::Mixin::pkg_sales_credit FS::part_event::Action::Mixin::credit_pkg FS::part_event::Action::pkg_sales_credit ); diff --git a/FS/FS/part_event/Action/pkg_sales_credit_pkg_class.pm b/FS/FS/part_event/Action/pkg_sales_credit_pkg_class.pm index c69c004ba..53ffc6cff 100644 --- a/FS/FS/part_event/Action/pkg_sales_credit_pkg_class.pm +++ b/FS/FS/part_event/Action/pkg_sales_credit_pkg_class.pm @@ -1,8 +1,10 @@ package FS::part_event::Action::pkg_sales_credit_pkg_class; use base qw( FS::part_event::Action::Mixin::pkg_sales_credit + FS::part_event::Action::Mixin::credit_pkg FS::part_event::Action::Mixin::credit_sales_pkg_class - FS::part_event::Action::pkg_sales_credit ); + FS::part_event::Action::pkg_sales_credit + ); sub description { "Credit the package sales person an amount based on their commission percentage for the package's class"; } diff --git a/FS/FS/part_export/send_email.pm b/FS/FS/part_export/send_email.pm index 41f04093e..3e5142260 100644 --- a/FS/FS/part_export/send_email.pm +++ b/FS/FS/part_export/send_email.pm @@ -20,7 +20,8 @@ my %template_select = ( %templates = (0 => '', map { $_->msgnum, $_->msgname } qsearch({ table => 'msg_template', - hashref => { disabled => 1 }, + hashref => { disabled => { 'op' => '!=', + 'value' => 1 }}, order_by => 'ORDER BY msgnum ASC' }) ); diff --git a/FS/FS/pay_batch/RBC.pm b/FS/FS/pay_batch/RBC.pm index 4b11fdb89..a5c468367 100644 --- a/FS/FS/pay_batch/RBC.pm +++ b/FS/FS/pay_batch/RBC.pm @@ -108,7 +108,7 @@ $name = 'RBC'; sprintf("%3s",$trans_code). sprintf("%10s",$client_num). ' '. - sprintf("%-19s", $cust_pay_batch->paybatchnum). + sprintf("%-19s", $cust_pay_batch->cust_main->custnum). '00'. sprintf("%04s", $bankno). sprintf("%05s", $branch). diff --git a/FS/FS/quotation_pkg.pm b/FS/FS/quotation_pkg.pm index 79cce80fa..33c761ef6 100644 --- a/FS/FS/quotation_pkg.pm +++ b/FS/FS/quotation_pkg.pm @@ -164,6 +164,26 @@ sub recur { sprintf('%.2f', $recur); } +sub unitsetup { + my $self = shift; + return '0.00' if $self->waive_setup eq 'Y' || $self->{'_NO_SETUP_KLUDGE'}; + my $part_pkg = $self->part_pkg; + my $setup = $part_pkg->option('setup_fee'); + + #XXX discounts + sprintf('%.2f', $setup); +} + +sub unitrecur { + my $self = shift; + return '0.00' if $self->{'_NO_RECUR_KLUDGE'}; + my $part_pkg = $self->part_pkg; + my $recur = $part_pkg->can('base_recur') ? $part_pkg->base_recur + : $part_pkg->option('recur_fee'); + #XXX discounts + sprintf('%.2f', $recur); +} + =item part_pkg_currency_option OPTIONNAME Returns a two item list consisting of the currency of this quotation's customer diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index e6b20db8f..f28989a9b 100644 --- a/FS/FS/reason.pm +++ b/FS/FS/reason.pm @@ -56,6 +56,10 @@ suspensions but not others. whether to bill the unsuspend package immediately ('') or to wait until the customer's next invoice ('Y'). +=item unused_credit - 'Y' or ''. For suspension reasons only (for now). +If enabled, the customer will be credited for their remaining time on +suspension. + =back =head1 METHODS @@ -109,7 +113,6 @@ sub check { || $self->ut_number('reason_type') || $self->ut_foreign_key('reason_type', 'reason_type', 'typenum') || $self->ut_text('reason') - || $self->ut_flag('disabled') ; return $error if $error; @@ -117,11 +120,13 @@ sub check { $error = $self->ut_numbern('unsuspend_pkgpart') || $self->ut_foreign_keyn('unsuspend_pkgpart', 'part_pkg', 'pkgpart') || $self->ut_flag('unsuspend_hold') + || $self->ut_flag('unused_credit') ; return $error if $error; } else { - $self->set('unsuspend_pkgpart' => ''); - $self->set('unsuspend_hold' => ''); + foreach (qw(unsuspend_pkgpart unsuspend_hold unused_credit)) { + $self->set($_ => ''); + } } $self->SUPER::check; @@ -178,8 +183,6 @@ sub new_or_existing { =head1 BUGS -Here by termintes. Don't use on wooden computers. - =head1 SEE ALSO L<FS::Record>, schema.html from the base documentation. diff --git a/FS/FS/router.pm b/FS/FS/router.pm index 4011bb097..c0c93dd32 100755 --- a/FS/FS/router.pm +++ b/FS/FS/router.pm @@ -200,6 +200,13 @@ sub delete { Returns a list of FS::addr_block objects (address blocks) associated with this object. +=cut + +sub addr_block { + my $self = shift; + qsearch('addr_block', { routernum => $self->routernum }); +} + =item auto_addr_block Returns a list of address blocks on which auto-assignment of IP addresses diff --git a/FS/FS/svc_circuit.pm b/FS/FS/svc_circuit.pm new file mode 100644 index 000000000..f705c68f4 --- /dev/null +++ b/FS/FS/svc_circuit.pm @@ -0,0 +1,230 @@ +package FS::svc_circuit; + +use strict; +use base qw( + FS::svc_IP_Mixin + FS::MAC_Mixin + FS::svc_Common +); +use FS::Record qw( qsearch qsearchs ); +use FS::circuit_provider; +use FS::circuit_type; +use FS::circuit_termination; + +=head1 NAME + +FS::svc_circuit - Object methods for svc_circuit records + +=head1 SYNOPSIS + + use FS::svc_circuit; + + $record = new FS::svc_circuit \%hash; + $record = new FS::svc_circuit { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::svc_circuit object represents a telecom circuit service (other than +an analog phone line, which is svc_phone, or a DSL Internet connection, +which is svc_dsl). FS::svc_circuit inherits from FS::svc_IP_Mixin, +FS::MAC_Mixin, and FS::svc_Common. The following fields are currently +supported: + +=over 4 + +=item svcnum - primary key; see also L<FS::cust_svc> + +=item typenum - circuit type (such as DS1, DS1-PRI, DS3, OC3, etc.); foreign +key to L<FS::circuit_type>. + +=item providernum - circuit provider (telco); foreign key to +L<FS::circuit_provider>. + +=item termnum - circuit termination type; foreign key to +L<FS::circuit_termination> + +=item circuit_id - circuit ID string defined by the provider + +=item desired_due_date - the requested date for completion of the circuit +order + +=item due_date - the provider's committed date for completion of the circuit +order + +=item vendor_order_id - the provider's order number + +=item vendor_qual_id - the qualification number, if a qualification was +performed + +=item vendor_order_type - + +=item vendor_order_status - the order status: ACCEPTED, PENDING, COMPLETED, +etc. + +=item endpoint_ip_addr - the IP address of the endpoint equipment, if any. +This will be validated as an IP address but not assigned from managed address +space or checked for uniqueness. + +=item endpoint_mac_addr - the MAC address of the endpoint. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new circuit service. To add the record to the database, see +L<"insert">. + +=cut + +sub table { 'svc_circuit'; } + +sub table_info { + my %dis = ( disable_default => 1, disable_fixed => 1, + disabled_inventory => 1, disable_select => 1 ); + + tie my %fields, 'Tie::IxHash', ( + 'svcnum' => 'Service', + 'providernum' => { + label => 'Provider', + type => 'select', + select_table => 'circuit_provider', + select_key => 'providernum', + select_label => 'provider', + disable_inventory => 1, + }, + 'typenum' => { + label => 'Circuit type', + type => 'select', + select_table => 'circuit_type', + select_key => 'typenum', + select_label => 'typename', + disable_inventory => 1, + }, + 'termnum' => { + label => 'Termination type', + type => 'select', + select_table => 'circuit_termination', + select_key => 'termnum', + select_label => 'termination', + disable_inventory => 1, + }, + 'circuit_id' => { label => 'Circuit ID', %dis }, + 'desired_due_date' => { label => 'Desired due date', + %dis + }, + 'due_date' => { label => 'Due date', + %dis + }, + 'vendor_order_id' => { label => 'Vendor order ID', %dis }, + 'vendor_qual_id' => { label => 'Vendor qualification ID', %dis }, + 'vendor_order_type' => { + label => 'Vendor order type', + disable_inventory => 1 + }, # should be a select? + 'vendor_order_status' => { + label => 'Vendor order status', + disable_inventory => 1 + }, # should also be a select? + 'endpoint_ip_addr' => { + label => 'Endpoint IP address', + }, + 'endpoint_mac_addr' => { + label => 'Endpoint MAC address', + type => 'input-mac_addr', + disable_inventory => 1, + }, + ); + return { + 'name' => 'Circuit', + 'name_plural' => 'Circuits', + 'longname_plural' => 'Voice and data circuit services', + 'display_weight' => 72, + 'cancel_weight' => 85, # after svc_phone + 'fields' => \%fields, + }; +} + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=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. + +=item check + +Checks all fields to make sure this is a valid 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 $mac_addr = uc($self->get('endpoint_mac_addr')); + $mac_addr =~ s/[\W_]//g; + $self->set('endpoint_mac_addr', $mac_addr); + + my $error = + $self->ut_numbern('svcnum') + || $self->ut_number('typenum') + || $self->ut_number('providernum') + || $self->ut_text('circuit_id') + || $self->ut_numbern('desired_due_date') + || $self->ut_numbern('due_date') + || $self->ut_textn('vendor_order_id') + || $self->ut_textn('vendor_qual_id') + || $self->ut_textn('vendor_order_type') + || $self->ut_textn('vendor_order_status') + || $self->ut_ipn('endpoint_ip_addr') + || $self->ut_textn('endpoint_mac_addr') + ; + + # no canonical values yet for vendor_order_status or _type + + return $error if $error; + + $self->SUPER::check; +} + +=item label + +Returns the circuit ID. + +=cut + +sub label { + my $self = shift; + $self->get('circuit_id'); +} + +=back + +=head1 SEE ALSO + +L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/svc_phone.pm b/FS/FS/svc_phone.pm index 4ca8d82fa..bd35cbac4 100644 --- a/FS/FS/svc_phone.pm +++ b/FS/FS/svc_phone.pm @@ -189,6 +189,14 @@ sub table_info { select_label => 'domain', disable_inventory => 1, }, + 'circuit_svcnum' => { label => 'Circuit', + type => 'select', + select_table => 'svc_domain', + select_key => 'svcnum', + select_label => 'circuit_label', + disable_inventory => 1, + }, + 'sms_carrierid' => { label => 'SMS Carrier', type => 'select', select_table => 'cdr_carrier', @@ -711,6 +719,8 @@ sub radius_groups { =item sms_cdr_carrier +Returns the L<FS::cdr_carrier> assigned as the SMS carrier for this phone. + =cut sub sms_cdr_carrier { @@ -721,6 +731,8 @@ sub sms_cdr_carrier { =item sms_carriername +Returns the name of the SMS carrier, or an empty string if there isn't one. + =cut sub sms_carriername { @@ -729,6 +741,29 @@ sub sms_carriername { $cdr_carrier->carriername; } +=item svc_circuit + +Returns the L<FS::svc_circuit> assigned as the trunk for this phone line. + +=item circuit_label + +Returns the label of the circuit (the part_svc label followed by the +circuit ID), or an empty string if there isn't one. + +=cut + +sub svc_circuit { + my $self = shift; + my $svcnum = $self->get('circuit_svcnum') or return ''; + return FS::svc_circuit->by_key($svcnum); +} + +sub circuit_label { + my $self = shift; + my $svc_circuit = $self->svc_circuit or return ''; + return join(' ', $svc_circuit->part_svc->svc, $svc_circuit->circuit_id); +} + =item phone_device Returns any FS::phone_device records associated with this service. diff --git a/FS/MANIFEST b/FS/MANIFEST index 79a7dc523..105447c6b 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -821,3 +821,11 @@ FS/deploy_zone_vertex.pm t/deploy_zone_vertex.t FS/tax_status.pm t/tax_status.t +FS/circuit_type.pm +t/circuit_type.t +FS/circuit_provider.pm +t/circuit_provider.t +FS/circuit_termination.pm +t/circuit_termination.t +FS/svc_circuit.pm +t/svc_circuit.t diff --git a/FS/t/circuit_provider.t b/FS/t/circuit_provider.t new file mode 100644 index 000000000..753a156d5 --- /dev/null +++ b/FS/t/circuit_provider.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::circuit_provider; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/circuit_termination.t b/FS/t/circuit_termination.t new file mode 100644 index 000000000..6f5127195 --- /dev/null +++ b/FS/t/circuit_termination.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::circuit_termination; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/circuit_type.t b/FS/t/circuit_type.t new file mode 100644 index 000000000..dbb6e0ac5 --- /dev/null +++ b/FS/t/circuit_type.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::circuit_type; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_circuit.t b/FS/t/svc_circuit.t new file mode 100644 index 000000000..7fefcc04b --- /dev/null +++ b/FS/t/svc_circuit.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_circuit; +$loaded=1; +print "ok 1\n"; |