diff options
Diffstat (limited to 'FS')
84 files changed, 5438 insertions, 1407 deletions
@@ -126,6 +126,12 @@ L<FS::registrar> - Domain registrar class L<FS::svc_forward> - Mail forwarding class +L<FS::svc_mailinglist> - (Customer) Mailing list class + +L<FS::mailinglist> - Mailing list class + +L<FS::mailinglistmember> - Mailing list member class + L<FS::svc_www> - Web virtual host class. L<FS::svc_broadband> - DSL, wireless and other broadband class. @@ -346,8 +352,12 @@ L<FS::h_svc_external> - Historical externally tracked service objects L<FS::h_svc_forward> - Historical mail forwarding alias objects +L<FS::h_svc_mailinglist> - Historical mailing list objects + L<FS::h_svc_phone> - Historical phone number objects +L<FS::h_svc_pbx> - Historical PBX objects + L<FS::h_svc_www> - Historical web virtual host objects =head2 Remote API modules diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 46e740cc1..03b98763a 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -94,6 +94,7 @@ tie my %rights, 'Tie::IxHash', 'View customer', #'View Customer | View tickets', 'Edit customer', + 'Edit referring customer', 'View customer history', 'Cancel customer', 'Complimentary customer', #aka users-allow_comp diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index dbc355205..50dc89c73 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -1,5 +1,6 @@ package FS::ClientAPI::MyAccount; +use 5.008; #require 5.8+ for Time::Local 1.05+ use strict; use vars qw( $cache $DEBUG $me ); use subs qw( _cache _provision ); @@ -8,6 +9,7 @@ use Digest::MD5 qw(md5_hex); use Date::Format; use Business::CreditCard; use Time::Duration; +use Time::Local qw(timelocal_nocheck); use FS::UI::Web::small_custview qw(small_custview); #less doh use FS::UI::Web; use FS::UI::bytecount qw( display_bytecount ); @@ -29,18 +31,11 @@ use FS::cust_pkg; use FS::payby; use FS::acct_rt_transaction; use HTML::Entities; +use FS::TicketSystem; -$DEBUG = 2; +$DEBUG = 0; $me = '[FS::ClientAPI::MyAccount]'; -#false laziness with FS::cust_main -BEGIN { - eval "use Time::Local;"; - die "Time::Local minimum version 1.05 required with Perl versions before 5.6" - if $] < 5.006 && !defined($Time::Local::VERSION); - eval "use Time::Local qw(timelocal_nocheck);"; -} - use vars qw( @cust_main_editable_fields ); @cust_main_editable_fields = qw( first last company address1 address2 city @@ -100,7 +95,20 @@ sub skin_info { ( map { $_ => scalar( $conf->config($_, $agentnum) ) } qw( company_name ) ), ( map { $_ => scalar( $conf->config("selfservice-$_", $agentnum ) ) } - qw( body_bgcolor box_bgcolor) ), + qw( body_bgcolor box_bgcolor + text_color link_color vlink_color hlink_color alink_color + font title_color title_align title_size menu_bgcolor menu_fontsize + ) + ), + ( map { $_ => $conf->exists("selfservice-$_", $agentnum ) } + qw( menu_skipblanks menu_skipheadings menu_nounderline ) + ), + ( map { $_ => scalar($conf->config_binary("selfservice-$_", $agentnum)) } + qw( title_left_image title_right_image + menu_top_image menu_body_image menu_bottom_image + ) + ), + 'logo' => scalar($conf->config_binary('logo.png', $agentnum )), ( map { $_ => join("\n", $conf->config("selfservice-$_", $agentnum ) ) } qw( head body_header body_footer company_address ) ), }; @@ -489,6 +497,8 @@ sub payment_info { 'show_ss' => $conf->exists('show_ss'), 'show_stateid' => $conf->exists('show_stateid'), 'show_paystate' => $conf->exists('show_bankstate'), + + 'save_unchecked' => $conf->exists('selfservice-save_unchecked'), }; } @@ -571,6 +581,11 @@ sub process_payment { my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) or return { 'error' => "unknown custnum $custnum" }; + $p->{'amount'} =~ /^\s*(\d+(\.\d{2})?)\s*$/ + or return { 'error' => gettext('illegal_amount') }; + my $amount = $1; + return { error => 'Amount must be greater than 0' } unless $amount > 0; + $p->{'payname'} =~ /^([\w \,\.\-\']+)$/ or return { 'error' => gettext('illegal_name'). " payname: ". $p->{'payname'} }; my $payname = $1; @@ -641,7 +656,7 @@ sub process_payment { 'CHEK' => [ qw( ss paytype paystate stateid stateid_state payip ) ], ); - my $error = $cust_main->realtime_bop( $FS::payby::payby2bop{$payby}, $p->{'amount'}, + my $error = $cust_main->realtime_bop( $FS::payby::payby2bop{$payby}, $amount, 'quiet' => 1, 'payinfo' => $payinfo, 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01', @@ -671,8 +686,21 @@ sub process_payment { $new->set( 'payinfo' => $payinfo ); $new->set( 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01' ); my $error = $new->replace($cust_main); - return { 'error' => $error } if $error; - $cust_main = $new; + if ( $error ) { + #no, this causes customers to process their payments again + #return { 'error' => $error }; + #XXX just warn verosely for now so i can figure out how these happen in + # the first place, eventually should redirect them to the "change + #address" page but indicate the payment did process?? + delete($p->{'payinfo'}); #don't want to log this! + warn "WARNING: error changing customer info when processing payment (not returning to customer as a processing error): $error\n". + "NEW: ". Dumper($new)."\n". + "OLD: ". Dumper($cust_main)."\n". + "PACKET: ". Dumper($p)."\n"; + #} else { + #not needed... + #$cust_main = $new; + } } return { 'error' => '' }; @@ -1636,6 +1664,43 @@ sub myaccount_passwd { } +sub create_ticket { + my $p = shift; + my($context, $session, $custnum) = _custoragent_session_custnum($p); + return { 'error' => $session } if $context eq 'error'; + + warn "$me create_ticket: initializing ticket system\n" if $DEBUG; + FS::TicketSystem->init(); + + my $conf = new FS::Conf; + my $queue = $p->{'queue'} + || $conf->config('ticket_system-selfservice_queueid') + || $conf->config('ticket_system-default_queueid'); + + warn "$me create_ticket: creating ticket\n" if $DEBUG; + my $err_or_ticket = FS::TicketSystem->create_ticket( + '', #create RT session based on FS CurrentUser (fs_selfservice) + 'queue' => $queue, + 'custnum' => $custnum, + 'svcnum' => $session->{'svcnum'}, + map { $_ => $p->{$_} } qw( requestor cc subject message mime_type ) + ); + + if ( ref($err_or_ticket) ) { + warn "$me create_ticket: sucessful: ". $err_or_ticket->id. "\n" + if $DEBUG; + return { 'error' => '', + 'ticket_id' => $err_or_ticket->id, + }; + } else { + warn "$me create_ticket: unsucessful: $err_or_ticket\n" + if $DEBUG; + return { 'error' => $err_or_ticket }; + } + + +} + #-- sub _custoragent_session_custnum { diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index f2960cd77..45d11c45c 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -564,6 +564,14 @@ worry that config_items is freeside-specific and icky. logo.eps ); +#Billing (81 items) +#Invoicing (50 items) +#UI (69 items) +#Self-service (29 items) +#... +#Unclassified (77 items) + + @config_items = map { new FS::ConfItem $_ } ( { @@ -721,6 +729,7 @@ worry that config_items is freeside-specific and icky. 'type' => 'select', 'select_hash' => [ '%m/%d/%Y' => 'MM/DD/YYYY', + '%d/%m/%Y' => 'DD/MM/YYYY', '%Y/%m/%d' => 'YYYY/MM/DD', ], }, @@ -814,35 +823,35 @@ worry that config_items is freeside-specific and icky. { 'key' => 'emailinvoiceonly', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Disables postal mail invoices', 'type' => 'checkbox', }, { 'key' => 'disablepostalinvoicedefault', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Disables postal mail invoices as the default option in the UI. Be careful not to setup customers which are not sent invoices. See <a href ="#emailinvoiceauto">emailinvoiceauto</a>.', 'type' => 'checkbox', }, { 'key' => 'emailinvoiceauto', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Automatically adds new accounts to the email invoice list', 'type' => 'checkbox', }, { 'key' => 'emailinvoiceautoalways', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Automatically adds new accounts to the email invoice list even when the list contains email addresses', 'type' => 'checkbox', }, { 'key' => 'emailinvoice-apostrophe', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Allows the apostrophe (single quote) character in the email addresses in the email invoice list.', 'type' => 'checkbox', }, @@ -892,7 +901,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_subject', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Subject: header on email invoices. Defaults to "Invoice". The following substitutions are available: $name, $name_short, $invoice_number, and $invoice_date.', 'type' => 'text', 'per_agent' => 1, @@ -900,21 +909,21 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_usesummary', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Indicates that html and latex invoices should be in summary style and make use of invoice_latexsummary.', 'type' => 'checkbox', }, { 'key' => 'invoice_template', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Text template file for invoices. Used if no invoice_html template is defined, and also seen by users using non-HTML capable mail clients. See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration#Plaintext_invoice_templates">billing documentation</a> for details.', 'type' => 'textarea', }, { 'key' => 'invoice_html', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Optional HTML template for invoices. See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration#HTML_invoice_templates">billing documentation</a> for details.', 'type' => 'textarea', @@ -922,7 +931,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_htmlnotes', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Notes section for HTML invoices. Defaults to the same data in invoice_latexnotes if not specified.', 'type' => 'textarea', 'per_agent' => 1, @@ -930,7 +939,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_htmlfooter', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Footer for HTML invoices. Defaults to the same data in invoice_latexfooter if not specified.', 'type' => 'textarea', 'per_agent' => 1, @@ -938,7 +947,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_htmlsummary', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Summary initial page for HTML invoices.', 'type' => 'textarea', 'per_agent' => 1, @@ -946,21 +955,21 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_htmlreturnaddress', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Return address for HTML invoices. Defaults to the same data in invoice_latexreturnaddress if not specified.', 'type' => 'textarea', }, { 'key' => 'invoice_latex', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Optional LaTeX template for typeset PostScript invoices. See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration#Typeset_.28LaTeX.29_invoice_templates">billing documentation</a> for details.', 'type' => 'textarea', }, { 'key' => 'invoice_latexnotes', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Notes section for LaTeX typeset PostScript invoices.', 'type' => 'textarea', 'per_agent' => 1, @@ -968,7 +977,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_latexfooter', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Footer for LaTeX typeset PostScript invoices.', 'type' => 'textarea', 'per_agent' => 1, @@ -976,7 +985,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_latexsummary', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Summary initial page for LaTeX typeset PostScript invoices.', 'type' => 'textarea', 'per_agent' => 1, @@ -984,7 +993,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_latexcoupon', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Remittance coupon for LaTeX typeset PostScript invoices.', 'type' => 'textarea', 'per_agent' => 1, @@ -992,14 +1001,14 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_latexreturnaddress', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Return address for LaTeX typeset PostScript invoices.', 'type' => 'textarea', }, { 'key' => 'invoice_latexsmallfooter', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Optional small footer for multi-page LaTeX typeset PostScript invoices.', 'type' => 'textarea', 'per_agent' => 1, @@ -1007,14 +1016,14 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_email_pdf', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Send PDF invoice as an attachment to emailed invoices. By default, includes the plain text invoice as the email body, unless invoice_email_pdf_note is set.', 'type' => 'checkbox' }, { 'key' => 'invoice_email_pdf_note', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'If defined, this text will replace the default plain text invoice as the body of emailed PDF invoices.', 'type' => 'textarea' }, @@ -1022,7 +1031,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_default_terms', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Optional default invoice term, used to calculate a due date printed on invoices.', 'type' => 'select', 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 10', 'Net 15', 'Net 20', 'Net 30', 'Net 45', 'Net 60' ], @@ -1030,35 +1039,35 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_show_prior_due_date', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Show previous invoice due dates when showing prior balances. Default is to show invoice date.', 'type' => 'checkbox', }, { 'key' => 'invoice_include_aging', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Show an aging line after the prior balance section. Only valud when invoice_sections is enabled.', 'type' => 'checkbox', }, { 'key' => 'invoice_sections', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Split invoice into sections and label according to package category when enabled.', 'type' => 'checkbox', }, { 'key' => 'usage_class_as_a_section', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Split usage into sections and label according to usage class name when enabled. Only valid when invoice_sections is enabled.', 'type' => 'checkbox', }, { 'key' => 'svc_phone_sections', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Create a section for each svc_phone when enabled. Only valid when invoice_sections is enabled.', 'type' => 'checkbox', }, @@ -1072,7 +1081,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'separate_usage', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Split the rated call usage into a separate line from the recurring charges.', 'type' => 'checkbox', }, @@ -1103,6 +1112,13 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'trigger_export_insert_on_payment', + 'section' => 'billing', + 'description' => 'Enable exports on payment application.', + 'type' => 'checkbox', + }, + + { 'key' => 'lpr', 'section' => 'required', 'description' => 'Print command for paper invoices, for example `lpr -h\'', @@ -1257,6 +1273,32 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'smtp-username', + 'section' => '', + 'description' => 'Optional SMTP username for Freeside\'s outgoing mail', + 'type' => 'text', + }, + + { + 'key' => 'smtp-password', + 'section' => '', + 'description' => 'Optional SMTP password for Freeside\'s outgoing mail', + 'type' => 'text', + }, + + { + 'key' => 'smtp-encryption', + 'section' => '', + 'description' => 'Optional SMTP encryption method. The STARTTLS methods require smtp-username and smtp-password to be set.', + 'type' => 'select', + 'select_hash' => [ '25' => 'None (port 25)', + '25-starttls' => 'STARTTLS (port 25)', + '587-starttls' => 'STARTTLS / submission (port 587)', + '465-tls' => 'SMTPS (SSL) (port 465)', + ], + }, + + { 'key' => 'soadefaultttl', 'section' => 'BIND', 'description' => 'SOA default TTL for new domains.', @@ -1470,15 +1512,22 @@ worry that config_items is freeside-specific and icky. { 'key' => 'signup_server-payby', - 'section' => '', + 'section' => 'self-service', 'description' => 'Acceptable payment types for the signup server', 'type' => 'selectmultiple', 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB PREPAY BILL COMP) ], }, { + 'key' => 'selfservice-save_unchecked', + 'section' => 'self-service', + 'description' => 'In self-service, uncheck "Remember information" checkboxes by default (normally, they are checked by default).', + 'type' => 'checkbox', + }, + + { 'key' => 'signup_server-default_agentnum', - 'section' => '', + 'section' => 'self-service', 'description' => 'Default agent for the signup server', 'type' => 'select-sub', 'options_sub' => sub { require FS::Record; @@ -1497,7 +1546,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'signup_server-default_refnum', - 'section' => '', + 'section' => 'self-service', 'description' => 'Default advertising source for the signup server', 'type' => 'select-sub', 'options_sub' => sub { require FS::Record; @@ -1517,21 +1566,21 @@ worry that config_items is freeside-specific and icky. { 'key' => 'signup_server-default_pkgpart', - 'section' => '', + 'section' => 'self-service', 'description' => 'Default package for the signup server', 'type' => 'select-part_pkg', }, { 'key' => 'signup_server-default_svcpart', - 'section' => '', + 'section' => 'self-service', 'description' => 'Default service definition for the signup server - only necessary for services that trigger special provisioning widgets (such as DID provisioning).', 'type' => 'select-part_svc', }, { 'key' => 'signup_server-mac_addr_svcparts', - 'section' => '', + 'section' => 'self-service', 'description' => 'Service definitions which can receive mac addresses (current mapped to username for svc_acct).', 'type' => 'select-part_svc', 'multiple' => 1, @@ -1539,14 +1588,14 @@ worry that config_items is freeside-specific and icky. { 'key' => 'signup_server-nomadix', - 'section' => '', + 'section' => 'self-service', 'description' => 'Signup page Nomadix integration', 'type' => 'checkbox', }, { 'key' => 'signup_server-service', - 'section' => '', + 'section' => 'self-service', 'description' => 'Service for the signup server - "Account (svc_acct)" is the default setting, or "Phone number (svc_phone)" for ITSP signup', 'type' => 'select', 'select_hash' => [ @@ -1557,7 +1606,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'selfservice_server-base_url', - 'section' => '', + 'section' => 'self-service', 'description' => 'Base URL for the self-service web interface - necessary for some widgets to find their way, including retrieval of non-US state information and phone number provisioning.', 'type' => 'text', }, @@ -1571,27 +1620,27 @@ worry that config_items is freeside-specific and icky. { 'key' => 'signup_server-realtime', - 'section' => '', + 'section' => 'self-service', 'description' => 'Run billing for signup server signups immediately, and do not provision accounts which subsequently have a balance.', 'type' => 'checkbox', }, { 'key' => 'signup_server-classnum2', - 'section' => '', + 'section' => 'self-service', 'description' => 'Package Class for first optional purchase', 'type' => 'select-pkg_class', }, { 'key' => 'signup_server-classnum3', - 'section' => '', + 'section' => 'self-service', 'description' => 'Package Class for second optional purchase', 'type' => 'select-pkg_class', }, { 'key' => 'backend-realtime', - 'section' => '', + 'section' => 'billing', 'description' => 'Run billing for backend signups immediately.', 'type' => 'checkbox', }, @@ -1788,7 +1837,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'svc_acct-notes', - 'section' => 'UI', + 'section' => 'deprecated', 'description' => 'Extra HTML to be displayed on the Account View screen.', 'type' => 'textarea', }, @@ -1798,7 +1847,7 @@ worry that config_items is freeside-specific and icky. 'section' => '', 'description' => 'RADIUS attribute for plain-text passwords.', 'type' => 'select', - 'select_enum' => [ 'Password', 'User-Password' ], + 'select_enum' => [ 'Password', 'User-Password', 'Cleartext-Password' ], }, { @@ -1926,7 +1975,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'cust_pkg-change_pkgpart-bill_now', 'section' => '', - 'description' => "When changing packages, bill the new package immediately. Useful for prepaid situations with RADIUS where an Expiration attribute base don the package must be present at all times.", + 'description' => "When changing packages, bill the new package immediately. Useful for prepaid situations with RADIUS where an Expiration attribute based on the package must be present at all times.", 'type' => 'checkbox', }, @@ -1954,21 +2003,21 @@ worry that config_items is freeside-specific and icky. { 'key' => 'selfservice_server-primary_only', - 'section' => '', + 'section' => 'self-service', 'description' => 'Only allow primary accounts to access self-service functionality.', 'type' => 'checkbox', }, { 'key' => 'selfservice_server-phone_login', - 'section' => '', + 'section' => 'self-service', 'description' => 'Allow login to self-service with phone number and PIN.', 'type' => 'checkbox', }, { 'key' => 'selfservice_server-single_domain', - 'section' => '', + 'section' => 'self-service', 'description' => 'If specified, only use this one domain for self-service access.', 'type' => 'text', }, @@ -2055,6 +2104,34 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'ticket_system-selfservice_queueid', + 'section' => '', + 'description' => 'Queue used when creating new customer tickets from self-service. Defautls to ticket_system-default_queueid if not specified.', + #false laziness w/above + 'type' => 'select-sub', + 'options_sub' => sub { + my $conf = new FS::Conf; + if ( $conf->config('ticket_system') ) { + eval "use FS::TicketSystem;"; + die $@ if $@; + FS::TicketSystem->queues(); + } else { + (); + } + }, + 'option_sub' => sub { + my $conf = new FS::Conf; + if ( $conf->config('ticket_system') ) { + eval "use FS::TicketSystem;"; + die $@ if $@; + FS::TicketSystem->queue(shift); + } else { + ''; + } + }, + }, + + { 'key' => 'ticket_system-priority_reverse', 'section' => '', 'description' => 'Enable this to consider lower numbered priorities more important. A bad habit we picked up somewhere. You probably want to avoid it and use the default.', @@ -2169,7 +2246,7 @@ worry that config_items is freeside-specific and icky. }, { 'key' => 'selfservice_server-cache_module', - 'section' => '', + 'section' => 'self-service', 'description' => 'Module used to store self-service session information. All modules handle any number of self-service servers. Cache::SharedMemoryCache is appropriate for a single database / single Freeside server. Cache::FileCache is useful for multiple databases on a single server, or when IPC::ShareLite is not available (i.e. FreeBSD).', # _Database stores session information in the database and is appropriate for multiple Freeside servers, but may be slower.', 'type' => 'select', 'select_enum' => [ 'Cache::SharedMemoryCache', 'Cache::FileCache', ], # '_Database' ], @@ -2184,7 +2261,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'cust_bill-ftpformat', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Enable FTP of raw invoice data - format.', 'type' => 'select', 'select_enum' => [ '', 'default', 'billco', ], @@ -2192,35 +2269,35 @@ worry that config_items is freeside-specific and icky. { 'key' => 'cust_bill-ftpserver', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Enable FTP of raw invoice data - server.', 'type' => 'text', }, { 'key' => 'cust_bill-ftpusername', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Enable FTP of raw invoice data - server.', 'type' => 'text', }, { 'key' => 'cust_bill-ftppassword', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Enable FTP of raw invoice data - server.', 'type' => 'text', }, { 'key' => 'cust_bill-ftpdir', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Enable FTP of raw invoice data - server.', 'type' => 'text', }, { 'key' => 'cust_bill-spoolformat', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Enable spooling of raw invoice data - format.', 'type' => 'select', 'select_enum' => [ '', 'default', 'billco', ], @@ -2228,7 +2305,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'cust_bill-spoolagent', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Enable per-agent spooling of raw invoice data.', 'type' => 'checkbox', }, @@ -2341,6 +2418,13 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'svc_forward-no_srcsvc', + 'section' => '', + 'description' => "Don't allow forwards from existing accounts, only arbitrary addresses. Useful when exporting to systems such as Communigate Pro which treat forwards in this fashion.", + 'type' => 'checkbox', + }, + + { 'key' => 'svc_forward-arbitrary_dst', 'section' => '', 'description' => "Allow forwards to point to arbitrary strings that don't necessarily look like email addresses. Only used when using forwards for weird, non-email things.", @@ -2363,28 +2447,28 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice-ship_address', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Include the shipping address on invoices.', 'type' => 'checkbox', }, { 'key' => 'invoice-unitprice', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Enable unit pricing on invoices.', 'type' => 'checkbox', }, { 'key' => 'invoice-smallernotes', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Display the notes section in a smaller font on invoices.', 'type' => 'checkbox', }, { 'key' => 'invoice-smallerfooter', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Display footers in a smaller font on invoices.', 'type' => 'checkbox', }, @@ -2637,7 +2721,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'logo.png', - 'section' => 'billing', #? + 'section' => 'UI', #'invoicing' ? 'description' => 'Company logo for HTML invoices and the backoffice interface, in PNG format. Suggested size somewhere near 92x62.', 'type' => 'image', 'per_agent' => 1, #XXX just view/logo.cgi, which is for the global @@ -2646,7 +2730,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'logo.eps', - 'section' => 'billing', #? + 'section' => 'invoicing', 'description' => 'Company logo for printed and PDF invoices, in EPS format.', 'type' => 'image', 'per_agent' => 1, #XXX as above, kinda @@ -2654,14 +2738,14 @@ worry that config_items is freeside-specific and icky. { 'key' => 'selfservice-ignore_quantity', - 'section' => '', + 'section' => 'self-service', 'description' => 'Ignores service quantity restrictions in self-service context. Strongly not recommended - just set your quantities correctly in the first place.', 'type' => 'checkbox', }, { 'key' => 'selfservice-session_timeout', - 'section' => '', + 'section' => 'self-service', 'description' => 'Self-service session timeout. Defaults to 1 hour.', 'type' => 'select', 'select_enum' => [ '1 hour', '2 hours', '4 hours', '8 hours', '1 day', '1 week', ], @@ -2778,7 +2862,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'signup_credit_type', - 'section' => 'billing', + 'section' => 'billing', #self-service? 'description' => 'The group to use for new, automatically generated credit reasons resulting from signup and self-service declines.', 'type' => 'select-sub', 'options_sub' => sub { require FS::Record; @@ -2825,14 +2909,14 @@ worry that config_items is freeside-specific and icky. { 'key' => 'disable_previous_balance', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Disable inclusion of previous balancem payment, and credit lines on invoices', 'type' => 'checkbox', }, { 'key' => 'previous_balance-summary_only', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Only show a single line summarizing the total previous balance rather than one line per invoice.', 'type' => 'checkbox', }, @@ -2941,14 +3025,14 @@ worry that config_items is freeside-specific and icky. { 'key' => 'cust_bill-max_same_services', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Maximum number of the same service to list individually on invoices before condensing to a single line listing the number of services. Defaults to 5.', 'type' => 'text', }, { 'key' => 'cust_bill-consolidate_services', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Consolidate service display into fewer lines on invoices rather than one per service.', 'type' => 'checkbox', }, @@ -2969,7 +3053,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'selfservice-head', - 'section' => '', + 'section' => 'self-service', 'description' => 'HTML for the HEAD section of the self-service interface, typically used for LINK stylesheet tags', 'type' => 'textarea', #htmlarea? 'per_agent' => 1, @@ -2978,7 +3062,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'selfservice-body_header', - 'section' => '', + 'section' => 'self-service', 'description' => 'HTML header for the self-service interface', 'type' => 'textarea', #htmlarea? 'per_agent' => 1, @@ -2986,8 +3070,8 @@ worry that config_items is freeside-specific and icky. { 'key' => 'selfservice-body_footer', - 'section' => '', - 'description' => 'HTML header for the self-service interface', + 'section' => 'self-service', + 'description' => 'HTML footer for the self-service interface', 'type' => 'textarea', #htmlarea? 'per_agent' => 1, }, @@ -2995,7 +3079,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'selfservice-body_bgcolor', - 'section' => '', + 'section' => 'self-service', 'description' => 'HTML background color for the self-service interface, for example, #FFFFFF', 'type' => 'text', 'per_agent' => 1, @@ -3003,15 +3087,166 @@ worry that config_items is freeside-specific and icky. { 'key' => 'selfservice-box_bgcolor', - 'section' => '', - 'description' => 'HTML color for self-service interface input boxes, for example, #C0C0C0"', + 'section' => 'self-service', + 'description' => 'HTML color for self-service interface input boxes, for example, #C0C0C0', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-text_color', + 'section' => 'self-service', + 'description' => 'HTML text color for the self-service interface, for example, #000000', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-link_color', + 'section' => 'self-service', + 'description' => 'HTML link color for the self-service interface, for example, #0000FF', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-vlink_color', + 'section' => 'self-service', + 'description' => 'HTML visited link color for the self-service interface, for example, #FF00FF', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-hlink_color', + 'section' => 'self-service', + 'description' => 'HTML hover link color for the self-service interface, for example, #808080', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-alink_color', + 'section' => 'self-service', + 'description' => 'HTML active (clicked) link color for the self-service interface, for example, #808080', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-font', + 'section' => 'self-service', + 'description' => 'HTML font CSS for the self-service interface, for example, 0.9em/1.5em Arial, Helvetica, Geneva, sans-serif', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-title_color', + 'section' => 'self-service', + 'description' => 'HTML color for the self-service title, for example, #000000', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-title_align', + 'section' => 'self-service', + 'description' => 'HTML alignment for the self-service title, for example, center', + 'type' => 'text', + 'per_agent' => 1, + }, + { + 'key' => 'selfservice-title_size', + 'section' => 'self-service', + 'description' => 'HTML font size for the self-service title, for example, 3', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-title_left_image', + 'section' => 'self-service', + 'description' => 'Image used for the top of the menu in the self-service interface, in PNG format.', + 'type' => 'image', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-title_right_image', + 'section' => 'self-service', + 'description' => 'Image used for the top of the menu in the self-service interface, in PNG format.', + 'type' => 'image', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-menu_skipblanks', + 'section' => 'self-service', + 'description' => 'Skip blank (spacer) entries in the self-service menu', + 'type' => 'checkbox', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-menu_skipheadings', + 'section' => 'self-service', + 'description' => 'Skip the unclickable heading entries in the self-service menu', + 'type' => 'checkbox', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-menu_bgcolor', + 'section' => 'self-service', + 'description' => 'HTML color for the self-service menu, for example, #C0C0C0', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-menu_fontsize', + 'section' => 'self-service', + 'description' => 'HTML font size for the self-service menu, for example, -1', 'type' => 'text', 'per_agent' => 1, }, + { + 'key' => 'selfservice-menu_nounderline', + 'section' => 'self-service', + 'description' => 'Styles menu links in the self-service without underlining.', + 'type' => 'checkbox', + 'per_agent' => 1, + }, + + + { + 'key' => 'selfservice-menu_top_image', + 'section' => 'self-service', + 'description' => 'Image used for the top of the menu in the self-service interface, in PNG format.', + 'type' => 'image', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-menu_body_image', + 'section' => 'self-service', + 'description' => 'Repeating image used for the body of the menu in the self-service interface, in PNG format.', + 'type' => 'image', + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-menu_bottom_image', + 'section' => 'self-service', + 'description' => 'Image used for the bottom of the menu in the self-service interface, in PNG format.', + 'type' => 'image', + 'per_agent' => 1, + }, { 'key' => 'selfservice-bulk_format', - 'section' => '', + 'section' => 'deprecated', 'description' => 'Parameter arrangement for selfservice bulk features', 'type' => 'select', 'select_enum' => [ '', 'izoom-soap', 'izoom-ftp' ], @@ -3020,7 +3255,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'selfservice-bulk_ftp_dir', - 'section' => '', + 'section' => 'deprecated', 'description' => 'Enable bulk ftp provisioning in this folder', 'type' => 'text', 'per_agent' => 1, @@ -3028,21 +3263,21 @@ worry that config_items is freeside-specific and icky. { 'key' => 'signup-no_company', - 'section' => '', + 'section' => 'self-service', 'description' => "Don't display a field for company name on signup.", 'type' => 'checkbox', }, { 'key' => 'signup-recommend_email', - 'section' => '', + 'section' => 'self-service', 'description' => 'Encourage the entry of an invoicing email address on signup.', 'type' => 'checkbox', }, { 'key' => 'signup-recommend_daytime', - 'section' => '', + 'section' => 'self-service', 'description' => 'Encourage the entry of a daytime phone number invoicing email address on signup.', 'type' => 'checkbox', }, @@ -3062,6 +3297,20 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'svc_phone-domain', + 'section' => '', + 'description' => 'Track an optional domain association with each phone service.', + 'type' => 'checkbox', + }, + + { + 'key' => 'svc_phone-phone_name-max_length', + 'section' => '', + 'description' => 'Maximum length of the phone service "Name" field (svc_phone.phone_name). Sometimes useful to limit this (to 15?) when exporting as Caller ID data.', + 'type' => 'text', + }, + + { 'key' => 'default_phone_countrycode', 'section' => '', 'description' => 'Default countrcode', @@ -3182,7 +3431,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'agent-invoice_template', - 'section' => 'billing', + 'section' => 'invoicing', 'description' => 'Enable display/edit of old-style per-agent invoice template selection', 'type' => 'checkbox', }, @@ -3290,6 +3539,20 @@ worry that config_items is freeside-specific and icky. 'type' => 'checkbox', }, + { + 'key' => 'svc_domain-edit_domain', + 'section' => '', + 'description' => 'Enable domain renaming', + 'type' => 'checkbox', + }, + + { + 'key' => 'enable_legacy_prepaid_income', + 'section' => '', + 'description' => "Enable legacy prepaid income reporting. Only useful when you have imported pre-Freeside packages with longer-than-monthly duration, and need to do prepaid income reporting on them before they've been invoiced the first time.", + 'type' => 'checkbox', + }, + { key => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index e732eb77d..cc2bdcc7c 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -172,6 +172,7 @@ if ( -e $addl_handler_use_file ) { use FS::part_export; use FS::part_export_option; use FS::export_svc; + use FS::export_device; use FS::msgcat; use FS::rate; use FS::rate_region; @@ -220,6 +221,8 @@ if ( -e $addl_handler_use_file ) { #use FS::h_phone_device; use FS::h_svc_www; use FS::cust_statement; + use FS::svc_pbx; + use FS::svc_mailinglist; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index 5231350fa..71670f758 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -216,9 +216,10 @@ encoding which, if specified, overrides the default "7bit". use vars qw( $conf ); use Date::Format; -use Mail::Header; -use Mail::Internet 2.00; use MIME::Entity; +use Email::Sender::Simple qw(sendmail); +use Email::Sender::Transport::SMTP; +use Email::Sender::Transport::SMTP::TLS; use FS::UID; FS::UID->install_callback( sub { @@ -234,7 +235,6 @@ sub send_email { # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n" } - $ENV{MAILADDRESS} = $options{'from'}; my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to}; my @mimeargs = (); @@ -287,7 +287,7 @@ sub send_email { $domain = $1; } else { warn 'no domain found in invoice from address '. $options{'from'}. - '; constructing Message-ID @example.com'; + '; constructing Message-ID (and saying HELO) @example.com'; $domain = 'example.com'; } my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain"; @@ -333,101 +333,32 @@ sub send_email { } - my $smtpmachine = $conf->config('smtpmachine'); - $!=0; + #send the email - $message->mysmtpsend( 'Host' => $smtpmachine, - 'MailFrom' => $options{'from'}, - ); + my %smtp_opt = ( 'host' => $conf->config('smtpmachine'), + 'helo' => $domain, + ); -} - -#this kludges a "mysmtpsend" method into Mail::Internet for send_email above -#now updated for MailTools v2! -package Mail::Internet; - -use Mail::Address; -use Net::SMTP; -use Net::Domain; - -sub Mail::Internet::mysmtpsend($@) { - my ($self, %opt) = @_; - - my $host = $opt{Host}; - my $envelope = $opt{MailFrom}; # || mailaddress(); - my $quit = 1; - - my ($smtp, @hello); - - push @hello, Hello => $opt{Hello} - if defined $opt{Hello}; - - push @hello, Port => $opt{Port} - if exists $opt{Port}; - - push @hello, Debug => $opt{Debug} - if exists $opt{Debug}; - -# if(!defined $host) -# { local $SIG{__DIE__}; -# my @hosts = qw(mailhost localhost); -# unshift @hosts, split /\:/, $ENV{SMTPHOSTS} -# if defined $ENV{SMTPHOSTS}; -# -# foreach $host (@hosts) -# { $smtp = eval { Net::SMTP->new($host, @hello) }; -# last if defined $smtp; -# } -# } -# elsif(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) - if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) - { $smtp = $host; - $quit = 0; - } - else - { #local $SIG{__DIE__}; - #$smtp = eval { Net::SMTP->new($host, @hello) }; - $smtp = Net::SMTP->new($host, @hello); - } + my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') ); + $smtp_opt{'port'} = $port; - unless ( defined($smtp) ) { - my $err = $!; - $err =~ s/Invalid argument/Unknown host/; - return "can't connect to $host: $err" + my $transport; + if ( defined($enc) && $enc eq 'starttls' ) { + $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password); + $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt ); + } else { + if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) { + $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password); } + $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls'; + $transport = Email::Sender::Transport::SMTP->new( %smtp_opt ); + } - my $head = $self->cleaned_header_dup; - - $head->delete('Bcc'); - - # Who is it to - - my @rcpt = map { ref $_ ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'}; - @rcpt = map { $head->get($_) } qw(To Cc Bcc) - unless @rcpt; - - my @addr = map {$_->address} Mail::Address->parse(@rcpt); - #@addr or return (); - return 'No valid destination addresses found!' - unless(@addr); - - # Send it - - my $ok = $smtp->mail($envelope) - && $smtp->to(@addr) - && $smtp->data(join("", @{$head->header}, "\n", @{$self->body})); + eval { sendmail($message, { transport => $transport }); }; + ref($@) ? ( $@->code ? $@->code.' ' : '' ). $@->message + : $@; - #$quit && $smtp->quit; - #$ok ? @addr : (); - if ( $ok ) { - $quit && $smtp->quit; - return ''; - } else { - return $smtp->code. ' '. $smtp->message; - } } -package FS::Misc; -#eokludge =item send_fax OPTION => VALUE ... diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 201e7b23c..3b1967e42 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2140,7 +2140,7 @@ sub ut_alpha { ''; } -=item ut_alpha COLUMN +=item ut_alphan COLUMN Check/untaint alphanumeric strings (no spaces). May be null. If there is an error, returns the error, otherwise returns false. @@ -2155,6 +2155,22 @@ sub ut_alphan { ''; } +=item ut_alphasn COLUMN + +Check/untaint alphanumeric strings, spaces allowed. May be null. If there is +an error, returns the error, otherwise returns false. + +=cut + +sub ut_alphasn { + my($self,$field)=@_; + $self->getfield($field) =~ /^([\w ]*)$/ + or return "Illegal (alphanumeric) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + + =item ut_alpha_lower COLUMN Check/untaint lowercase alphanumeric strings (no spaces). May not be null. If diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index e5bb4fe15..660a072b8 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -102,6 +102,10 @@ sub dbdef_dist { my %hash = map { $_ => shift @coldef } qw( name type null length default local ); + #can be removed once we depend on DBIx::DBSchema 0.39; + $hash{'type'} = 'LONGTEXT' + if $hash{'type'} =~ /^TEXT$/i && $datasrc =~ /^dbi:mysql/i; + unless ( defined $hash{'default'} ) { warn "$tablename:\n". join('', map "$_ => $hash{$_}\n", keys %hash) ;# $stop = <STDIN>; @@ -113,7 +117,17 @@ sub dbdef_dist { #false laziness w/sub indices in DBIx::DBSchema::DBD (well, sorta) #and sub sql_create_table in DBIx::DBSchema::Table (slighty more?) my $unique = $tables_hashref->{$tablename}{'unique'}; - my $index = $tables_hashref->{$tablename}{'index'}; + my @index = @{ $tables_hashref->{$tablename}{'index'} }; + + # kludge to avoid avoid "BLOB/TEXT column 'statustext' used in key + # specification without a key length". + # better solution: teach DBIx::DBSchema to specify a default length for + # MySQL indices on text columns, or just to support an index length at all + # so we can pass something in. + # best solution: eliminate need for this index in cust_main::retry_realtime + @index = grep { @{$_}[0] ne 'statustext' } @index + if $datasrc =~ /^dbi:mysql/i; + my @indices = (); push @indices, map { DBIx::DBSchema::Index->new({ @@ -130,7 +144,7 @@ sub dbdef_dist { 'columns' => $_, }); } - @$index; + @index; DBIx::DBSchema::Table->new({ 'name' => $tablename, @@ -641,10 +655,11 @@ sub tables_hashref { 'addlinfo', 'text', 'NULL', '', '', '', 'closed', 'char', 'NULL', 1, '', '', 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances + 'eventnum', 'int', 'NULL', '', '', '', #triggering event for commission ], 'primary_key' => 'crednum', 'unique' => [], - 'index' => [ ['custnum'], ['_date'] ], + 'index' => [ ['custnum'], ['_date'], ['eventnum'] ], }, 'cust_credit_bill' => { @@ -1353,8 +1368,8 @@ sub tables_hashref { 'part_pkg_taxoverride' => { 'columns' => [ 'taxoverridenum', 'serial', '', '', '', '', - 'pkgpart', 'serial', '', '', '', '', - 'taxclassnum', 'serial', '', '', '', '', + 'pkgpart', 'int', '', '', '', '', + 'taxclassnum', 'int', '', '', '', '', 'usage_class', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'taxoverridenum', @@ -1475,14 +1490,26 @@ sub tables_hashref { 'downbytes_threshold', 'bigint', 'NULL', '', '', '', 'totalbytes','bigint', 'NULL', '', '', '', 'totalbytes_threshold', 'bigint', 'NULL', '', '', '', - 'domsvc', 'int', '', '', '', '', + 'domsvc', 'int', '', '', '', '', + 'pbxsvc', 'int', 'NULL', '', '', '', 'last_login', @date_type, '', '', 'last_logout', @date_type, '', '', + #communigate pro fields (quota = MaxAccountSize) + 'file_quota', 'varchar', 'NULL', $char_d, '', '', #MaxWebSize + 'file_maxnum', 'varchar', 'NULL', $char_d, '', '', #MaxWebFiles + 'file_maxsize', 'varchar', 'NULL', $char_d, '', '', #MaxFileSize + 'cgp_accessmodes', 'varchar', 'NULL', 255, '', '', #AccessModes + 'password_selfchange','char', 'NULL', 1, '', '', #PWDAllowed + 'password_recover', 'char', 'NULL', 1, '', '', #PasswordRecovery + 'cgp_type', 'varchar', 'NULL', $char_d, '', '', #AccountType + 'cgp_aliases', 'varchar', 'NULL', 255, '', '', + 'cgp_deletemode', 'varchar', 'NULL', $char_d, '', '', #DeleteMode + 'cgp_emptytrash', 'varchar', 'NULL', $char_d, '', '', #EmptyTrash ], 'primary_key' => 'svcnum', #'unique' => [ [ 'username', 'domsvc' ] ], 'unique' => [], - 'index' => [ ['username'], ['domsvc'] ], + 'index' => [ ['username'], ['domsvc'], ['pbxsvc'] ], }, 'acct_rt_transaction' => { @@ -1518,9 +1545,22 @@ sub tables_hashref { 'parent_svcnum', 'int', 'NULL', '', '', '', 'registrarnum', 'int', 'NULL', '', '', '', 'registrarkey', 'varchar', 'NULL', 512, '', '', - 'setup_date', @date_type, '', '', + 'setup_date', @date_type, '', '', 'renewal_interval', 'int', 'NULL', '', '', '', 'expiration_date', @date_type, '', '', + #communigate pro fields (quota = MaxAccountSize) + 'max_accounts', 'int', 'NULL', '', '', '', + 'cgp_aliases', 'varchar', 'NULL', 255, '', '', + 'cgp_accessmodes','varchar','NULL', 255, '', '', #DomainAccessModes + 'acct_def_password_selfchange','char', 'NULL', 1, '', '', + 'acct_def_password_recover', 'char', 'NULL', 1, '', '', + 'acct_def_cgp_accessmodes', 'varchar', 'NULL', 255, '', '', + 'acct_def_quota', 'varchar', 'NULL', $char_d, '', '', + 'acct_def_file_quota', 'varchar', 'NULL', $char_d, '', '', + 'acct_def_file_maxnum', 'varchar', 'NULL', $char_d, '', '', + 'acct_def_file_maxsize', 'varchar', 'NULL', $char_d, '', '', + 'acct_def_cgp_deletemode', 'varchar', 'NULL', $char_d, '', '', + 'acct_def_cgp_emptytrash', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'svcnum', 'unique' => [ ], @@ -1696,6 +1736,17 @@ sub tables_hashref { 'index' => [ [ 'exportnum' ], [ 'svcpart' ] ], }, + 'export_device' => { + 'columns' => [ + 'exportdevicenum' => 'serial', '', '', '', '', + 'exportnum' => 'int', '', '', '', '', + 'devicepart' => 'int', '', '', '', '', + ], + 'primary_key' => 'exportdevicenum', + 'unique' => [ [ 'exportnum', 'devicepart' ] ], + 'index' => [ [ 'exportnum' ], [ 'devicepart' ] ], + }, + 'part_export' => { 'columns' => [ 'exportnum', 'serial', '', '', '', '', @@ -1933,16 +1984,17 @@ sub tables_hashref { 'rate_detail' => { 'columns' => [ - 'ratedetailnum', 'serial', '', '', '', '', - 'ratenum', 'int', '', '', '', '', - 'orig_regionnum', 'int', 'NULL', '', '', '', - 'dest_regionnum', 'int', '', '', '', '', - 'min_included', 'int', '', '', '', '', - #'min_charge', @money_type, '', '', - 'min_charge', 'decimal', '', '10,5', '', '', - 'sec_granularity', 'int', '', '', '', '', + 'ratedetailnum', 'serial', '', '', '', '', + 'ratenum', 'int', '', '', '', '', + 'orig_regionnum', 'int', 'NULL', '', '', '', + 'dest_regionnum', 'int', '', '', '', '', + 'min_included', 'int', '', '', '', '', + 'conn_charge', @money_type, '0', '', #'decimal','','10,5','0','', + 'conn_sec', 'int', '', '', '0', '', + 'min_charge', 'decimal', '', '10,5', '', '', #@money_type, '', '', + 'sec_granularity', 'int', '', '', '', '', #time period (link to table of periods)? - 'classnum', 'int', 'NULL', '', '', '', + 'classnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'ratedetailnum', 'unique' => [ [ 'ratenum', 'orig_regionnum', 'dest_regionnum' ] ], @@ -2329,11 +2381,12 @@ sub tables_hashref { '_password', 'varchar', '', $char_d, '', '', 'last', 'varchar', '', $char_d, '', '', 'first', 'varchar', '', $char_d, '', '', + 'user_custnum', 'int', 'NULL', '', '', '', 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'usernum', 'unique' => [ [ 'username' ] ], - 'index' => [], + 'index' => [ [ 'user_custnum' ] ], }, 'access_user_pref' => { @@ -2401,10 +2454,15 @@ sub tables_hashref { 'pin', 'varchar', 'NULL', $char_d, '', '', 'sip_password', 'varchar', 'NULL', $char_d, '', '', 'phone_name', 'varchar', 'NULL', $char_d, '', '', + 'pbxsvc', 'int', 'NULL', '', '', '', + 'domsvc', 'int', 'NULL', '', '', '', + 'locationnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'svcnum', 'unique' => [], - 'index' => [ [ 'countrycode', 'phonenum' ] ], + 'index' => [ ['countrycode', 'phonenum'], ['pbxsvc'], ['domsvc'], + ['locationnum'], + ], }, 'phone_device' => { @@ -2499,6 +2557,58 @@ sub tables_hashref { 'unique' => [ [ 'pkgnum', 'refnum' ] ], 'index' => [ [ 'pkgnum' ], [ 'refnum' ] ], }, + + 'svc_pbx' => { + 'columns' => [ + 'svcnum', 'int', '', '', '', '', + 'id', 'int', 'NULL', '', '', '', + 'title', 'varchar', 'NULL', $char_d, '', '', + 'max_extensions', 'int', 'NULL', '', '', '', + ], + 'primary_key' => 'svcnum', + 'unique' => [], + 'index' => [ [ 'id' ] ], + }, + + 'svc_mailinglist' => { #svc_group? + 'columns' => [ + 'svcnum', 'int', '', '', '', '', + 'username', 'varchar', '', $username_len, '', '', + 'domsvc', 'int', '', '', '', '', + 'listnum', 'int', '', '', '', '', + 'reply_to', 'char', 'NULL', 1, '', '',#SetReplyTo + 'remove_from', 'char', 'NULL', 1, '', '',#RemoveAuthor + 'reject_auto', 'char', 'NULL', 1, '', '',#RejectAuto + 'remove_to_and_cc', 'char', 'NULL', 1, '', '',#RemoveToAndCc + ], + 'primary_key' => 'svcnum', + 'unique' => [], + 'index' => [ ['username'], ['domsvc'], ['listnum'] ], + }, + + 'mailinglist' => { + 'columns' => [ + 'listnum', 'serial', '', '', '', '', + 'listname', 'varchar', '', $char_d, '', '', + ], + 'primary_key' => 'listnum', + 'unique' => [], + 'index' => [], + }, + + 'mailinglistmember' => { + 'columns' => [ + 'membernum', 'serial', '', '', '', '', + 'listnum', 'int', '', '', '', '', + 'svcnum', 'int', 'NULL', '', '', '', + 'email', 'varchar', 'NULL', 255, '', '', + ], + 'primary_key' => 'membernum', + 'unique' => [], + 'index' => [['listnum'],['svcnum'],['email']], + }, + + # name type nullability length default local #'new_table' => { diff --git a/FS/FS/TicketSystem/RT_External.pm b/FS/FS/TicketSystem/RT_External.pm index 8ccc93712..46af1f5a1 100644 --- a/FS/FS/TicketSystem/RT_External.pm +++ b/FS/FS/TicketSystem/RT_External.pm @@ -247,7 +247,7 @@ sub href_customer_tickets { } -sub href_new_ticket { +sub href_params_new_ticket { my( $self, $custnum_or_cust_main, $requestors ) = @_; my( $custnum, $cust_main ); @@ -258,14 +258,25 @@ sub href_new_ticket { $custnum = $custnum_or_cust_main; $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ); } - my $queueid = $cust_main->agent->ticketing_queueid || $default_queueid; - - $self->baseurl. - 'Ticket/Create.html?'. - "Queue=$queueid". - "&new-MemberOf=freeside://freeside/cust_main/$custnum". - ( $requestors ? '&Requestors='. uri_escape($requestors) : '' ) - ; + + my %param = ( + 'Queue' => ($cust_main->agent->ticketing_queueid || $default_queueid), + 'new-MemberOf'=> "freeside://freeside/cust_main/$custnum", + 'Requestors' => $requestors, + ); + + ( $self->baseurl.'Ticket/Create.html', %param ); +} + +sub href_new_ticket { + my $self = shift; + + my( $base, %param ) = $self->href_params_new_ticket(@_); + + my $uri = new URI $base; + $uri->query_form(%param); + $uri; + } sub href_ticket { @@ -356,5 +367,9 @@ sub access_right { 0; } +sub create_ticket { + return 'create_ticket unimplemented w/external RT (write something w/RT::Client::REST?)'; +} + 1; diff --git a/FS/FS/TicketSystem/RT_Internal.pm b/FS/FS/TicketSystem/RT_Internal.pm index 033c746ba..52e3922c9 100644 --- a/FS/FS/TicketSystem/RT_Internal.pm +++ b/FS/FS/TicketSystem/RT_Internal.pm @@ -1,7 +1,9 @@ package FS::TicketSystem::RT_Internal; use strict; -use vars qw( @ISA $DEBUG ); +use vars qw( @ISA $DEBUG $me ); +use Data::Dumper; +use MIME::Entity; use FS::UID qw(dbh); use FS::CGI qw(popurl); use FS::TicketSystem::RT_Libs; @@ -10,6 +12,7 @@ use RT::CurrentUser; @ISA = qw( FS::TicketSystem::RT_Libs ); $DEBUG = 0; +$me = '[FS::TicketSystem::RT_Internal]'; sub sql_num_customer_tickets { "( select count(*) from tickets @@ -36,24 +39,190 @@ sub access_right { #return '' unless $conf->config('ticket_system'); return '' unless FS::Conf->new->config('ticket_system'); - $self->_web_external_auth($session) - unless $session - && $session->{'CurrentUser'}; + $session = $self->session($session); $session->{'CurrentUser'}->HasRight( Right => $right, Object => $RT::System ); } +sub session { + my( $self, $session ) = @_; + + if ( $session && $session->{'Current_User'} ) { + warn "$me session: using existing session and CurrentUser: \n". + Dumper($session->{'CurrentUser'}) + if $DEBUG; + } else { + warn "$me session: loading session and CurrentUser\n" if $DEBUG > 1; + $session = $self->_web_external_auth($session); + } + + $session; +} + +sub init { + my $self = shift; + + warn "$me init: loading RT libraries\n" if $DEBUG; + eval ' + use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); + use RT; + #it looks like the rest are taken care of these days in RT::InitClasses + #use RT::Ticket; + #use RT::Transactions; + #use RT::Users; + #use RT::CurrentUser; + #use RT::Templates; + #use RT::Queues; + #use RT::ScripActions; + #use RT::ScripConditions; + #use RT::Scrips; + #use RT::Groups; + #use RT::GroupMembers; + #use RT::CustomFields; + #use RT::CustomFieldValues; + #use RT::ObjectCustomFieldValues; + + #for web external auth... + use RT::Interface::Web; + '; + die $@ if $@; + + warn "$me init: loading RT config\n" if $DEBUG; + { + local $SIG{__DIE__}; + eval 'RT::LoadConfig();'; + } + die $@ if $@; + + warn "$me init: initializing RT\n" if $DEBUG; + { + local $SIG{__DIE__}; + eval 'RT::Init("NoSignalHandlers"=>1);'; + } + die $@ if $@; + + warn "$me init: complete" if $DEBUG; +} + +=item create_ticket SESSION_HASHREF, OPTION => VALUE ... + +Class method. Creates a ticket. If there is an error, returns the scalar +error, otherwise returns the newly created RT::Ticket object. + +Accepts the following options: + +=over 4 + +=item queue + +Queue name or Id + +=item subject + +Ticket subject + +=item requestor + +Requestor email address or arrayref of addresses + +=item cc + +Cc: email address or arrayref of addresses + +=item message + +Ticket message + +=item mime_type + +MIME type to use for message. Defaults to text/plain. Specifying text/html +can be useful to use HTML markup in message. + +=item custnum + +Customer number (see L<FS::cust_main>) to associate with ticket. + +=item svcnum + +Service number (see L<FS::cust_svc>) to associate with ticket. Will also +associate the customer who has this service (unless the service is unlinked). + +=back + +=cut + +sub create_ticket { + my($self, $session, %param) = @_; + + $session = $self->session($session); + + my $Queue = RT::Queue->new($session->{'CurrentUser'}); + $Queue->Load( $param{'queue'} ); + + my $req = ref($param{'requestor'}) + ? $param{'requestor'} + : ( $param{'requestor'} ? [ $param{'requestor'} ] : [] ); + + my $cc = ref($param{'cc'}) + ? $param{'cc'} + : ( $param{'cc'} ? [ $param{'cc'} ] : [] ); + + my $mimeobj = MIME::Entity->build( + 'Data' => $param{'message'}, + 'Type' => ( $param{'mime_type'} || 'text/plain' ), + ); + + my %ticket = ( + 'Queue' => $Queue->Id, + 'Subject' => $param{'subject'}, + 'Requestor' => $req, + 'Cc' => $cc, + 'MIMEObj' => $mimeobj, + ); + warn Dumper(\%ticket) if $DEBUG > 1; + + my $Ticket = RT::Ticket->new($session->{'CurrentUser'}); + my( $id, $Transaction, $ErrStr ); + { + local $SIG{__DIE__}; + ( $id, $Transaction, $ErrStr ) = $Ticket->Create( %ticket ); + } + return $ErrStr if $id == 0; + + warn "ticket got id $id\n" if $DEBUG; + + #XXX check errors adding custnum/svcnum links (put it in a transaction)... + # but we do already know they're good + + if ( $param{'custnum'} ) { + my( $val, $msg ) = $Ticket->_AddLink( + 'Type' => 'MemberOf', + 'Target' => 'freeside://freeside/cust_main/'. $param{'custnum'}, + ); + } + + if ( $param{'svcnum'} ) { + my( $val, $msg ) = $Ticket->_AddLink( + 'Type' => 'MemberOf', + 'Target' => 'freeside://freeside/cust_svc/'. $param{'svcnum'}, + ); + } + + $Ticket; +} + #shameless false laziness w/rt/html/autohandler to get logged into RT from afar sub _web_external_auth { my( $self, $session ) = @_; my $user = $FS::CurrentUser::CurrentUser->username; + $session ||= {}; $session->{'CurrentUser'} = RT::CurrentUser->new(); - warn "loading RT user for $user\n" - if $DEBUG; + warn "$me _web_external_auth loading RT user for $user\n" + if $DEBUG > 1; $session->{'CurrentUser'}->Load($user); @@ -132,6 +301,8 @@ sub _web_external_auth { #} } + $session; + } 1; diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index 148085c4c..5e987429c 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -270,6 +270,7 @@ sub cust_header { ); my %header2align = ( 'Cust. Status' => 'c', + 'Cust#' => 'r', ); my $cust_fields; @@ -373,12 +374,10 @@ sub cust_fields { my $seen_unlinked = 0; map { if ( $record->custnum ) { - warn " $record -> $_" - if $DEBUG > 1; + warn " $record -> $_" if $DEBUG > 1; $record->$_(@_); } else { - warn " ($record unlinked)" - if $DEBUG > 1; + warn " ($record unlinked)" if $DEBUG > 1; $seen_unlinked++ ? '' : '(unlinked)'; } } @cust_fields; diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index e3a4604b4..e042c05b1 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -128,7 +128,7 @@ sub forksuidsetup { } } else { - warn "NO CONFIGURATION TABLE FOUND"; + warn "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack; } unless ( $callback_hack ) { diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index c39680ef7..ff577f2f2 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -99,7 +99,6 @@ sub upgrade_data { #reason type and reasons 'reason_type' => [], - 'reason' => [], 'cust_pkg_reason' => [], #need part_pkg before cust_credit... @@ -129,9 +128,6 @@ sub upgrade_data { #fixup access rights 'access_right' => [], - #change tax_rate column types - 'tax_rate' => [], - #change recur_flat and enable_prorate 'part_pkg_option' => [], diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index 8cc8b64fc..1bf6e9387 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -10,6 +10,7 @@ use FS::option_Common; use FS::access_user_pref; use FS::access_usergroup; use FS::agent; +use FS::cust_main; @ISA = qw( FS::m2m_Common FS::option_Common FS::Record ); #@ISA = qw( FS::m2m_Common FS::option_Common ); @@ -220,6 +221,9 @@ sub replace { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; return $error; } + } elsif ( $old->disabled && !$new->disabled + && $new->_password =~ /changeme/i ) { + return "Must change password when enabling this account"; } my $error = $new->SUPER::replace($old, @_); @@ -254,6 +258,7 @@ sub check { || $self->ut_text('_password') || $self->ut_text('last') || $self->ut_text('first') + || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum') || $self->ut_enum('disabled', [ '', 'Y' ] ) ; return $error if $error; @@ -272,6 +277,18 @@ sub name { $self->get('last'). ', '. $self->first; } +=item user_cust_main + +Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this +user. + +=cut + +sub user_cust_main { + my $self = shift; + qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } ); +} + =item access_usergroup Returns links to the the groups this user is a part of, as FS::access_usergroup diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 0f08aaa51..28a7257cd 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -1,7 +1,7 @@ package FS::cust_bill; use strict; -use vars qw( @ISA $DEBUG $me $conf $money_char $date_format ); +use vars qw( @ISA $DEBUG $me $conf $money_char $date_format $rdate_format ); use vars qw( $invoice_lines @buf ); #yuck use Fcntl qw(:flock); #for spool_csv use List::Util qw(min max); @@ -43,8 +43,9 @@ $me = '[FS::cust_bill]'; #ask FS::UID to run this stuff for us later FS::UID->install_callback( sub { $conf = new FS::Conf; - $money_char = $conf->config('money_char') || '$'; - $date_format = $conf->config('date_format') || '%x'; + $money_char = $conf->config('money_char') || '$'; + $date_format = $conf->config('date_format') || '%x'; + $rdate_format = $conf->config('date_format') || '%m/%d/%Y'; } ); =head1 NAME @@ -2293,7 +2294,7 @@ sub print_generic { 'template' => $template, #params{'template'}, 'notice_name' => ($params{'notice_name'} || 'Invoice'),#escape_function? 'current_charges' => sprintf("%.2f", $self->charged), - 'duedate' => $self->due_date2str('%m/%d/%Y'), #date_format? + 'duedate' => $self->due_date2str($rdate_format), #date_format? #customer info 'custnum' => $cust_main->display_custnum, @@ -2630,7 +2631,9 @@ sub print_generic { $invoice_data{current_less_finance} = sprintf('%.2f', $self->charged - $invoice_data{finance_amount} ); - if ( $multisection && !$conf->exists('disable_previous_balance') ) { + if ( $multisection && !$conf->exists('disable_previous_balance') + || $conf->exists('previous_balance-summary_only') ) + { unshift @sections, $previous_section if $pr_total; } @@ -3151,7 +3154,7 @@ sub balance_due_msg { my $msg = 'Balance Due'; return $msg unless $self->terms; if ( $self->due_date ) { - $msg .= ' - Please pay by '. $self->due_date2str('%x'); + $msg .= ' - Please pay by '. $self->due_date2str($date_format); } elsif ( $self->terms ) { $msg .= ' - '. $self->terms; } @@ -3163,7 +3166,7 @@ sub balance_due_date { my $duedate = ''; if ( $conf->exists('invoice_default_terms') && $conf->config('invoice_default_terms')=~ /^\s*Net\s*(\d+)\s*$/ ) { - $duedate = time2str("%m/%d/%Y", $self->_date + ($1*86400) ); + $duedate = time2str($rdate_format, $self->_date + ($1*86400) ); } $duedate; } @@ -3188,7 +3191,7 @@ Returns a string with the date, for example: "3/20/2008" sub _date_pretty { my $self = shift; - time2str('%x', $self->_date); + time2str($date_format, $self->_date); } use vars qw(%pkg_category_cache); @@ -3823,9 +3826,7 @@ sub _items_previous { foreach ( @pr_cust_bill ) { my $date = $conf->exists('invoice_show_prior_due_date') ? 'due '. $_->due_date2str($date_format) - : time2str('%x', $_->_date); # date_format here, too, - # but fix _items_cust_bill_pkg, - # header, others? + : time2str($date_format, $_->_date); push @b, { 'description' => 'Previous Balance, Invoice #'. $_->invnum. " ($date)", #'pkgpart' => 'N/A', @@ -3994,8 +3995,8 @@ sub _items_cust_bill_pkg { ? "Usage charges" : $desc; unless ( $conf->exists('disable_line_item_date_ranges') ) { - $description .= " (" . time2str("%x", $cust_bill_pkg->sdate). - " - ". time2str("%x", $cust_bill_pkg->edate). ")"; + $description .= " (" . time2str($date_format, $cust_bill_pkg->sdate). + " - ". time2str($date_format, $cust_bill_pkg->edate). ")"; } my @d = (); @@ -4087,8 +4088,8 @@ sub _items_cust_bill_pkg { if ( $cust_bill_pkg->recur != 0 ) { push @b, { 'description' => "$desc (". - time2str("%x", $cust_bill_pkg->sdate). ' - '. - time2str("%x", $cust_bill_pkg->edate). ')', + time2str($date_format, $cust_bill_pkg->sdate). ' - '. + time2str($date_format, $cust_bill_pkg->edate). ')', 'amount' => sprintf("%.2f", $cust_bill_pkg->recur), }; } @@ -4132,7 +4133,7 @@ sub _items_credits { # " (". time2str("%x",$_->cust_credit->_date) .")". # $reason, 'description' => 'Credit applied '. - time2str("%x",$_->cust_credit->_date). $reason, + time2str($date_format,$_->cust_credit->_date). $reason, 'amount' => sprintf("%.2f",$_->amount), }; } @@ -4152,7 +4153,7 @@ sub _items_payments { push @b, { 'description' => "Payment received ". - time2str("%x",$_->cust_pay->_date ), + time2str($date_format,$_->cust_pay->_date ), 'amount' => sprintf("%.2f", $_->amount ) }; } diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm index 7449679a8..8ba57f36f 100644 --- a/FS/FS/cust_bill_ApplicationCommon.pm +++ b/FS/FS/cust_bill_ApplicationCommon.pm @@ -203,7 +203,7 @@ sub apply_to_lineitems { my %saw = (); my @weights = sort { $b <=> $a } # highest weight first grep { ! $saw{$_}++ } # want a list of unique weights - map { $_->[1] } + map { $_->[1] } @openweight; my $remaining_amount = $self->amount; @@ -224,83 +224,85 @@ sub apply_to_lineitems { #if some items are less than applytotal/num_items, then apply then in full my $lessflag; do { - $lessflag = 0; + $lessflag = 0; - #no, not sprintf("%.2f", - # we want this rounded DOWN for purposes of checking for line items - # less than it, we don't want .66666 becoming .67 and causing this - # to trigger when it shouldn't + #no, not sprintf("%.2f", + # we want this rounded DOWN for purposes of checking for line items + # less than it, we don't want .66666 becoming .67 and causing this + # to trigger when it shouldn't my $applyeach = int( 100 * $applytotal / scalar(@items) ) / 100; - my @newitems = (); - foreach my $item ( @items ) { - my $itemamount = $item->setup || $item->recur; + my @newitems = (); + foreach my $item ( @items ) { + my $itemamount = $item->setup || $item->recur; if ( $itemamount < $applyeach ) { - warn "$me applying full $itemamount". - " to small line item (cust_bill_pkg ". $item->billpkgnum. ")\n" - if $DEBUG; - push @apply, [ $item, $itemamount ]; - $applytotal -= $itemamount; + warn "$me applying full $itemamount". + " to small line item (cust_bill_pkg ". $item->billpkgnum. ")\n" + if $DEBUG; + push @apply, [ $item, $itemamount ]; + $applytotal -= $itemamount; $lessflag=1; - } else { - push @newitems, $item; - } - } - @items = @newitems; - - } while ( $lessflag ); - - #and now that we've fallen out of the loop, distribute the rest equally... - - # should cust_bill_pay_pkg and cust_credit_bill_pkg amount columns - # become real instead of numeric(10,2) ??? no.. - my $applyeach = sprintf("%.2f", $applytotal / scalar(@items) ); - - my @equi_apply = map { [ $_, $applyeach ] } @items; - - # or should we futz with pennies instead? yes, bah! - my $diff = - sprintf('%.0f', 100 * ( $applytotal - $applyeach * scalar(@items) ) ); - $diff = 0 if $diff eq '-0'; #yay ieee fp - if ( abs($diff) > scalar(@items) ) { - #we must have done something really wrong, the difference is more than - #a penny an item - $dbh->rollback if $oldAutoCommit; - return 'Error distributing pennies applying '. $self->_app_source_name. - " - can't distribute difference of $diff pennies". - ' among '. scalar(@items). ' line items'; - } - - warn "$me futzing with $diff pennies difference\n" - if $DEBUG && $diff; - - my $futz = 0; - while ( $diff != 0 && $futz < scalar(@equi_apply) ) { - if ( $diff > 0 ) { - $equi_apply[$futz++]->[1] += .01; - $diff -= 1; - } elsif ( $diff < 0 ) { - $equi_apply[$futz++]->[1] -= .01; - $diff += 1; - } else { - die "guru exception #5 (in fortran tongue the answer)"; - } - } + } else { + push @newitems, $item; + } + } + @items = @newitems; + + } while ( $lessflag && @items ); + + if ( @items ) { + + #and now that we've fallen out of the loop, distribute the rest equally + + # should cust_bill_pay_pkg and cust_credit_bill_pkg amount columns + # become real instead of numeric(10,2) ??? no.. + my $applyeach = sprintf("%.2f", $applytotal / scalar(@items) ); + + my @equi_apply = map { [ $_, $applyeach ] } @items; + + # or should we futz with pennies instead? yes, bah! + my $diff = + sprintf('%.0f', 100 * ( $applytotal - $applyeach * scalar(@items) ) ); + $diff = 0 if $diff eq '-0'; #yay ieee fp + if ( abs($diff) > scalar(@items) ) { + #we must have done something really wrong, the difference is more than + #a penny an item + $dbh->rollback if $oldAutoCommit; + return 'Error distributing pennies applying '.$self->_app_source_name. + " - can't distribute difference of $diff pennies". + ' among '. scalar(@items). ' line items'; + } + + warn "$me futzing with $diff pennies difference\n" + if $DEBUG && $diff; + + my $futz = 0; + while ( $diff != 0 && $futz < scalar(@equi_apply) ) { + if ( $diff > 0 ) { + $equi_apply[$futz++]->[1] += .01; + $diff -= 1; + } elsif ( $diff < 0 ) { + $equi_apply[$futz++]->[1] -= .01; + $diff += 1; + } else { + die "guru exception #5 (in fortran tongue the answer)"; + } + } + + if ( sprintf('%.0f', $diff ) ) { + $dbh->rollback if $oldAutoCommit; + return "couldn't futz with pennies enough: still $diff left"; + } + + if ( $DEBUG ) { + warn "$me applying ". $_->[1]. + " to line item (cust_bill_pkg ". $_->[0]->billpkgnum. ")\n" + foreach @equi_apply; + } + push @apply, @equi_apply; - if ( sprintf('%.0f', $diff ) ) { - $dbh->rollback if $oldAutoCommit; - return "couldn't futz with pennies enough: still $diff left"; } - if ( $DEBUG ) { - warn "$me applying ". $_->[1]. - " to line item (cust_bill_pkg ". $_->[0]->billpkgnum. ")\n" - foreach @equi_apply; - } - - - push @apply, @equi_apply; - #$remaining_amount -= $applytotal; last unless $remaining_amount; diff --git a/FS/FS/cust_bill_pkg_detail.pm b/FS/FS/cust_bill_pkg_detail.pm index f2e60d2f4..4d9ee8191 100644 --- a/FS/FS/cust_bill_pkg_detail.pm +++ b/FS/FS/cust_bill_pkg_detail.pm @@ -241,8 +241,8 @@ sub _upgrade_data { # class method warn "$me upgrading $class\n" if $DEBUG; - my $columndef = dbdef->table($class->table)->column('classnum'); - unless ($columndef->type eq 'int4') { + my $type = dbdef->table($class->table)->column('classnum')->type; + unless ( $type =~ /^int/i || $type =~ /int$/i ) { my $dbh = dbh; if ( $dbh->{Driver}->{Name} eq 'Pg' ) { diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 6c3effa13..d0aa3a4b4 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -14,6 +14,7 @@ use FS::cust_credit_bill; use FS::part_pkg; use FS::reason_type; use FS::reason; +use FS::cust_event; @ISA = qw( FS::cust_main_Mixin FS::Record ); $me = '[ FS::cust_credit ]'; @@ -301,6 +302,7 @@ sub check { || $self->ut_textn('addlinfo') || $self->ut_enum('closed', [ '', 'Y' ]) || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_foreign_keyn('eventnum', 'cust_event', 'eventnum') ; return $error if $error; diff --git a/FS/FS/cust_event.pm b/FS/FS/cust_event.pm index d2fcfc1e2..52b5911dc 100644 --- a/FS/FS/cust_event.pm +++ b/FS/FS/cust_event.pm @@ -1,18 +1,16 @@ package FS::cust_event; use strict; +use base qw( FS::cust_main_Mixin FS::Record ); use vars qw( @ISA $DEBUG $me ); use Carp qw( croak confess ); use FS::Record qw( qsearch qsearchs dbdef ); -use FS::cust_main_Mixin; use FS::part_event; #for cust_X use FS::cust_main; use FS::cust_pkg; use FS::cust_bill; -@ISA = qw(FS::cust_main_Mixin FS::Record); - $DEBUG = 0; $me = '[FS::cust_event]'; @@ -230,7 +228,7 @@ sub do_event { my $error; { local $SIG{__DIE__}; # don't want Mason __DIE__ handler active - $error = eval { $part_event->do_action($object); }; + $error = eval { $part_event->do_action($object, $self); }; } my $status = ''; diff --git a/FS/FS/cust_location.pm b/FS/FS/cust_location.pm index 87c6c3eb6..a90fbe170 100644 --- a/FS/FS/cust_location.pm +++ b/FS/FS/cust_location.pm @@ -225,6 +225,20 @@ sub line { $self->location_label; } +=item location_hash + +Returns a list of key/value pairs, with the following keys: address1, adddress2, +city, county, state, zip, country. + +=cut + +#geocode? not yet set + +sub location_hash { + my $self = shift; + map { $_ => $self->$_ } qw( address1 address2 city county state zip country ); +} + =back =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 4b712de44..88aceb935 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1910,6 +1910,25 @@ sub has_ship_address { scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields ); } +=item location_hash + +Returns a list of key/value pairs, with the following keys: address1, adddress2, +city, county, state, zip, country. The shipping address is used if present. + +=cut + +#geocode? dependent on tax-ship_address config, not available in cust_location +#mostly. not yet then. + +sub location_hash { + my $self = shift; + my $prefix = $self->has_ship_address ? 'ship_' : ''; + + map { $_ => $self->get($prefix.$_) } + qw( address1 address2 city county state zip country geocode ); + #fields that cust_location has +} + =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all packages (see L<FS::cust_pkg>) for this customer. @@ -3815,7 +3834,7 @@ sub due_cust_event { warn " invalid conditions not eliminated with condition_sql:\n". join('', map " $_: ".$unsat{$_}."\n", keys %unsat ) - if $DEBUG; # > 1; + if keys %unsat && $DEBUG; # > 1; ## # insert @@ -4768,9 +4787,19 @@ sub realtime_refund_bop { ) { warn " attempting void\n" if $DEBUG > 1; my $void = new Business::OnlinePayment( $processor, @bop_options ); - $content{'card_number'} = $cust_pay->payinfo - if $cust_pay->payby eq 'CARD' - && $void->can('info') && $void->info('CC_void_requires_card'); + if ( $void->can('info') ) { + if ( $cust_pay->payby eq 'CARD' + && $void->info('CC_void_requires_card') ) + { + $content{'card_number'} = $cust_pay->payinfo + } elsif ( $cust_pay->payby eq 'CHEK' + && $void->info('ECHECK_void_requires_account') ) + { + ( $content{'account_number'}, $content{'routing_code'} ) = + split('@', $cust_pay->payinfo); + $content{'name'} = $self->get('first'). ' '. $self->get('last'); + } + } $void->content( 'action' => 'void', %content ); $void->submit(); if ( $void->is_success ) { @@ -6111,9 +6140,19 @@ sub _new_realtime_refund_bop { ) { warn " attempting void\n" if $DEBUG > 1; my $void = new Business::OnlinePayment( $processor, @bop_options ); - $content{'card_number'} = $cust_pay->payinfo - if $cust_pay->payby eq 'CARD' - && $void->can('info') && $void->info('CC_void_requires_card'); + if ( $void->can('info') ) { + if ( $cust_pay->payby eq 'CARD' + && $void->info('CC_void_requires_card') ) + { + $content{'card_number'} = $cust_pay->payinfo; + } elsif ( $cust_pay->payby eq 'CHEK' + && $void->info('ECHECK_void_requires_account') ) + { + ( $content{'account_number'}, $content{'routing_code'} ) = + split('@', $cust_pay->payinfo); + $content{'name'} = $self->get('first'). ' '. $self->get('last'); + } + } $void->content( 'action' => 'void', %content ); $void->submit(); if ( $void->is_success ) { @@ -7281,7 +7320,7 @@ sub referral_cust_main_ncancelled { Like referral_cust_main, except returns a flat list of all unsuspended (and uncancelled) packages for each customer. The number of items in this list may -be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). +be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). =cut @@ -7343,8 +7382,10 @@ sub credit { $cust_credit->set('reason', $reason) } - $cust_credit->addlinfo( delete $options{'addlinfo'} ) - if exists($options{'addlinfo'}); + for (qw( addlinfo eventnum )) { + $cust_credit->$_( delete $options{$_} ) + if exists($options{$_}); + } $cust_credit->insert(%options); diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 8415d629d..89eadd599 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,17 +1,19 @@ package FS::cust_pkg; use strict; +use base qw( FS::cust_main_Mixin FS::location_Mixin + FS::m2m_Common FS::option_Common FS::Record + ); use vars qw(@ISA $disable_agentcheck $DEBUG $me); use Carp qw(cluck); use Scalar::Util qw( blessed ); use List::Util qw(max); use Tie::IxHash; +use Time::Local qw( timelocal_nocheck ); use MIME::Entity; use FS::UID qw( getotaker dbh ); use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs ); -use FS::m2m_Common; -use FS::cust_main_Mixin; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; @@ -38,8 +40,6 @@ use FS::svc_forward; # for sending cancel emails in sub cancel use FS::Conf; -@ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record ); - $DEBUG = 0; $me = '[FS::cust_pkg]'; @@ -250,6 +250,26 @@ an optional queue name for ticket additions sub insert { my( $self, %options ) = @_; + if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) { + my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5]; + $mon += 1 unless $mday == 1; + until ( $mon < 12 ) { $mon -= 12; $year++; } + $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) ); + } + + my $expire_months = $self->part_pkg->option('expire_months', 1); + if ( $expire_months && !$self->expire ) { + my $start = $self->start_date || $self->setup || time; + + #false laziness w/part_pkg::add_freq + my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($start) )[0,1,2,3,4,5]; + $mon += $expire_months; + until ( $mon < 12 ) { $mon -= 12; $year++; } + + #$self->expire( timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year) ); + $self->expire( timelocal_nocheck(0,0,0,$mday,$mon,$year) ); + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1683,7 +1703,9 @@ sub extra_part_svc { #seems to benchmark slightly faster... qsearch( { - 'select' => 'DISTINCT ON (svcpart) part_svc.*', + #'select' => 'DISTINCT ON (svcpart) part_svc.*', + #MySQL doesn't grok DISINCT ON + 'select' => 'DISTINCT part_svc.*', 'table' => 'part_svc', 'addl_from' => 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart @@ -1925,41 +1947,24 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +#these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin + =item cust_location Returns the location object, if any (see L<FS::cust_location>). -=cut - -sub cust_location { - my $self = shift; - return '' unless $self->locationnum; - qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } ); -} - =item cust_location_or_main If this package is associated with a location, returns the locaiton (see L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>). -=cut - -sub cust_location_or_main { - my $self = shift; - $self->cust_location || $self->cust_main; -} - =item location_label [ OPTION => VALUE ... ] Returns the label of the location object (see L<FS::cust_location>). =cut -sub location_label { - my $self = shift; - my $object = $self->cust_location_or_main; - $object->location_label(@_); -} +#end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin =item seconds_since TIMESTAMP diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 3c2820412..3ce13144c 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -251,6 +251,18 @@ sub replace { } } +# #trigger a re-export on pkgnum changes? +# # (of prepaid packages), for Expiration RADIUS attribute +# if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) { +# my $svc_x = $new->svc_x; +# local($FS::Record::nowarn_identical) = 1; +# my $error = $svc_x->export('replace'); +# if ( $error ) { +# $dbh->rollback if $oldAutoCommit; +# return $error if $error; +# } +# } + #my $error = $new->SUPER::replace($old, @_); my $error = $new->SUPER::replace($old); if ( $error ) { @@ -411,7 +423,7 @@ sub _svc_label { =item export_links -Returns a list of html elements associated with this services exports. +Returns a listref of html elements associated with this service's exports. =cut @@ -423,6 +435,21 @@ sub export_links { $svc_x->export_links; } +=item export_getsettings + +Returns two hashrefs of settings associated with this service's exports. + +=cut + +sub export_getsettings { + my $self = shift; + my $svc_x = $self->svc_x + or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum; + + $svc_x->export_getsettings; +} + + =item svc_x Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or diff --git a/FS/FS/h_svc_mailinglist.pm b/FS/FS/h_svc_mailinglist.pm new file mode 100644 index 000000000..3d1fd272a --- /dev/null +++ b/FS/FS/h_svc_mailinglist.pm @@ -0,0 +1,33 @@ +package FS::h_svc_mailinglist; + +use strict; +use vars qw( @ISA ); +use FS::h_Common; +use FS::svc_mailinglist; + +@ISA = qw( FS::h_Common FS::svc_mailinglist ); + +sub table { 'h_svc_mailinglist' }; + +=head1 NAME + +FS::h_svc_mailinglist - Historical mailing list objects + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +An FS::h_svc_mailinglist object represents a historical mailing list. +FS::h_svc_mailinglist inherits from FS::h_Common and FS::svc_mailinglist. + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::h_Common>, L<FS::svc_mailinglist>, L<FS::Record>, schema.html from the +base documentation. + +=cut + +1; + diff --git a/FS/FS/h_svc_pbx.pm b/FS/FS/h_svc_pbx.pm new file mode 100644 index 000000000..db702f322 --- /dev/null +++ b/FS/FS/h_svc_pbx.pm @@ -0,0 +1,33 @@ +package FS::h_svc_pbx; + +use strict; +use vars qw( @ISA ); +use FS::h_Common; +use FS::svc_pbx; + +@ISA = qw( FS::h_Common FS::svc_pbx ); + +sub table { 'h_svc_pbx' }; + +=head1 NAME + +FS::h_svc_pbx - Historical PBX objects + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +An FS::h_svc_pbx object represents a historical PBX tenant. FS::h_svc_pbx +inherits from FS::h_Common and FS::svc_pbx. + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::h_Common>, L<FS::svc_pbx>, L<FS::Record>, schema.html from the base +documentation. + +=cut + +1; + diff --git a/FS/FS/location_Mixin.pm b/FS/FS/location_Mixin.pm new file mode 100644 index 000000000..d45738682 --- /dev/null +++ b/FS/FS/location_Mixin.pm @@ -0,0 +1,57 @@ +package FS::location_Mixin; + +use strict; +use FS::Record qw( qsearchs ); +use FS::cust_location; + +=item cust_location + +Returns the location object, if any (see L<FS::cust_location>). + +=cut + +sub cust_location { + my $self = shift; + return '' unless $self->locationnum; + qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } ); +} + +=item cust_location_or_main + +If this package is associated with a location, returns the locaiton (see +L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>). + +=cut + +sub cust_location_or_main { + my $self = shift; + $self->cust_location || $self->cust_main; +} + +=item location_label [ OPTION => VALUE ... ] + +Returns the label of the location object (see L<FS::cust_location>). + +=cut + +sub location_label { + my $self = shift; + my $object = $self->cust_location_or_main; + $object->location_label(@_); +} + +=item location_hash + +Returns a hash of values for the location, either from the location object, +the cust_main shipping address, or the cust_main address, whichever is present +first. + +=cut + +sub location_hash { + my $self = shift; + my $object = $self->cust_location_or_main; + $object->location_hash(@_); +} + +1; diff --git a/FS/FS/mailinglist.pm b/FS/FS/mailinglist.pm new file mode 100644 index 000000000..129461092 --- /dev/null +++ b/FS/FS/mailinglist.pm @@ -0,0 +1,173 @@ +package FS::mailinglist; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs dbh ); +use FS::mailinglistmember; +use FS::svc_mailinglist; + +=head1 NAME + +FS::mailinglist - Object methods for mailinglist records + +=head1 SYNOPSIS + + use FS::mailinglist; + + $record = new FS::mailinglist \%hash; + $record = new FS::mailinglist { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::mailinglist object represents a mailing list FS::mailinglist inherits +from FS::Record. The following fields are currently supported: + +=over 4 + +=item listnum + +primary key + +=item listname + +Mailing list name + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new mailing list. To add the mailing list 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 { 'mailinglist'; } + +=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 + +sub delete { + 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; + + foreach my $member ( $self->mailinglistmember ) { + my $error = $member->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=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 mailing list. 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('listnum') + || $self->ut_text('listname') + ; + return $error if $error; + + $self->SUPER::check; +} + +=item mailinglistmember + +=cut + +sub mailinglistmember { + my $self = shift; + qsearch('mailinglistmember', { 'listnum' => $self->listnum } ); +} + +=item svc_mailinglist + +=cut + +sub svc_mailinglist { + my $self = shift; + qsearchs('svc_mailinglist', { 'listnum' => $self->listnum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::mailinglistmember>, L<FS::svc_mailinglist>, L<FS::Record>, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/mailinglistmember.pm b/FS/FS/mailinglistmember.pm new file mode 100644 index 000000000..8655d61b2 --- /dev/null +++ b/FS/FS/mailinglistmember.pm @@ -0,0 +1,239 @@ +package FS::mailinglistmember; + +use strict; +use base qw( FS::Record ); +use Scalar::Util qw( blessed ); +use FS::Record qw( dbh qsearchs ); # qsearch ); +use FS::mailinglist; +use FS::svc_acct; + +=head1 NAME + +FS::mailinglistmember - Object methods for mailinglistmember records + +=head1 SYNOPSIS + + use FS::mailinglistmember; + + $record = new FS::mailinglistmember \%hash; + $record = new FS::mailinglistmember { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::mailinglistmember object represents a mailing list member. +FS::mailinglistmember inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item membernum + +primary key + +=item listnum + +listnum + +=item svcnum + +svcnum + +=item email + +email + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new mailing list member. To add the member 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 { 'mailinglistmember'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert + || $self->export('mailinglistmember_insert'); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::delete + || $self->export('mailinglistmember_delete'); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + +=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 = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $new->SUPER::replace($old) + || $new->export('mailinglistmember_replace', $old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + +=item check + +Checks all fields to make sure this is a valid member. 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('membernum') + || $self->ut_foreign_key('listnum', 'mailinglist', 'listnum') + || $self->ut_foreign_keyn('svcnum', 'svc_acct', 'svcnum') + || $self->ut_textn('email') #XXX ut_email! from svc_forward, cust_main_invoice + ; + return $error if $error; + + $self->SUPER::check; +} + +=item mailinglist + +=cut + +sub mailinglist { + my $self = shift; + qsearchs('mailinglist', { 'listnum' => $self->listnum } ); +} + +=item email_address + +=cut + +sub email_address { + my $self = shift; + #XXX svcnum + $self->email; +} + +=item export + +=cut + +sub export { + my( $self, $method ) = ( shift, shift ); + my $svc_mailinglist = $self->mailinglist->svc_mailinglist + or return ''; + $svc_mailinglist->export($method, $self, @_); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_event/Action/Mixin/credit_pkg.pm b/FS/FS/part_event/Action/Mixin/credit_pkg.pm new file mode 100644 index 000000000..aeda92f91 --- /dev/null +++ b/FS/FS/part_event/Action/Mixin/credit_pkg.pm @@ -0,0 +1,63 @@ +package FS::part_event::Action::Mixin::credit_pkg; + +use strict; + +sub eventtable_hashref { + { 'cust_pkg' => 1 }; +} + +sub option_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( base_recur_permonth unit_setup recur_cost_permonth setup_cost ) ], + 'labels' => { 'base_recur_permonth' => 'Base monthly fee', + 'unit_setup' => 'Setup fee', + 'recur_cost_permonth' => 'Monthly cost', + 'setup_cost' => 'Setup cost', + }, + }, + ); + +} + +#my %no_cust_pkg = ( 'setup_cost' => 1 ); + +sub _calc_credit { + my( $self, $cust_pkg ) = @_; + + my $cust_main = $self->cust_main($cust_pkg); + + my $part_pkg = $cust_pkg->part_pkg; + + my $what = $self->option('what'); + + #false laziness w/Condition/cust_payments_pkg.pm + if ( $what =~ /_permonth$/ ) { #huh. yuck. + if ( $part_pkg->freq !~ /^\d+$/ ) { + die 'WARNING: Not crediting for package '. $cust_pkg->pkgnum. + ' ( customer '. $cust_pkg->custnum. ')'. + ' - credits not (yet) available for '. + ' packages with '. $part_pkg->freq_pretty. ' frequency'; + } + } + + my $percent = $self->option('percent'); + + #my @arg = $no_cust_pkg{$what} ? () : ($cust_pkg); + my @arg = ($what eq 'setup_cost') ? () : ($cust_pkg); + + sprintf('%.2f', $part_pkg->$what(@arg) * $percent / 100 ); + +} + +1; diff --git a/FS/FS/part_event/Action/pkg_agent_credit.pm b/FS/FS/part_event/Action/pkg_agent_credit.pm new file mode 100644 index 000000000..4bcee983b --- /dev/null +++ b/FS/FS/part_event/Action/pkg_agent_credit.pm @@ -0,0 +1,39 @@ +package FS::part_event::Action::pkg_agent_credit; + +use strict; +use base qw( FS::part_event::Action::pkg_referral_credit ); + +sub description { 'Credit the agent a specific amount'; } + +#a little false laziness w/pkg_referral_credit +sub do_action { + my( $self, $cust_pkg, $cust_event ) = @_; + + my $cust_main = $self->cust_main($cust_pkg); + + my $agent = $cust_main->agent; + return "No customer record for agent ". $agent->agent + unless $agent->agent_custnum; + + my $agent_cust_main = $agent->agent_cust_main; + #? or return "No customer record for agent ". $agent->agent; + + my $amount = $self->_calc_credit($cust_pkg); + return '' unless $amount > 0; + + my $reasonnum = $self->option('reasonnum'); + + my $error = $agent_cust_main->credit( + $amount, + \$reasonnum, + 'eventnum' => $cust_event->eventnum, + 'addlinfo' => 'for customer #'. $cust_main->display_custnum. + ': '.$cust_main->name, + ); + die "Error crediting customer ". $agent_cust_main->custnum. + " for agent commission: $error" + if $error; + +} + +1; diff --git a/FS/FS/part_event/Action/pkg_agent_credit_pkg.pm b/FS/FS/part_event/Action/pkg_agent_credit_pkg.pm new file mode 100644 index 000000000..b3e11817d --- /dev/null +++ b/FS/FS/part_event/Action/pkg_agent_credit_pkg.pm @@ -0,0 +1,9 @@ +package FS::part_event::Action::pkg_agent_credit_pkg; + +use strict; +use base qw( FS::part_event::Action::Mixin::credit_pkg + FS::part_event::Action::pkg_agent_credit ); + +sub description { 'Credit the agent an amount based on the referred package'; } + +1; diff --git a/FS/FS/part_event/Action/pkg_employee_credit.pm b/FS/FS/part_event/Action/pkg_employee_credit.pm new file mode 100644 index 000000000..e4913a21f --- /dev/null +++ b/FS/FS/part_event/Action/pkg_employee_credit.pm @@ -0,0 +1,44 @@ +package FS::part_event::Action::pkg_employee_credit; + +use strict; +use base qw( FS::part_event::Action::pkg_referral_credit ); +use FS::Record qw(qsearchs); +use FS::access_user; + +sub description { 'Credit the ordering employee a specific amount'; } + +#a little false laziness w/pkg_referral_credit +sub do_action { + my( $self, $cust_pkg, $cust_event ) = @_; + + my $cust_main = $self->cust_main($cust_pkg); + + #yuck. this is why text $otaker is gone in 2.1 + my $otaker = $cust_pkg->otaker; + my $employee = qsearchs('access_user', { 'username' => $otaker } ) + or return "No employee for username $otaker"; + return "No customer record for employee ". $employee->username + unless $employee->user_custnum; + + my $employee_cust_main = $employee->user_cust_main; + #? or return "No customer record for employee ". $employee->username; + + my $amount = $self->_calc_credit($cust_pkg); + return '' unless $amount > 0; + + my $reasonnum = $self->option('reasonnum'); + + my $error = $employee_cust_main->credit( + $amount, + \$reasonnum, + 'eventnum' => $cust_event->eventnum, + 'addlinfo' => 'for customer #'. $cust_main->display_custnum. + ': '.$cust_main->name, + ); + die "Error crediting customer ". $employee_cust_main->custnum. + " for employee commission: $error" + if $error; + +} + +1; diff --git a/FS/FS/part_event/Action/pkg_employee_credit_pkg.pm b/FS/FS/part_event/Action/pkg_employee_credit_pkg.pm new file mode 100644 index 000000000..e3b867fb2 --- /dev/null +++ b/FS/FS/part_event/Action/pkg_employee_credit_pkg.pm @@ -0,0 +1,9 @@ +package FS::part_event::Action::pkg_employee_credit_pkg; + +use strict; +use base qw( FS::part_event::Action::Mixin::credit_pkg + FS::part_event::Action::pkg_employee_credit ); + +sub description { 'Credit the ordering employee an amount based on the referred package'; } + +1; diff --git a/FS/FS/part_event/Action/pkg_referral_credit.pm b/FS/FS/part_event/Action/pkg_referral_credit.pm index 98d982066..e7c92d650 100644 --- a/FS/FS/part_event/Action/pkg_referral_credit.pm +++ b/FS/FS/part_event/Action/pkg_referral_credit.pm @@ -22,9 +22,8 @@ sub option_fields { } -#a little false laziness w/pkg_referral_credit_pkg sub do_action { - my( $self, $cust_pkg ) = @_; + my( $self, $cust_pkg, $cust_event ) = @_; my $cust_main = $self->cust_main($cust_pkg); @@ -36,14 +35,17 @@ sub do_action { return 'Referring customer is cancelled' if $referring_cust_main->status eq 'cancelled'; - my $amount = $self->_calc_referral_credit($cust_pkg); + my $amount = $self->_calc_credit($cust_pkg); + return '' unless $amount > 0; + my $reasonnum = $self->option('reasonnum'); my $error = $referring_cust_main->credit( $amount, \$reasonnum, - 'addlinfo' => - 'for customer #'. $cust_main->display_custnum. ': '.$cust_main->name, + 'eventnum' => $cust_event->eventnum, + 'addlinfo' => 'for customer #'. $cust_main->display_custnum. + ': '.$cust_main->name, ); die "Error crediting customer ". $cust_main->referral_custnum. " for referral: $error" @@ -51,7 +53,7 @@ sub do_action { } -sub _calc_referral_credit { +sub _calc_credit { my( $self, $cust_pkg ) = @_; $self->option('amount'); diff --git a/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm b/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm index eb9b5107c..667c4ce19 100644 --- a/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm +++ b/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm @@ -1,58 +1,9 @@ package FS::part_event::Action::pkg_referral_credit_pkg; use strict; -use base qw( FS::part_event::Action::pkg_referral_credit ); +use base qw( FS::part_event::Action::Mixin::credit_pkg + FS::part_event::Action::pkg_referral_credit ); sub description { 'Credit the referring customer an amount based on the referred package'; } -#sub eventtable_hashref { -# { 'cust_pkg' => 1 }; -#} - -sub option_fields { - ( - 'reasonnum' => { 'label' => 'Credit reason', - 'type' => 'select-reason', - 'reason_class' => 'R', - }, - 'percent' => { 'label' => 'Percent', - 'type' => 'input-percentage', - 'default' => '100', - }, - 'what' => { 'label' => 'Of', - 'type' => 'select', - #also add some way to specify in the package def, no? - 'options' => [ qw( base_recur_permonth ) ], - 'labels' => { 'base_recur_permonth' => 'Base monthly fee', }, - }, - ); - -} - -sub _calc_referral_credit { - my( $self, $cust_pkg ) = @_; - - my $cust_main = $self->cust_main($cust_pkg); - - my $part_pkg = $cust_pkg->part_pkg; - - my $what = $self->option('what'); - - #false laziness w/Condition/cust_payments_pkg.pm - if ( $what eq 'base_recur_permonth' ) { #huh. yuck. - if ( $part_pkg->freq !~ /^\d+$/ ) { - die 'WARNING: Not crediting customer '. $cust_main->referral_custnum. - ' for package '. $cust_pkg->pkgnum. - ' ( customer '. $cust_pkg->custnum. ')'. - ' - Referral credits not (yet) available for '. - ' packages with '. $part_pkg->freq_pretty. ' frequency'; - } - } - - my $percent = $self->option('percent'); - - sprintf('%.2f', $part_pkg->$what($cust_pkg) * $percent / 100 ); - -} - 1; diff --git a/FS/FS/part_event/Condition/balance.pm b/FS/FS/part_event/Condition/balance.pm index 65670c030..3b8854ab8 100644 --- a/FS/FS/part_event/Condition/balance.pm +++ b/FS/FS/part_event/Condition/balance.pm @@ -40,7 +40,7 @@ sub condition_sql { my $balance_sql = FS::cust_main->balance_sql; - "$balance_sql > CAST( $over AS numeric )"; + "$balance_sql > CAST( $over AS DECIMAL(10,2) )"; } diff --git a/FS/FS/part_event/Condition/balance_age.pm b/FS/FS/part_event/Condition/balance_age.pm index f1a970796..fc3461210 100644 --- a/FS/FS/part_event/Condition/balance_age.pm +++ b/FS/FS/part_event/Condition/balance_age.pm @@ -38,7 +38,7 @@ sub condition_sql { my $balance_sql = FS::cust_main->balance_date_sql( $age ); - "$balance_sql > CAST( $over AS numeric )"; + "$balance_sql > CAST( $over AS DECIMAL(10,2) )"; } sub order_sql { diff --git a/FS/FS/part_event/Condition/balance_under.pm b/FS/FS/part_event/Condition/balance_under.pm index 9c7159011..2002c7018 100644 --- a/FS/FS/part_event/Condition/balance_under.pm +++ b/FS/FS/part_event/Condition/balance_under.pm @@ -34,7 +34,7 @@ sub condition_sql { my $balance_sql = FS::cust_main->balance_sql; - "$balance_sql <= CAST( $under AS numeric )"; + "$balance_sql <= CAST( $under AS DECIMAL(10,2) )"; } diff --git a/FS/FS/part_event/Condition/cust_bill_has_service.pm b/FS/FS/part_event/Condition/cust_bill_has_service.pm index 91d75ddac..d85af261e 100644 --- a/FS/FS/part_event/Condition/cust_bill_has_service.pm +++ b/FS/FS/part_event/Condition/cust_bill_has_service.pm @@ -38,14 +38,16 @@ sub condition { } sub condition_sql { - my( $class, $table ) = @_; + my( $class, $table, %opt ) = @_; + + my $integer = $opt{'driver_name'} =~ /^mysql/ ? 'UNSIGNED INTEGER' : 'INTEGER'; my $servicenum = $class->condition_sql_option('has_service'); my $sql = qq| 0 < ( SELECT COUNT(cs.svcpart) FROM cust_bill_pkg cbp, cust_svc cs WHERE cbp.invnum = cust_bill.invnum AND cs.pkgnum = cbp.pkgnum - AND cs.svcpart = CAST( $servicenum AS integer ) + AND cs.svcpart = CAST( $servicenum AS $integer ) ) |; return $sql; diff --git a/FS/FS/part_event/Condition/cust_bill_owed.pm b/FS/FS/part_event/Condition/cust_bill_owed.pm index 0fd992282..d8c77c777 100644 --- a/FS/FS/part_event/Condition/cust_bill_owed.pm +++ b/FS/FS/part_event/Condition/cust_bill_owed.pm @@ -48,7 +48,7 @@ sub condition_sql { my $owed_sql = FS::cust_bill->owed_sql; - "$owed_sql > CAST( $over AS numeric )"; + "$owed_sql > CAST( $over AS DECIMAL(10,2) )"; } 1; diff --git a/FS/FS/part_event/Condition/cust_bill_owed_under.pm b/FS/FS/part_event/Condition/cust_bill_owed_under.pm index a0bf92f27..4eb6439b6 100644 --- a/FS/FS/part_event/Condition/cust_bill_owed_under.pm +++ b/FS/FS/part_event/Condition/cust_bill_owed_under.pm @@ -43,7 +43,7 @@ sub condition_sql { my $owed_sql = FS::cust_bill->owed_sql; - "$owed_sql <= CAST( $under AS numeric )"; + "$owed_sql <= CAST( $under AS DECIMAL(10,2) )"; } 1; diff --git a/FS/FS/part_event/Condition/every.pm b/FS/FS/part_event/Condition/every.pm index 3408b0aa9..1910674f8 100644 --- a/FS/FS/part_event/Condition/every.pm +++ b/FS/FS/part_event/Condition/every.pm @@ -50,7 +50,7 @@ sub condition { or die "unparsable retry_delay: $retry_delay"; my $date_after = $time - $1 * $after{$2}; - my $sth = dbh->prepare("$sql AND date > ?") # AND status = 'failed' " + my $sth = dbh->prepare("$sql AND _date > ?") # AND status = 'failed' " or die dbh->errstr. " preparing: $sql"; $sth->execute($self->eventpart, $tablenum, $date_after) or die $sth->errstr. " executing: $sql"; diff --git a/FS/FS/part_event_condition.pm b/FS/FS/part_event_condition.pm index d13e84927..32f19a3ae 100644 --- a/FS/FS/part_event_condition.pm +++ b/FS/FS/part_event_condition.pm @@ -2,7 +2,7 @@ package FS::part_event_condition; use strict; use vars qw( @ISA $DEBUG @SKIP_CONDITION_SQL ); -use FS::UID qw(dbh); +use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearch qsearchs ); use FS::option_Common; use FS::part_event; #for order_conditions_sql... @@ -285,7 +285,9 @@ sub where_conditions_sql { map { my $conditionname = $_; my $coderef = $conditions{$conditionname}->{condition_sql}; - my $sql = &$coderef( $eventtable, 'time'=>$time ); + my $sql = &$coderef( $eventtable, 'time' => $time, + 'driver_name' => driver_name(), + ); die "$coderef is not a CODEREF" unless ref($coderef) eq 'CODE'; "( cond_$conditionname.conditionname IS NULL OR $sql )"; } diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 16aad6dcd..588606dc1 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -226,6 +226,17 @@ sub export_svc { qsearch('export_svc', { 'exportnum' => $self->exportnum } ); } +=item export_device + +Returns a list of associated FS::export_device records. + +=cut + +sub export_device { + my $self = shift; + qsearch('export_device', { 'exportnum' => $self->exportnum } ); +} + =item part_export_option Returns all options as FS::part_export_option objects (see @@ -365,6 +376,15 @@ Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT. The elements are displayed in the UI to lead the the operator to external configuration, monitoring, and similar tools. +=item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF + +Adds a hashref of settings to SETTINGSREF specific to this export and +SVC_OBJECT. The elements can be displayed in the UI on the service view. + +DEFAULTSREF is a hashref with the same keys where true values indicate the +setting is a default (and thus can be displayed in the UI with less emphasis, +or hidden by default). + =cut =back diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm index ecb378090..7f5cece59 100644 --- a/FS/FS/part_export/communigate_pro.pm +++ b/FS/FS/part_export/communigate_pro.pm @@ -1,35 +1,43 @@ package FS::part_export::communigate_pro; -use vars qw(@ISA %info %options); +use strict; +use vars qw(@ISA %info %options %quotas $DEBUG); +use Data::Dumper; use Tie::IxHash; use FS::part_export; use FS::queue; @ISA = qw(FS::part_export); +$DEBUG = 1; + tie %options, 'Tie::IxHash', - 'port' => { label=>'Port number', default=>'106', }, - 'login' => { label=>'The administrator account name. The name can contain a domain part.', }, - 'password' => { label=>'The administrator account password.', }, - 'accountType' => { label=>'Type for newly-created accounts', - type=>'select', - options=>[qw( MultiMailbox TextMailbox MailDirMailbox )], - default=>'MultiMailbox', - }, - 'externalFlag' => { label=> 'Create accounts with an external (visible for legacy mailers) INBOX.', - type=>'checkbox', - }, - 'AccessModes' => { label=>'Access modes', - default=>'Mail POP IMAP PWD WebMail WebSite', - }, + 'port' => { label =>'Port number', default=>'106', }, + 'login' => { label =>'The administrator account name. The name can contain a domain part.', }, + 'password' => { label =>'The administrator account password.', }, + 'accountType' => { label => 'Type for newly-created accounts (default when not specified in service)', + type => 'select', + options => [qw(MultiMailbox TextMailbox MailDirMailbox AGrade BGrade CGrade)], + default => 'MultiMailbox', + }, + 'externalFlag' => { label => 'Create accounts with an external (visible for legacy mailers) INBOX.', + type => 'checkbox', + }, + 'AccessModes' => { label => 'Access modes (default when not specified in service)', + default => 'Mail POP IMAP PWD WebMail WebSite', + }, + 'create_domain' => { label => 'Domain creation API call', + type => 'select', + options => [qw( CreateDomain CreateSharedDomain )], + } ; %info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to a CommuniGate Pro mail server', + 'svc' => [qw( svc_acct svc_domain svc_forward svc_mailinglist )], + 'desc' => 'Real-time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro mail server', 'options' => \%options, 'notes' => <<'END' -Real time export to a +Real time export of accounts, domains, mail forwards and mailing lists to a <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> mail server. The <a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> @@ -37,6 +45,13 @@ must be installed as CGP::CLI. END ); +%quotas = ( + 'quota' => 'MaxAccountSize', + 'file_quota' => 'MaxWebSize', + 'file_maxnum' => 'MaxWebFiles', + 'file_maxsize' => 'MaxFileSize', +); + sub rebless { shift; } sub export_username { @@ -45,82 +60,727 @@ sub export_username { } sub _export_insert { + my( $self, $svc_x ) = (shift, shift); + + my $table = $svc_x->table; + my $method = "_export_insert_$table"; + $self->$method($svc_x, @_); +} + +sub _export_insert_svc_acct { my( $self, $svc_acct ) = (shift, shift); - my @options = ( $svc_acct->svcnum, 'CreateAccount', - 'accountName' => $self->export_username($svc_acct), - 'accountType' => $self->option('accountType'), - 'AccessModes' => $self->option('AccessModes'), + + my %settings = ( + 'AccessModes' => [ split(' ', ( $svc_acct->cgp_accessmodes + || $self->option('AccessModes') ) + ) + ], 'RealName' => $svc_acct->finger, 'Password' => $svc_acct->_password, + map { $quotas{$_} => $svc_acct->$_() } + grep $svc_acct->$_(), keys %quotas + ); + #phase 2: pwdallowed, passwordrecovery, allowed mail rules, + # RPOP modifications, accepts mail to all, add trailer to sent mail + #phase 3: archive messages, mailing lists + + my @options = ( 'CreateAccount', + 'accountName' => $self->export_username($svc_acct), + 'accountType' => ( $svc_acct->cgp_type + || $self->option('accountType') ), + 'settings' => \%settings ); - push @options, 'MaxAccountSize' => $svc_acct->quota if $svc_acct->quota; + push @options, 'externalFlag' => $self->option('externalFlag') if $self->option('externalFlag'); - $self->communigate_pro_queue( @options ); + #let's do the create realtime too, for much the same reasons, and to avoid + #pain of trying to queue w/dep the prefs & aliases + eval { $self->communigate_pro_runcommand( @options ) }; + return $@ if $@; + + #preferences + my %prefs = (); + $prefs{'DeleteMode'} = $svc_acct->cgp_deletemode if $svc_acct->cgp_deletemode; + $prefs{'EmptyTrash'} = $svc_acct->cgp_emptytrash if $svc_acct->cgp_emptytrash; + #phase 2: language, time zone, layout, pronto style, send read receipts + if ( keys %prefs ) { + my $pref_err = $self->communigate_pro_queue( $svc_acct->svcnum, + 'UpdateAccountPrefs', + $self->export_username($svc_acct), + %prefs, + ); + warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err" + if $pref_err; + } + + #aliases + if ( $svc_acct->cgp_aliases ) { + my $alias_err = $self->communigate_pro_queue( $svc_acct->svcnum, + 'SetAccountAliases', + $self->export_username($svc_acct), + [ split(/\s*[,\s]\s*/, $svc_acct->cgp_aliases) ], + ); + warn "WARNING: error queueing SetAccountAliases job: $alias_err" + if $alias_err; + } + + ''; + +} + +sub _export_insert_svc_domain { + my( $self, $svc_domain ) = (shift, shift); + + my $create = $self->option('create_domain') || 'CreateDomain'; + + my %settings = ( + 'DomainAccessModes' => [ split(' ', $svc_domain->cgp_accessmodes ) ], + ); + $settings{'AccountsLimit'} = $svc_domain->max_accounts + if $svc_domain->max_accounts; + $settings{'AdminDomainName'} = $svc_domain->parent_svc_x->domain + if $svc_domain->parent_svcnum; + + my @options = ( $create, $svc_domain->domain, \%settings ); + + eval { $self->communigate_pro_runcommand( @options ) }; + return $@ if $@; + + #aliases + if ( $svc_domain->cgp_aliases ) { + my $alias_err = $self->communigate_pro_queue( $svc_domain->svcnum, + 'SetDomainAliases', + $svc_domain->domain, + split(/\s*[,\s]\s*/, $svc_domain->cgp_aliases), + ); + warn "WARNING: error queueing SetDomainAliases job: $alias_err" + if $alias_err; + } + + #account defaults + my $def_err = $self->communigate_pro_queue( $svc_domain->svcnum, + 'SetAccountDefaults', + $svc_domain->domain, + 'PWDAllowed' =>($svc_domain->acct_def_password_selfchange ? 'YES':'NO'), + 'PasswordRecovery' => ($svc_domain->acct_def_password_recover ? 'YES':'NO'), + 'AccessModes' => $svc_domain->acct_def_cgp_accessmodes, + 'MaxAccountSize' => $svc_domain->acct_def_quota, + 'MaxWebSize' => $svc_domain->acct_def_file_quota, + 'MaxWebFile' => $svc_domain->acct_def_file_maxnum, + 'MaxFileSize' => $svc_domain->acct_def_file_maxsize, + ); + warn "WARNING: error queueing SetAccountDefaults job: $def_err" + if $def_err; + + #account defaults prefs + my $pref_err = $self->communigate_pro_queue( $svc_domain->svcnum, + 'SetAccountDefaultPrefs', + $svc_domain->domain, + 'DeleteMode' => $svc_domain->acct_def_cgp_deletemode, + 'EmptyTrash' => $svc_domain->acct_def_cgp_emptytrash, + ); + warn "WARNING: error queueing SetAccountDefaultPrefs job: $pref_err" + if $pref_err; + + ''; + +} + +sub _export_insert_svc_forward { + my( $self, $svc_forward ) = (shift, shift); + + my $src = $svc_forward->src || $svc_forward->srcsvc_acct->email; + my $dst = $svc_forward->dst || $svc_forward->dstsvc_acct->email; + + #real-time here, presuming CGP does some dup detection? + eval { $self->communigate_pro_runcommand( 'CreateForwarder', $src, $dst); }; + return $@ if $@; + + ''; +} + +sub _export_insert_svc_mailinglist { + my( $self, $svc_mlist ) = (shift, shift); + + my @members = map $_->email_address, + $svc_mlist->mailinglist->mailinglistmember; + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'CreateGroup', + $svc_mlist->username.'@'.$svc_mlist->domain, + { 'RealName' => $svc_mlist->listname, + 'SetReplyTo' => ( $svc_mlist->reply_to ? 'YES' : 'NO' ), + 'RemoveAuthor' => ( $svc_mlist->remove_from ? 'YES' : 'NO' ), + 'RejectAuto' => ( $svc_mlist->reject_auto ? 'YES' : 'NO' ), + 'RemoveToAndCc' => ( $svc_mlist->remove_to_and_cc ? 'YES' : 'NO' ), + 'Members' => \@members, + } + ); + }; + return $@ if $@; + + ''; + } sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); - return "can't (yet) change username with CommuniGate Pro" - if $old->username ne $new->username; - return "can't (yet) change domain with CommuniGate Pro" - if $self->export_username($old) ne $self->export_username($new); - return "can't (yet) change GECOS with CommuniGate Pro" + + my $table = $new->table; + my $method = "_export_replace_$table"; + $self->$method($new, $old, @_); +} + +sub _export_replace_svc_acct { + my( $self, $new, $old ) = (shift, shift, shift); + + #let's just do the rename part realtime rather than trying to queue + #w/dependencies. we don't want FS winding up out-of-sync with the wrong + #username and a queued job anyway. right?? + if ( $self->export_username($old) ne $self->export_username($new) ) { + eval { $self->communigate_pro_runcommand( + 'RenameAccount', + $self->export_username($old), + $self->export_username($new), + ) }; + return $@ if $@; + } + + if ( $new->_password ne $old->_password + && '*SUSPENDED* '.$old->_password ne $new->_password + ) { + $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword', + $self->export_username($new), $new->_password + ); + } + + my %settings = (); + + $settings{'RealName'} = $new->finger if $old->finger ne $new->finger; - return "can't (yet) change quota with CommuniGate Pro" - if $old->quota ne $new->quota; - return '' unless $old->username ne $new->username - || $old->_password ne $new->_password - || $old->finger ne $new->finger - || $old->quota ne $new->quota; + $settings{$quotas{$_}} = $new->$_() + foreach grep $old->$_() ne $new->$_(), keys %quotas; + $settings{'accountType'} = $new->cgp_type + if $old->cgp_type ne $new->cgp_type; + $settings{'AccessModes'} = $new->cgp_accessmodes + if $old->cgp_accessmodes ne $new->cgp_accessmodes + || $old->cgp_type ne $new->cgp_type; + + #phase 2: pwdallowed, passwordrecovery, allowed mail rules, + # RPOP modifications, accepts mail to all, add trailer to sent mail + #phase 3: archive messages, mailing lists - return '' if '*SUSPENDED* '. $old->_password eq $new->_password; + if ( keys %settings ) { + my $error = $self->communigate_pro_queue( + $new->svcnum, + 'UpdateAccountSettings', + $self->export_username($new), + %settings, + ); + return $error if $error; + } - #my $err_or_queue = $self->communigate_pro_queue( $new->svcnum,'RenameAccount', - # $old->email, $new->email ); - #return $err_or_queue unless ref($err_or_queue); - #my $jobnum = $err_or_queue->jobnum; + #preferences + my %prefs = (); + $prefs{'DeleteMode'} = $new->cgp_deletemode + if $old->cgp_deletemode ne $new->cgp_deletemode; + $prefs{'EmptyTrash'} = $new->cgp_emptytrash + if $old->cgp_emptytrash ne $new->cgp_emptytrash; + #phase 2: language, time zone, layout, pronto style, send read receipts + if ( keys %prefs ) { + my $pref_err = $self->communigate_pro_queue( $new->svcnum, + 'UpdateAccountPrefs', + $self->export_username($new), + %prefs, + ); + warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err" + if $pref_err; + } - $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword', - $self->export_username($new), $new->_password ) - if $new->_password ne $old->_password; + if ( $old->cgp_aliases ne $new->cgp_aliases ) { + my $error = $self->communigate_pro_queue( + $new->svcnum, + 'SetAccountAliases', + $self->export_username($new), + [ split(/\s*[,\s]\s*/, $new->cgp_aliases) ], + ); + return $error if $error; + } + + ''; + +} + +sub _export_replace_svc_domain { + my( $self, $new, $old ) = (shift, shift, shift); + + if ( $old->domain ne $new->domain ) { + my $error = $self->communigate_pro_queue( $new->svcnum, 'RenameDomain', + $old->domain, $new->domain, + ); + return $error if $error; + } + my %settings = (); + $settings{'AccountsLimit'} = $new->max_accounts + if $old->max_accounts ne $new->max_accounts; + $settings{'DomainAccessModes'} = $new->cgp_accessmodes + if $old->cgp_accessmodes ne $new->cgp_accessmodes; + $settings{'AdminDomainName'} = + $new->parent_svcnum ? $new->parent_svc_x->domain : '' + if $old->parent_svcnum != $new->parent_svcnum; + + if ( keys %settings ) { + my $error = $self->communigate_pro_queue( $new->svcnum, + 'UpdateDomainSettings', + $new->domain, + %settings, + ); + return $error if $error; + } + + if ( $old->cgp_aliases ne $new->cgp_aliases ) { + my $error = $self->communigate_pro_queue( $new->svcnum, + 'SetDomainAliases', + $new->domain, + split(/\s*[,\s]\s*/, $new->cgp_aliases), + ); + return $error if $error; + } + + #below this identical to insert... any value to doing an Update here? + #not seeing any big one... i guess it would be nice to avoid the update + #when things haven't changed + + #account defaults + my $def_err = $self->communigate_pro_queue( $new->svcnum, + 'SetAccountDefaults', + $new->domain, + 'PWDAllowed' => ( $new->acct_def_password_selfchange ? 'YES' : 'NO' ), + 'PasswordRecovery' => ( $new->acct_def_password_recover ? 'YES' : 'NO' ), + 'AccessModes' => $new->acct_def_cgp_accessmodes, + 'MaxAccountSize' => $new->acct_def_quota, + 'MaxWebSize' => $new->acct_def_file_quota, + 'MaxWebFile' => $new->acct_def_file_maxnum, + 'MaxFileSize' => $new->acct_def_file_maxsize, + ); + warn "WARNING: error queueing SetAccountDefaults job: $def_err" + if $def_err; + + #account defaults prefs + my $pref_err = $self->communigate_pro_queue( $new->svcnum, + 'SetAccountDefaultPrefs', + $new->domain, + 'DeleteMode' => $new->acct_def_cgp_deletemode, + 'EmptyTrash' => $new->acct_def_cgp_emptytrash, + ); + warn "WARNING: error queueing SetAccountDefaultPrefs job: $pref_err" + if $pref_err; + + ''; +} + +sub _export_replace_svc_forward { + my( $self, $new, $old ) = (shift, shift, shift); + + my $osrc = $old->src || $old->srcsvc_acct->email; + my $nsrc = $new->src || $new->srcsvc_acct->email; + my $odst = $old->dst || $old->dstsvc_acct->email; + my $ndst = $new->dst || $new->dstsvc_acct->email; + + if ( $odst ne $ndst ) { + + #no change command, so delete and create (real-time) + eval { $self->communigate_pro_runcommand('DeleteForwarder', $osrc) }; + return $@ if $@; + eval { $self->communigate_pro_runcommand('CreateForwarder', $nsrc, $ndst)}; + return $@ if $@; + + } elsif ( $osrc ne $nsrc ) { + + #real-time here, presuming CGP does some dup detection? + eval { $self->communigate_pro_runcommand( 'RenameForwarder', $osrc, $nsrc)}; + return $@ if $@; + + } else { + warn "communigate replace called for svc_forward with no changes\n";#confess + } + + ''; +} + +sub _export_replace_svc_mailinglist { + my( $self, $new, $old ) = (shift, shift, shift); + + my $oldGroupName = $old->username.'@'.$old->domain; + my $newGroupName = $new->username.'@'.$new->domain; + + if ( $oldGroupName ne $newGroupName ) { + eval { $self->communigate_pro_runcommand( + 'RenameGroup', $oldGroupName, $newGroupName ); }; + return $@ if $@; + } + + my @members = map $_->email_address, + $new->mailinglist->mailinglistmember; + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'SetGroup', $newGroupName, + { 'RealName' => $new->listname, + 'SetReplyTo' => ( $new->reply_to ? 'YES' : 'NO' ), + 'RemoveAuthor' => ( $new->remove_from ? 'YES' : 'NO' ), + 'RejectAuto' => ( $new->reject_auto ? 'YES' : 'NO' ), + 'RemoveToAndCc' => ( $new->remove_to_and_cc ? 'YES' : 'NO' ), + 'Members' => \@members, + } + ); + }; + return $@ if $@; + + ''; } sub _export_delete { + my( $self, $svc_x ) = (shift, shift); + + my $table = $svc_x->table; + my $method = "_export_delete_$table"; + $self->$method($svc_x, @_); +} + +sub _export_delete_svc_acct { my( $self, $svc_acct ) = (shift, shift); + $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount', $self->export_username($svc_acct), ); } +sub _export_delete_svc_domain { + my( $self, $svc_domain ) = (shift, shift); + + $self->communigate_pro_queue( $svc_domain->svcnum, 'DeleteDomain', + $svc_domain->domain, + #XXX turn on force option for domain deletion? + ); +} + +sub _export_delete_svc_forward { + my( $self, $svc_forward ) = (shift, shift); + + $self->communigate_pro_queue( $svc_forward->svcnum, 'DeleteForwarder', + ($svc_forward->src || $svc_forward->srcsvc_acct->email), + ); +} + +sub _export_delete_svc_mailinglist { + my( $self, $svc_mailinglist ) = (shift, shift); + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'DeleteGroup', + $svc_mailinglist->username.'@'.$svc_mailinglist->domain, + ); + }; + return $@ if $@; + + ''; + +} + sub _export_suspend { + my( $self, $svc_x ) = (shift, shift); + + my $table = $svc_x->table; + my $method = "_export_suspend_$table"; + $self->$method($svc_x, @_); + +} + +sub _export_suspend_svc_acct { my( $self, $svc_acct ) = (shift, shift); - $self->communigate_pro_queue( $svc_acct->svcnum, 'UpdateAccountSettings', - 'accountName' => $self->export_username($svc_acct), + + #XXX is this the desired suspnsion action? + + $self->communigate_pro_queue( + $svc_acct->svcnum, + 'UpdateAccountSettings', + $self->export_username($svc_acct), 'AccessModes' => 'Mail', ); + +} + +sub _export_suspend_svc_domain { + my( $self, $svc_domain) = (shift, shift); + + #XXX domain operations + ''; + } sub _export_unsuspend { + my( $self, $svc_x ) = (shift, shift); + + my $table = $svc_x->table; + my $method = "_export_unsuspend_$table"; + $self->$method($svc_x, @_); + +} + +sub _export_unsuspend_svc_acct { my( $self, $svc_acct ) = (shift, shift); - $self->communigate_pro_queue( $svc_acct->svcnum, 'UpdateAccountSettings', - 'accountName' => $self->export_username($svc_acct), - 'AccessModes' => $self->option('AccessModes'), + + $self->communigate_pro_queue( + $svc_acct->svcnum, + 'UpdateAccountSettings', + $self->export_username($svc_acct), + 'AccessModes' => ( $svc_acct->cgp_accessmodes + || $self->option('AccessModes') ), + ); + +} + +sub _export_unsuspend_svc_domain { + my( $self, $svc_domain) = (shift, shift); + + #XXX domain operations + ''; + +} + +sub export_mailinglistmember_insert { + my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift); + $svc_mailinglist->replace(); +} + +sub export_mailinglistmember_replace { + my( $self, $svc_mailinglist, $new, $old ) = (shift, shift, shift, shift); + die "no way to do this from the UI right now"; +} + +sub export_mailinglistmember_delete { + my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift); + $svc_mailinglist->replace(); +} + +sub export_getsettings { + my($self, $svc_x) = (shift, shift); + + my $table = $svc_x->table; + my $method = "export_getsettings_$table"; + + $self->can($method) ? $self->$method($svc_x, @_) : ''; + +} + +sub export_getsettings_svc_domain { + my($self, $svc_domain, $settingsref, $defaultref ) = @_; + + my $settings = eval { $self->communigate_pro_runcommand( + 'GetDomainSettings', + $svc_domain->domain + ) }; + return $@ if $@; + + my $effective_settings = eval { $self->communigate_pro_runcommand( + 'GetDomainEffectiveSettings', + $svc_domain->domain + ) }; + return $@ if $@; + + my $acct_defaults = eval { $self->communigate_pro_runcommand( + 'GetAccountDefaults', + $svc_domain->domain + ) }; + return $@ if $@; + + my $acct_defaultprefs = eval { $self->communigate_pro_runcommand( + 'GetAccountDefaultPrefs', + $svc_domain->domain + ) }; + return $@ if $@; + + %$effective_settings = ( + %$effective_settings, + ( map { ("Acct. Default $_" => $acct_defaults->{$_}); } + keys(%$acct_defaults) + ), + ( map { ("Acct. Default $_" => $acct_defaultprefs->{$_}); } #diff label?? + keys(%$acct_defaultprefs) + ), ); + %$settings = ( + %$settings, + ( map { ("Acct. Default $_" => $acct_defaults->{$_}); } + keys(%$acct_defaults) + ), + ( map { ("Acct. Default $_" => $acct_defaultprefs->{$_}); } #diff label?? + keys(%$acct_defaultprefs) + ), + ); + + #aliases too + my $aliases = eval { $self->communigate_pro_runcommand( + 'GetDomainAliases', + $svc_domain->domain + ) }; + return $@ if $@; + + $effective_settings->{'Aliases'} = join(', ', @$aliases); + $settings->{'Aliases'} = join(', ', @$aliases); + + + #false laziness w/below + + my %defaults = map { $_ => 1 } + grep !exists(${$settings}{$_}), keys %$effective_settings; + + foreach my $key ( grep ref($effective_settings->{$_}), + keys %$effective_settings ) + { + my $value = $effective_settings->{$key}; + if ( ref($value) eq 'ARRAY' ) { + $effective_settings->{$key} = join(' ', @$value); + } else { + #XXX + warn "serializing ". ref($value). " for table display not yet handled"; + } + } + + %{$settingsref} = %$effective_settings; + %{$defaultref} = %defaults; + + ''; +} + +sub export_getsettings_svc_acct { + my($self, $svc_acct, $settingsref, $defaultref ) = @_; + + my $settings = eval { $self->communigate_pro_runcommand( + 'GetAccountSettings', + $svc_acct->email + ) }; + return $@ if $@; + + delete($settings->{'Password'}); + + my $effective_settings = eval { $self->communigate_pro_runcommand( + 'GetAccountEffectiveSettings', + $svc_acct->email + ) }; + return $@ if $@; + + delete($effective_settings->{'Password'}); + + #prefs/effectiveprefs too + + my $prefs = eval { $self->communigate_pro_runcommand( + 'GetAccountPrefs', + $svc_acct->email + ) }; + return $@ if $@; + + my $effective_prefs = eval { $self->communigate_pro_runcommand( + 'GetAccountEffectivePrefs', + $svc_acct->email + ) }; + return $@ if $@; + + %$effective_settings = ( %$effective_settings, + map { ("Pref $_" => $effective_prefs->{$_}); } + keys(%$effective_prefs) + ); + %$settings = ( %$settings, + map { ("Pref $_" => $prefs->{$_}); } + keys(%$prefs) + ); + + #aliases too + + my $aliases = eval { $self->communigate_pro_runcommand( + 'GetAccountAliases', + $svc_acct->email + ) }; + return $@ if $@; + + $effective_settings->{'Aliases'} = join(', ', @$aliases); + $settings->{'Aliases'} = join(', ', @$aliases); + + #false laziness w/above + + my %defaults = map { $_ => 1 } + grep !exists(${$settings}{$_}), keys %$effective_settings; + + foreach my $key ( grep ref($effective_settings->{$_}), + keys %$effective_settings ) + { + my $value = $effective_settings->{$key}; + if ( ref($value) eq 'ARRAY' ) { + $effective_settings->{$key} = join(' ', @$value); + } else { + #XXX + warn "serializing ". ref($value). " for table display not yet handled"; + } + } + + %{$settingsref} = %$effective_settings; + %{$defaultref} = %defaults; + + ''; + +} + +sub export_getsettings_svc_mailinglist { + my($self, $svc_mailinglist, $settingsref, $defaultref ) = @_; + + my $settings = eval { $self->communigate_pro_runcommand( + 'GetGroup', + $svc_mailinglist->username.'@'.$svc_mailinglist->domain, + ) }; + return $@ if $@; + + $settings->{'Members'} = join(', ', @{ $settings->{'Members'} } ); + + %{$settingsref} = %$settings; + + ''; } sub communigate_pro_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); - my @kludge_methods = qw(CreateAccount UpdateAccountSettings); - my $sub = 'communigate_pro_command'; - $sub = $method if grep { $method eq $_ } @kludge_methods; + my $jobnum = ''; #don't actually care + $self->communigate_pro_queue_dep( \$jobnum, $svcnum, $method, @_); +} + +sub communigate_pro_queue_dep { + my( $self, $jobnumref, $svcnum, $method ) = splice(@_,0,4); + + my %kludge_methods = ( + #'CreateAccount' => 'CreateAccount', + 'UpdateAccountSettings' => 'UpdateAccountSettings', + 'UpdateAccountPrefs' => 'cp_Scalar_Hash', + #'CreateDomain' => 'cp_Scalar_Hash', + #'CreateSharedDomain' => 'cp_Scalar_Hash', + 'UpdateDomainSettings' => 'cp_Scalar_settingsHash', + 'SetDomainAliases' => 'cp_Scalar_Array', + 'SetAccountDefaults' => 'cp_Scalar_settingsHash', + 'UpdateAccountDefaults' => 'cp_Scalar_settingsHash', + 'SetAccountDefaultPrefs' => 'cp_Scalar_settingsHash', + 'UpdateAccountDefaultPrefs' => 'cp_Scalar_settingsHash', + ); + my $sub = exists($kludge_methods{$method}) + ? $kludge_methods{$method} + : 'communigate_pro_command'; + my $queue = new FS::queue { 'svcnum' => $svcnum, 'job' => "FS::part_export::communigate_pro::$sub", }; - $queue->insert( + my $error = $queue->insert( $self->machine, $self->option('port'), $self->option('login'), @@ -128,31 +788,76 @@ sub communigate_pro_queue { $method, @_, ); + $$jobnumref = $queue->jobnum unless $error; + return $error; } -sub CreateAccount { - my( $machine, $port, $login, $password, $method, %args ) = @_; - my $accountName = delete $args{'accountName'}; - my $accountType = delete $args{'accountType'}; - my $externalFlag = delete $args{'externalFlag'}; - $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; - my @args = ( accountName => $accountName, - accountType => $accountType, - settings => \%args, - ); - #externalFlag => $externalFlag, - push @args, externalFlag => $externalFlag if $externalFlag; +sub communigate_pro_runcommand { + my( $self, $method ) = (shift, shift); + + communigate_pro_command( + $self->machine, + $self->option('port'), + $self->option('login'), + $self->option('password'), + $method, + @_, + ); +} + +#XXX one sub per arg prototype is lame. more magic? i suppose queue needs +# to store data strctures properly instead of just an arg list. right. + +sub cp_Scalar_Hash { + my( $machine, $port, $login, $password, $method, $scalar, %hash ) = @_; + my @args = ( $scalar, \%hash ); + communigate_pro_command( $machine, $port, $login, $password, $method, @args ); +} + +sub cp_Scalar_Array { + my( $machine, $port, $login, $password, $method, $scalar, @array ) = @_; + my @args = ( $scalar, \@array ); communigate_pro_command( $machine, $port, $login, $password, $method, @args ); +} + +#sub cp_Hash { +# my( $machine, $port, $login, $password, $method, %hash ) = @_; +# my @args = ( \%hash ); +# communigate_pro_command( $machine, $port, $login, $password, $method, @args ); +#} +sub cp_Scalar_settingsHash { + my( $machine, $port, $login, $password, $method, $domain, %settings ) = @_; + for (qw( AccessModes DomainAccessModes )) { + $settings{$_} = [split(' ',$settings{$_})] if $settings{$_}; + } + my @args = ( 'domain' => $domain, 'settings' => \%settings ); + communigate_pro_command( $machine, $port, $login, $password, $method, @args ); } +#sub CreateAccount { +# my( $machine, $port, $login, $password, $method, %args ) = @_; +# my $accountName = delete $args{'accountName'}; +# my $accountType = delete $args{'accountType'}; +# my $externalFlag = delete $args{'externalFlag'}; +# $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; +# my @args = ( accountName => $accountName, +# accountType => $accountType, +# settings => \%args, +# ); +# #externalFlag => $externalFlag, +# push @args, externalFlag => $externalFlag if $externalFlag; +# +# communigate_pro_command( $machine, $port, $login, $password, $method, @args ); +# +#} + sub UpdateAccountSettings { - my( $machine, $port, $login, $password, $method, %args ) = @_; - my $accountName = delete $args{'accountName'}; + my( $machine, $port, $login, $password, $method, $accountName, %args ) = @_; $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; - @args = ( $accountName, \%args ); + my @args = ( $accountName, \%args ); communigate_pro_command( $machine, $port, $login, $password, $method, @args ); } @@ -168,10 +873,15 @@ sub communigate_pro_command { #subroutine, not method 'password' => $password, } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n"; - $cli->$method(@args) or die "CGPro error: ". $cli->getErrMessage; + #warn "$method ". Dumper(@args) if $DEBUG; + + my $return = $cli->$method(@args) + or die "Communigate Pro error: ". $cli->getErrMessage. "\n"; $cli->Logout; # or die "Can't logout of CGPro: $CGP::ERR_STRING\n"; + $return; + } 1; diff --git a/FS/FS/part_export/domain_shellcommands.pm b/FS/FS/part_export/domain_shellcommands.pm index 994c113bf..582e29217 100644 --- a/FS/FS/part_export/domain_shellcommands.pm +++ b/FS/FS/part_export/domain_shellcommands.pm @@ -26,7 +26,7 @@ tie my %options, 'Tie::IxHash', 'options' => \%options, 'notes' => <<'END' Run remote commands via SSH, for domains. You will need to -<a href="../docs/ssh.html">setup SSH for unattended operation</a>. +<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. <BR><BR>Use these buttons for some useful presets: <UL> <LI> diff --git a/FS/FS/part_export/forward_shellcommands.pm b/FS/FS/part_export/forward_shellcommands.pm index cee24e452..0f79edea0 100644 --- a/FS/FS/part_export/forward_shellcommands.pm +++ b/FS/FS/part_export/forward_shellcommands.pm @@ -26,7 +26,7 @@ tie my %options, 'Tie::IxHash', 'options' => \%options, 'notes' => <<'END' Run remote commands via SSH, for forwards. You will need to -<a href="../docs/ssh.html">setup SSH for unattended operation</a>. +<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. <BR><BR>Use these buttons for some useful presets: <UL> <LI> diff --git a/FS/FS/part_export/grandstream.pm b/FS/FS/part_export/grandstream.pm new file mode 100644 index 000000000..5c6f1ed8d --- /dev/null +++ b/FS/FS/part_export/grandstream.pm @@ -0,0 +1,257 @@ +package FS::part_export::grandstream; + +use base 'FS::part_export'; +use vars qw($DEBUG $me %info $GAPSLITE_HOME $JAVA_HOME); +use URI; +use MIME::Base64; +use Tie::IxHash; +use IPC::Run qw(run); +use FS::CGI qw(rooturl); + +$DEBUG = 0; + +$me = '[' . __PACKAGE__ . ']'; +$GAPSLITE_HOME = '/usr/local/src/GS_CFG_GEN/'; + +my @java = qw( /usr/lib/jvm/default-java/ /usr/java/default/ + /usr/lib/jvm/java-6-sun/ + /usr/lib/jvm/java-1.4.2-gcj-4.1-1.4.2.0/ + ); #add more common places distros and people put their JREs + +$JAVA_HOME = (grep { -e $_ } @java)[0]; + +tie my %options, 'Tie::IxHash', + 'upload' => { label=>'Enable upload to TFTP server via SSH', + type=>'checkbox', + }, + 'user' => { label=>'User name for SSH to TFTP server' }, + 'tftproot' => { label=>'Directory in which to upload configuration' }, + 'java_home' => { label=>'Path to java to be used', + default=>$JAVA_HOME, + }, + 'gapslite_home' => { label=>'Path to grandstream configuration tool', + default=>$GAPSLITE_HOME, + }, + 'template' => { label=>'Configuration template', + type=>'textarea', + notes=>'Type or paste the configuration template here', + }, +; + +%info = ( + 'svc' => [ qw( part_device ) ], # svc_phone + 'desc' => 'Provision phone numbers to Grandstream Networks phones/ATAs', + 'options' => \%options, + 'notes' => 'Provision phone numbers to Grandstream Networks phones/ATAs. Requires a Java runtime environment and the Grandstream configuration tool to be installed.', +); + +sub rebless { shift; } + +sub gs_create_config { + my($self, $mac, %opt) = (@_); + + eval "use Net::SCP;"; + die $@ if $@; + + warn "gs_create_config called with mac of $mac\n" if $DEBUG; + $mac = sprintf('%012s', lc($mac)); + my $dir = '%%%FREESIDE_CONF%%%/cache.'. $FS::UID::datasrc; + + my $fh = new File::Temp( + TEMPLATE => "grandstream.$mac.XXXXXXXX", + DIR => $dir, + UNLINK => 0, + ); + + my $filename = $fh->filename; + + #my $template = new Text::Template ( + # TYPE => 'ARRAY', + # SOURCE => $self->option('template'), + # DELIMITERS => $delimiters, + # OUTPUT => $fh, + #); + + #$template->compile or die "Can't compile template: $Text::Template::ERROR\n"; + + #my $config = $template->fill_in( HASH => { mac_addr => $mac } ); + + print $fh $self->option('template') or die "print failed: $!"; + close $fh; + + #system( "export GAPSLITE_HOME=$GAPSLITE_HOME; export JAVA_HOME=$JAVA_HOME; ". + # "cd $dir; $GAPSLITE_HOME/bin/encode.sh $mac $filename $dir/cfg$mac" + # ) == 0 + # or die "grandstream encode failed: $!"; + my $out_and_err = ''; + my @cmd = ( "$JAVA_HOME/bin/java", + '-classpath', "$GAPSLITE_HOME/lib/gapslite.jar:$GAPSLITE_HOME/lib/bcprov-jdk14-124.jar:$GAPSLITE_HOME/config", + 'com.grandstream.cmd.TextEncoder', + $mac, $filename, "$dir/cfg$mac", + ); + run \@cmd, '>&', \$out_and_err + or die "grandstream encode failed: $out_and_err"; + + unlink $filename; + + open my $encoded, "$dir/cfg$mac" or die "open cfg$mac failed: $!"; + + my $content; + + if ($opt{upload}) { + if ($self->option('upload')) { + my $scp = new Net::SCP ( { + 'host' => $self->machine, + 'user' => $self->option('user'), + 'cwd' => $self->option('tftproot'), + } ); + + $scp->put( "$dir/cfg$mac" ) or die "upload failed: ". $scp->errstr; + } + } else { + local $/; + $content = <$encoded>; + } + + close $encoded; + unlink "$dir/cfg$mac"; + + $content; +} + +sub gs_create { + my($self, $mac) = (shift, shift); + + return unless $mac; # be more alarmed? Or check upstream? + + $self->gs_create_config($mac, 'upload' => 1); + ''; +} + +sub gs_delete { + my($self, $mac) = (shift, shift); + + $mac = sprintf('%012s', lc($mac)); + + ssh_cmd( user => $self->option('user'), + host => $self->machine, + command => 'rm', + args => [ '-f', $self->option('tftproot'). "/cfg$mac" ], + ); + ''; + +} + +sub ssh_cmd { #subroutine, not method + use Net::SSH '0.08'; + &Net::SSH::ssh_cmd( { @_ } ); +} + +sub _export_insert { +# my( $self, $svc_phone ) = (shift, shift); +# $self->gs_create($svc_phone->mac_addr); + ''; +} + +sub _export_replace { +# my( $self, $new_svc, $old_svc ) = (shift, shift, shift); +# $self->gs_delete($old_svc->mac_addr); +# $self->gs_create($new_svc->mac_addr); + ''; +} + +sub _export_delete { +# my( $self, $svc_phone ) = (shift, shift); +# $self->gs_delete($svc_phone->mac_addr); + ''; +} + +sub _export_suspend { + ''; +} + +sub _export_unsuspend { + ''; +} + +sub export_device_insert { + my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); + $self->gs_create($phone_device->mac_addr); + ''; +} + +sub export_device_delete { + my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); + $self->gs_delete($phone_device->mac_addr); + ''; +} + +sub export_device_config { + my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); + + my $mac; +# if ($phone_device) { + $mac = $phone_device->mac_addr; +# } else { +# $mac = $svc_phone->mac_addr; +# } + + return '' unless $mac; # be more alarmed? Or check upstream? + + $self->gs_create_config($mac); +} + + +sub export_device_replace { + my( $self, $svc_phone, $new_svc_or_device, $old_svc_or_device ) = + (shift, shift, shift, shift); + + $self->gs_delete($old_svc_or_device->mac_addr); + $self->gs_create($new_svc_or_device->mac_addr); + ''; +} + +# bad overloading? +sub export_links { + my($self, $svc_phone, $arrayref) = (shift, shift, shift); + + return; # remove if we actually support being an export for svc_phone; + + my @deviceparts = map { $_->devicepart } $self->export_device; + my @devices = grep { my $part = $_->devicepart; + scalar( grep { $_ == $part } @deviceparts ); + } $svc_phone->phone_device; + + my $export = $self->exportnum; + my $fsurl = rooturl(); + if (@devices) { + foreach my $device ( @devices ) { + next unless $device->mac_addr; + my $num = $device->devicenum; + push @$arrayref, + qq!<A HREF="$fsurl/misc/phone_device_config.html?exportnum=$export;devicenum=$num">!. + qq! Phone config </A>!; + } + } elsif ($svc_phone->mac_addr) { + my $num = $svc_phone->svcnum; + push @$arrayref, + qq!<A HREF="$fsurl/misc/phone_device_config.html?exportnum=$export;svcnum=$num">!. + qq! Phone config </A>!; + } #else + ''; +} + +sub export_device_links { + my($self, $svc_phone, $device, $arrayref) = (shift, shift, shift, shift); + warn "export_device_links $self $svc_phone $device $arrayref\n" if $DEBUG; + return unless $device && $device->mac_addr; + my $export = $self->exportnum; + my $fsurl = rooturl(); + my $num = $device->devicenum; + push @$arrayref, + qq!<A HREF="$fsurl/misc/phone_device_config.html?exportnum=$export;devicenum=$num">!. + qq! Phone config </A>!; + ''; +} + +1; diff --git a/FS/FS/part_export/indosoft.pm b/FS/FS/part_export/indosoft.pm new file mode 100644 index 000000000..b5734019b --- /dev/null +++ b/FS/FS/part_export/indosoft.pm @@ -0,0 +1,219 @@ +package FS::part_export::indosoft; + +use vars qw(@ISA %info $insert_hack); +use Tie::IxHash; +use Date::Format; +use FS::part_export; + +@ISA = qw(FS::part_export); + +tie my %options, 'Tie::IxHash', + 'url' => { label => 'Voicebridge API URL' }, + 'account_id' => { label => 'Voicebridge Account ID' }, +; + +%info = ( + 'svc' => 'svc_phone', #svc_bridge? svc_confbridge? + 'desc' => + 'Export conferences to the Indosoft Conference Bridge', + 'options' => \%options, + 'notes' => <<'END' +Export conferences to the Indosoft conference bridge. +Net::Indosoft::Voicebridge is required. +END +); + +$insert_hack = 0; + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_phone) = (shift, shift); + + my $cust_main = $svc_phone->cust_svc->cust_pkg->cust_main; + + my $address = $cust_main->address1; + $address .= ' '.$cust_main->address2 if $cust_main->address2; + + my $phone = $cust_main->daytime || $cust_main->night; + + my @email = $cust_main->invoicing_list_emailonly; + + #svc_phone->location_hash stuff? well that was for e911.. this shouldn't + # even be svc_phone + + #add client + my $client_return = eval { + indosoft_runcommand( 'addClient', + 'account_id' => $self->option('account_id'), + + 'client_contact_name' => $cust_main->name, #or just first last? + 'client_contact_password' => $svc_phone->sip_password, # ? + + 'client_contact_addr' => $address, + 'client_contact_city' => $cust_main->city, + 'client_contact_state' => $cust_main->state, + 'client_contact_country' => $cust_main->country, + 'client_contact_zip' => $cust_main->zip, + + 'client_contact_phone' => $phone, + 'client_contact_fax' => $cust_main->fax, + 'client_contact_email' => $email[0], + ); + }; + return $@ if $@; + + my $client_id = $client_return->{client_id}; + + #add conference + my $conf_return = eval { + indosoft_runcommand( 'addConference', + 'client_id' => $client_id, + 'conference_name' => $cust_main->name, + 'conference_desc' => $svc_phone->svcnum. ' for '. $cust_main->name, + 'start_time' => time2str('%Y-%d-$m %T', time), #now, right?? '2010-20-04 16:20:00', + #'moderated_flag' => 0, + #'entry_ann_flag' => 0 + #'record_flag' => 0 + #'moh_flag' => 0 + #'talk_detect_flag' => 0 + #'play_user_cnt_flag' => 0 + #'wait_for_admin' => 0 + #'stop_on_admin_exit' => 0 + #'second_pin' => 0 + #'secondary_pin' => 0, + #'allow_sub-conf' => 0, + #'duration' => 0, + #'conference_type' => 'reservation', #'reservationless', + ); + }; + return $@ if $@; + + my $conference_id = $conf_return->{conference_id}; + + #put conference_id in svc_phone.phonenum (and client_id in... phone_name???) + local($insert_hack) = 1; + $svc_phone->phonenum($conference_id); + $svc_phone->phone_name($client_id); + #my $error = $svc_phone->replace; + #return $error if $error; + $svc_phone->replace; + +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return "can't change phone number as conference_id with indosoft" + if $old->phonenum ne $new->phonenum && ! $insert_hack; + return ''; + + #change anything? +} + +sub _export_delete { + my( $self, $svc_phone ) = (shift, shift); + + #delete conference + my $conf_return = eval { + indosoft_runcommand( 'deleteConference', + 'conference_id' => $svc_phone->phonenum, + ); + }; + return $@ if $@; + + #delete client + my $client_return = eval { + indosoft_runcommand( 'deleteClient', + 'client_id' => $svc_phone->phone_name, + ) + }; + return $@ if $@; + + ''; + +} + +# #these three are optional +# # fallback for svc_acct will change and restore password +# sub _export_suspend { +# my( $self, $svc_phone ) = (shift, shift); +# $err_or_queue = $self->indosoft_queue( $svc_phone->svcnum, +# 'suspend', $svc_phone->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +# } +# +# sub _export_unsuspend { +# my( $self, $svc_phone ) = (shift, shift); +# $err_or_queue = $self->indosoft_queue( $svc_phone->svcnum, +# 'unsuspend', $svc_phone->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +# } +# +# sub export_links { +# my($self, $svc_phone, $arrayref) = (shift, shift, shift); +# #push @$arrayref, qq!<A HREF="http://example.com/~!. $svc_phone->username. +# # qq!">!. $svc_phone->username. qq!</A>!; +# ''; +# } + +### + +sub indosoft_runcommand { + my( $self, $method ) = (shift, shift); + + indosoft_command( + $self->option('url'), + $method, + @_, + ); + +} + +sub indosoft_command { + my( $url, $method, @args ) = @_; + + eval 'use Net::Indosoft::Voicebridge;'; + die $@ if $@; + + my $vb = new Net::Indosoft::Voicebridge( 'url' => $url ); + + my $return = $vb->$method( @args ); + + die "Indosoft error: ". $return->{'error'} if $return->{'error'}; + + $return; + +} + + +# #a good idea to queue anything that could fail or take any time +# sub indosoft_queue { +# my( $self, $svcnum, $method ) = (shift, shift, shift); +# my $queue = new FS::queue { +# 'svcnum' => $svcnum, +# 'job' => "FS::part_export::indosoft::indosoft_$method", +# }; +# $queue->insert( @_ ) or $queue; +# } +# +# sub indosoft_insert { #subroutine, not method +# my( $username, $password ) = @_; +# #do things with $username and $password +# } +# +# sub indosoft_replace { #subroutine, not method +# } +# +# sub indosoft_delete { #subroutine, not method +# my( $username ) = @_; +# #do things with $username +# } +# +# sub indosoft_suspend { #subroutine, not method +# } +# +# sub indosoft_unsuspend { #subroutine, not method +# } + + +1; diff --git a/FS/FS/part_export/netsapiens.pm b/FS/FS/part_export/netsapiens.pm index 332edccc0..83f0f0184 100644 --- a/FS/FS/part_export/netsapiens.pm +++ b/FS/FS/part_export/netsapiens.pm @@ -21,7 +21,7 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => 'svc_phone', + 'svc' => [ 'svc_phone', ], # 'part_device', 'desc' => 'Provision phone numbers to NetSapiens', 'options' => \%options, 'notes' => <<'END' @@ -72,10 +72,15 @@ sub _ns_command { $ns; } +sub ns_domain { + my($self, $svc_phone) = (shift, shift); + $svc_phone->domain || $self->option('domain'); +} + sub ns_subscriber { my($self, $svc_phone) = (shift, shift); - my $domain = $self->option('domain'); + my $domain = $self->ns_domain($svc_phone); my $phonenum = $svc_phone->phonenum; "/domains_config/$domain/subscriber_config/$phonenum"; @@ -91,7 +96,7 @@ sub ns_registrar { sub ns_devicename { my( $self, $svc_phone ) = (shift, shift); - my $domain = $self->option('domain'); + my $domain = $self->ns_domain($svc_phone); #my $countrycode = $svc_phone->countrycode; my $phonenum = $svc_phone->phonenum; @@ -121,7 +126,7 @@ sub ns_device { sub ns_create_or_update { my($self, $svc_phone, $dial_policy) = (shift, shift, shift); - my $domain = $self->option('domain'); + my $domain = $self->ns_domain($svc_phone); #my $countrycode = $svc_phone->countrycode; my $phonenum = $svc_phone->phonenum; @@ -238,7 +243,7 @@ sub _export_unsuspend { sub export_device_insert { my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); - #my $domain = $self->option('domain'); + my $domain = $self->ns_domain($svc_phone); my $countrycode = $svc_phone->countrycode; my $phonenum = $svc_phone->phonenum; @@ -256,7 +261,7 @@ sub export_device_insert { #'notes' => 'server' => 'SiPbx', - 'domain' => $self->option('domain'), + 'domain' => $domain, 'brand' => $phone_device->part_device->devicename, diff --git a/FS/FS/part_export/phone_shellcommands.pm b/FS/FS/part_export/phone_shellcommands.pm index fbb7a0bf8..040af27a7 100644 --- a/FS/FS/part_export/phone_shellcommands.pm +++ b/FS/FS/part_export/phone_shellcommands.pm @@ -27,7 +27,7 @@ tie my %options, 'Tie::IxHash', 'options' => \%options, 'notes' => <<'END' Run remote commands via SSH, for phone numbers. You will need to -<a href="../docs/ssh.html">setup SSH for unattended operation</a>. +<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. <BR><BR>Use these buttons for some useful presets: <UL> <LI> diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index 0b9e475db..ec861d3b2 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -95,7 +95,7 @@ tie my %options, 'Tie::IxHash', Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to -<a href="../docs/ssh.html">setup SSH for unattended operation</a>. +<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. <BR><BR>Use these buttons for some useful presets: <UL> diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm index c209002c8..d5a618733 100644 --- a/FS/FS/part_export/shellcommands_withdomain.pm +++ b/FS/FS/part_export/shellcommands_withdomain.pm @@ -77,7 +77,7 @@ Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to -<a href="../docs/ssh.html">setup SSH for unattended operation</a>. +<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. <BR><BR>Use these buttons for some useful presets: <UL> diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm index 3cd7039f8..869c7c7dc 100644 --- a/FS/FS/part_export/textradius.pm +++ b/FS/FS/part_export/textradius.pm @@ -25,7 +25,7 @@ Requires installation of from CPAN. If using RADIUS::UserFile 1.01, make sure to apply <a href="http://rt.cpan.org/NoAuth/Bug.html?id=1210">this patch</a>. Also make sure <a href="http://rsync.samba.org/">rsync</a> is installed on the -remote machine, and <a href="../docs/ssh.html">SSH is setup for unattended +remote machine, and <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">SSH is setup for unattended operation</a>. END ); diff --git a/FS/FS/part_export/thirdlane.pm b/FS/FS/part_export/thirdlane.pm new file mode 100644 index 000000000..60c099748 --- /dev/null +++ b/FS/FS/part_export/thirdlane.pm @@ -0,0 +1,348 @@ +package FS::part_export::thirdlane; + +use base qw( FS::part_export ); + +use vars qw(%info $me); +use Tie::IxHash; +use URI::Escape; +use Frontier::Client; + +$me = '['.__PACKAGE__.']'; + +tie my %options, 'Tie::IxHash', + #'server' => { label => 'Thirdlane server name or IP address', }, + 'username' => { label => 'Thirdlane username', }, + 'password' => { label => 'Thirdlane password', }, + 'ssl' => { label => 'Enable HTTPS (SSL) connection', + type => 'checkbox', + }, + 'port' => { label => 'Port number if not 80 or 443', }, + 'prototype_tenant' => { label => 'Prototype tenant name', }, + 'omit_countrycode' => { label => 'Omit country code', type => 'checkbox' }, + 'debug' => { label => 'Checkbox label', type => 'checkbox' }, +# 'select_option' => { label => 'Select option description', +# type => 'select', options=>[qw(chocolate vanilla)], +# default => 'vanilla', +# }, +# 'textarea_option' => { label => 'Textarea option description', +# type => 'textarea', +# default => 'Default text.', +# }, +; + +%info = ( + 'svc' => [qw( svc_pbx svc_phone svc_acct )], + 'desc' => + 'Export tenants, DIDs and admins to Thirdlane PBX manager', + 'options' => \%options, + 'notes' => <<'END' +Exports tenants, DIDs and admins to Thirdlane PBX manager using the XML-RPC API. +END +); + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_x) = (shift, shift); + + if ( $svc_x->isa('FS::svc_pbx') ) { + + return 'Name must be 19 characters or less (thirdlane restriction?)' + if length($svc_x->title) > 19; + + return 'Name must consist of alphanumerics and spaces only (thirdlane restriction?)' + unless $svc_x->title =~ /^[\w\s]+$/; + + my $tenant = { + 'tenant' => $svc_x->title, + 'maxusers' => $svc_x->max_extensions, + #others? will they not clone? + }; + + @what_to_clone = qw(routes schedules menus queues voiceprompts moh); + + my $result = $self->_thirdlane_command( 'asterisk::rpc_tenant_create', + $tenant, + $self->option('prototype_tenant'), + \@what_to_clone, + ); + + #use Data::Dumper; + #warn Dumper(\$result); + $result eq '0' ? '' : 'Thirdlane API failure (rpc_tenant_create)'; + + } elsif ( $svc_x->isa('FS::svc_phone') ) { + + my $result = $self->_thirdlane_command( + 'asterisk::rpc_did_create', + $self->_thirdlane_did($svc_x) + ); + + #use Data::Dumper; + #warn Dumper(\$result); + $result eq '0' or return 'Thirdlane API failure (rpc_did_create)'; + + return '' unless $svc_x->pbxsvc; + + $result = $self->_thirdlane_command( + 'asterisk::rpc_did_assign', + $self->_thirdlane_did($svc_x), + $svc_x->pbx_title, + ); + + #use Data::Dumper; + #warn Dumper(\$result); + $result eq '0' ? '' : 'Thirdlane API failure (rpc_did_assign)'; + + } elsif ( $svc_x->isa('FS::svc_acct') ) { + + return 'Must select a PBX' unless $svc_x->pbxsvc; + + my $result = $self->_thirdlane_command( + 'asterisk::rpc_admin_create', + $svc_x->username, + $svc_x->_password, + $svc_x->pbx_title, + ); + + #use Data::Dumper; + #warn Dumper(\$result); + $result eq '0' ? '' : 'Thirdlane API failure (rpc_admin_create)'; + + } else { + die "guru meditation #10: $svc_x is not FS::svc_pbx, FS::svc_phone or FS::svc_acct"; + } + +} + +sub _export_replace { + my($self, $new, $old) = (shift, shift, shift); + +# #return "can't change username with thirdlane" +# # if $old->username ne $new->username; +# #return '' unless $old->_password ne $new->_password; +# $err_or_queue = $self->thirdlane_queue( $new->svcnum, +# 'replace', $new->username, $new->_password ); +# ref($err_or_queue) ? '' : $err_or_queue; + + if ( $new->isa('FS::svc_pbx') ) { + + #need more info on how the API works for changing names.. can it? + return "can't change PBX name with thirdlane (yet?)" + if $old->title ne $new->title; + + my $tenant = { + 'tenant' => $old->title, + 'maxusers' => $new->max_extensions, + #others? will they not clone? + }; + + my $result = $self->_thirdlane_command( 'asterisk::rpc_tenant_update', + $tenant + ); + + #use Data::Dumper; + #warn Dumper(\$result); + $result eq '0' ? '' : 'Thirdlane API failure (rpc_tenant_update)'; + + } elsif ( $new->isa('FS::svc_phone') ) { + + return "can't change DID countrycode with thirdlane" + if $old->countrycode ne $new->countrycode; + return "can't change DID number with thirdlane" + if $old->phonenum ne $new->phonenum; + + if ( $old->pbxsvc != $new->pbxsvc ) { + + if ( $old->pbxsvc ) { + my $result = $self->_thirdlane_command( + 'asterisk::rpc_did_unassign', + $self->_thirdlane_did($old), + ); + $result eq '0' or return 'Thirdlane API failure (rpc_did_unassign)'; + } + + if ( $new->pbxsvc ) { + my $result = $self->_thirdlane_command( + 'asterisk::rpc_did_assign', + $self->_thirdlane_did($new), + $new->pbx_title, + ); + $result eq '0' or return 'Thirdlane API failure (rpc_did_assign)'; + } + + + } + + ''; + + } elsif ( $new->isa('FS::svc_acct') ) { + + return "can't change uesrname with thirdlane" + if $old->username ne $new->username; + + return "can't change password with thirdlane" + if $old->_password ne $new->_password; + + return "can't change PBX for user with thirdlane" + if $old->pbxsvc != $new->pbxsvc; + + ''; #we don't care then + + } else { + die "guru meditation #11: $new is not FS::svc_pbx, FS::svc_phone or FS::svc_acct"; + } + +} + +sub _export_delete { + my($self, $svc_x) = (shift, shift); + #my( $self, $svc_something ) = (shift, shift); + #$err_or_queue = $self->thirdlane_queue( $svc_something->svcnum, + # 'delete', $svc_something->username ); + #ref($err_or_queue) ? '' : $err_or_queue; + + if ( $svc_x->isa('FS::svc_pbx') ) { + + my $result = $self->_thirdlane_command( 'asterisk::rpc_tenant_delete', + $svc_x->title, + ); + + #use Data::Dumper; + #warn Dumper(\$result); + #$result eq '0' ? '' : 'Thirdlane API failure (rpc_tenant_delete)'; + warn "Thirdlane API failure (rpc_tenant_delete); deleting anyway\n" + if $result ne '0'; + ''; + + } elsif ( $svc_x->isa('FS::svc_phone') ) { + + if ( $svc_x->pbxsvc ) { + my $result = $self->_thirdlane_command( + 'asterisk::rpc_did_unassign', + $self->_thirdlane_did($svc_x), + ); + $result eq '0' or return 'Thirdlane API failure (rpc_did_unassign)'; + } + + my $result = $self->_thirdlane_command( + 'asterisk::rpc_did_delete', + $self->_thirdlane_did($svc_x), + ); + $result eq '0' ? '' : 'Thirdlane API failure (rpc_did_delete)'; + + } elsif ( $svc_x->isa('FS::svc_acct') ) { + + return '' unless $svc_x->pbxsvc; #error out? nah + + my $result = $self->_thirdlane_command( + 'asterisk::rpc_admin_delete', + $svc_x->username, + $svc_x->pbx_title, + ); + + #use Data::Dumper; + #warn Dumper(\$result); + #$result eq '0' ? '' : 'Thirdlane API failure (rpc_admin_delete)'; + warn "Thirdlane API failure (rpc_admin_delete); deleting anyway\n" + if $result ne '0'; + ''; + + } else { + die "guru meditation #12: $svc_x is not FS::svc_pbx, FS::svc_phone or FS::svc_acct"; + } + +} + +sub _thirdlane_command { + my($self, @param) = @_; + + my $url = $self->option('ssl') ? 'https://' : 'http://'; + $url .= uri_escape($self->option('username')). ':'. + uri_escape($self->option('password')). '@'. + $self->machine; + $url .= ':'. $self->option('port') if $self->option('port'); + $url .= '/xmlrpc.cgi'; + + warn "$me connecting to $url\n" + if $self->option('debug'); + my $conn = Frontier::Client->new( 'url' => $url, + #no, spews output to browser + #'debug' => $self->option('debug'), + ); + + warn "$me sending command: ". join(' ', @param). "\n" + if $self->option('debug'); + $conn->call(@param); + +} + +sub _thirdlane_did { + my($self, $svc_phone) = @_; + if ( $self->option('omit_countrycode') ) { + $svc_phone->phonenum; + } else { + $svc_phone->countrycode. $svc_phone->phonenum; + } +} + + #my( $self, $svc_something ) = (shift, shift); + #$err_or_queue = $self->thirdlane_queue( $svc_something->svcnum, + # 'delete', $svc_something->username ); + #ref($err_or_queue) ? '' : $err_or_queue; + +#these three are optional +## fallback for svc_acct will change and restore password +#sub _export_suspend { +# my( $self, $svc_something ) = (shift, shift); +# $err_or_queue = $self->thirdlane_queue( $svc_something->svcnum, +# 'suspend', $svc_something->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +#} +# +#sub _export_unsuspend { +# my( $self, $svc_something ) = (shift, shift); +# $err_or_queue = $self->thirdlane_queue( $svc_something->svcnum, +# 'unsuspend', $svc_something->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +#} +# +#sub export_links { +# my($self, $svc_something, $arrayref) = (shift, shift, shift); +# #push @$arrayref, qq!<A HREF="http://example.com/~!. $svc_something->username. +# # qq!">!. $svc_something->username. qq!</A>!; +# ''; +#} + +#### +# +##a good idea to queue anything that could fail or take any time +#sub thirdlane_queue { +# my( $self, $svcnum, $method ) = (shift, shift, shift); +# my $queue = new FS::queue { +# 'svcnum' => $svcnum, +# 'job' => "FS::part_export::thirdlane::thirdlane_$method", +# }; +# $queue->insert( @_ ) or $queue; +#} +# +#sub thirdlane_insert { #subroutine, not method +# my( $username, $password ) = @_; +# #do things with $username and $password +#} +# +#sub thirdlane_replace { #subroutine, not method +#} +# +#sub thirdlane_delete { #subroutine, not method +# my( $username ) = @_; +# #do things with $username +#} +# +#sub thirdlane_suspend { #subroutine, not method +#} +# +#sub thirdlane_unsuspend { #subroutine, not method +#} + +1; diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index 4cda65755..799a8e1c1 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -30,7 +30,7 @@ export that uses vpopmail CLI commands instead.<BR> Real time export to <a href="http://inter7.com/vpopmail/">vpopmail</a> text files. <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> must be installed, and you will need to -<a href="../docs/ssh.html">setup SSH for unattended operation</a> +<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a> to <b>vpopmail</b>@<i>export.host</i>. END ); diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm index 7e4be9ce4..91b294eab 100644 --- a/FS/FS/part_export/www_shellcommands.pm +++ b/FS/FS/part_export/www_shellcommands.pm @@ -32,7 +32,7 @@ tie my %options, 'Tie::IxHash', 'options' => \%options, 'notes' => <<'END' Run remote commands via SSH, for virtual web sites. You will need to -<a href="../docs/ssh.html">setup SSH for unattended operation</a>. +<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. <BR><BR>Use these buttons for some useful presets: <UL> <LI> diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 46f4e7241..276889d62 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -1179,6 +1179,18 @@ sub calc_units { 0; } #fallback for everything except bulk.pm sub hide_svc_detail { 0; } +=item recur_cost_permonth CUST_PKG + +recur_cost divided by freq (only supported for monthly and longer frequencies) + +=cut + +sub recur_cost_permonth { + my($self, $cust_pkg) = @_; + return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0; + sprintf('%.2f', $self->recur_cost / $self->freq ); +} + =item format OPTION DATA Returns data formatted according to the function 'format' described diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm index f9aaebee7..be17fd803 100644 --- a/FS/FS/part_pkg/flat.pm +++ b/FS/FS/part_pkg/flat.pm @@ -104,19 +104,30 @@ tie my %temporalities, 'Tie::IxHash', 'type' => 'select', 'select_options' => \%temporalities, }, - - %usage_fields, - %usage_recharge_fields, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. ' of service at cancellation', 'type' => 'checkbox', }, + + #used in cust_pkg.pm so could add to any price plan + 'expire_months' => { 'name' => 'Auto-add an expiration date this number of months out', + }, + #used in cust_pkg.pm so could add to any price plan where it made sense + 'start_1st' => { 'name' => 'Auto-add a start date to the 1st, ignoring the current month.', + 'type' => 'checkbox', + }, + + %usage_fields, + %usage_recharge_fields, + 'externalid' => { 'name' => 'Optional External ID', 'default' => '', }, }, - 'fieldorder' => [ qw( setup_fee recur_fee recur_temporality unused_credit ), + 'fieldorder' => [ qw( setup_fee recur_fee + recur_temporality unused_credit + expire_months start_1st + ), @usage_fieldorder, @usage_recharge_fieldorder, qw( externalid ), ], diff --git a/FS/FS/part_pkg/sql_external.pm b/FS/FS/part_pkg/sql_external.pm index 70f9f048a..effc101ee 100644 --- a/FS/FS/part_pkg/sql_external.pm +++ b/FS/FS/part_pkg/sql_external.pm @@ -1,12 +1,10 @@ package FS::part_pkg::sql_external; use strict; -use vars qw(@ISA %info); +use base qw( FS::part_pkg::recur_Common ); +use vars qw( %info ); use DBI; #use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); %info = ( 'name' => 'Base charge plus additional fees for external services from a configurable SQL query', @@ -22,6 +20,17 @@ use FS::part_pkg::flat; ' of service at cancellation', 'type' => 'checkbox', }, + 'cutoff_day' => { 'name' => 'Billing Day (1 - 28) for prorating or '. + 'subscription', + 'default' => '1', + }, + + 'recur_method' => { 'name' => 'Recurring fee method', + #'type' => 'radio', + #'options' => \%recur_method, + 'type' => 'select', + 'select_options' => \%FS::part_pkg::recur_Common::recur_method, + }, 'datasrc' => { 'name' => 'DBI data source', 'default' => '', }, @@ -35,14 +44,17 @@ use FS::part_pkg::flat; 'default' => '', }, }, - 'fieldorder' => [qw( setup_fee recur_fee unused_credit datasrc db_username db_password query )], - #'setup' => 'what.setup_fee.value', - #'recur' => q!'my $dbh = DBI->connect("' + what.datasrc.value + '", "' + what.db_username.value + '", "' + what.db_password.value + '" ) or die $DBI::errstr; my $sth = $dbh->prepare("' + what.query.value + '") or die $dbh->errstr; my $price = ' + what.recur_fee.value + '; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq "svc_external" } $cust_pkg->cust_svc ){ my $id = $cust_svc->svc_x->id; $sth->execute($id) or die $sth->errstr; $price += $sth->fetchrow_arrayref->[0]; } $price;'!, + 'fieldorder' => [qw( setup_fee recur_fee unused_credit recur_method cutoff_day + datasrc db_username db_password query + )], 'weight' => '58', ); sub calc_recur { - my($self, $cust_pkg ) = @_; + my $self = shift; + my($cust_pkg) = @_; #, $sdate, $details, $param ) = @_; + + my $price = $self->calc_recur_Common(@_); my $dbh = DBI->connect( map { $self->option($_) } qw( datasrc db_username db_password ) @@ -52,8 +64,6 @@ sub calc_recur { my $sth = $dbh->prepare( $self->option('query') ) or die $dbh->errstr; - my $price = $self->option('recur_fee'); - foreach my $cust_svc ( grep { $_->part_svc->svcdb eq "svc_external" } $cust_pkg->cust_svc ) { @@ -69,9 +79,4 @@ sub is_free { 0; } -sub base_recur { - my($self, $cust_pkg) = @_; - $self->option('recur_fee'); -} - 1; diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm index 0c87581ed..38e5941a9 100644 --- a/FS/FS/part_pkg/voip_cdr.pm +++ b/FS/FS/part_pkg/voip_cdr.pm @@ -535,6 +535,9 @@ sub calc_usage { # length($cdr->billsec) ? $cdr->billsec : $cdr->duration; $seconds = $use_duration ? $cdr->duration : $cdr->billsec; + $seconds -= $rate_detail->conn_sec; + $seconds = 0 if $seconds < 0; + $seconds += $granularity - ( $seconds % $granularity ) if $seconds # don't granular-ize 0 billsec calls (bills them) && $granularity; # 0 is per call @@ -546,12 +549,15 @@ sub calc_usage { $included_min{$regionnum} -= $minutes; + $charge = sprintf('%.2f', $rate_detail->conn_charge); + if ( $included_min{$regionnum} < 0 ) { my $charge_min = 0 - $included_min{$regionnum}; #XXX should preserve #(display?) this $included_min{$regionnum} = 0; - $charge = sprintf('%.2f', ( $rate_detail->min_charge * $charge_min ) - + 0.00000001 ); #so 1.005 rounds to 1.01 + $charge += sprintf('%.2f', ($rate_detail->min_charge * $charge_min) + + 0.00000001 ); #so 1.005 rounds to 1.01 + $charge = sprintf('%.2f', $charge); $charges += $charge; } diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index db39ea9ae..3ed153e0c 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -724,7 +724,18 @@ sub process { ref($param->{'svc_acct__usergroup'}) ? join(',', @{$param->{'svc_acct__usergroup'}} ) : $param->{'svc_acct__usergroup'}; + + #unmunge cgp_accessmodes (falze laziness-ish w/edit/process/svc_acct.cgi) + $param->{'svc_acct__cgp_accessmodes'} ||= + join(' ', sort + grep { $_ !~ /^(flag|label)$/ } + map { /^svc_acct__cgp_accessmodes_([\w\/]+)$/ or die "no way"; $1; } + grep $param->{$_}, + grep /^svc_acct__cgp_accessmodes_([\w\/]+)$/, + keys %$param + ); + my $new = new FS::part_svc ( { map { $_ => $param->{$_}; diff --git a/FS/FS/rate_detail.pm b/FS/FS/rate_detail.pm index b7b23babe..f6cdedf6e 100644 --- a/FS/FS/rate_detail.pm +++ b/FS/FS/rate_detail.pm @@ -232,6 +232,31 @@ sub granularities { %granularities; } +=item conn_secs + + Returns an (ordered) hash of conn_sec => name pairs + +=cut + +tie my %conn_secs, 'Tie::IxHash', + '0' => 'connection', + '1' => 'first second', + '6' => 'first 6 seconds', + '30' => 'first 30 seconds', # '1/2 minute', + '60' => 'first minute', + '120' => 'first 2 minutes', + '180' => 'first 3 minutes', + '300' => 'first 5 minutes', +; + +sub conn_secs { + %conn_secs; +} + +=item process_edit_import + +=cut + use Storable qw(thaw); use Data::Dumper; use MIME::Base64; @@ -311,6 +336,10 @@ sub process_edit_import { } +=item edit_import + +=cut + #false laziness w/ #FS::Record::batch_import, grep "edit_import" for differences #could be turned into callbacks or something use Text::CSV_XS; @@ -569,8 +598,6 @@ sub edit_import { } - - =back =head1 BUGS diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index 5311ec5aa..377da4985 100644 --- a/FS/FS/reason.pm +++ b/FS/FS/reason.pm @@ -114,60 +114,6 @@ sub reasontype { qsearchs( 'reason_type', { 'typenum' => shift->reason_type } ); } -# _upgrade_data -# -# Used by FS::Upgrade to migrate to a new database. -# -# - -sub _upgrade_data { # class method - my ($self, %opts) = @_; - my $dbh = dbh; - - warn "$me upgrading $self\n" if $DEBUG; - - my $column = dbdef->table($self->table)->column('reason'); - unless ($column->type eq 'text') { # assume history matches main table - - # ideally this would be supported in DBIx-DBSchema and friends - warn "$me Shifting reason column to type 'text'\n" if $DEBUG; - foreach my $table ( $self->table, 'h_'. $self->table ) { - my @sql = (); - - $column = dbdef->table($self->table)->column('reason'); - my $columndef = $column->line($dbh); - $columndef =~ s/varchar\(\d+\)/text/i; - - if ( $dbh->{Driver}->{Name} eq 'Pg' ) { - - my $notnull = $columndef =~ s/not null//i; - push @sql,"ALTER TABLE $table RENAME reason TO freeside_upgrade_reason"; - push @sql,"ALTER TABLE $table ADD $columndef"; - push @sql,"UPDATE $table SET reason = freeside_upgrade_reason"; - push @sql,"ALTER TABLE $table ALTER reason SET NOT NULL" - if $notnull; - push @sql,"ALTER TABLE $table DROP freeside_upgrade_reason"; - - } elsif ( $dbh->{Driver}->{Name} =~ /^mysql/i ){ - - #crap, this isn't working - #push @sql,"ALTER TABLE $table MODIFY reason ". $column->line($dbh); - warn "WARNING: reason table upgrade not yet supported for mysql, sorry"; - - } else { - die "watchu talkin' 'bout, Willis? (unsupported database type)"; - } - - foreach (@sql) { - my $sth = $dbh->prepare($_) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - } - } - } - - ''; - -} =back =head1 BUGS diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index a67504a5b..fd2745dac 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -401,7 +401,7 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $new->set_auto_inventory; + my $error = $new->set_auto_inventory($old); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -586,15 +586,115 @@ sub part_svc { } +=item svc_pbx + +Returns the FS::svc_pbx record for this service, if any (see L<FS::svc_pbx>). + +Only makes sense if the service has a pbxsvc field (currently, svc_phone and +svc_acct). + +=cut + +# XXX FS::h_svc_{acct,phone} could have a history-aware svc_pbx override + +sub svc_pbx { + my $self = shift; + return '' unless $self->pbxsvc; + qsearchs( 'svc_pbx', { 'svcnum' => $self->pbxsvc } ); +} + +=item pbx_title + +Returns the title of the FS::svc_pbx record associated with this service, if +any. + +Only makes sense if the service has a pbxsvc field (currently, svc_phone and +svc_acct). + +=cut + +sub pbx_title { + my $self = shift; + my $svc_pbx = $self->svc_pbx or return ''; + $svc_pbx->title; +} + +=item pbx_select_hash %OPTIONS + +Can be called as an object method or a class method. + +Returns a hash SVCNUM => TITLE ... representing the PBXes this customer +that may be associated with this service. + +Currently available options are: I<pkgnum> I<svcpart> + +Only makes sense if the service has a pbxsvc field (currently, svc_phone and +svc_acct). + +=cut + +#false laziness w/svc_acct::domain_select_hash +sub pbx_select_hash { + my ($self, %options) = @_; + my %pbxes = (); + my $part_svc; + my $cust_pkg; + + if (ref($self)) { + $part_svc = $self->part_svc; + $cust_pkg = $self->cust_svc->cust_pkg + if $self->cust_svc; + } + + $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} }) + if $options{'svcpart'}; + + $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} }) + if $options{'pkgnum'}; + + if ($part_svc && ( $part_svc->part_svc_column('pbxsvc')->columnflag eq 'S' + || $part_svc->part_svc_column('pbxsvc')->columnflag eq 'F')) { + %pbxes = map { $_->svcnum => $_->title } + map { qsearchs('svc_pbx', { 'svcnum' => $_ }) } + split(',', $part_svc->part_svc_column('pbxsvc')->columnvalue); + } elsif ($cust_pkg) { # && !$conf->exists('svc_acct-alldomains') ) { + %pbxes = map { $_->svcnum => $_->title } + map { qsearchs('svc_pbx', { 'svcnum' => $_->svcnum }) } + map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) } + qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum }); + } else { + #XXX agent-virt + %pbxes = map { $_->svcnum => $_->title } qsearch('svc_pbx', {} ); + } + + if ($part_svc && $part_svc->part_svc_column('pbxsvc')->columnflag eq 'D') { + my $svc_pbx = qsearchs('svc_pbx', + { 'svcnum' => $part_svc->part_svc_column('pbxsvc')->columnvalue } ); + if ( $svc_pbx ) { + $pbxes{$svc_pbx->svcnum} = $svc_pbx->title; + } else { + warn "unknown svc_pbx.svcnum for part_svc_column pbxsvc: ". + $part_svc->part_svc_column('pbxsvc')->columnvalue; + + } + } + + (%pbxes); + +} + =item set_auto_inventory -Sets any fields which auto-populate from inventory (see L<FS::part_svc>). +Sets any fields which auto-populate from inventory (see L<FS::part_svc>), and +also check any manually populated inventory fields. + If there is an error, returns the error, otherwise returns false. =cut sub set_auto_inventory { my $self = shift; + my $old = @_ ? shift : ''; my $error = $self->ut_numbern('svcnum') @@ -618,39 +718,69 @@ sub set_auto_inventory { #set default/fixed/whatever fields from part_svc my $table = $self->table; foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) { + my $part_svc_column = $part_svc->part_svc_column($field); - if ( $part_svc_column->columnflag eq 'A' && $self->$field() eq '' ) { - - my $classnum = $part_svc_column->columnvalue; - my $inventory_item = qsearchs({ - 'table' => 'inventory_item', - 'hashref' => { 'classnum' => $classnum, - 'svcnum' => '', - }, - 'extra_sql' => 'LIMIT 1 FOR UPDATE', - }); + my $columnflag = $part_svc_column->columnflag; + next unless $columnflag =~ /^[AM]$/; - unless ( $inventory_item ) { - $dbh->rollback if $oldAutoCommit; - my $inventory_class = - qsearchs('inventory_class', { 'classnum' => $classnum } ); - return "Can't find inventory_class.classnum $classnum" - unless $inventory_class; - return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS - #for pluralizing - } + next if $columnflag eq 'A' && $self->$field() ne ''; - $inventory_item->svcnum( $self->svcnum ); - my $ierror = $inventory_item->replace(); - if ( $ierror ) { - $dbh->rollback if $oldAutoCommit; - return "Error provisioning inventory: $ierror"; - - } + my $classnum = $part_svc_column->columnvalue; + my %hash = ( 'classnum' => $classnum ); + + if ( $columnflag eq 'A' && $self->$field() eq '' ) { + $hash{'svcnum'} = ''; + } elsif ( $columnflag eq 'M' ) { + return "Select inventory item for $field" unless $self->getfield($field); + $hash{'item'} = $self->getfield($field); + } + + my $inventory_item = qsearchs({ + 'table' => 'inventory_item', + 'hashref' => \%hash, + 'extra_sql' => 'LIMIT 1 FOR UPDATE', + }); + + unless ( $inventory_item ) { + $dbh->rollback if $oldAutoCommit; + my $inventory_class = + qsearchs('inventory_class', { 'classnum' => $classnum } ); + return "Can't find inventory_class.classnum $classnum" + unless $inventory_class; + return "Out of ". $inventory_class->classname. "s\n"; #Lingua:: BS + #for pluralizing + } + + next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum; - $self->setfield( $field, $inventory_item->item ); + $self->setfield( $field, $inventory_item->item ); + #if $columnflag eq 'A' && $self->$field() eq ''; + $inventory_item->svcnum( $self->svcnum ); + my $ierror = $inventory_item->replace(); + if ( $ierror ) { + $dbh->rollback if $oldAutoCommit; + return "Error provisioning inventory: $ierror"; } + + if ( $old && $old->$field() && $old->$field() ne $self->$field() ) { + my $old_inv = qsearchs({ + 'table' => 'inventory_item', + 'hashref' => { 'classnum' => $classnum, + 'svcnum' => $old->svcnum, + 'item' => $old->$field(), + }, + }); + if ( $old_inv ) { + $old_inv->svcnum(''); + my $oerror = $old_inv->replace; + if ( $oerror ) { + $dbh->rollback if $oldAutoCommit; + return "Error unprovisioning inventory: $oerror"; + } + } + } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -757,6 +887,25 @@ sub export_links { $return; } +=item export_getsettings + +Runs export_getsettings callbacks and returns the two hashrefs. + +=cut + +sub export_getsettings { + my $self = shift; + my %settings = (); + my %defaults = (); + my $error = $self->export('getsettings', \%settings, \%defaults); + if ( $error ) { + #XXX bubble this up better + warn "error running export_getsetings: $error"; + return ( {}, {} ); + } + ( \%settings, \%defaults ); +} + =item export HOOK [ EXPORT_ARGS ] Runs the provided export hook (i.e. "suspend", "unsuspend") for this service. diff --git a/FS/FS/svc_Domain_Mixin.pm b/FS/FS/svc_Domain_Mixin.pm new file mode 100644 index 000000000..202899cab --- /dev/null +++ b/FS/FS/svc_Domain_Mixin.pm @@ -0,0 +1,134 @@ +package FS::svc_Domain_Mixin; + +use strict; +use FS::Conf; +use FS::Record qw(qsearch qsearchs); +use FS::part_svc; +use FS::cust_pkg; +use FS::cust_svc; +use FS::svc_domain; + +=head1 NAME + +FS::svc_Domain_Mixin - Mixin class for svc_classes with a domsvc field + +=head1 SYNOPSIS + +package FS::svc_table; +use base qw( FS::svc_Domain_Mixin FS::svc_Common ); + +=head1 DESCRIPTION + +This is a mixin class for svc_ classes that contain a domsvc field linking to +a domain (see L<FS::svc_domain>). + +=head1 METHODS + +=over 4 + +=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 { + my $self = shift; + #die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc; + return '' unless $self->domsvc; + my $svc_domain = $self->svc_domain(@_) + or die "no svc_domain.svcnum for domsvc ". $self->domsvc; + $svc_domain->domain; +} + +=item svc_domain + +Returns the FS::svc_domain record for this account's domain (see +L<FS::svc_domain>). + +=cut + +# FS::h_svc_acct has a history-aware svc_domain override + +sub svc_domain { + my $self = shift; + $self->{'_domsvc'} + ? $self->{'_domsvc'} + : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); +} + +=item domain_select_hash %OPTIONS + +Object or class method. + +Returns a hash SVCNUM => DOMAIN ... representing the domains this customer +may at present purchase. + +Currently available options are: I<pkgnum> and I<svcpart>. + +=cut + +sub domain_select_hash { + my ($self, %options) = @_; + my %domains = (); + + my $conf = new FS::Conf; + + my $part_svc; + my $cust_pkg; + + if (ref($self)) { + $part_svc = $self->part_svc; + $cust_pkg = $self->cust_svc->cust_pkg + if $self->cust_svc; + } + + $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} }) + if $options{'svcpart'}; + + $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} }) + if $options{'pkgnum'}; + + if ($part_svc && ( $part_svc->part_svc_column('domsvc')->columnflag eq 'S' + || $part_svc->part_svc_column('domsvc')->columnflag eq 'F')) { + %domains = map { $_->svcnum => $_->domain } + map { qsearchs('svc_domain', { 'svcnum' => $_ }) } + split(',', $part_svc->part_svc_column('domsvc')->columnvalue); + }elsif ($cust_pkg && !$conf->exists('svc_acct-alldomains') ) { + %domains = map { $_->svcnum => $_->domain } + map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum }) } + map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) } + qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum }); + }else{ + %domains = map { $_->svcnum => $_->domain } qsearch('svc_domain', {} ); + } + + if ($part_svc && $part_svc->part_svc_column('domsvc')->columnflag eq 'D') { + my $svc_domain = qsearchs('svc_domain', + { 'svcnum' => $part_svc->part_svc_column('domsvc')->columnvalue } ); + if ( $svc_domain ) { + $domains{$svc_domain->svcnum} = $svc_domain->domain; + }else{ + warn "unknown svc_domain.svcnum for part_svc_column domsvc: ". + $part_svc->part_svc_column('domsvc')->columnvalue; + + } + } + + (%domains); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::svc_Common>, L<FS::Record> + +=cut + +1; diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 3e264e6a3..fbf47072d 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,7 +1,8 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles +use base qw( FS::svc_Domain_Mixin FS::svc_Common ); +use vars qw( $DEBUG $me $conf $skip_fuzzyfiles $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst @@ -32,12 +33,11 @@ use FS::Msgcat qw(gettext); use FS::UI::bytecount; use FS::UI::Web; use FS::part_pkg; -use FS::svc_Common; -use FS::cust_svc; use FS::part_svc; use FS::svc_acct_pop; use FS::cust_main_invoice; use FS::svc_domain; +use FS::svc_pbx; use FS::raddb; use FS::queue; use FS::radius_usergroup; @@ -47,8 +47,6 @@ use FS::svc_forward; use FS::svc_www; use FS::cdr; -@ISA = qw( FS::svc_Common ); - $DEBUG = 0; $me = '[FS::svc_acct]'; @@ -161,45 +159,71 @@ FS::svc_Common. The following fields are currently supported: =over 4 -=item svcnum - primary key (assigned automatcially for new accounts) +=item svcnum + +Primary key (assigned automatcially for new accounts) =item username -=item _password - generated if blank +=item _password + +generated if blank + +=item _password_encoding + +plain, crypt, ldap (or empty for autodetection) + +=item sec_phrase -=item _password_encoding - plain, crypt, ldap (or empty for autodetection) +security phrase -=item sec_phrase - security phrase +=item popnum -=item popnum - Point of presence (see L<FS::svc_acct_pop>) +Point of presence (see L<FS::svc_acct_pop>) =item uid =item gid -=item finger - GECOS +=item finger -=item dir - set automatically if blank (and uid is not) +GECOS + +=item dir + +set automatically if blank (and uid is not) =item shell -=item quota - (unimplementd) +=item quota + +=item slipip + +IP address + +=item seconds + +=item upbytes -=item slipip - IP address +=item downbyte -=item seconds - +=item totalbytes -=item upbytes - +=item domsvc + +svcnum from svc_domain + +=item pbxsvc -=item downbytes - +Optional svcnum from svc_pbx -=item totalbytes - +=item radius_I<Radius_Attribute> -=item domsvc - svcnum from svc_domain +I<Radius-Attribute> (reply) -=item radius_I<Radius_Attribute> - I<Radius-Attribute> (reply) +=item rc_I<Radius_Attribute> -=item rc_I<Radius_Attribute> - I<Radius-Attribute> (check) +I<Radius-Attribute> (check) =back @@ -244,8 +268,64 @@ sub table_info { disable_fixed => 1, disable_select => 1, }, + 'cgp_type'=> { + label => 'Communigate account type', + type => 'select', + select_list => [qw( MultiMailbox TextMailbox MailDirMailbox AGrade BGrade CGrade )], + disable_inventory => 1, + disable_select => 1, + }, + 'cgp_accessmodes' => { + label => 'Communigate enabled services', + type => 'communigate_pro-accessmodes', + disable_inventory => 1, + disable_select => 1, + }, + 'cgp_aliases' => { + label => 'Communigate aliases', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'password_selfchange' => { label => 'Password modification', + type => 'checkbox', + }, + 'password_recover' => { label => 'Password recovery', + type => 'checkbox', + }, + 'cgp_deletemode' => { + label => 'Communigate message delete method', + type => 'select', + select_list => [ 'Move To Trash', 'Immediately', 'Mark' ], + disable_inventory => 1, + disable_select => 1, + }, + 'cgp_emptytrash' => { + label => 'Communigate on logout remove trash', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, 'quota' => { - label => 'Quota', + label => 'Quota', #Mail storage limit + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'file_quota'=> { + label => 'File storage limit', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'file_maxnum'=> { + label => 'Number of files limit', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'file_maxsize'=> { + label => 'File size limit', type => 'text', disable_inventory => 1, disable_select => 1, @@ -273,7 +353,11 @@ sub table_info { select_key => 'svcnum', select_label => 'domain', disable_inventory => 1, - + }, + 'pbxsvc' => { label => 'PBX', + type => 'select-svc_pbx.html', + disable_inventory => 1, + disable_select => 1, #UI wonky, pry works otherwise }, 'usergroup' => { label => 'RADIUS groups', @@ -656,13 +740,16 @@ sub insert { } # set usage fields and thresholds if unset but set in a package def +# AND the package already has a last bill date (otherwise they get double added) sub preinsert_hook_first { my $self = shift; return '' unless $self->pkgnum; my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); - my $part_pkg = $cust_pkg->part_pkg if $cust_pkg; + return '' unless $cust_pkg && $cust_pkg->last_bill; + + my $part_pkg = $cust_pkg->part_pkg; return '' unless $part_pkg && $part_pkg->can('usage_valuehash'); my %values = $part_pkg->usage_valuehash; @@ -1011,15 +1098,21 @@ sub check { my $error = $self->ut_numbern('svcnum') #|| $self->ut_number('domsvc') - || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum' ) + || $self->ut_foreign_key( 'domsvc', 'svc_domain', 'svcnum' ) + || $self->ut_foreign_keyn('pbxsvc', 'svc_pbx', 'svcnum' ) || $self->ut_textn('sec_phrase') || $self->ut_snumbern('seconds') || $self->ut_snumbern('upbytes') || $self->ut_snumbern('downbytes') || $self->ut_snumbern('totalbytes') - || $self->ut_enum( '_password_encoding', - [ '', qw( plain crypt ldap ) ] - ) + || $self->ut_enum('_password_encoding', ['',qw(plain crypt ldap)]) + || $self->ut_enum('password_selfchange', [ '', 'Y' ]) + || $self->ut_enum('password_recover', [ '', 'Y' ]) + || $self->ut_textn('cgp_accessmodes') + || $self->ut_alphan('cgp_type') + || $self->ut_textn('cgp_aliases' ) #well + || $self->ut_alphasn('cgp_deletemode') + || $self->ut_alphan('cgp_emptytrash') ; return $error if $error; @@ -1155,8 +1248,12 @@ sub check { or return "Illegal finger: ". $self->getfield('finger'); $self->setfield('finger', $1); - $recref->{quota} =~ /^(\w*)$/ or return "Illegal quota"; - $recref->{quota} = $1; + for (qw( quota file_quota file_maxsize )) { + $recref->{$_} =~ /^(\w*)$/ or return "Illegal $_"; + $recref->{$_} = $1; + } + $recref->{file_maxnum} =~ /^\s*(\d*)\s*$/ or return "Illegal file_maxnum"; + $recref->{file_maxnum} = $1; unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { if ( $recref->{slipip} eq '' ) { @@ -1289,80 +1386,81 @@ is >0), one will be generated randomly. =cut sub set_password { - my $self = shift; - my $pass = shift; - my ($encoding, $encryption); + my( $self, $pass ) = ( shift, shift ); + + warn "[$me] set_password (to $pass) called on $self: ". Dumper($self) + if $DEBUG; + my $failure = gettext('illegal_password'). " $passwordmin-$passwordmax ". FS::Msgcat::_gettext('illegal_password_characters'). ": ". $pass; - if(($passwordmin and length($pass) < $passwordmin) or - ($passwordmax and length($pass) > $passwordmax)) { - return $failure; - } + my( $encoding, $encryption ) = ('', ''); - if($self->_password_encoding) { + if ( $self->_password_encoding ) { $encoding = $self->_password_encoding; # identify existing encryption method, try to use it. $encryption = $self->_password_encryption; - if(!$encryption) { + if (!$encryption) { # use the system default undef $encoding; } } - if(!$encoding) { + if ( !$encoding ) { # set encoding to system default - ($encoding, $encryption) = split(/-/, lc($conf->config('default-password-encoding'))); + ($encoding, $encryption) = + split(/-/, lc($conf->config('default-password-encoding'))); $encoding ||= 'legacy'; $self->_password_encoding($encoding); } - if($encoding eq 'legacy') { + if ( $encoding eq 'legacy' ) { + # The legacy behavior from check(): # If the password is blank, randomize it and set encoding to 'plain'. if(!defined($pass) or (length($pass) == 0 and $passwordmin)) { $pass = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ); $self->_password_encoding('plain'); - } - else { + } else { # Prefix + valid-length password if ( $pass =~ /^((\*SUSPENDED\* |!!?)?)([^\t\n]{$passwordmin,$passwordmax})$/ ) { $pass = $1.$3; $self->_password_encoding('plain'); - } # Prefix + crypt string - elsif ( $pass =~ /^((\*SUSPENDED\* |!!?)?)([\w\.\/\$\;\+]{13,64})$/ ) { + } elsif ( $pass =~ /^((\*SUSPENDED\* |!!?)?)([\w\.\/\$\;\+]{13,64})$/ ) { $pass = $1.$3; $self->_password_encoding('crypt'); - } # Various disabled crypt passwords - elsif ( $pass eq '*' or - $pass eq '!' or - $pass eq '!!' ) { + } elsif ( $pass eq '*' || $pass eq '!' || $pass eq '!!' ) { $self->_password_encoding('crypt'); - } - else { + } else { return $failure; } - } + } + + $self->_password($pass); + return; + } - elsif($encoding eq 'crypt') { - if($encryption eq 'md5') { + + return $failure + if $passwordmin && length($pass) < $passwordmin + or $passwordmax && length($pass) > $passwordmax; + + if ( $encoding eq 'crypt' ) { + if ($encryption eq 'md5') { $pass = unix_md5_crypt($pass); - } - elsif($encryption eq 'des') { + } elsif ($encryption eq 'des') { $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]); } - } - elsif($encoding eq 'ldap') { - if($encryption eq 'md5') { + + } elsif ( $encoding eq 'ldap' ) { + if ($encryption eq 'md5') { $pass = md5_base64($pass); - } - elsif($encryption eq 'sha1') { + } elsif ($encryption eq 'sha1') { $pass = sha1_base64($pass); - } - elsif($encryption eq 'crypt') { + } elsif ($encryption eq 'crypt') { $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]); } # else $encryption eq 'plain', do nothing @@ -1630,30 +1728,20 @@ for the password. sub radius_password { my $self = shift; - my($pw_attrib, $password); + my $pw_attrib; if ( $self->_password_encoding eq 'ldap' ) { - $pw_attrib = 'Password-With-Header'; - $password = $self->_password; - } elsif ( $self->_password_encoding eq 'crypt' ) { - $pw_attrib = 'Crypt-Password'; - $password = $self->_password; - } elsif ( $self->_password_encoding eq 'plain' ) { - - $pw_attrib = $radius_password; #Cleartext-Password? man rlm_pap - $password = $self->_password; - + $pw_attrib = $radius_password; } else { - - $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; - $password = $self->_password; - + $pw_attrib = length($self->_password) <= 12 + ? $radius_password + : 'Crypt-Password'; } - ($pw_attrib, $password); + ($pw_attrib, $self->_password); } @@ -1709,22 +1797,6 @@ sub domain { $svc_domain->domain; } -=item svc_domain - -Returns the FS::svc_domain record for this account's domain (see -L<FS::svc_domain>). - -=cut - -# FS::h_svc_acct has a history-aware svc_domain override - -sub svc_domain { - my $self = shift; - $self->{'_domsvc'} - ? $self->{'_domsvc'} - : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); -} - =item cust_svc Returns the FS::cust_svc record for this account (see L<FS::cust_svc>). @@ -3046,61 +3118,4 @@ schema.html from the base documentation. =cut -=item domain_select_hash %OPTIONS - -Returns a hash SVCNUM => DOMAIN ... representing the domains this customer -may at present purchase. - -Currently available options are: I<pkgnum> I<svcpart> - -=cut - -sub domain_select_hash { - my ($self, %options) = @_; - my %domains = (); - my $part_svc; - my $cust_pkg; - - if (ref($self)) { - $part_svc = $self->part_svc; - $cust_pkg = $self->cust_svc->cust_pkg - if $self->cust_svc; - } - - $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} }) - if $options{'svcpart'}; - - $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} }) - if $options{'pkgnum'}; - - if ($part_svc && ( $part_svc->part_svc_column('domsvc')->columnflag eq 'S' - || $part_svc->part_svc_column('domsvc')->columnflag eq 'F')) { - %domains = map { $_->svcnum => $_->domain } - map { qsearchs('svc_domain', { 'svcnum' => $_ }) } - split(',', $part_svc->part_svc_column('domsvc')->columnvalue); - }elsif ($cust_pkg && !$conf->exists('svc_acct-alldomains') ) { - %domains = map { $_->svcnum => $_->domain } - map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum }) } - map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) } - qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum }); - }else{ - %domains = map { $_->svcnum => $_->domain } qsearch('svc_domain', {} ); - } - - if ($part_svc && $part_svc->part_svc_column('domsvc')->columnflag eq 'D') { - my $svc_domain = qsearchs('svc_domain', - { 'svcnum' => $part_svc->part_svc_column('domsvc')->columnvalue } ); - if ( $svc_domain ) { - $domains{$svc_domain->svcnum} = $svc_domain->domain; - }else{ - warn "unknown svc_domain.svcnum for part_svc_column domsvc: ". - $part_svc->part_svc_column('domsvc')->columnvalue; - - } - } - - (%domains); -} - 1; - diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 8ca30c2ff..d6eaf2579 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -89,6 +89,8 @@ FS::svc_Common. The following fields are currently supported: =item expiration_date - UNIX timestamp +=item max_accounts + =back =head1 METHODS @@ -109,6 +111,86 @@ sub table_info { 'cancel_weight' => 60, 'fields' => { 'domain' => 'Domain', + 'parent_svcnum' => { + label => 'Parent domain / Communigate administrator domain', + type => 'select', + select_table => 'svc_domain', + select_key => 'svcnum', + select_label => 'domain', + disable_inventory => 1, + disable_select => 1, + }, + 'max_accounts' => { label => 'Maximum number of accounts', + 'disable_inventory' => 1, + }, + 'cgp_aliases' => { + label => 'Communigate aliases', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'cgp_accessmodes' => { + label => 'Communigate enabled services', + type => 'communigate_pro-accessmodes', + disable_inventory => 1, + disable_select => 1, + }, + + 'acct_def_cgp_accessmodes' => { + label => 'Acct. default Communigate enabled services', + type => 'communigate_pro-accessmodes', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_password_selfchange' => { label => 'Acct. default Password modification', + type => 'checkbox', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_password_recover' => { label => 'Acct. default Password recovery', + type => 'checkbox', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_cgp_deletemode' => { + label => 'Acct. default Communigate message delete method', + type => 'select', + select_list => [ 'Move To Trash', 'Immediately', 'Mark' ], + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_cgp_emptytrash' => { + label => 'Acct. default Communigate on logout remove trash', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_quota' => { + label => 'Acct. default Quota', #Mail storage limit + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_file_quota'=> { + label => 'Acct. default File storage limit', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_file_maxnum'=> { + label => 'Acct. default Number of files limit', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_file_maxsize'=> { + label => 'Acct. default File size limit', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + + }, }; } @@ -290,7 +372,8 @@ sub replace { : $new->replace_old; return "Can't change domain - reorder." - if $old->getfield('domain') ne $new->getfield('domain'); + if $old->getfield('domain') ne $new->getfield('domain') + && ! $conf->exists('svc_domain-edit_domain'); # Better to do it here than to force the caller to remember that svc_domain is weird. $new->setfield(action => 'I'); @@ -335,6 +418,17 @@ sub check { my $error = $self->ut_numbern('svcnum') || $self->ut_numbern('catchall') + || $self->ut_numbern('max_accounts') + || $self->ut_textn('cgp_aliases') #well + || $self->ut_enum('acct_def_password_selfchange', [ '', 'Y' ]) + || $self->ut_enum('acct_def_password_recover', [ '', 'Y' ]) + || $self->ut_textn('acct_def_cgp_accessmodes') + || $self->ut_alphan('acct_def_quota') + || $self->ut_alphan('acct_def_file_quota') + || $self->ut_alphan('acct_def_maxnum') + || $self->ut_alphan('acct_def_maxsize') + || $self->ut_alphasn('acct_def_cgp_deletemode') + || $self->ut_alphan('acct_def_cgp_emptytrash') ; return $error if $error; @@ -429,6 +523,7 @@ sub domain_record { 'PTR' => sub { $_[0]->reczone <=> $_[1]->reczone }, ); + map { $_ } #return $self->num_domain_record( PARAMS ) unless wantarray; sort { $order{$a->rectype} <=> $order{$b->rectype} or &{ $sort{$a->rectype} || sub { 0; } }($a, $b) } diff --git a/FS/FS/svc_external.pm b/FS/FS/svc_external.pm index aca7c1bcc..338fdbcd9 100644 --- a/FS/FS/svc_external.pm +++ b/FS/FS/svc_external.pm @@ -76,7 +76,7 @@ sub table_info { }, 'title' => { label => 'Printed on invoice line items', type => 'text', - disable_inventory => 1, + #disable_inventory => 1, }, }, }; diff --git a/FS/FS/svc_mailinglist.pm b/FS/FS/svc_mailinglist.pm new file mode 100644 index 000000000..ba297eedc --- /dev/null +++ b/FS/FS/svc_mailinglist.pm @@ -0,0 +1,330 @@ +package FS::svc_mailinglist; + +use strict; +use base qw( FS::svc_Domain_Mixin FS::svc_Common ); +use Scalar::Util qw( blessed ); +use FS::Record qw( qsearchs dbh ); # qsearch ); +use FS::svc_domain; +use FS::mailinglist; + +=head1 NAME + +FS::svc_mailinglist - Object methods for svc_mailinglist records + +=head1 SYNOPSIS + + use FS::svc_mailinglist; + + $record = new FS::svc_mailinglist \%hash; + $record = new FS::svc_mailinglist { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::svc_mailinglist object represents a mailing list customer service. +FS::svc_mailinglist inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item svcnum + +primary key + +=item username + +username + +=item domsvc + +domsvc + +=item listnum + +listnum + +=item reply_to_group + +reply_to_group + +=item remove_author + +remove_author + +=item reject_auto + +reject_auto + +=item remove_to_and_cc + +remove_to_and_cc + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record 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 { 'svc_mailinglist'; } + +sub table_info { + { + 'name' => 'Mailing list', + 'display_weight' => 80, + 'cancel_weight' => 55, + 'fields' => { + 'username' => { 'label' => 'List address', + 'disable_default' => 1, + 'disable_fixed' => 1, + 'disable_inventory' => 1, + }, + 'domsvc' => { 'label' => 'List address domain', + 'disable_inventory' => 1, + }, + 'domain' => 'List address domain', + 'listnum' => { 'label' => 'List name', + 'disable_inventory' => 1, + }, + 'listname' => 'List name', #actually mailinglist.listname + 'reply_to' => { 'label' => 'Reply-To list', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + 'remove_from' => { 'label' => 'Remove From: from messages', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + 'reject_auto' => { 'label' => 'Reject automatic messages', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + 'remove_to_and_cc' => { 'label' => 'Remove To: and Cc: from messages', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + }, + }; +} + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error; + + #attach to existing lists? sound scary + #unless ( $self->listnum ) { + my $mailinglist = new FS::mailinglist { + 'listname' => $self->get('listname'), + }; + $error = $mailinglist->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $self->listnum($mailinglist->listnum); + #} + + $error = $self->SUPER::insert(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->mailinglist->delete || $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=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 = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + return "can't change listnum" if $old->listnum != $new->listnum; #? + + my %options = @_; + + 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; + + if ( $new->get('listname') && $new->get('listname') ne $old->listname ) { + my $mailinglist = $old->mailinglist; + $mailinglist->listname($new->get('listname')); + my $error = $mailinglist->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; + } + } + + my $error = $new->SUPER::replace($old, %options); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error + + +} + +=item check + +Checks all fields to make sure this is a valid record. 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('svcnum') + || $self->ut_text('username') + || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum') + #|| $self->ut_foreign_key('listnum', 'mailinglist', 'listnum') + || $self->ut_foreign_keyn('listnum', 'mailinglist', 'listnum') + || $self->ut_enum('reply_to_group', [ '', 'Y' ] ) + || $self->ut_enum('remove_author', [ '', 'Y' ] ) + || $self->ut_enum('reject_auto', [ '', 'Y' ] ) + || $self->ut_enum('remove_to_and_cc', [ '', 'Y' ] ) + ; + return $error if $error; + + return "Can't remove listnum" if $self->svcnum && ! $self->listnum; + + $self->SUPER::check; +} + +=item mailinglist + +=cut + +sub mailinglist { + my $self = shift; + qsearchs('mailinglist', { 'listnum' => $self->listnum } ); +} + +=item listname + +=cut + +sub listname { + my $self = shift; + my $mailinglist = $self->mailinglist; + $mailinglist ? $mailinglist->listname : ''; +} + +=item label + +=cut + +sub label { + my $self = shift; + $self->listname. ' <'. $self->username. '@'. $self->domain. '>'; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_pbx.pm b/FS/FS/svc_pbx.pm new file mode 100644 index 000000000..6ae04189c --- /dev/null +++ b/FS/FS/svc_pbx.pm @@ -0,0 +1,277 @@ +package FS::svc_pbx; + +use strict; +use base qw( FS::svc_External_Common ); +use FS::Record qw( qsearch qsearchs dbh ); +use FS::cust_svc; +use FS::svc_phone; +use FS::svc_acct; + +=head1 NAME + +FS::svc_pbx - Object methods for svc_pbx records + +=head1 SYNOPSIS + + use FS::svc_pbx; + + $record = new FS::svc_pbx \%hash; + $record = new FS::svc_pbx { '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 + +An FS::svc_pbx object represents a PBX tenant. FS::svc_pbx inherits from +FS::svc_Common. The following fields are currently supported: + +=over 4 + +=item svcnum + +Primary key (assigned automatcially for new accounts) + +=item id + +(Unique?) number of external record + +=item title + +PBX name + +=item max_extensions + +Maximum number of extensions + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new PBX tenant. To add the PBX tenant 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 + +sub table { 'svc_pbx'; } + +sub table_info { + { + 'name' => 'PBX', + 'name_plural' => 'PBXs', #optional, + 'longname_plural' => 'PBXs', #optional + 'sorts' => 'svcnum', # optional sort field (or arrayref of sort fields, main first) + 'display_weight' => 70, + 'cancel_weight' => 90, + 'fields' => { + 'id' => 'ID', + 'title' => 'Name', + 'max_extensions' => 'Maximum number of User Extensions', +# 'field' => 'Description', +# 'another_field' => { +# 'label' => 'Description', +# 'def_label' => 'Description for service definitions', +# 'type' => 'text', +# 'disable_default' => 1, #disable switches +# 'disable_fixed' => 1, # +# 'disable_inventory' => 1, # +# }, +# 'foreign_key' => { +# 'label' => 'Description', +# 'def_label' => 'Description for service defs', +# 'type' => 'select', +# 'select_table' => 'foreign_table', +# 'select_key' => 'key_field_in_table', +# 'select_label' => 'label_field_in_table', +# }, + + }, + }; +} + +=item search_sql STRING + +Class method which returns an SQL fragment to search for the given string. + +=cut + +#XXX +#or something more complicated if necessary +#sub search_sql { +# my($class, $string) = @_; +# $class->search_sql_field('title', $string); +#} + +=item label + +Returns the title field for this PBX tenant. + +=cut + +sub label { + my $self = shift; + $self->title; +} + +=item insert + +Adds this record 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. + +=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; + + 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; + + foreach my $svc_phone (qsearch('svc_phone', { 'pbxsvc' => $self->svcnum } )) { + $svc_phone->pbxsvc(''); + my $error = $svc_phone->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + foreach my $svc_acct (qsearch('svc_acct', { 'pbxsvc' => $self->svcnum } )) { + my $error = $svc_acct->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + + +=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 PBX tenant. If there is +an error, returns the error, otherwise returns false. Called by the insert +and repalce methods. + +=cut + +sub check { + my $self = shift; + + my $x = $self->setfixed; + return $x unless ref($x); + my $part_svc = $x; + + + $self->SUPER::check; +} + +#XXX this is a way-too simplistic implementation +# at the very least, title should be unique across exports that need that or +# controlled by a conf setting or something +sub _check_duplicate { + my $self = shift; + + $self->lock_table; + + if ( qsearchs( 'svc_pbx', { 'title' => $self->title } ) ) { + return "Name in use"; + } else { + return ''; + } +} + +=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; + diff --git a/FS/FS/svc_phone.pm b/FS/FS/svc_phone.pm index 88582d393..30572ecc0 100644 --- a/FS/FS/svc_phone.pm +++ b/FS/FS/svc_phone.pm @@ -1,15 +1,21 @@ package FS::svc_phone; use strict; -use vars qw( @ISA @pw_set $conf ); +use base qw( FS::svc_Domain_Mixin FS::location_Mixin FS::svc_Common ); +use vars qw( $DEBUG $me @pw_set $conf $phone_name_max ); +use Data::Dumper; +use Scalar::Util qw( blessed ); use FS::Conf; use FS::Record qw( qsearch qsearchs dbh ); use FS::Msgcat qw(gettext); -use FS::svc_Common; use FS::part_svc; use FS::phone_device; +use FS::svc_pbx; +use FS::svc_domain; +use FS::cust_location; -@ISA = qw( FS::svc_Common ); +$me = '[' . __PACKAGE__ . ']'; +$DEBUG = 0; #avoid l 1 and o O 0 @pw_set = ( 'a'..'k', 'm','n', 'p-z', 'A'..'N', 'P'..'Z' , '2'..'9' ); @@ -17,6 +23,7 @@ use FS::phone_device; #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_acct'} = sub { $conf = new FS::Conf; + $phone_name_max = $conf->config('svc_phone-phone_name-max_length'); }; =head1 NAME @@ -67,6 +74,10 @@ Voicemail PIN =item phone_name +=item pbxsvc + +Optional svcnum from svc_pbx + =back =head1 METHODS @@ -104,6 +115,24 @@ sub table_info { }, 'sip_password' => 'SIP password', 'phone_name' => 'Name', + 'pbxsvc' => { label => 'PBX', + type => 'select-svc_pbx.html', + disable_inventory => 1, + disable_select => 1, #UI wonky, pry works otherwise + }, + 'domsvc' => { + label => 'Domain', + type => 'select', + select_table => 'svc_domain', + select_key => 'svcnum', + select_label => 'domain', + disable_inventory => 1, + }, + 'locationnum' => { + label => 'E911 location', + disable_inventory => 1, + disable_select => 1, + }, }, }; } @@ -149,18 +178,61 @@ sub label { my $self = shift; my $phonenum = $self->phonenum; #XXX format it better my $label = $phonenum; + $label .= '@'.$self->domain if $self->domsvc; $label .= ' ('.$self->phone_name.')' if $self->phone_name; $label; } =item insert -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. +Adds this phone number to the database. If there is an error, returns the +error, otherwise returns false. =cut -# the insert method can be inherited from FS::Record +sub insert { + my $self = shift; + my %options = @_; + + if ( $DEBUG ) { + warn "[$me] insert called on $self: ". Dumper($self). + "\nwith options: ". Dumper(%options); + } + + 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; + + #false laziness w/cust_pkg.pm... move this to location_Mixin? that would + #make it more of a base class than a mixin... :) + if ( $options{'cust_location'} + && ( ! $self->locationnum || $self->locationnum == -1 ) ) { + my $error = $options{'cust_location'}->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_location (transaction rolled back): $error"; + } + $self->locationnum( $options{'cust_location'}->locationnum ); + } + #what about on-the-fly edits? if the ui supports it? + + my $error = $self->SUPER::insert(%options); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} =item delete @@ -210,7 +282,53 @@ returns the error, otherwise returns false. =cut -# the replace method can be inherited from FS::Record +sub replace { + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + my %options = @_; + + if ( $DEBUG ) { + warn "[$me] replacing $old with $new\n". + "\nwith options: ". Dumper(%options); + } + + 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; + + #false laziness w/cust_pkg.pm... move this to location_Mixin? that would + #make it more of a base class than a mixin... :) + if ( $options{'cust_location'} + && ( ! $new->locationnum || $new->locationnum == -1 ) ) { + my $error = $options{'cust_location'}->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_location (transaction rolled back): $error"; + } + $new->locationnum( $options{'cust_location'}->locationnum ); + } + #what about on-the-fly edits? if the ui supports it? + + my $error = $new->SUPER::replace($old, %options); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error +} =item suspend @@ -251,6 +369,8 @@ sub check { } $self->phonenum($phonenum); + $self->locationnum('') if !$self->locationnum || $self->locationnum == -1; + my $error = $self->ut_numbern('svcnum') || $self->ut_numbern('countrycode') @@ -258,9 +378,16 @@ sub check { || $self->ut_anything('sip_password') || $self->ut_numbern('pin') || $self->ut_textn('phone_name') + || $self->ut_foreign_keyn('pbxsvc', 'svc_pbx', 'svcnum' ) + || $self->ut_foreign_keyn('domsvc', 'svc_domain', 'svcnum' ) + || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum') ; return $error if $error; + return 'Name ('. $self->phone_name. + ") is longer than $phone_name_max characters" + if $phone_name_max && length($self->phone_name) > $phone_name_max; + $self->countrycode(1) unless $self->countrycode; unless ( length($self->sip_password) ) { @@ -387,6 +514,17 @@ sub phone_device { qsearch('phone_device', { 'svcnum' => $self->svcnum } ); } +#override location_Mixin version cause we want to try the cust_pkg location +#in between us and cust_main +# XXX what to do in the unlinked case??? return a pseudo-object that returns +# empty fields? +sub cust_location_or_main { + my $self = shift; + return $self->cust_location if $self->locationnum; + my $cust_pkg = $self->cust_svc->cust_pkg; + $cust_pkg ? $cust_pkg->cust_location_or_main : ''; +} + =back =head1 BUGS diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 30d7f58d0..75e72c542 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -3,11 +3,11 @@ package FS::tax_rate; use strict; use vars qw( @ISA $DEBUG $me %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities - %tax_passtypes %GetInfoType ); + %tax_passtypes %GetInfoType $keep_cch_files ); use Date::Parse; use DateTime; use DateTime::Format::Strptime; -use Storable qw( thaw ); +use Storable qw( thaw nfreeze ); use IO::File; use File::Temp; use LWP::UserAgent; @@ -31,6 +31,7 @@ use FS::Misc qw( csv_from_fixed ); $DEBUG = 0; $me = '[FS::tax_rate]'; +$keep_cch_files = 0; =head1 NAME @@ -501,7 +502,9 @@ given customer (see L<FS::cust_main>) =cut + #hot sub tax_on_tax { + #akshun my $self = shift; my $cust_main = shift; @@ -575,6 +578,10 @@ sub tax_rate_location { =cut +sub _progressbar_foo { + return (0, time, 5); +} + sub batch_import { my ($param, $job) = @_; @@ -603,7 +610,7 @@ sub batch_import { } my $line; - my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar + my ( $count, $last, $min_sec ) = _progressbar_foo(); if ( $job || scalar(@column_callbacks) ) { my $error = csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks); @@ -629,6 +636,7 @@ sub batch_import { my $dt = $parser->parse_datetime( $hash->{'effective_date'} ); $hash->{'effective_date'} = $dt ? $dt->epoch : ''; + $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ; $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax ); my $taxclassid = @@ -874,57 +882,43 @@ Load a batch import as a queued JSRPC job sub process_batch_import { my $job = shift; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $param = thaw(decode_base64(shift)); - my $format = $param->{'format'}; #well... this is all cch specific + my $args = '$job, encode_base64( nfreeze( $param ) )'; - my $files = $param->{'uploaded_files'} - or die "No files provided."; + my $method = '_perform_batch_import'; + if ( $param->{reload} ) { + $method = 'process_batch_reload'; + } - my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files; + eval "$method($args);"; + if ($@) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $@; + } - if ($format eq 'cch' || $format eq 'cch-fixed') { + #success! + $dbh->commit or die $dbh->errstr if $oldAutoCommit; +} - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - my $error = ''; - my $have_location = 0; - - my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import, - 'CODE', 'codefile', \&FS::tax_class::batch_import, - 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import, - 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import, - 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import, - 'DETAIL', 'detail', \&FS::tax_rate::batch_import, - ); - while( scalar(@list) ) { - my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list); - unless ($files{$file}) { - next if $name eq 'PLUS4'; - $error = "No $name supplied"; - $error = "Neither PLUS4 nor ZIP supplied" - if ($name eq 'ZIP' && !$have_location); - next; - } - $have_location = 1 if $name eq 'PLUS4'; - my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' ); - my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc; - my $filename = "$dir/". $files{$file}; - open my $fh, "< $filename" or $error ||= "Can't open $name file: $!"; +sub _perform_batch_import { + my $job = shift; - $error ||= &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job); - close $fh; - unlink $filename or warn "Can't delete $filename: $!"; - } - - if ($error) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - }else{ - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - } + my $param = thaw(decode_base64(shift)); + my $format = $param->{'format'}; #well... this is all cch specific - }elsif ($format eq 'cch-update' || $format eq 'cch-fixed-update') { + my $files = $param->{'uploaded_files'} + or die "No files provided."; + + my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() } + split /,/, $files; + + if ( $format eq 'cch' || $format eq 'cch-fixed' + || $format eq 'cch-update' || $format eq 'cch-fixed-update' ) + { my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; @@ -933,116 +927,70 @@ sub process_batch_import { my @insert_list = (); my @delete_list = (); my @predelete_list = (); + my $insertname = ''; + my $deletename = ''; + my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc; - my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import, - 'CODE', 'codefile', \&FS::tax_class::batch_import, - 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import, - 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import, - 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import, + my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import, + 'CODE', \&FS::tax_class::batch_import, + 'PLUS4', \&FS::cust_tax_location::batch_import, + 'ZIP', \&FS::cust_tax_location::batch_import, + 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import, + 'DETAIL', \&FS::tax_rate::batch_import, ); - my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc; while( scalar(@list) ) { - my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list); - unless ($files{$file}) { - my $vendor = $name eq 'ZIP' ? 'cch' : 'cch-zip'; - next # update expected only for previously installed location data - if ( ($name eq 'PLUS4' || $name eq 'ZIP') - && !scalar( qsearch( { table => 'cust_tax_location', - hashref => { data_vendor => $vendor }, - select => 'DISTINCT data_vendor', - } ) - ) - ); + my ( $name, $import_sub ) = splice( @list, 0, 2 ); + my $file = lc($name). 'file'; + unless ($files{$file}) { $error = "No $name supplied"; next; } + next if $name eq 'DETAIL' && $format =~ /update/; + my $filename = "$dir/". $files{$file}; - open my $fh, "< $filename" or $error ||= "Can't open $name file $filename: $!"; - unlink $filename or warn "Can't delete $filename: $!"; - - my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX", - DIR => $dir, - UNLINK => 0, #meh - ) or die "can't open temp file: $!\n"; - - my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX", - DIR => $dir, - UNLINK => 0, #meh - ) or die "can't open temp file: $!\n"; - - my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/; - my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/; - while(<$fh>) { - my $handle = ''; - $handle = $ifh if $_ =~ /$insert_pattern/; - $handle = $dfh if $_ =~ /$delete_pattern/; - unless ($handle) { - $error = "bad input line: $_" unless $handle; - last; + + if ( $format =~ /update/ ) { + + ( $error, $insertname, $deletename ) = + _perform_cch_insert_delete_split( $name, $filename, $dir, $format ) + unless $error; + last if $error; + + unlink $filename or warn "Can't delete $filename: $!" + unless $keep_cch_files; + push @insert_list, $name, $insertname, $import_sub, $format; + if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better + unshift @predelete_list, $name, $deletename, $import_sub, $format; + } else { + unshift @delete_list, $name, $deletename, $import_sub, $format; } - print $handle $_; - } - close $fh; - close $ifh; - close $dfh; - push @insert_list, $name, $ifh->filename, $import_sub; - if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better - unshift @predelete_list, $name, $dfh->filename, $import_sub; } else { - unshift @delete_list, $name, $dfh->filename, $import_sub; + + push @insert_list, $name, $filename, $import_sub, $format; + } } - while( scalar(@predelete_list) ) { - my ($name, $file, $import_sub) = - (shift @predelete_list, shift @predelete_list, shift @predelete_list); + push @insert_list, + 'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format + if $format =~ /update/; - my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' ); - open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; - $error ||= - &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job); - close $fh; - unlink $file or warn "Can't delete $file: $!"; - } + $error ||= _perform_cch_tax_import( $job, + [ @predelete_list ], + [ @insert_list ], + [ @delete_list ], + ); - while( scalar(@insert_list) ) { - my ($name, $file, $import_sub) = - (shift @insert_list, shift @insert_list, shift @insert_list); - - my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' ); - open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; - $error ||= - &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job); - close $fh; - unlink $file or warn "Can't delete $file: $!"; - } - $error ||= "No DETAIL supplied" - unless ($files{detail}); - open my $fh, "< $dir/". $files{detail} - or $error ||= "Can't open DETAIL file: $!"; - $error ||= - &FS::tax_rate::batch_import({ 'filehandle' => $fh, 'format' => $format }, - $job); - close $fh; - unlink "$dir/". $files{detail} or warn "Can't delete $files{detail}: $!" - if $files{detail}; - - while( scalar(@delete_list) ) { - my ($name, $file, $import_sub) = - (shift @delete_list, shift @delete_list, shift @delete_list); - - my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' ); - open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; - $error ||= - &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job); - close $fh; + @list = ( @predelete_list, @insert_list, @delete_list ); + while( !$keep_cch_files && scalar(@list) ) { + my ( undef, $file, undef, undef ) = splice( @list, 0, 4 ); unlink $file or warn "Can't delete $file: $!"; } - + if ($error) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; die $error; @@ -1056,45 +1004,207 @@ sub process_batch_import { } -=item process_download_and_reload -Download and process a tax update as a queued JSRPC job after wiping the -existing wipable tax data. +sub _perform_cch_tax_import { + my ( $job, $predelete_list, $insert_list, $delete_list ) = @_; -=cut + my $error = ''; + foreach my $list ($predelete_list, $insert_list, $delete_list) { + while( scalar(@$list) ) { + my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 ); + my $fmt = "$format-update"; + $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' ); + open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; + $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job); + close $fh; + } + } -sub process_download_and_reload { - my $job = shift; + return $error; +} - my $param = thaw(decode_base64($_[0])); - my $format = $param->{'format'}; #well... this is all cch specific +sub _perform_cch_insert_delete_split { + my ($name, $filename, $dir, $format) = @_; - my ( $count, $last, $min_sec, $imported ) = (0, time, 5, 0); #progressbar - $count = 100; + my $error = ''; - if ( $job ) { # progress bar - my $error = $job->update_statustext( int( 100 * $imported / $count ) ); + open my $fh, "< $filename" + or $error ||= "Can't open $name file $filename: $!"; + + my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX", + DIR => $dir, + UNLINK => 0, #meh + ) or die "can't open temp file: $!\n"; + my $insertname = $ifh->filename; + + my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX", + DIR => $dir, + UNLINK => 0, #meh + ) or die "can't open temp file: $!\n"; + my $deletename = $dfh->filename; + + my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/; + my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/; + while(<$fh>) { + my $handle = ''; + $handle = $ifh if $_ =~ /$insert_pattern/; + $handle = $dfh if $_ =~ /$delete_pattern/; + unless ($handle) { + $error = "bad input line: $_" unless $handle; + last; + } + print $handle $_; + } + close $fh; + close $ifh; + close $dfh; + + return ($error, $insertname, $deletename); +} + +sub _perform_cch_diff { + my ($name, $newdir, $olddir) = @_; + + my %oldlines = (); + + if ($olddir) { + open my $oldcsvfh, "$olddir/$name.txt" + or die "failed to open $olddir/$name.txt: $!\n"; + + while(<$oldcsvfh>) { + chomp; + $oldlines{$_} = 1; + } + close $oldcsvfh; + } + + open my $newcsvfh, "$newdir/$name.txt" + or die "failed to open $newdir/$name.txt: $!\n"; + + my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX", + DIR => "$newdir", + UNLINK => 0, #meh + ) or die "can't open temp file: $!\n"; + my $diffname = $dfh->filename; + + while(<$newcsvfh>) { + chomp; + if (exists($oldlines{$_})) { + $oldlines{$_} = 0; + } else { + print $dfh $_, ',"I"', "\n"; + } + } + close $newcsvfh; + + for (keys %oldlines) { + print $dfh $_, ',"D"', "\n" if $oldlines{$_}; + } + + close $dfh; + + return $diffname; +} + +sub _cch_fetch_and_unzip { + my ( $job, $urls, $secret, $dir ) = @_; + + my $ua = new LWP::UserAgent; + foreach my $url (split ',', $urls) { + my @name = split '/', $url; #somewhat restrictive + my $name = pop @name; + $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more + $name = $1; + + open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n"; + + my ( $imported, $last, $min_sec ) = _progressbar_foo(); + my $res = $ua->request( + new HTTP::Request( GET => $url ), + sub { + print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n"; + my $content_length = $_[1]->content_length; + $imported += length($_[0]); + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + ($content_length ? int(100 * $imported/$content_length) : 0 ). + ",Downloading data from CCH" + ); + die $error if $error; + $last = time; + } + }, + ); + die "download of $url failed: ". $res->status_line + unless $res->is_success; + + close $taxfh; + my $error = $job->update_statustext( "0,Unpacking data" ); die $error if $error; + $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more + $secret = $1; + system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0 + or die "unzip -P $secret -d $dir $dir/$name failed"; + #unlink "$dir/$name"; } +} + +sub _cch_extract_csv_from_dbf { + my ( $job, $dir, $name ) = @_; - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - my $error = ''; + eval "use Text::CSV_XS;"; + die $@ if $@; - my $sql = - "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ". - "USING (taxclassnum) WHERE data_vendor = '$format'"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute - or die "Unexpected error executing statement $sql: ". $sth->errstr; - die "Don't (yet) know how to handle part_pkg_taxoverride records." - if $sth->fetchrow_arrayref->[0]; + eval "use XBase;"; + die $@ if $@; - # really should get a table EXCLUSIVE lock here + my ( $imported, $last, $min_sec ) = _progressbar_foo(); + my $error = $job->update_statustext( "0,Unpacking $name" ); + die $error if $error; + warn "opening $dir.new/$name.dbf\n" if $DEBUG; + my $table = new XBase 'name' => "$dir.new/$name.dbf"; + die "failed to access $dir.new/$name.dbf: ". XBase->errstr + unless defined($table); + my $count = $table->last_record; # approximately; + open my $csvfh, ">$dir.new/$name.txt" + or die "failed to open $dir.new/$name.txt: $!\n"; + + my $csv = new Text::CSV_XS { 'always_quote' => 1 }; + my @fields = $table->field_names; + my $cursor = $table->prepare_select; + my $format_date = + sub { my $date = shift; + $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1"); + $date; + }; + while (my $row = $cursor->fetch_hashref) { + $csv->combine( map { ($table->field_type($_) eq 'D') + ? &{$format_date}($row->{$_}) + : $row->{$_} + } + @fields + ); + print $csvfh $csv->string, "\n"; + $imported++; + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + int(100 * $imported/$count). ",Unpacking $name" + ); + die $error if $error; + $last = time; + } + } + $table->close; + close $csvfh; +} + +sub _remember_disabled_taxes { + my ( $job, $format, $disabled_tax_rate ) = @_; + + # cch specific hash + + my ( $imported, $last, $min_sec ) = _progressbar_foo(); - #remember disabled taxes - my %disabled_tax_rate = (); my @items = qsearch( { table => 'tax_rate', hashref => { disabled => 'Y', data_vendor => $format, @@ -1102,16 +1212,12 @@ sub process_download_and_reload { select => 'geocode, taxclassnum', } ); - $count = scalar(@items); + my $count = scalar(@items); foreach my $tax_rate ( @items ) { if ( time - $min_sec > $last ) { - my $error = $job->update_statustext( + $job->update_statustext( int( 100 * $imported / $count ). ",Remembering disabled taxes" ); - if ($error) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } $last = time; } $imported++; @@ -1121,148 +1227,75 @@ sub process_download_and_reload { warn "failed to find tax_class ". $tax_rate->taxclassnum; next; } - $disabled_tax_rate{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1; + $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1; } +} + +sub _remember_tax_products { + my ( $job, $format, $taxproduct ) = @_; - #remember tax products # XXX FIXME this loop only works when cch is the only data provider - my %taxproduct = (); + + my ( $imported, $last, $min_sec ) = _progressbar_foo(); + my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ". "0 < ( SELECT count(*) from part_pkg_option WHERE ". " part_pkg_option.pkgpart = part_pkg.pkgpart AND ". " optionname LIKE 'usage_taxproductnum_%' AND ". " optionvalue != '' )"; - @items = qsearch( { table => 'part_pkg', - select => 'DISTINCT pkgpart,taxproductnum', - hashref => {}, - extra_sql => $extra_sql, - } - ); - $count = scalar(@items); - $imported = 0; + my @items = qsearch( { table => 'part_pkg', + select => 'DISTINCT pkgpart,taxproductnum', + hashref => {}, + extra_sql => $extra_sql, + } + ); + my $count = scalar(@items); foreach my $part_pkg ( @items ) { if ( time - $min_sec > $last ) { - my $error = $job->update_statustext( + $job->update_statustext( int( 100 * $imported / $count ). ",Remembering tax products" ); - if ($error) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } $last = time; } $imported++; warn "working with package part ". $part_pkg->pkgpart. "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG; my $part_pkg_taxproduct = $part_pkg->taxproduct(''); - $taxproduct{$part_pkg->pkgpart}{''} = $part_pkg_taxproduct->taxproduct - if $part_pkg_taxproduct; + $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct + if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format; foreach my $option ( $part_pkg->part_pkg_option ) { - next unless $option->optionname =~ /^usage_taxproductnum_(\w)$/; + next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/; my $class = $1; $part_pkg_taxproduct = $part_pkg->taxproduct($class); - $taxproduct{$part_pkg->pkgpart}{$class} = $part_pkg_taxproduct->taxproduct - if $part_pkg_taxproduct; + $taxproduct->{$part_pkg->pkgpart}->{$class} = + $part_pkg_taxproduct->taxproduct + if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format; } } +} - #wipe out the old data - $error = $job->update_statustext( "0,Removing old tax data" ); - if ($error) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } - foreach my $tax_rate_location ( qsearch( 'tax_rate_location', - { data_vendor => $format, - disabled => '', - } - ) - ) - { - $tax_rate_location->disabled('Y'); - my $error = $tax_rate_location->replace; - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } - } +sub _restore_remembered_tax_products { + my ( $job, $format, $taxproduct ) = @_; - local $FS::part_pkg_taxproduct::delete_kludge = 1; - my @table = qw( - tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location - ); - foreach my $table ( @table ) { - my $dbh = dbh; -# my $primary_key = dbdef->table($table)->primary_key; -# my $sql = "SELECT $primary_key FROM $table WHERE data_vendor = ". - my $sql = "DELETE FROM $table WHERE data_vendor = ". - $dbh->quote($format); - my $sth = $dbh->prepare($sql); - unless ($sth) { - $error = $dbh->errstr; - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } - unless ($sth->execute) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die "Failed to execute $sql: ". $sth->errstr; - } -# foreach my $row ( @{ $sth->fetchall_arrayref } ) { -# my $record = qsearchs( $table, { $primary_key => $row->[0] } ) -# or die "Failed to find $table with $primary_key ". $row->[0]; -# my $error = $record->delete; -# if ( $error ) { -# $dbh->rollback or die $dbh->errstr if $oldAutoCommit; -# die $error; -# } -# } - } + # cch specific - if ( $format eq 'cch' ) { - foreach my $cust_tax_location ( qsearch( 'cust_tax_location', - { data_vendor => "$format-zip" } - ) - ) - { - my $error = $cust_tax_location->delete; - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } - } - } - - #import new data - my $statement = ' &process_download_and_update($job, @_); '; - eval $statement; - if ($@) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $@; - } - - #restore taxproducts - $count = scalar(keys %taxproduct); - $imported = 0; - foreach my $pkgpart ( keys %taxproduct ) { + my ( $imported, $last, $min_sec ) = _progressbar_foo(); + my $count = scalar(keys %$taxproduct); + foreach my $pkgpart ( keys %$taxproduct ) { warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG; if ( time - $min_sec > $last ) { - my $error = $job->update_statustext( + $job->update_statustext( int( 100 * $imported / $count ). ",Restoring tax products" ); - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } $last = time; } $imported++; my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } ); unless ( $part_pkg ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die "somehow failed to find part_pkg with pkgpart $pkgpart!\n"; + return "somehow failed to find part_pkg with pkgpart $pkgpart!\n"; } my %options = $part_pkg->options; @@ -1270,19 +1303,18 @@ sub process_download_and_reload { my $primary_svc = $part_pkg->svcpart; my $new = new FS::part_pkg { $part_pkg->hash }; - foreach my $class ( keys %{ $taxproduct{$pkgpart} } ) { + foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) { warn "working with class '$class'\n" if $DEBUG; my $part_pkg_taxproduct = qsearchs( 'part_pkg_taxproduct', - { taxproduct => $taxproduct{$pkgpart}{$class}, + { taxproduct => $taxproduct->{$pkgpart}->{$class}, data_vendor => $format, } ); unless ( $part_pkg_taxproduct ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die "failed to find part_pkg_taxproduct ($taxproduct{pkgpart}{$class})". - " for pkgpart $pkgpart\n"; + return "failed to find part_pkg_taxproduct (". + $taxproduct->{pkgpart}->{$class}. ") for pkgpart $pkgpart\n"; } if ( $class eq '' ) { @@ -1301,24 +1333,23 @@ sub process_download_and_reload { 'options' => \%options, ); - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } + return $error if $error; + } - #disable tax_rates - $count = scalar(keys %disabled_tax_rate); - $imported = 0; - foreach my $key (keys %disabled_tax_rate) { + ''; +} + +sub _restore_remembered_disabled_taxes { + my ( $job, $format, $disabled_tax_rate ) = @_; + + my ( $imported, $last, $min_sec ) = _progressbar_foo(); + my $count = scalar(keys %$disabled_tax_rate); + foreach my $key (keys %$disabled_tax_rate) { if ( time - $min_sec > $last ) { - my $error = $job->update_statustext( + $job->update_statustext( int( 100 * $imported / $count ). ",Disabling tax rates" ); - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } $last = time; } $imported++; @@ -1326,10 +1357,8 @@ sub process_download_and_reload { my @tax_class = qsearch( 'tax_class', { data_vendor => $format, taxclass => $taxclass, } ); - if (scalar(@tax_class) > 1) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die "found multiple tax_class records for format $format class $taxclass"; - } + return "found multiple tax_class records for format $format class $taxclass" + if scalar(@tax_class) > 1; unless (scalar(@tax_class)) { warn "no tax_class for format $format class $taxclass\n"; @@ -1344,28 +1373,188 @@ sub process_download_and_reload { ); if (scalar(@tax_rate) > 1) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die "found multiple tax_rate records for format $format geocode $geocode". - " and taxclass $taxclass ( taxclassnum ". $tax_class[0]->taxclassnum. - " )"; + return "found multiple tax_rate records for format $format geocode ". + "$geocode and taxclass $taxclass ( taxclassnum ". + $tax_class[0]->taxclassnum. " )"; } if (scalar(@tax_rate)) { $tax_rate[0]->disabled('Y'); my $error = $tax_rate[0]->replace; - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } + return $error if $error; } } +} - #success! +sub _remove_old_tax_data { + my ( $job, $format ) = @_; + + my $dbh = dbh; + my $error = $job->update_statustext( "0,Removing old tax data" ); + die $error if $error; + + my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ". + "WHERE data_vendor = ". $dbh->quote($format); + $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr; + + my @table = qw( + tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location + ); + foreach my $table ( @table ) { + $sql = "DELETE FROM public.$table WHERE data_vendor = ". + $dbh->quote($format); + $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr; + } + + if ( $format eq 'cch' ) { + $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ". + $dbh->quote("$format-zip"); + $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr; + } + + ''; +} + +sub _create_temporary_tables { + my ( $job, $format ) = @_; + + my $dbh = dbh; + my $error = $job->update_statustext( "0,Creating temporary tables" ); + die $error if $error; + + my @table = qw( tax_rate + tax_rate_location + part_pkg_taxrate + part_pkg_taxproduct + tax_class + cust_tax_location + ); + foreach my $table ( @table ) { + my $sql = + "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )"; + $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr; + } + + ''; +} + +sub _copy_from_temp { + my ( $job, $format ) = @_; + + my $dbh = dbh; + my $error = $job->update_statustext( "0,Making permanent" ); + die $error if $error; + + my @table = qw( tax_rate + tax_rate_location + part_pkg_taxrate + part_pkg_taxproduct + tax_class + cust_tax_location + ); + foreach my $table ( @table ) { + my $sql = + "INSERT INTO public.$table SELECT * from $table"; + $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr; + } + + ''; +} + +=item process_download_and_reload + +Download and process a tax update as a queued JSRPC job after wiping the +existing wipable tax data. + +=cut + +sub process_download_and_reload { + _process_reload('process_download_and_update', @_); +} + + +=item process_batch_reload + +Load and process a tax update from the provided files as a queued JSRPC job +after wiping the existing wipable tax data. + +=cut + +sub process_batch_reload { + _process_reload('_perform_batch_import', @_); +} - $dbh->commit or die $dbh->errstr if $oldAutoCommit; +sub _process_reload { + my ( $method, $job ) = ( shift, shift ); + + my $param = thaw(decode_base64($_[0])); + my $format = $param->{'format'}; #well... this is all cch specific + + my ( $imported, $last, $min_sec ) = _progressbar_foo(); + + if ( $job ) { # progress bar + my $error = $job->update_statustext( 0 ); + die $error if $error; + } + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $error = ''; + + my $sql = + "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ". + "USING (taxclassnum) WHERE data_vendor = '$format'"; + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute + or die "Unexpected error executing statement $sql: ". $sth->errstr; + die "Don't (yet) know how to handle part_pkg_taxoverride records." + if $sth->fetchrow_arrayref->[0]; + + # really should get a table EXCLUSIVE lock here + + #remember disabled taxes + my %disabled_tax_rate = (); + $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate ); + + #remember tax products + my %taxproduct = (); + $error ||= _remember_tax_products( $job, $format, \%taxproduct ); + + #create temp tables + $error ||= _create_temporary_tables( $job, $format ); + + #import new data + unless ($error) { + my $args = '$job, @_'; + eval "$method($args);"; + $error = $@ if $@; + } + + #restore taxproducts + $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct ); + + #disable tax_rates + $error ||= + _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate ); + + #wipe out the old data + $error ||= _remove_old_tax_data( $job, $format ); + + #untemporize + $error ||= _copy_from_temp( $job, $format ); + + if ($error) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + } + + #success! + $dbh->commit or die $dbh->errstr if $oldAutoCommit; } + =item process_download_and_update Download and process a tax update as a queued JSRPC job @@ -1378,26 +1567,22 @@ sub process_download_and_update { my $param = thaw(decode_base64(shift)); my $format = $param->{'format'}; #well... this is all cch specific - my ( $count, $last, $min_sec, $imported ) = (0, time, 5, 0); #progressbar - $count = 100; + my ( $imported, $last, $min_sec ) = _progressbar_foo(); if ( $job ) { # progress bar - my $error = $job->update_statustext( int( 100 * $imported / $count ) ); + my $error = $job->update_statustext( 0); die $error if $error; } - my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/taxdata'; + my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/'; + my $dir = $cache_dir. 'taxdata'; unless (-d $dir) { mkdir $dir or die "can't create $dir: $!\n"; } if ($format eq 'cch') { - eval "use Text::CSV_XS;"; - die $@ if $@; - - eval "use XBase;"; - die $@ if $@; + my @namelist = qw( code detail geocode plus4 txmatrix zip ); my $conf = new FS::Conf; die "direct download of tax data not enabled\n" @@ -1410,18 +1595,18 @@ sub process_download_and_update { $dir .= '/cch'; - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; my $dbh = dbh; my $error = ''; # really should get a table EXCLUSIVE lock here # check if initial import or update + # + # relying on mkdir "$dir.new" as a mutex my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'"; my $sth = $dbh->prepare($sql) or die $dbh->errstr; $sth->execute() or die $sth->errstr; - my $upgrade = $sth->fetchrow_arrayref->[0]; + my $update = $sth->fetchrow_arrayref->[0]; # create cache and/or rotate old tax data @@ -1445,7 +1630,7 @@ sub process_download_and_update { } else { - die "can't find previous tax data\n" if $upgrade; + die "can't find previous tax data\n" if $update; } @@ -1453,215 +1638,37 @@ sub process_download_and_update { # fetch and unpack the zip files - my $ua = new LWP::UserAgent; - foreach my $url (split ',', $urls) { - my @name = split '/', $url; #somewhat restrictive - my $name = pop @name; - $name =~ /(.*)/; # untaint that which we trust; - $name = $1; - - open my $taxfh, ">$dir.new/$name" or die "Can't open $dir.new/$name: $!\n"; - - my $res = $ua->request( - new HTTP::Request( GET => $url), - sub { #my ($data, $response_object) = @_; - print $taxfh $_[0] or die "Can't write to $dir.new/$name: $!\n"; - my $content_length = $_[1]->content_length; - $imported += length($_[0]); - if ( time - $min_sec > $last ) { - my $error = $job->update_statustext( - ($content_length ? int(100 * $imported/$content_length) : 0 ). - ",Downloading data from CCH" - ); - die $error if $error; - $last = time; - } - }, - ); - die "download of $url failed: ". $res->status_line - unless $res->is_success; - - close $taxfh; - my $error = $job->update_statustext( "0,Unpacking data" ); - die $error if $error; - $secret =~ /(.*)/; # untaint that which we trust; - $secret = $1; - system('unzip', "-P", $secret, "-d", "$dir.new", "$dir.new/$name") == 0 - or die "unzip -P $secret -d $dir.new $dir.new/$name failed"; - #unlink "$dir.new/$name"; - } + _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" ); # extract csv files from the dbf files - foreach my $name ( qw( code detail geocode plus4 txmatrix zip ) ) { - my $error = $job->update_statustext( "0,Unpacking $name" ); - die $error if $error; - warn "opening $dir.new/$name.dbf\n" if $DEBUG; - my $table = new XBase 'name' => "$dir.new/$name.dbf"; - die "failed to access $dir.new/$name.dbf: ". XBase->errstr - unless defined($table); - $count = $table->last_record; # approximately; - $imported = 0; - open my $csvfh, ">$dir.new/$name.txt" - or die "failed to open $dir.new/$name.txt: $!\n"; - - my $csv = new Text::CSV_XS { 'always_quote' => 1 }; - my @fields = $table->field_names; - my $cursor = $table->prepare_select; - my $format_date = - sub { my $date = shift; - $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1"); - $date; - }; - while (my $row = $cursor->fetch_hashref) { - $csv->combine( map { ($table->field_type($_) eq 'D') - ? &{$format_date}($row->{$_}) - : $row->{$_} - } - @fields - ); - print $csvfh $csv->string, "\n"; - $imported++; - if ( time - $min_sec > $last ) { - my $error = $job->update_statustext( - int(100 * $imported/$count). ",Unpacking $name" - ); - die $error if $error; - $last = time; - } - } - $table->close; - close $csvfh; + foreach my $name ( @namelist ) { + _cch_extract_csv_from_dbf( $job, $dir, $name ); } # generate the diff files - my @insert_list = (); - my @delete_list = (); - my @predelete_list = (); - - my @list = ( - 'geocode', \&FS::tax_rate_location::batch_import, - 'code', \&FS::tax_class::batch_import, - 'plus4', \&FS::cust_tax_location::batch_import, - 'zip', \&FS::cust_tax_location::batch_import, - 'txmatrix', \&FS::part_pkg_taxrate::batch_import, - 'detail', \&FS::tax_rate::batch_import, - ); - - while( scalar(@list) ) { - my ( $name, $method ) = ( shift @list, shift @list ); - my %oldlines = (); - - my $error = $job->update_statustext( "0,Comparing to previous $name" ); - die $error if $error; - - warn "processing $dir.new/$name.txt\n" if $DEBUG; - - if ($upgrade) { - open my $oldcsvfh, "$dir.1/$name.txt" - or die "failed to open $dir.1/$name.txt: $!\n"; - - while(<$oldcsvfh>) { - chomp; - $oldlines{$_} = 1; - } - close $oldcsvfh; + my @list = (); + foreach my $name ( @namelist ) { + my $difffile = "$dir.new/$name.txt"; + if ($update) { + my $error = $job->update_statustext( "0,Comparing to previous $name" ); + die $error if $error; + warn "processing $dir.new/$name.txt\n" if $DEBUG; + my $olddir = $update ? "$dir.1" : ""; + $difffile = _perform_cch_diff( $name, "$dir.new", $olddir ); } - - open my $newcsvfh, "$dir.new/$name.txt" - or die "failed to open $dir.new/$name.txt: $!\n"; - - my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX", - DIR => "$dir.new", - UNLINK => 0, #meh - ) or die "can't open temp file: $!\n"; - - my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX", - DIR => "$dir.new", - UNLINK => 0, #meh - ) or die "can't open temp file: $!\n"; - - while(<$newcsvfh>) { - chomp; - if (exists($oldlines{$_})) { - $oldlines{$_} = 0; - } else { - print $ifh $_, ',"I"', "\n"; - } - } - close $newcsvfh; - - if ($name eq 'detail') { - for (keys %oldlines) { # one file for rate details - print $ifh $_, ',"D"', "\n" if $oldlines{$_}; - } - } else { - for (keys %oldlines) { - print $dfh $_, ',"D"', "\n" if $oldlines{$_}; - } - } - %oldlines = (); - - push @insert_list, $name, $ifh->filename, $method; - if ( $name eq 'geocode' ) { - unshift @predelete_list, $name, $dfh->filename, $method - unless $name eq 'detail'; - } else { - unshift @delete_list, $name, $dfh->filename, $method - unless $name eq 'detail'; - } - - close $dfh; - close $ifh; + $difffile =~ s/^$cache_dir//; + push @list, "${name}file:$difffile"; } - while( scalar(@predelete_list) ) { - my ($name, $file, $method) = - (shift @predelete_list, shift @predelete_list, shift @predelete_list); - - my $fmt = "$format-update"; - $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' ); - open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; - $error ||= - &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job); - close $fh; - #unlink $file or warn "Can't delete $file: $!"; - } - - while( scalar(@insert_list) ) { - my ($name, $file, $method) = - (shift @insert_list, shift @insert_list, shift @insert_list); - - my $fmt = "$format-update"; - $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' ); - open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; - $error ||= - &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job); - close $fh; - #unlink $file or warn "Can't delete $file: $!"; - } - - while( scalar(@delete_list) ) { - my ($name, $file, $method) = - (shift @delete_list, shift @delete_list, shift @delete_list); - - my $fmt = "$format-update"; - $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' ); - open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; - $error ||= - &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job); - close $fh; - #unlink $file or warn "Can't delete $file: $!"; - } + # perform the import + local $keep_cch_files = 1; + $param->{uploaded_files} = join( ',', @list ); + $param->{format} .= '-update' if $update; + $error ||= + _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) ); - if ($error) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - }else{ - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - } - rename "$dir.new", "$dir" or die "cch tax update processed, but can't rename $dir.new: $!\n"; @@ -1750,111 +1757,6 @@ sub browse_queries { return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql"); } -# _upgrade_data -# -# Used by FS::Upgrade to migrate to a new database. -# -# - -sub _upgrade_data { # class method - my ($self, %opts) = @_; - my $dbh = dbh; - - warn "$me upgrading $self\n" if $DEBUG; - - my @column = qw ( tax excessrate usetax useexcessrate fee excessfee - feebase feemax ); - - if ( $dbh->{Driver}->{Name} eq 'Pg' ) { - - eval "use DBI::Const::GetInfoType;"; - die $@ if $@; - - my $major_version = 0; - $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/ - && ( $major_version = sprintf("%d", $1) ); - - if ( $major_version > 7 ) { - - # ideally this would be supported in DBIx-DBSchema and friends - - foreach my $column ( @column ) { - my $columndef = dbdef->table($self->table)->column($column); - unless ($columndef->type eq 'numeric') { - - warn "updating tax_rate column $column to numeric\n" if $DEBUG; - my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - warn "updating h_tax_rate column $column to numeric\n" if $DEBUG; - $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - } - } - - } elsif ( $dbh->{pg_server_version} =~ /^704/ ) { - - # ideally this would be supported in DBIx-DBSchema and friends - - foreach my $column ( @column ) { - my $columndef = dbdef->table($self->table)->column($column); - unless ($columndef->type eq 'numeric') { - - warn "updating tax_rate column $column to numeric\n" if $DEBUG; - - foreach my $table ( qw( tax_rate h_tax_rate ) ) { - - my $sql = "ALTER TABLE $table RENAME $column TO old_$column"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - my $def = dbdef->table($table)->column($column); - $def->type('numeric'); - $def->length('14,8'); - my $null = $def->null; - $def->null('NULL'); - - $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh); - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - unless ( $null eq 'NULL' ) { - $sql = "ALTER TABLE $table ALTER $column SET NOT NULL"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - } - - $sql = "ALTER TABLE $table DROP old_$column"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - } - } - } - - } else { - - warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n"; - - } - - } else { - - warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n"; - - } - - ''; - -} - =back =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index 56436792f..4755f1f64 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -87,6 +87,7 @@ FS/h_svc_www.pm FS/part_bill_event.pm FS/payinfo_Mixin.pm FS/export_svc.pm +FS/export_device.pm FS/part_export.pm FS/part_export_option.pm FS/part_export/acct_sql.pm @@ -231,6 +232,7 @@ t/domain_record.t t/nas.t t/part_bill_event.t t/export_svc.t +t/export_device.t t/part_export.t t/part_export_option.t t/part_export-acct_sql.t @@ -364,6 +366,8 @@ FS/cust_credit_bill_pkg.pm t/cust_credit_bill_pkg.t FS/registrar.pm t/registrar.t +FS/svc_Domain_Mixin.pm +t/svc_Domain_Mixin.t FS/svc_External_Common.pm t/svc_External_Common.t FS/svc_Parent_Mixin.pm @@ -455,3 +459,20 @@ FS/cust_statement.pm t/cust_statement.t FS/cdr_batch.pm t/cdr_batch.t +FS/svc_pbx.pm +t/svc_pbx.t +FS/h_svc_www.pm +t/h_svc_www.t +FS/location_Mixin.pm +t/location_Mixin.t +FS/svc_mailinglist.pm +t/svc_mailinglist.t +FS/mailinglist.pm +t/mailinglist.t +FS/mailinglistmember.pm +t/mailinglistmember.t +FS/part_event/Action/Mixin/credit_pkg.pm +FS/part_event/Action/pkg_agent_credit.pm +FS/part_event/Action/pkg_agent_credit_pkg.pm +FS/part_event/Action/pkg_employee_credit.pm +FS/part_event/Action/pkg_employee_credit_pkg.pm diff --git a/FS/bin/freeside-paymentech-upload b/FS/bin/freeside-paymentech-upload index 06bef68be..3f8abc047 100755 --- a/FS/bin/freeside-paymentech-upload +++ b/FS/bin/freeside-paymentech-upload @@ -12,15 +12,15 @@ use FS::pay_batch; use FS::cust_pay_batch; use FS::Conf; -use vars qw( $opt_a $opt_t $opt_v ); -getopts('avt'); +use vars qw( $opt_a $opt_t $opt_v $opt_p ); +getopts('avtp:'); #$Net::SFTP::Foreign::debug = -1; sub usage { " Usage: freeside-paymentech-upload [ -v ] [ -t ] user batchnum - freeside-paymentech-upload -a [ -v ] [ -t ] user\n + freeside-paymentech-upload -a [ -p payby ] [ -v ] [ -t ] user\n " } my $user = shift or die &usage; @@ -31,8 +31,11 @@ my $zip_check = `which zip` or die "can't find zip executable\n"; my @batches; if($opt_a) { - @batches = qsearch('pay_batch', { status => 'O' } ); - die "No open batches found.\n" if !@batches; + my %criteria = (status => 'O'); + $criteria{'payby'} = uc($opt_p) if $opt_p; + @batches = qsearch('pay_batch', \%criteria); + die "No open batches found".($opt_p ? " of type '$opt_p'" : '').".\n" + if !@batches; } else { my $batchnum = shift; @@ -95,7 +98,7 @@ freeside-paymentech-upload - Transmit a payment batch to Chase Paymentech via SF =head1 SYNOPSIS - freeside-paymentech-upload [ -a ] [ -v ] [ -t ] user batchnum + freeside-paymentech-upload [ -a [ -p PAYBY ] ] [ -v ] [ -t ] user batchnum =head1 DESCRIPTION @@ -106,6 +109,8 @@ response file. -a: Send all open batches, instead of specifying a batchnum. +-p PAYBY: With -a, limit to batches of that payment type, e.g. -p CARD. + -v: Be verbose. -t: Send the transaction to the test server. diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade index 97c704c91..f4ff1c28e 100755 --- a/FS/bin/freeside-upgrade +++ b/FS/bin/freeside-upgrade @@ -4,7 +4,7 @@ use strict; use vars qw($opt_d $opt_s $opt_q $opt_v $opt_r); use vars qw($DEBUG $DRY_RUN); use Getopt::Std; -use DBIx::DBSchema 0.31; +use DBIx::DBSchema 0.31; #0.39 use FS::UID qw(adminsuidsetup checkeuid datasrc driver_name); #getsecrets); use FS::CurrentUser; use FS::Schema qw( dbdef dbdef_dist reload_dbdef ); @@ -30,6 +30,11 @@ $FS::UID::callback_hack = 1; my $dbh = adminsuidsetup($user); $FS::UID::callback_hack = 0; +if ( driver_name =~ /^mysql/i ) { #until 0.39 is required above + eval "use DBIx::DBSchema 0.39;"; + die $@ if $@; +} + #needs to match FS::Schema... my $dbdef_file = "%%%FREESIDE_CONF%%%/dbdef.". datasrc; diff --git a/FS/t/h_svc_mailinglist.t b/FS/t/h_svc_mailinglist.t new file mode 100644 index 000000000..d75575a81 --- /dev/null +++ b/FS/t/h_svc_mailinglist.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_svc_mailinglist; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_svc_pbx.t b/FS/t/h_svc_pbx.t new file mode 100644 index 000000000..8b30f52a7 --- /dev/null +++ b/FS/t/h_svc_pbx.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_svc_pbx; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/location_Mixin.t b/FS/t/location_Mixin.t new file mode 100644 index 000000000..b6a9bf23f --- /dev/null +++ b/FS/t/location_Mixin.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::location_Mixin; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/mailinglist.t b/FS/t/mailinglist.t new file mode 100644 index 000000000..45b7dd583 --- /dev/null +++ b/FS/t/mailinglist.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::mailinglist; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/mailinglistmember.t b/FS/t/mailinglistmember.t new file mode 100644 index 000000000..1ceb2f567 --- /dev/null +++ b/FS/t/mailinglistmember.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::mailinglistmember; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_Domain_Mixin.t b/FS/t/svc_Domain_Mixin.t new file mode 100644 index 000000000..261af7537 --- /dev/null +++ b/FS/t/svc_Domain_Mixin.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_Domain_Mixin; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_mailinglist.t b/FS/t/svc_mailinglist.t new file mode 100644 index 000000000..73896da3c --- /dev/null +++ b/FS/t/svc_mailinglist.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_mailinglist; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_pbx.t b/FS/t/svc_pbx.t new file mode 100644 index 000000000..2a41372a0 --- /dev/null +++ b/FS/t/svc_pbx.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_pbx; +$loaded=1; +print "ok 1\n"; |