summaryrefslogtreecommitdiff
path: root/FS/FS
diff options
context:
space:
mode:
Diffstat (limited to 'FS/FS')
-rw-r--r--FS/FS/AccessRight.pm401
-rw-r--r--FS/FS/CGI.pm333
-rw-r--r--FS/FS/ClientAPI.pm42
-rw-r--r--FS/FS/ClientAPI/Agent.pm214
-rw-r--r--FS/FS/ClientAPI/Bulk.pm384
-rw-r--r--FS/FS/ClientAPI/MasonComponent.pm131
-rw-r--r--FS/FS/ClientAPI/MyAccount.pm2039
-rw-r--r--FS/FS/ClientAPI/PrepaidPhone.pm253
-rw-r--r--FS/FS/ClientAPI/SGNG.pm277
-rw-r--r--FS/FS/ClientAPI/Signup.pm888
-rw-r--r--FS/FS/ClientAPI/passwd.pm46
-rw-r--r--FS/FS/ClientAPI_SessionCache.pm79
-rw-r--r--FS/FS/ClientAPI_XMLRPC.pm148
-rw-r--r--FS/FS/Conf.pm4235
-rw-r--r--FS/FS/ConfDefaults.pm86
-rw-r--r--FS/FS/ConfItem.pm63
-rw-r--r--FS/FS/Conf_compat17.pm2520
-rw-r--r--FS/FS/Cron/alert_expiration.pm189
-rw-r--r--FS/FS/Cron/backup.pm45
-rw-r--r--FS/FS/Cron/bill.pm245
-rw-r--r--FS/FS/Cron/breakage.pm84
-rw-r--r--FS/FS/Cron/check.pm200
-rw-r--r--FS/FS/Cron/expire_user_pref.pm20
-rw-r--r--FS/FS/Cron/notify.pm159
-rw-r--r--FS/FS/Cron/upload.pm176
-rw-r--r--FS/FS/Cron/vacuum.pm23
-rw-r--r--FS/FS/CurrentUser.pm67
-rw-r--r--FS/FS/Daemon.pm120
-rw-r--r--FS/FS/InitHandler.pm91
-rw-r--r--FS/FS/Maestro.pm248
-rw-r--r--FS/FS/Mason.pm555
-rw-r--r--FS/FS/Mason/Request.pm87
-rw-r--r--FS/FS/Misc.pm904
-rw-r--r--FS/FS/Misc/DateTime.pm64
-rw-r--r--FS/FS/Misc/eps2png.pm278
-rw-r--r--FS/FS/Misc/prune.pm131
-rw-r--r--FS/FS/Msgcat.pm100
-rw-r--r--FS/FS/Pony.pm23
-rw-r--r--FS/FS/Record.pm3157
-rw-r--r--FS/FS/Report.pm46
-rw-r--r--FS/FS/Report/FCC_477.pm90
-rw-r--r--FS/FS/Report/Table.pm27
-rw-r--r--FS/FS/Report/Table/Monthly.pm590
-rw-r--r--FS/FS/Schema.pm3171
-rw-r--r--FS/FS/SearchCache.pm96
-rw-r--r--FS/FS/Setup.pm552
-rw-r--r--FS/FS/TicketSystem.pm52
-rw-r--r--FS/FS/TicketSystem/RT_External.pm401
-rw-r--r--FS/FS/TicketSystem/RT_Internal.pm402
-rw-r--r--FS/FS/TicketSystem/RT_Libs.pm10
-rw-r--r--FS/FS/Tron.pm123
-rw-r--r--FS/FS/UI/Web.pm644
-rw-r--r--FS/FS/UI/Web/small_custview.pm149
-rw-r--r--FS/FS/UI/bytecount.pm101
-rw-r--r--FS/FS/UID.pm405
-rw-r--r--FS/FS/Upgrade.pm378
-rw-r--r--FS/FS/XMLRPC.pm166
-rw-r--r--FS/FS/Yori.pm94
-rw-r--r--FS/FS/access_group.pm162
-rw-r--r--FS/FS/access_groupagent.pm146
-rw-r--r--FS/FS/access_right.pm198
-rw-r--r--FS/FS/access_user.pm544
-rw-r--r--FS/FS/access_user_pref.pm129
-rw-r--r--FS/FS/access_usergroup.pm143
-rw-r--r--FS/FS/acct_rt_transaction.pm316
-rw-r--r--FS/FS/acct_snarf.pm215
-rwxr-xr-xFS/FS/addr_block.pm385
-rw-r--r--FS/FS/agent.pm592
-rw-r--r--FS/FS/agent_payment_gateway.pm139
-rw-r--r--FS/FS/agent_type.pm195
-rw-r--r--FS/FS/banned_pay.pm141
-rw-r--r--FS/FS/bill_batch.pm151
-rw-r--r--FS/FS/category_Common.pm87
-rw-r--r--FS/FS/cdr.pm950
-rw-r--r--FS/FS/cdr/asterisk.pm45
-rw-r--r--FS/FS/cdr/bell_west.pm122
-rw-r--r--FS/FS/cdr/broadsoft.pm108
-rw-r--r--FS/FS/cdr/cia.pm39
-rw-r--r--FS/FS/cdr/genband.pm120
-rw-r--r--FS/FS/cdr/genband_meetme.pm17
-rw-r--r--FS/FS/cdr/indosoft.pm71
-rw-r--r--FS/FS/cdr/infinite.pm41
-rw-r--r--FS/FS/cdr/netcentrex.pm783
-rw-r--r--FS/FS/cdr/nextone.pm26
-rw-r--r--FS/FS/cdr/openser.pm24
-rw-r--r--FS/FS/cdr/sansay.pm408
-rw-r--r--FS/FS/cdr/simple.pm52
-rw-r--r--FS/FS/cdr/simple2.pm51
-rw-r--r--FS/FS/cdr/taqua.pm190
-rw-r--r--FS/FS/cdr/taqua_om.pm19
-rw-r--r--FS/FS/cdr/telos_csv.pm60
-rw-r--r--FS/FS/cdr/telos_xml.pm36
-rw-r--r--FS/FS/cdr/transnexus.pm66
-rw-r--r--FS/FS/cdr/troop.pm128
-rw-r--r--FS/FS/cdr/unitel.pm39
-rw-r--r--FS/FS/cdr/vitelity.pm25
-rw-r--r--FS/FS/cdr/wip.pm48
-rw-r--r--FS/FS/cdr_batch.pm128
-rw-r--r--FS/FS/cdr_calltype.pm115
-rw-r--r--FS/FS/cdr_carrier.pm116
-rw-r--r--FS/FS/cdr_termination.pm155
-rw-r--r--FS/FS/cdr_type.pm119
-rw-r--r--FS/FS/cgp_rule.pm363
-rw-r--r--FS/FS/cgp_rule_action.pm141
-rw-r--r--FS/FS/cgp_rule_condition.pm148
-rw-r--r--FS/FS/class_Common.pm143
-rw-r--r--FS/FS/clientapi_session.pm121
-rw-r--r--FS/FS/clientapi_session_field.pm124
-rw-r--r--FS/FS/conf.pm114
-rw-r--r--FS/FS/contact.pm300
-rw-r--r--FS/FS/contact_email.pm128
-rw-r--r--FS/FS/contact_phone.pm143
-rw-r--r--FS/FS/cust_attachment.pm199
-rw-r--r--FS/FS/cust_bill.pm4710
-rw-r--r--FS/FS/cust_bill_ApplicationCommon.pm518
-rw-r--r--FS/FS/cust_bill_batch.pm70
-rw-r--r--FS/FS/cust_bill_batch_option.pm126
-rw-r--r--FS/FS/cust_bill_event.pm380
-rw-r--r--FS/FS/cust_bill_pay.pm186
-rw-r--r--FS/FS/cust_bill_pay_batch.pm120
-rw-r--r--FS/FS/cust_bill_pay_pkg.pm224
-rw-r--r--FS/FS/cust_bill_pkg.pm902
-rw-r--r--FS/FS/cust_bill_pkg_detail.pm376
-rw-r--r--FS/FS/cust_bill_pkg_discount.pm158
-rw-r--r--FS/FS/cust_bill_pkg_display.pm166
-rw-r--r--FS/FS/cust_bill_pkg_tax_location.pm225
-rw-r--r--FS/FS/cust_bill_pkg_tax_rate_location.pm221
-rw-r--r--FS/FS/cust_category.pm97
-rw-r--r--FS/FS/cust_class.pm120
-rw-r--r--FS/FS/cust_credit.pm639
-rw-r--r--FS/FS/cust_credit_bill.pm170
-rw-r--r--FS/FS/cust_credit_bill_pkg.pm355
-rw-r--r--FS/FS/cust_credit_refund.pm186
-rw-r--r--FS/FS/cust_event.pm508
-rw-r--r--FS/FS/cust_location.pm278
-rw-r--r--FS/FS/cust_main.pm4830
-rw-r--r--FS/FS/cust_main/Billing.pm2111
-rw-r--r--FS/FS/cust_main/Billing_Discount.pm207
-rw-r--r--FS/FS/cust_main/Billing_Realtime.pm1494
-rw-r--r--FS/FS/cust_main/Import.pm472
-rw-r--r--FS/FS/cust_main/Packages.pm452
-rw-r--r--FS/FS/cust_main/Search.pm881
-rw-r--r--FS/FS/cust_main/_Marketgear.pm146
-rw-r--r--FS/FS/cust_main_Mixin.pm554
-rw-r--r--FS/FS/cust_main_county.pm506
-rw-r--r--FS/FS/cust_main_exemption.pm128
-rw-r--r--FS/FS/cust_main_invoice.pm188
-rw-r--r--FS/FS/cust_main_note.pm193
-rw-r--r--FS/FS/cust_note_class.pm105
-rw-r--r--FS/FS/cust_pay.pm1061
-rw-r--r--FS/FS/cust_pay_batch.pm353
-rw-r--r--FS/FS/cust_pay_pending.pm341
-rw-r--r--FS/FS/cust_pay_refund.pm188
-rw-r--r--FS/FS/cust_pay_void.pm291
-rw-r--r--FS/FS/cust_pkg.pm3435
-rw-r--r--FS/FS/cust_pkg/Import.pm373
-rw-r--r--FS/FS/cust_pkg_detail.pm140
-rw-r--r--FS/FS/cust_pkg_discount.pm246
-rw-r--r--FS/FS/cust_pkg_option.pm115
-rw-r--r--FS/FS/cust_pkg_reason.pm331
-rw-r--r--FS/FS/cust_recon.pm193
-rw-r--r--FS/FS/cust_refund.pm394
-rw-r--r--FS/FS/cust_statement.pm272
-rw-r--r--FS/FS/cust_svc.pm775
-rw-r--r--FS/FS/cust_svc_option.pm134
-rw-r--r--FS/FS/cust_tag.pm147
-rw-r--r--FS/FS/cust_tax_adjustment.pm149
-rw-r--r--FS/FS/cust_tax_exempt.pm152
-rw-r--r--FS/FS/cust_tax_exempt_pkg.pm152
-rw-r--r--FS/FS/cust_tax_location.pm344
-rw-r--r--FS/FS/discount.pm193
-rw-r--r--FS/FS/domain_record.pm465
-rw-r--r--FS/FS/dsl_note.pm127
-rw-r--r--FS/FS/export_device.pm136
-rw-r--r--FS/FS/export_svc.pm322
-rw-r--r--FS/FS/geocode_Mixin.pm164
-rw-r--r--FS/FS/h_Common.pm124
-rw-r--r--FS/FS/h_cust_bill.pm33
-rw-r--r--FS/FS/h_cust_credit.pm33
-rw-r--r--FS/FS/h_cust_pay.pm33
-rw-r--r--FS/FS/h_cust_pkg.pm34
-rw-r--r--FS/FS/h_cust_pkg_reason.pm34
-rw-r--r--FS/FS/h_cust_svc.pm165
-rw-r--r--FS/FS/h_cust_tax_exempt.pm40
-rw-r--r--FS/FS/h_domain_record.pm33
-rw-r--r--FS/FS/h_inventory_item.pm33
-rw-r--r--FS/FS/h_svc_acct.pm78
-rw-r--r--FS/FS/h_svc_broadband.pm33
-rw-r--r--FS/FS/h_svc_domain.pm33
-rw-r--r--FS/FS/h_svc_dsl.pm33
-rw-r--r--FS/FS/h_svc_external.pm33
-rw-r--r--FS/FS/h_svc_forward.pm85
-rw-r--r--FS/FS/h_svc_mailinglist.pm33
-rw-r--r--FS/FS/h_svc_pbx.pm33
-rw-r--r--FS/FS/h_svc_phone.pm33
-rw-r--r--FS/FS/h_svc_www.pm67
-rw-r--r--FS/FS/inventory_class.pm264
-rw-r--r--FS/FS/inventory_item.pm182
-rw-r--r--FS/FS/location_Mixin.pm57
-rw-r--r--FS/FS/m2m_Common.pm170
-rw-r--r--FS/FS/m2name_Common.pm177
-rw-r--r--FS/FS/mailinglist.pm173
-rw-r--r--FS/FS/mailinglistmember.pm245
-rw-r--r--FS/FS/msg_template.pm572
-rw-r--r--FS/FS/msgcat.pm166
-rw-r--r--FS/FS/nas.pm150
-rw-r--r--FS/FS/o2m_Common.pm152
-rw-r--r--FS/FS/option_Common.pm352
-rw-r--r--FS/FS/otaker_Mixin.pm84
-rw-r--r--FS/FS/part_bill_event.pm368
-rw-r--r--FS/FS/part_device.pm148
-rw-r--r--FS/FS/part_event.pm444
-rw-r--r--FS/FS/part_event/Action.pm240
-rw-r--r--FS/FS/part_event/Action/Mixin/credit_pkg.pm63
-rw-r--r--FS/FS/part_event/Action/addpost.pm20
-rw-r--r--FS/FS/part_event/Action/apply.pm24
-rw-r--r--FS/FS/part_event/Action/bill.pm26
-rw-r--r--FS/FS/part_event/Action/cancel.pm30
-rw-r--r--FS/FS/part_event/Action/collect.pm26
-rw-r--r--FS/FS/part_event/Action/cust_bill_batch.pm25
-rw-r--r--FS/FS/part_event/Action/cust_bill_comp.pm28
-rw-r--r--FS/FS/part_event/Action/cust_bill_email.pm23
-rw-r--r--FS/FS/part_event/Action/cust_bill_fee_percent.pm28
-rw-r--r--FS/FS/part_event/Action/cust_bill_realtime_card.pm28
-rw-r--r--FS/FS/part_event/Action/cust_bill_realtime_check.pm28
-rw-r--r--FS/FS/part_event/Action/cust_bill_realtime_lec.pm28
-rw-r--r--FS/FS/part_event/Action/cust_bill_send.pm20
-rw-r--r--FS/FS/part_event/Action/cust_bill_send_agent.pm42
-rw-r--r--FS/FS/part_event/Action/cust_bill_send_alternate.pm31
-rw-r--r--FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm50
-rw-r--r--FS/FS/part_event/Action/cust_bill_send_if_newest.pm38
-rw-r--r--FS/FS/part_event/Action/cust_bill_send_reminder.pm31
-rw-r--r--FS/FS/part_event/Action/cust_bill_spool_csv.pm59
-rw-r--r--FS/FS/part_event/Action/cust_bill_suspend_if_balance.pm42
-rw-r--r--FS/FS/part_event/Action/cust_statement.pm39
-rw-r--r--FS/FS/part_event/Action/cust_statement_send.pm26
-rw-r--r--FS/FS/part_event/Action/fee.pm58
-rw-r--r--FS/FS/part_event/Action/notice.pm47
-rw-r--r--FS/FS/part_event/Action/notice_to.pm55
-rw-r--r--FS/FS/part_event/Action/pkg_agent_credit.pm39
-rw-r--r--FS/FS/part_event/Action/pkg_agent_credit_pkg.pm9
-rw-r--r--FS/FS/part_event/Action/pkg_cancel.pm32
-rw-r--r--FS/FS/part_event/Action/pkg_employee_credit.pm39
-rw-r--r--FS/FS/part_event/Action/pkg_employee_credit_pkg.pm9
-rw-r--r--FS/FS/part_event/Action/pkg_referral_credit.pm62
-rw-r--r--FS/FS/part_event/Action/pkg_referral_credit_pkg.pm9
-rw-r--r--FS/FS/part_event/Action/suspend.pm32
-rw-r--r--FS/FS/part_event/Action/suspend_if_pkgpart.pm40
-rw-r--r--FS/FS/part_event/Action/suspend_unless_pkgpart.pm40
-rw-r--r--FS/FS/part_event/Action/writeoff.pm33
-rw-r--r--FS/FS/part_event/Condition.pm470
-rw-r--r--FS/FS/part_event/Condition/agent.pm37
-rw-r--r--FS/FS/part_event/Condition/agent_type.pm40
-rw-r--r--FS/FS/part_event/Condition/balance.pm48
-rw-r--r--FS/FS/part_event/Condition/balance_age.pm52
-rw-r--r--FS/FS/part_event/Condition/balance_credit_limit.pm32
-rw-r--r--FS/FS/part_event/Condition/balance_under.pm42
-rw-r--r--FS/FS/part_event/Condition/cust_bill_age.pm46
-rw-r--r--FS/FS/part_event/Condition/cust_bill_has_noauto.pm33
-rw-r--r--FS/FS/part_event/Condition/cust_bill_has_service.pm56
-rw-r--r--FS/FS/part_event/Condition/cust_bill_hasnt_noauto.pm33
-rw-r--r--FS/FS/part_event/Condition/cust_bill_owed.pm54
-rw-r--r--FS/FS/part_event/Condition/cust_bill_owed_under.pm49
-rw-r--r--FS/FS/part_event/Condition/cust_bill_past_due.pm41
-rw-r--r--FS/FS/part_event/Condition/cust_pay_batch_declined.pm51
-rw-r--r--FS/FS/part_event/Condition/cust_payments.pm43
-rw-r--r--FS/FS/part_event/Condition/cust_payments_pkg.pm68
-rw-r--r--FS/FS/part_event/Condition/cust_status.pm40
-rw-r--r--FS/FS/part_event/Condition/dundate.pm26
-rw-r--r--FS/FS/part_event/Condition/every.pm67
-rw-r--r--FS/FS/part_event/Condition/has_pkg_class.pm40
-rw-r--r--FS/FS/part_event/Condition/has_pkgpart.pm41
-rw-r--r--FS/FS/part_event/Condition/has_referral_custnum.pm50
-rw-r--r--FS/FS/part_event/Condition/hasnt_pkgpart.pm40
-rw-r--r--FS/FS/part_event/Condition/once.pm55
-rw-r--r--FS/FS/part_event/Condition/once_every.pm46
-rw-r--r--FS/FS/part_event/Condition/once_percust.pm67
-rw-r--r--FS/FS/part_event/Condition/once_perinv.pm57
-rw-r--r--FS/FS/part_event/Condition/payby.pm44
-rw-r--r--FS/FS/part_event/Condition/pkg_age.pm66
-rw-r--r--FS/FS/part_event/Condition/pkg_class.pm38
-rw-r--r--FS/FS/part_event/Condition/pkg_freq.pm36
-rw-r--r--FS/FS/part_event/Condition/pkg_next_bill_within.pm51
-rw-r--r--FS/FS/part_event/Condition/pkg_notchange.pm31
-rw-r--r--FS/FS/part_event/Condition/pkg_pkgpart.pm39
-rw-r--r--FS/FS/part_event/Condition/pkg_recurring.pm28
-rw-r--r--FS/FS/part_event/Condition/pkg_status.pm44
-rw-r--r--FS/FS/part_event/Condition/pkg_unless_pkgpart.pm39
-rw-r--r--FS/FS/part_event_condition.pm354
-rw-r--r--FS/FS/part_event_condition_option.pm151
-rw-r--r--FS/FS/part_event_condition_option_option.pm129
-rw-r--r--FS/FS/part_event_option.pm214
-rw-r--r--FS/FS/part_export.pm493
-rw-r--r--FS/FS/part_export/acct_freeside.pm139
-rw-r--r--FS/FS/part_export/acct_http.pm63
-rw-r--r--FS/FS/part_export/acct_plesk.pm121
-rw-r--r--FS/FS/part_export/acct_sql.pm310
-rw-r--r--FS/FS/part_export/amazon_ec2.pm169
-rw-r--r--FS/FS/part_export/apache.pm47
-rw-r--r--FS/FS/part_export/artera_turbo.pm181
-rw-r--r--FS/FS/part_export/bind.pm35
-rw-r--r--FS/FS/part_export/bind_slave.pm28
-rw-r--r--FS/FS/part_export/bsdshell.pm25
-rw-r--r--FS/FS/part_export/cardfortress.pm64
-rw-r--r--FS/FS/part_export/communigate_pro.pm1070
-rw-r--r--FS/FS/part_export/communigate_pro_singledomain.pm37
-rw-r--r--FS/FS/part_export/cp.pm161
-rw-r--r--FS/FS/part_export/cpanel.pm192
-rw-r--r--FS/FS/part_export/cust_http.pm67
-rw-r--r--FS/FS/part_export/cyrus.pm120
-rw-r--r--FS/FS/part_export/dashcs_e911.pm153
-rw-r--r--FS/FS/part_export/domain_shellcommands.pm165
-rw-r--r--FS/FS/part_export/domain_sql.pm241
-rw-r--r--FS/FS/part_export/domreg_net_dri.pm614
-rw-r--r--FS/FS/part_export/domreg_opensrs.pm616
-rw-r--r--FS/FS/part_export/everyone_net.pm132
-rw-r--r--FS/FS/part_export/forward_shellcommands.pm182
-rw-r--r--FS/FS/part_export/globalpops_voip.pm370
-rw-r--r--FS/FS/part_export/grandstream.pm257
-rw-r--r--FS/FS/part_export/http.pm151
-rw-r--r--FS/FS/part_export/ikano.pm697
-rw-r--r--FS/FS/part_export/indosoft.pm219
-rw-r--r--FS/FS/part_export/infostreet.pm277
-rw-r--r--FS/FS/part_export/internal_diddb.pm134
-rw-r--r--FS/FS/part_export/ldap.pm264
-rw-r--r--FS/FS/part_export/nas_wrapper.pm311
-rw-r--r--FS/FS/part_export/netsapiens.pm312
-rw-r--r--FS/FS/part_export/null.pm13
-rw-r--r--FS/FS/part_export/passwdfile.pm18
-rw-r--r--FS/FS/part_export/phone_shellcommands.pm140
-rw-r--r--FS/FS/part_export/phone_sqlradius.pm158
-rw-r--r--FS/FS/part_export/postfix.pm32
-rw-r--r--FS/FS/part_export/prizm.pm591
-rw-r--r--FS/FS/part_export/radiator.pm167
-rw-r--r--FS/FS/part_export/router.pm375
-rw-r--r--FS/FS/part_export/rt_ticket.pm219
-rw-r--r--FS/FS/part_export/shellcommands.pm480
-rw-r--r--FS/FS/part_export/shellcommands_withdomain.pm138
-rw-r--r--FS/FS/part_export/snmp.pm256
-rw-r--r--FS/FS/part_export/soma.pm412
-rw-r--r--FS/FS/part_export/sqlmail.pm220
-rw-r--r--FS/FS/part_export/sqlradius.pm861
-rw-r--r--FS/FS/part_export/sqlradius_withdomain.pm28
-rw-r--r--FS/FS/part_export/sysvshell.pm25
-rw-r--r--FS/FS/part_export/textradius.pm191
-rw-r--r--FS/FS/part_export/thirdlane.pm348
-rw-r--r--FS/FS/part_export/trango.pm434
-rw-r--r--FS/FS/part_export/vitelity.pm250
-rw-r--r--FS/FS/part_export/vpopmail.pm254
-rw-r--r--FS/FS/part_export/www_plesk.pm138
-rw-r--r--FS/FS/part_export/www_shellcommands.pm190
-rw-r--r--FS/FS/part_export_option.pm134
-rw-r--r--FS/FS/part_pkg.pm1643
-rw-r--r--FS/FS/part_pkg/agent.pm172
-rw-r--r--FS/FS/part_pkg/base_delayed.pm42
-rw-r--r--FS/FS/part_pkg/base_rate.pm83
-rw-r--r--FS/FS/part_pkg/bulk.pm130
-rw-r--r--FS/FS/part_pkg/cdr_termination.pm204
-rw-r--r--FS/FS/part_pkg/discount_Mixin.pm128
-rw-r--r--FS/FS/part_pkg/flat.pm204
-rw-r--r--FS/FS/part_pkg/flat_comission.pm60
-rw-r--r--FS/FS/part_pkg/flat_comission_cust.pm44
-rw-r--r--FS/FS/part_pkg/flat_comission_pkg.pm38
-rw-r--r--FS/FS/part_pkg/flat_delayed.pm54
-rw-r--r--FS/FS/part_pkg/flat_introrate.pm60
-rw-r--r--FS/FS/part_pkg/global_Mixin.pm38
-rw-r--r--FS/FS/part_pkg/incomplete/billoneday.pm48
-rw-r--r--FS/FS/part_pkg/prepaid.pm51
-rw-r--r--FS/FS/part_pkg/prorate.pm43
-rw-r--r--FS/FS/part_pkg/prorate_Mixin.pm105
-rw-r--r--FS/FS/part_pkg/prorate_delayed.pm53
-rw-r--r--FS/FS/part_pkg/recur_Common.pm70
-rw-r--r--FS/FS/part_pkg/rt_time.pm73
-rw-r--r--FS/FS/part_pkg/sesmon_hour.pm50
-rw-r--r--FS/FS/part_pkg/sesmon_minute.pm49
-rw-r--r--FS/FS/part_pkg/sql_external.pm77
-rw-r--r--FS/FS/part_pkg/sql_generic.pm81
-rw-r--r--FS/FS/part_pkg/sqlradacct_hour.pm163
-rw-r--r--FS/FS/part_pkg/subscription.pm108
-rw-r--r--FS/FS/part_pkg/usage_Mixin.pm77
-rw-r--r--FS/FS/part_pkg/voip_cdr.pm925
-rw-r--r--FS/FS/part_pkg/voip_inbound.pm366
-rw-r--r--FS/FS/part_pkg/voip_sqlradacct.pm185
-rw-r--r--FS/FS/part_pkg_discount.pm129
-rw-r--r--FS/FS/part_pkg_link.pm163
-rw-r--r--FS/FS/part_pkg_option.pm159
-rw-r--r--FS/FS/part_pkg_report_option.pm125
-rw-r--r--FS/FS/part_pkg_taxclass.pm226
-rw-r--r--FS/FS/part_pkg_taxoverride.pm119
-rw-r--r--FS/FS/part_pkg_taxproduct.pm139
-rw-r--r--FS/FS/part_pkg_taxrate.pm420
-rw-r--r--FS/FS/part_pkg_vendor.pm140
-rw-r--r--FS/FS/part_pop_local.pm113
-rw-r--r--FS/FS/part_referral.pm208
-rw-r--r--FS/FS/part_svc.pm881
-rw-r--r--FS/FS/part_svc_column.pm123
-rwxr-xr-xFS/FS/part_svc_router.pm33
-rw-r--r--FS/FS/part_tag.pm132
-rwxr-xr-xFS/FS/part_virtual_field.pm301
-rw-r--r--FS/FS/pay_batch.pm589
-rw-r--r--FS/FS/pay_batch/BoM.pm73
-rw-r--r--FS/FS/pay_batch/PAP.pm103
-rw-r--r--FS/FS/pay_batch/RBC.pm143
-rw-r--r--FS/FS/pay_batch/ach_spiritone.pm65
-rw-r--r--FS/FS/pay_batch/chase_canada.pm89
-rw-r--r--FS/FS/pay_batch/paymentech.pm144
-rw-r--r--FS/FS/pay_batch/td_canada_trust.pm90
-rw-r--r--FS/FS/pay_batch/td_eft1464.pm156
-rw-r--r--FS/FS/pay_batch/td_eftack264.pm59
-rw-r--r--FS/FS/pay_batch/td_eftret80.pm46
-rw-r--r--FS/FS/payby.pm209
-rw-r--r--FS/FS/payinfo_Mixin.pm268
-rw-r--r--FS/FS/payinfo_transaction_Mixin.pm123
-rw-r--r--FS/FS/payment_gateway.pm247
-rw-r--r--FS/FS/payment_gateway_option.pm126
-rw-r--r--FS/FS/phone_avail.pm217
-rw-r--r--FS/FS/phone_device.pm299
-rw-r--r--FS/FS/phone_type.pm137
-rw-r--r--FS/FS/pkg_category.pm132
-rw-r--r--FS/FS/pkg_class.pm119
-rw-r--r--FS/FS/pkg_referral.pm126
-rw-r--r--FS/FS/pkg_svc.pm163
-rw-r--r--FS/FS/port.pm154
-rw-r--r--FS/FS/prepay_credit.pm203
-rw-r--r--FS/FS/prospect_main.pm292
-rw-r--r--FS/FS/qual.pm191
-rw-r--r--FS/FS/qual_option.pm128
-rw-r--r--FS/FS/queue.pm526
-rw-r--r--FS/FS/queue_arg.pm120
-rw-r--r--FS/FS/queue_depend.pm121
-rw-r--r--FS/FS/raddb.pm1912
-rw-r--r--FS/FS/radius_usergroup.pm131
-rw-r--r--FS/FS/rate.pm450
-rw-r--r--FS/FS/rate_detail.pm640
-rw-r--r--FS/FS/rate_prefix.pm160
-rw-r--r--FS/FS/rate_region.pm315
-rw-r--r--FS/FS/rate_time.pm168
-rw-r--r--FS/FS/rate_time_interval.pm178
-rw-r--r--FS/FS/reason.pm130
-rw-r--r--FS/FS/reason_type.pm209
-rw-r--r--FS/FS/reg_code.pm223
-rw-r--r--FS/FS/reg_code_pkg.pm139
-rw-r--r--FS/FS/registrar.pm119
-rwxr-xr-xFS/FS/router.pm152
-rw-r--r--FS/FS/session.pm265
-rw-r--r--FS/FS/svc_CGPRule_Mixin.pm61
-rw-r--r--FS/FS/svc_CGP_Mixin.pm160
-rw-r--r--FS/FS/svc_Common.pm1106
-rw-r--r--FS/FS/svc_Domain_Mixin.pm134
-rw-r--r--FS/FS/svc_External_Common.pm199
-rw-r--r--FS/FS/svc_Parent_Mixin.pm103
-rw-r--r--FS/FS/svc_acct.pm3249
-rw-r--r--FS/FS/svc_acct_pop.pm206
-rwxr-xr-xFS/FS/svc_broadband.pm490
-rw-r--r--FS/FS/svc_cert.pm408
-rw-r--r--FS/FS/svc_domain.pm701
-rw-r--r--FS/FS/svc_dsl.pm299
-rw-r--r--FS/FS/svc_external.pm205
-rw-r--r--FS/FS/svc_forward.pm368
-rw-r--r--FS/FS/svc_mailinglist.pm330
-rw-r--r--FS/FS/svc_pbx.pm370
-rw-r--r--FS/FS/svc_phone.pm675
-rw-r--r--FS/FS/svc_www.pm286
-rw-r--r--FS/FS/tax_class.pm392
-rw-r--r--FS/FS/tax_rate.pm2087
-rw-r--r--FS/FS/tax_rate_location.pm317
-rw-r--r--FS/FS/type_pkgs.pm130
-rw-r--r--FS/FS/usage_class.pm470
468 files changed, 0 insertions, 126098 deletions
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm
deleted file mode 100644
index adb4a06..0000000
--- a/FS/FS/AccessRight.pm
+++ /dev/null
@@ -1,401 +0,0 @@
-package FS::AccessRight;
-
-use strict;
-use vars qw(@rights); # %rights);
-use Tie::IxHash;
-
-=head1 NAME
-
-FS::AccessRight - Access control rights.
-
-=head1 SYNOPSIS
-
- use FS::AccessRight;
-
- my @rights = FS::AccessRight->rights;
-
- #my %rights = FS::AccessRight->rights_categorized;
- tie my %rights, 'Tie::IxHash', FS::AccessRight->rights_categorized;
- foreach my $category ( keys %rights ) {
- my @category_rights = @{ $rights{$category} };
- }
-
-=head1 DESCRIPTION
-
-Access control rights - Permission to perform specific actions that can be
-assigned to users and/or groups.
-
-=cut
-
-#@rights = (
-# 'Reports' => [
-# '_desc' => 'Access to high-level reporting',
-# ],
-# 'Configuration' => [
-# '_desc' => 'Access to configuration',
-#
-# 'Settings' => {},
-#
-# 'agent' => [
-# '_desc' => 'Master access to reseller configuration',
-# 'agent_type' => {},
-# 'agent' => {},
-# ],
-#
-# 'export_svc_pkg' => [
-# '_desc' => 'Access to export, service and package configuration',
-# 'part_export' => {},
-# 'part_svc' => {},
-# 'part_pkg' => {},
-# 'pkg_class' => {},
-# ],
-#
-# 'billing' => [
-# '_desc' => 'Access to billing configuration',
-# 'payment_gateway' => {},
-# 'part_bill_event' => {},
-# 'prepay_credit' => {},
-# 'rate' => {},
-# 'cust_main_county' => {},
-# ],
-#
-# 'dialup' => [
-# '_desc' => 'Access to dialup configuraiton',
-# 'svc_acct_pop' => {},
-# ],
-#
-# 'broadband' => [
-# '_desc' => 'Access to broadband configuration',
-# 'router' => {},
-# 'addr_block' => {},
-# ],
-#
-# 'misc' => [
-# 'part_referral' => {},
-# 'part_virtual_field' => {},
-# 'msgcat' => {},
-# 'inventory_class' => {},
-# ],
-#
-# },
-#
-#);
-#
-##turn it into a more hash-like structure, but ordered via IxHash
-
-#well, this is what we have for now. getting better.
-tie my %rights, 'Tie::IxHash',
-
- ###
- # contact rights
- ###
- 'Contact and Prospect rights' => [
- 'New prospect',
- 'View prospect',
- 'Edit prospect',
- 'List prospects',
- 'Edit contact', #!
- #'New contact',
- #'View customer contacts',
- #'List contacts',
- ],
-
- ###
- # basic customer rights
- ###
- 'Customer rights' => [
- 'New customer',
- 'View customer',
- #'View Customer | View tickets',
- 'Edit customer',
- 'Edit customer tags',
- 'Edit referring customer',
- 'View customer history',
- 'Cancel customer',
- 'Complimentary customer', #aka users-allow_comp
- 'Merge customer',
- { rightname=>'Delete customer', desc=>"Enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customer's packages if they cancel service." }, #aka. deletecustomers
- 'Bill customer now', #NEW
- 'Bulk send customer notices', #NEW
- { rightname=>'View customers of all agents', global=>1 },
- ],
-
- ###
- # customer package rights
- ###
- 'Customer package rights' => [
- 'View customer packages', #NEW
- 'Order customer package',
- 'One-time charge',
- 'Change customer package',
- 'Bulk change customer packages',
- 'Edit customer package dates',
- 'Discount customer package', #NEW
- 'Custom discount customer package', #NEW
- 'Customize customer package',
- 'Suspend customer package',
- 'Suspend customer package later',
- 'Unsuspend customer package',
- 'Cancel customer package immediately',
- 'Cancel customer package later',
- 'Delay suspension events',
- 'Add on-the-fly cancel reason', #NEW
- 'Add on-the-fly suspend reason', #NEW
- 'Edit customer package invoice details', #NEW
- 'Edit customer package comments', #NEW
- 'Qualify service', #NEW
- ],
-
- ###
- # customer service rights
- ###
- 'Customer service rights' => [
- 'View customer services', #NEW
- 'Provision customer service',
- 'Recharge customer service', #NEW
- 'Unprovision customer service',
- 'Change customer service', #NEWNEW
- 'Edit usage', #NEW
- 'Edit home dir', #NEW
- 'Edit www config', #NEW
- 'Edit domain catchall', #NEW
- 'Edit domain nameservice', #NEW
- 'Manage domain registration',
-
- { rightname=>'View/link unlinked services', global=>1 }, #not agent-virtualizable without more work
- ],
-
- ###
- # customer invoice/financial info rights
- ###
- 'Customer invoice / financial info rights' => [
- 'View invoices',
- 'Resend invoices', #NEWNEW
- 'Delete invoices', #new, but no need to phase in
- 'View customer tax exemptions', #yow
- 'Add customer tax adjustment', #new, but no need to phase in
- 'View customer batched payments', #NEW
- 'View customer pending payments', #NEW
- 'Edit customer pending payments', #NEW
- 'View customer billing events', #NEW
- ],
-
- ###
- # customer payment rights
- ###
- 'Customer payment rights' => [
- { rightname=>'Post payment', desc=>'Make check or cash payments.' },
- 'Post check payment',
- 'Post cash payment',
- 'Post payment batch',
- 'Apply payment', #NEWNEW
- { rightname=>'Unapply payment', desc=>'Enable "unapplication" of unclosed payments from specific invoices.' }, #aka. unapplypayments
- { rightname=>'Process payment', desc=>'Process credit card or e-check payments' },
- 'Process credit card payment',
- 'Process Echeck payment',
- { rightname=>'Delete payment', desc=>'Enable deletion of unclosed payments. Be very careful! Only delete payments that were data-entry errors, not adjustments.' }, #aka. deletepayments Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted.
- ],
-
- ###
- # customer credit rights
- ###
- 'Customer credit and refund rights' => [
- 'Post credit',
- 'Apply credit', #NEWNEW
- { rightname=>'Unapply credit', desc=>'Enable "unapplication" of unclosed credits.' }, #aka unapplycredits
- { rightname=>'Delete credit', desc=>'Enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments.' }, #aka. deletecredits Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted.
- { rightname=>'Post refund', desc=>'Enable posting of check and cash refunds.' },
- 'Post check refund',
- 'Post cash refund',
-# { rightname=>'Process refund', desc=>'Enable processing of generic credit card/ACH refunds (i.e. not associated with a specific prior payment).' },
- { rightname=>'Refund payment', desc=>'Enable refund of existing customer credit card or e-check payments.' },
- 'Refund credit card payment',
- 'Refund Echeck payment',
- 'Delete refund', #NEW
- 'Add on-the-fly credit reason', #NEW
- ],
-
- ###
- # customer voiding rights..
- ###
- 'Customer void rights' => [
- { rightname=>'Credit card void', desc=>'Enable local-only voiding of echeck payments in addition to refunds against the payment gateway.' }, #aka. cc-void
- { rightname=>'Echeck void', desc=>'Enable local-only voiding of echeck payments in addition to refunds against the payment gateway.' }, #aka. echeck-void
- 'Regular void',
- { rightname=>'Unvoid', desc=>'Enable unvoiding of voided payments' }, #aka. unvoid
-
-
- ],
-
- ###
- # note/attachment rights...
- ###
- 'Customer note and attachment rights' => [
- 'Add customer note', #NEW
- 'Edit customer note', #NEW
- 'View attachments', #NEW
- 'Browse attachments', #NEW
- 'Download attachment', #NEW
- 'Add attachment', #NEW
- 'Edit attachment', #NEW
- 'Delete attachment', #NEW
- 'View deleted attachments', #NEW
- 'Undelete attachment', #NEW
- 'Purge attachment', #NEW
- ],
-
- ###
- # report/listing rights...
- ###
- 'Reporting/listing rights' => [
- 'List customers',
- 'List zip codes', #NEW
- 'List invoices',
- 'List packages',
- 'List services',
- 'List service passwords',
-
- { rightname=> 'List rating data', desc=>'Usage reports', global=>1 },
- 'Billing event reports',
- 'Receivables report',
- 'Financial reports',
-
- #{ rightname => 'List customers of all agents', global=>1 },
- ],
-
- ###
- # misc rights
- ###
- 'Miscellaneous rights' => [
- { rightname=>'Job queue', global=>1 },
- { rightname=>'Time queue', global=>1 },
- { rightname=>'Process batches', global=>1 },
- { rightname=>'Reprocess batches', global=>1 },
- { rightname=>'Redownload resolved batches', global=>1 },
- { rightname=>'Import', global=>1 }, #some of these are ag-virt'ed now? give em their own ACLs
- { rightname=>'Export', global=>1 },
- { rightname=> 'Edit rating data', desc=>'Delete CDRs', global=>1 },
- #],
- #
- ###
- # misc misc rights
- ###
- #'Database access rights' => [
- { rightname=>'Raw SQL', global=>1 }, #NEW
- ],
-
- ###
- # setup/config rights
- ###
- 'Configuration rights' => [
- 'Edit advertising sources',
- { rightname=>'Edit global advertising sources', global=>1 },
-
- 'Edit package definitions',
- { rightname=>'Edit global package definitions', global=>1 },
-
- 'Edit billing events',
- { rightname=>'Edit global billing events', global=>1 },
-
- 'Edit templates',
- { rightname=>'Edit global templates', global=>1 },
-
- 'Edit inventory',
- { rightname=>'Edit global inventory', global=>1 },
-
- { rightname=>'Dialup configuration' },
- { rightname=>'Dialup global configuration', global=>1 },
-
- { rightname=>'Broadband configuration' },
- { rightname=>'Broadband global configuration', global=>1 },
-
- #{ rightname=>'Edit employees', global=>1, },
- #{ rightname=>'Edit employee groupss', global=>1, },
-
- { rightname=>'Configuration', global=>1 }, #most of the rest of the configuraiton is not agent-virtualized
-
- { rightname=>'Configuration download', }, #description of how it affects
- #search/elements/search.html
-
- ],
-
-;
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item rights
-
-Returns the full list of right names.
-
-=cut
-
-sub rights {
- #my $class = shift;
- map { ref($_) ? $_->{'rightname'} : $_ } map @{ $rights{$_} }, keys %rights;
-}
-
-=item default_superuser_rights
-
-Most (but not all) right names.
-
-=cut
-
-sub default_superuser_rights {
- my $class = shift;
- my %omit = map { $_=>1 } (
- 'Delete customer',
- 'Delete invoices',
- 'Delete payment',
- 'Delete credit', #?
- 'Delete refund', #?
- 'Time queue',
- 'Redownload resolved batches',
- 'Raw SQL',
- 'Configuration download',
- 'View customers of all agents',
- 'View/link unlinked services',
- 'Edit usage',
- );
-
- no warnings 'uninitialized';
- grep { ! $omit{$_} } $class->rights;
-}
-
-=item rights_info
-
-Returns a list of key-value pairs suitable for assigning to a hash. Keys are
-category names and values are list references of rights. Each element of the
-list reference scalar right name or a hashref with the following keys:
-
-=over 4
-
-=item rightname - Right name
-
-=item desc - Extended right description
-
-=item global - Global flag, indicates that this access right provides access to global data which is shared among all agents.
-
-=back
-
-=cut
-
-sub rights_info {
- %rights;
-}
-
-=back
-
-=head1 BUGS
-
-Damn those infernal six-legged creatures!
-
-=head1 SEE ALSO
-
-L<FS::access_right>, L<FS::access_group>, L<FS::access_user>
-
-=cut
-
-1;
-
diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm
deleted file mode 100644
index 9454784..0000000
--- a/FS/FS/CGI.pm
+++ /dev/null
@@ -1,333 +0,0 @@
-package FS::CGI;
-
-use strict;
-use vars qw(@EXPORT_OK @ISA);
-use Exporter;
-use CGI;
-use URI::URL;
-#use CGI::Carp qw(fatalsToBrowser);
-use FS::UID;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw( header menubar idiot eidiot popurl rooturl table itable ntable
- myexit http_header);
-
-=head1 NAME
-
-FS::CGI - Subroutines for the web interface
-
-=head1 SYNOPSIS
-
- use FS::CGI qw(header menubar idiot eidiot popurl);
-
- print header( 'Title', '' );
- print header( 'Title', menubar('item', 'URL', ... ) );
-
- idiot "error message";
- eidiot "error message";
-
- $url = popurl; #returns current url
- $url = popurl(3); #three levels up
-
-=head1 DESCRIPTION
-
-Provides a few common subroutines for the web interface.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item header TITLE, MENUBAR
-
-Returns an HTML header.
-
-=cut
-
-sub header {
- use Carp;
- carp 'FS::CGI::header deprecated; include /elements/header.html instead';
-
- my($title,$menubar,$etc)=@_; #$etc is for things like onLoad= etc.
- $etc = '' unless defined $etc;
-
- my $x = <<END;
- <HTML>
- <HEAD>
- <TITLE>
- $title
- </TITLE>
- <META HTTP-Equiv="Cache-Control" Content="no-cache">
- <META HTTP-Equiv="Pragma" Content="no-cache">
- <META HTTP-Equiv="Expires" Content="0">
- </HEAD>
- <BODY BGCOLOR="#e8e8e8"$etc>
- <FONT SIZE=6>
- <CENTER>$title</CENTER>
- </FONT>
- <BR><!--<BR>-->
-END
- $x .= $menubar. "<BR><BR>" if $menubar;
- $x;
-}
-
-=item http_header
-
-Sets an http header.
-
-=cut
-
-sub http_header {
- my ( $header, $value ) = @_;
- if (exists $ENV{MOD_PERL}) {
- if ( defined $HTML::Mason::Commands::r ) { #Mason
- ## is this the correct pacakge for $r ??? for 1.0x and 1.1x ?
- if ( $header =~ /^Content-Type$/ ) {
- $HTML::Mason::Commands::r->content_type($value);
- } else {
- $HTML::Mason::Commands::r->header_out( $header => $value );
- }
- } else {
- die "http_header called in unknown environment";
- }
- } else {
- die "http_header called not running under mod_perl";
- }
-
-}
-
-=item menubar ITEM, URL, ...
-
-Returns an HTML menubar.
-
-=cut
-
-sub menubar { #$menubar=menubar('Main Menu', '../', 'Item', 'url', ... );
- use Carp;
- carp 'FS::CGI::menubar deprecated; include /elements/menubar.html instead';
-
- my($item,$url,@html);
- while (@_) {
- ($item,$url)=splice(@_,0,2);
- next if $item =~ /^\s*Main\s+Menu\s*$/i;
- push @html, qq!<A HREF="$url">$item</A>!;
- }
- join(' | ',@html);
-}
-
-=item idiot ERROR
-
-This is depriciated. Don't use it.
-
-Sends an HTML error message.
-
-=cut
-
-sub idiot {
- #warn "idiot depriciated";
- my($error)=@_;
-# my $cgi = &FS::UID::cgi();
-# if ( $cgi->isa('CGI::Base') ) {
-# no strict 'subs';
-# &CGI::Base::SendHeaders;
-# } else {
-# print $cgi->header( @FS::CGI::header );
-# }
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error processing your request</TITLE>
- <META HTTP-Equiv="Cache-Control" Content="no-cache">
- <META HTTP-Equiv="Pragma" Content="no-cache">
- <META HTTP-Equiv="Expires" Content="0">
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error processing your request</H4>
- </CENTER>
- Your request could not be processed because of the following error:
- <P><B>$error</B>
- </BODY>
-</HTML>
-END
-
-}
-
-=item eidiot ERROR
-
-This is depriciated. Don't use it.
-
-Sends an HTML error message, then exits.
-
-=cut
-
-sub eidiot {
- warn "eidiot depriciated";
- $HTML::Mason::Commands::r->send_http_header
- if defined $HTML::Mason::Commands::r;
- idiot(@_);
- &myexit();
-}
-
-=item myexit
-
-You probably shouldn't use this; but if you must:
-
-If running under mod_perl, calles Apache::exit, otherwise, calls exit.
-
-=cut
-
-sub myexit {
- if (exists $ENV{MOD_PERL}) {
-
- if ( defined $HTML::Mason::Commands::m ) { #Mason
- #$HTML::Mason::Commands::m->flush_buffer();
- $HTML::Mason::Commands::m->abort();
- die "shouldn't fall through to here (mason \$m->abort didn't)";
- } else {
- #??? well, it is $ENV{MOD_PERL}
- warn "running under unknown mod_perl environment; trying Apache::exit()";
- require Apache;
- Apache::exit();
- }
- } else {
- exit;
- }
-}
-
-=item popurl LEVEL [URL]
-
-Returns current (or, optionally, passed) URL with LEVEL levels of path removed
-from the end (default 0).
-
-=cut
-
-sub popurl {
- my $up = shift;
-
- my $url_string;
- if ( scalar(@_) ) {
- $url_string = shift;
- } else {
- my $cgi = &FS::UID::cgi;
- $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url;
- }
-
- $url_string =~ s/\?.*//;
- my $url = new URI::URL ( $url_string );
- my(@path)=$url->path_components;
- splice @path, 0-$up;
- $url->path_components(@path);
- my $x = $url->as_string;
- $x .= '/' unless $x =~ /\/$/;
- $x;
-}
-
-=item rooturl
-
-=cut
-
-sub rooturl {
- my $url_string;
- if ( scalar(@_) ) {
- $url_string = shift;
- } else {
- # better to start with the client-provided URL
- my $cgi = &FS::UID::cgi;
- $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url;
- }
-
- $url_string =~ s/\?.*//;
-
- #even though this is kludgy
- $url_string =~ s{ / index\.html /? $ }
- {/}x;
- $url_string =~
- s{
- /
- (browse|config|docs|edit|graph|misc|search|view|pref|rt|elements)
- /
- (process/)?
- ([\w\-\.\/]*)
- $
- }
- {}x;
-
- #elements because of progress-popup.html...
- #XXX remove anything from elements that is called directly & prevent
- #those pages from being served up
-
- $url_string .= '/' unless $url_string =~ /\/$/;
-
- $url_string;
-
-}
-
-=item table
-
-Returns HTML tag for beginning a table.
-
-=cut
-
-sub table {
- use Carp;
- carp 'FS::CGI::table deprecated; include /elements/table.html instead';
-
- my $col = shift;
- if ( $col ) {
- qq!<TABLE BGCOLOR="$col" BORDER=1 WIDTH="100%" CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">!;
- } else {
- '<TABLE BORDER=1 CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">';
- }
-}
-
-=item itable
-
-Returns HTML tag for beginning an (invisible) table.
-
-=cut
-
-sub itable {
- my $col = shift;
- my $cellspacing = shift || 0;
- my $width = ( scalar(@_) && shift ) ? '' : 'WIDTH="100%"'; #bah
- if ( $col ) {
- qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing $width>!;
- } else {
- qq!<TABLE BORDER=0 CELLSPACING=$cellspacing $width>!;
- }
-}
-
-=item ntable
-
-This is getting silly.
-
-=cut
-
-sub ntable {
- my $col = shift;
- my $cellspacing = shift || 0;
- if ( $col ) {
- qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing>!;
- } else {
- '<TABLE BORDER CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">';
- }
-
-}
-
-=back
-
-=head1 BUGS
-
-Not OO.
-
-Not complete.
-
-=head1 SEE ALSO
-
-L<CGI>, L<CGI::Base>
-
-=cut
-
-1;
-
-
diff --git a/FS/FS/ClientAPI.pm b/FS/FS/ClientAPI.pm
deleted file mode 100644
index 1677fcc..0000000
--- a/FS/FS/ClientAPI.pm
+++ /dev/null
@@ -1,42 +0,0 @@
-package FS::ClientAPI;
-
-use strict;
-use base 'Exporter';
-use vars qw( @EXPORT_OK %handler $domain $DEBUG );
-
-@EXPORT_OK = qw( load_clientapi_modules );
-
-$DEBUG = 0;
-
-%handler = ();
-
-sub load_clientapi_modules {
-
- #find modules
- foreach my $INC ( @INC ) {
- my $glob = "$INC/FS/ClientAPI/*.pm";
- warn "FS::ClientAPI: searching $glob" if $DEBUG;
- foreach my $file ( glob($glob) ) {
- $file =~ /\/(\w+)\.pm$/ or do {
- warn "unrecognized ClientAPI file: $file";
- next
- };
- my $mod = $1;
- warn "using FS::ClientAPI::$mod" if $DEBUG;
- eval "use FS::ClientAPI::$mod;";
- die "error using FS::ClientAPI::$mod: $@" if $@;
- }
- }
-
-}
-
-sub dispatch {
- my ( $self, $name ) = ( shift, shift );
- $name =~ s(/)(::)g;
- my $sub = "FS::ClientAPI::$name";
- no strict 'refs';
- &{$sub}(@_);
-}
-
-1;
-
diff --git a/FS/FS/ClientAPI/Agent.pm b/FS/FS/ClientAPI/Agent.pm
deleted file mode 100644
index 923920d..0000000
--- a/FS/FS/ClientAPI/Agent.pm
+++ /dev/null
@@ -1,214 +0,0 @@
-package FS::ClientAPI::Agent;
-
-#some false laziness w/MyAccount
-
-use strict;
-use vars qw($cache);
-use subs qw(_cache);
-use Digest::MD5 qw(md5_hex);
-use FS::Record qw(qsearchs); # qsearch dbdef dbh);
-use FS::ClientAPI_SessionCache;
-use FS::agent;
-use FS::cust_main::Search qw(smart_search);
-use FS::svc_domain;
-use FS::svc_acct;
-
-sub _cache {
- $cache ||= new FS::ClientAPI_SessionCache( {
- 'namespace' => 'FS::ClientAPI::Agent',
- } );
-}
-
-sub new_agent {
- my $p = shift;
-
- my $conf = new FS::Conf;
- return { error=>'Disabled' } unless $conf->exists('selfservice-agent_signup');
-
- #add a customer record and set agent_custnum?
-
- my $agent = new FS::agent {
- 'typenum' => $conf->config('selfservice-agent_signup-agent_type'),
- 'agent' => $p->{'agent'},
- 'username' => $p->{'username'},
- '_password' => $p->{'password'},
- #
- };
-
- my $error = $agent->insert;
-
- return { 'error' => $error } if $error;
-
- agent_login({ 'username' => $p->{'username'},
- 'password' => $p->{'password'},
- });
-}
-
-sub agent_login {
- my $p = shift;
-
- #don't allow a blank login to first unconfigured agent with no user/pass
- return { error => 'Must specify your reseller username and password.' }
- unless length($p->{'username'}) && length($p->{'password'});
-
- my $agent = qsearchs( 'agent', {
- 'username' => $p->{'username'},
- '_password' => $p->{'password'},
- } );
-
- unless ( $agent ) { return { error => 'Incorrect password.' } }
-
- my $session = {
- 'agentnum' => $agent->agentnum,
- 'agent' => $agent->agent,
- };
-
- my $session_id;
- do {
- $session_id = md5_hex(md5_hex(time(). {}. rand(). $$))
- } until ( ! defined _cache->get($session_id) ); #just in case
-
- _cache->set( $session_id, $session, '1 hour' );
-
- { 'error' => '',
- 'session_id' => $session_id,
- };
-}
-
-sub agent_logout {
- my $p = shift;
- if ( $p->{'session_id'} ) {
- _cache->remove($p->{'session_id'});
- return { 'error' => '' };
- } else {
- return { 'error' => "Can't resume session" }; #better error message
- }
-}
-
-sub agent_info {
- my $p = shift;
-
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- #my %return;
-
- my $agentnum = $session->{'agentnum'};
-
- my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } )
- or return { 'error' => "unknown agentnum $agentnum" };
-
- { 'error' => '',
- 'agentnum' => $agentnum,
- 'agent' => $agent->agent,
- 'num_prospect' => $agent->num_prospect_cust_main,
- 'num_active' => $agent->num_active_cust_main,
- 'num_susp' => $agent->num_susp_cust_main,
- 'num_cancel' => $agent->num_cancel_cust_main,
- #%return,
- };
-
-}
-
-sub agent_list_customers {
- my $p = shift;
-
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- #my %return;
-
- my $agentnum = $session->{'agentnum'};
-
- my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } )
- or return { 'error' => "unknown agentnum $agentnum" };
-
- my @cust_main = smart_search( 'search' => $p->{'search'},
- 'agentnum' => $agentnum,
- );
-
- #aggregate searches
- push @cust_main,
- map $agent->$_(), map $_.'_cust_main',
- grep $p->{$_}, qw( prospect active susp cancel );
-
- #eliminate dups?
- my %saw = ();
- @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
-
- { customers => [ map {
- my $cust_main = $_;
- my $hashref = $cust_main->hashref;
- $hashref->{$_} = $cust_main->$_()
- foreach qw(name status statuscolor);
- delete $hashref->{$_} foreach qw( payinfo paycvv );
- $hashref;
- } @cust_main
- ],
- }
-
-}
-
-sub check_username {
- my $p = shift;
- my($session, $agentnum, $svc_acct) = _session_agentnum_svc_acct($p);
- return { 'error' => $session } unless ref($session);
-
- { 'error' => '',
- #'username' => $username,
- #'domain' => $domain,
- 'available' => $svc_acct ? 0 : 1,
- };
-
-}
-
-sub _session_agentnum_svc_acct {
- my $p = shift;
-
- my $session = _cache->get($p->{'session_id'})
- or return "Can't resume session"; #better error message
-
- my $username = $p->{'username'};
-
- #XXX some way to default this per agent (by default product's service def?)
- my $domain = $p->{'domain'};
-
- my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
- or return { 'error' => 'Unknown domain' };
-
- my $svc_acct = qsearchs('svc_acct', { 'username' => $username,
- 'domsvc' => $svc_domain->svcnum, } );
-
- ( $session, $session->{'agentnum'}, $svc_acct );
-
-}
-
-sub _session_agentnum_cust_pkg {
- my $p = shift;
- my($session, $agentnum, $svc_acct) = _session_agentnum_svc_acct($p);
- return $session unless ref($session);
- return 'Account not found' unless $svc_acct;
- my $cust_svc = $svc_acct->cust_svc;
- return 'Unlinked account' unless $cust_svc->pkgnum;
- my $cust_pkg = $cust_svc->cust_pkg;
- return 'Not your account' unless $cust_pkg->cust_main->agentnum == $agentnum;
- ($session, $agentnum, $cust_pkg);
-}
-
-sub suspend_username {
- my $p = shift;
- my($session, $agentnum, $cust_pkg) = _session_agentnum_cust_pkg($p);
- return { 'error' => $session } unless ref($session);
-
- return { 'error' => $cust_pkg->suspend };
-}
-
-sub unsuspend_username {
- my $p = shift;
- my($session, $agentnum, $cust_pkg) = _session_agentnum_cust_pkg($p);
- return { 'error' => $session } unless ref($session);
-
- return { 'error' => $cust_pkg->unsuspend };
-}
-
-1;
diff --git a/FS/FS/ClientAPI/Bulk.pm b/FS/FS/ClientAPI/Bulk.pm
deleted file mode 100644
index ec617df..0000000
--- a/FS/FS/ClientAPI/Bulk.pm
+++ /dev/null
@@ -1,384 +0,0 @@
-package FS::ClientAPI::Bulk;
-
-use strict;
-
-use vars qw( $DEBUG $cache );
-use Date::Parse;
-use FS::Record qw( qsearchs );
-use FS::Conf;
-use FS::ClientAPI_SessionCache;
-use FS::cust_main;
-use FS::cust_pkg;
-use FS::cust_svc;
-use FS::svc_acct;
-use FS::svc_external;
-use FS::cust_recon;
-use Data::Dumper;
-
-$DEBUG = 1;
-
-sub _cache {
- $cache ||= new FS::ClientAPI_SessionCache ( {
- 'namespace' => 'FS::ClientAPI::Agent', #yes, share session_ids
- } );
-}
-
-sub _izoom_ftp_row_fixup {
- my $hash = shift;
-
- my @addr_fields = qw( address1 address2 city state zip );
- my @fields = ( qw( agent_custid username _password first last ),
- @addr_fields,
- map { "ship_$_" } @addr_fields );
-
- $hash->{$_} =~ s/[&\/\*'"]/_/g foreach @fields;
-
- #$hash->{action} = '' if $hash->{action} eq 'R'; #unsupported for ftp
-
- $hash->{refnum} = 1; #ahem
- $hash->{country} = 'US';
- $hash->{ship_country} = 'US';
- $hash->{payby} = 'LECB';
- $hash->{payinfo} = $hash->{daytime};
- $hash->{ship_fax} = '' if ( !$hash->{sms} || $hash->{sms} eq 'F' );
-
- my $has_ship =
- grep { $hash->{"ship_$_"} &&
- (! $hash->{$_} || $hash->{"ship_$_"} ne $hash->{$_} )
- }
- ( @addr_fields, 'fax' );
-
- if ( $has_ship ) {
- foreach ( @addr_fields, qw( first last ) ) {
- $hash->{"ship_$_"} = $hash->{$_} unless $hash->{"ship_$_"};
- }
- }
-
- delete $hash->{sms};
-
- '';
-
-};
-
-sub _izoom_ftp_result {
- my ($hash, $error) = @_;
- my $cust_main =
- qsearchs( 'cust_main', { 'agent_custid' => $hash->{agent_custid},
- 'agentnum' => $hash->{agentnum}
- }
- );
-
- my $custnum = $cust_main ? $cust_main->custnum : '';
- my @response = ( $hash->{action}, $hash->{agent_custid}, $custnum );
-
- if ( $error ) {
- push @response, ( 'ERROR', $error );
- } else {
- push @response, ( 'OK', 'OK' );
- }
-
- join( ',', @response );
-
-}
-
-sub _izoom_ftp_badaction {
- "Invalid action: $_[0] record: @_ ";
-}
-
-sub _izoom_soap_row_fixup { _izoom_ftp_row_fixup(@_) };
-
-sub _izoom_soap_result {
- my ($hash, $error) = @_;
-
- if ( $hash->{action} eq 'R' ) {
- if ( $error ) {
- return "Please check errors:\n $error"; # odd extra space
- } else {
- return join(' ', "Everything ok.", $hash->{pkg}, $hash->{adjourn} );
- }
- }
-
- my $pkg = $hash->{pkg} || $hash->{saved_pkg} || '';
- if ( $error ) {
- return join(' ', $hash->{agent_custid}, $error );
- } else {
- return join(' ', $hash->{agent_custid}, $pkg, $hash->{adjourn} );
- }
-
-}
-
-sub _izoom_soap_badaction {
- "Unknown action '$_[13]' ";
-}
-
-my %format = (
- 'izoom-ftp' => {
- 'fields' => [ qw ( action agent_custid username _password
- daytime ship_fax sms first last
- address1 address2 city state zip
- pkg adjourn ship_address1 ship_address2
- ship_city ship_state ship_zip ) ],
- 'fixup' => sub { _izoom_ftp_row_fixup(@_) },
- 'result' => sub { _izoom_ftp_result(@_) },
- 'action' => sub { _izoom_ftp_badaction(@_) },
- },
- 'izoom-soap' => {
- 'fields' => [ qw ( agent_custid username _password
- daytime first last address1 address2
- city state zip pkg action adjourn
- ship_fax sms ship_address1 ship_address2
- ship_city ship_state ship_zip ) ],
- 'fixup' => sub { _izoom_soap_row_fixup(@_) },
- 'result' => sub { _izoom_soap_result(@_) },
- 'action' => sub { _izoom_soap_badaction(@_) },
- },
-);
-
-sub processrow {
- my $p = shift;
-
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $conf = new FS::Conf;
- my $format = $conf->config('selfservice-bulk_format', $session->{agentnum})
- || 'izoom-soap';
- my ( @row ) = @{ $p->{row} };
-
- warn "processrow called with '". join("' '", @row). "'\n" if $DEBUG;
-
- return { 'error' => "unknown format: $format" }
- unless exists $format{$format};
-
- return { 'error' => "Invalid record record length: ". scalar(@row).
- "record: @row " #sic
- }
- unless scalar(@row) == scalar(@{$format{$format}{fields}});
-
- my %hash = ( 'agentnum' => $session->{agentnum} );
- my $error;
-
- foreach my $field ( @{ $format{ $format }{ fields } } ) {
- $hash{$field} = shift @row;
- }
-
- $error ||= &{ $format{ $format }{ fixup } }( \%hash );
-
- # put in the fixup routine?
- if ( 'R' eq $hash{action} ) {
- warn "processing reconciliation\n" if $DEBUG;
- $error ||= process_recon($hash{agentnum}, $hash{agent_custid});
- } elsif ( 'P' eq $hash{action} ) {
- # do nothing
- } elsif( 'D' eq $hash{action} ) {
- $hash{promo_pkg} = 'disk-1-'. $session->{agent};
- } elsif ( 'S' eq $hash{action} ) {
- $hash{promo_pkg} = 'disk-2-'. $session->{agent};
- $hash{saved_pkg} = $hash{pkg};
- $hash{pkg} = '';
- } else {
- $error ||= &{ $format{ $format }{ action } }( @row );
- }
-
- warn "processing provision\n" if ($DEBUG && !$error && $hash{action} ne 'R');
- $error ||= provision( %hash ) unless $hash{action} eq 'R';
-
- my $result = &{ $format{ $format }{ result } }( \%hash, $error );
-
- warn "processrow returning '". join("' '", $result, $error). "'\n"
- if $DEBUG;
-
- return { 'error' => $error, 'message' => $result };
-
-}
-
-sub provision {
- my %args = ( @_ );
-
- delete $args{action};
-
- my $cust_main =
- qsearchs( 'cust_main',
- { map { $_ => $args{$_} } qw ( agent_custid agentnum ) },
- );
-
- unless ( $cust_main ) {
- $cust_main = new FS::cust_main { %args };
- my $error = $cust_main->insert;
- return $error if $error;
- }
-
- my @pkgs = grep { $_->part_pkg->freq } $cust_main->ncancelled_pkgs;
- if ( scalar(@pkgs) > 1 ) {
- return "Invalid account, should not be more then one active package ". #sic
- "but found: ". scalar(@pkgs). " packages.";
- }
-
- my $part_pkg = qsearchs( 'part_pkg', { 'pkg' => $args{pkg} } )
- or return "Unknown pkgpart: $args{pkg}"
- if $args{pkg};
-
-
- my $create_package = $args{pkg};
- if ( scalar(@pkgs) && $create_package ) {
- my $pkg = pop(@pkgs);
-
- if ( $part_pkg->pkgpart != $pkg->pkgpart ) {
- my @cust_bill_pkg = $pkg->cust_bill_pkg();
- if ( 1 == scalar(@cust_bill_pkg) ) {
- my $cbp= pop(@cust_bill_pkg);
- my $cust_bill = $cbp->cust_bill;
- $cust_bill->delete(); #really? wouldn't a credit be better?
- }
- $pkg->cancel();
- } else {
- $create_package = '';
- $pkg->setfield('adjourn', str2time($args{adjourn}));
- my $error = $pkg->replace();
- return $error if $error;
- }
- }
-
- if ( $create_package ) {
- my $cust_pkg = new FS::cust_pkg ( {
- 'pkgpart' => $part_pkg->pkgpart,
- 'adjourn' => str2time( $args{adjourn} ),
- } );
-
- my $svcpart = $part_pkg->svcpart('svc_acct');
-
- my $svc_acct = new FS::svc_acct ( {
- 'svcpart' => $svcpart,
- 'username' => $args{username},
- '_password' => $args{_password},
- } );
-
- my $error = $cust_main->order_pkg( cust_pkg => $cust_pkg,
- svcs => [ $svc_acct ],
- );
- return $error if $error;
- }
-
- if ( $args{promo_pkg} ) {
- my $part_pkg =
- qsearchs( 'part_pkg', { 'promo_code' => $args{promo_pkg} } )
- or return "unknown pkgpart: $args{promo_pkg}";
-
- my $svcpart = $part_pkg->svcpart('svc_external')
- or return "unknown svcpart: svc_external";
-
- my $cust_pkg = new FS::cust_pkg ( {
- 'svcpart' => $svcpart,
- 'pkgpart' => $part_pkg->pkgpart,
- } );
-
- my $svc_ext = new FS::svc_external ( { 'svcpart' => $svcpart } );
-
- my $ticket_subject = 'Send setup disk to customer '. $cust_main->custnum;
- my $error = $cust_main->order_pkg ( cust_pkg => $cust_pkg,
- svcs => [ $svc_ext ],
- noexport => 1,
- ticket_subject => $ticket_subject,
- ticket_queue => "disk-$args{agentnum}",
- );
- return $error if $error;
- }
-
- my $error = $cust_main->bill();
- return $error if $error;
-}
-
-sub process_recon {
- my ( $agentnum, $id ) = @_;
- my @recs = split /;/, $id;
- my $err = '';
- foreach my $rec ( @recs ) {
- my @record = split /,/, $rec;
- my $result = process_recon_record(@record, $agentnum);
- $err .= "$result\n" if $result;
- }
- return $err;
-}
-
-sub process_recon_record {
- my ( $agent_custid, $username, $_password, $daytime, $first, $last, $address1, $address2, $city, $state, $zip, $pkg, $adjourn, $agentnum) = @_;
-
- warn "process_recon_record called with '". join("','", @_). "'\n" if $DEBUG;
-
- my ($cust_pkg, $package);
-
- my $cust_main =
- qsearchs( 'cust_main',
- { 'agent_custid' => $agent_custid, 'agentnum' => $agentnum },
- );
-
- my $comments = '';
- if ( $cust_main ) {
- my @cust_pkg = grep { $_->part_pkg->freq } $cust_main->ncancelled_pkgs;
- if ( scalar(@cust_pkg) == 1) {
- $cust_pkg = pop(@cust_pkg);
- $package = $cust_pkg->part_pkg->pkg;
- $comments = "$agent_custid wrong package, expected: $pkg found: $package"
- if ( $pkg ne $package );
- } else {
- $comments = "invalid account, should be one active package but found: ".
- scalar(@cust_pkg). " packages.";
- }
- } else {
- $comments =
- "Customer not found agent_custid=$agent_custid, agentnum=$agentnum";
- }
-
- my $cust_recon = new FS::cust_recon( {
- 'recondate' => time,
- 'agentnum' => $agentnum,
- 'first' => $first,
- 'last' => $last,
- 'address1' => $address1,
- 'address2' => $address2,
- 'city' => $city,
- 'state' => $state,
- 'zip' => $zip,
- 'custnum' => $cust_main ? $cust_main->custnum : '', #really?
- 'status' => $cust_main ? $cust_main->status : '',
- 'pkg' => $package,
- 'adjourn' => $cust_pkg ? $cust_pkg->adjourn : '',
- 'agent_custid' => $agent_custid, # redundant?
- 'agent_pkg' => $pkg,
- 'agent_adjourn' => str2time($adjourn),
- 'comments' => $comments,
- } );
-
- warn Dumper($cust_recon) if $DEBUG;
- my $error = $cust_recon->insert;
- return $error if $error;
-
- warn "process_recon_record returning $comments\n" if $DEBUG;
-
- $comments;
-
-}
-
-sub check_username {
- my $p = shift;
-
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $svc_domain = qsearchs( 'svc_domain', { 'domain' => $p->{domain} } )
- or return { 'error' => 'Unknown domain '. $p->{domain} };
-
- my $svc_acct = qsearchs( 'svc_acct', { 'username' => $p->{user},
- 'domsvc' => $svc_domain->svcnum,
- },
- );
-
- return { 'error' => $p->{user}. '@'. $p->{domain}. " alerady in use" } # sic
- if $svc_acct;
-
- return { 'error' => '',
- 'message' => $p->{user}. '@'. $p->{domain}. " is free"
- };
-}
-
-1;
diff --git a/FS/FS/ClientAPI/MasonComponent.pm b/FS/FS/ClientAPI/MasonComponent.pm
deleted file mode 100644
index 20b4e5b..0000000
--- a/FS/FS/ClientAPI/MasonComponent.pm
+++ /dev/null
@@ -1,131 +0,0 @@
-package FS::ClientAPI::MasonComponent;
-
-use strict;
-use vars qw( $cache $DEBUG $me );
-use subs qw( _cache );
-use FS::Mason qw( mason_interps );
-use FS::Conf;
-use FS::ClientAPI_SessionCache;
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_main;
-use FS::part_pkg;
-
-$DEBUG = 0;
-$me = '[FS::ClientAPI::MasonComponent]';
-
-my %allowed_comps = map { $_=>1 } qw(
- /elements/select-did.html
- /misc/areacodes.cgi
- /misc/exchanges.cgi
- /misc/phonenums.cgi
- /misc/states.cgi
- /misc/counties.cgi
- /misc/svc_acct-domains.cgi
- /misc/part_svc-columns.cgi
-);
-
-my %session_comps = map { $_=>1 } qw(
- /elements/location.html
- /edit/cust_main/first_pkg/select-part_pkg.html
-);
-
-my %session_callbacks = (
-
- '/elements/location.html' => sub {
- my( $custnum, $argsref ) = @_;
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return "unknown custnum $custnum";
- my %args = @$argsref;
- $args{object} = $cust_main;
- @$argsref = ( %args );
- return ''; #no error
- },
-
- '/edit/cust_main/first_pkg/select-part_pkg.html' => sub {
- my( $custnum, $argsref ) = @_;
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return "unknown custnum $custnum";
-
- my $pkgpart = $cust_main->agent->pkgpart_hashref;
-
- #false laziness w/ edit/cust_main/first_pkg.html
- my @first_svc = ( 'svc_acct', 'svc_phone' );
-
- my @part_pkg =
- grep { $_->svcpart(\@first_svc)
- && ( $pkgpart->{ $_->pkgpart }
- || ( $_->agentnum && $_->agentnum == $cust_main->agentnum )
- )
- }
- qsearch( 'part_pkg', { 'disabled' => '' }, '', 'ORDER BY pkg' ); # case?
-
- my $conf = new FS::Conf;
- if ( $conf->exists('pkg-addon_classnum') ) {
-
- my %classnum = map { ( $_->addon_classnum => 1 ) }
- grep { $_->freq !~ /^0/ }
- map { $_->part_pkg }
- $cust_main->ncancelled_pkgs;
-
- unless ( $classnum{''} || ! keys %classnum ) {
- @part_pkg = grep $classnum{ $_->classnum }, @part_pkg;
- }
- }
-
- my %args = @$argsref;
- $args{part_pkg} = \@part_pkg;
- @$argsref = ( %args );
- return ''; #no error
-
- },
-
-);
-
-my $outbuf;
-my( $fs_interp, $rt_interp ) = mason_interps('standalone', 'outbuf'=>\$outbuf);
-
-sub mason_comp {
- my $packet = shift;
-
- warn "$me mason_comp called on $packet\n" if $DEBUG;
-
- my $comp = $packet->{'comp'};
- unless ( $allowed_comps{$comp} || $session_comps{$comp} ) {
- return { 'error' => 'Illegal component' };
- }
-
- my @args = $packet->{'args'} ? @{ $packet->{'args'} } : ();
-
- if ( $session_comps{$comp} ) {
-
- my $session = _cache->get($packet->{'session_id'})
- or return ( 'error' => "Can't resume session" ); #better error message
- my $custnum = $session->{'custnum'};
-
- my $error = &{ $session_callbacks{$comp} }( $custnum, \@args );
- return { 'error' => $error } if $error;
-
- }
-
- my $conf = new FS::Conf;
- $FS::Mason::Request::FSURL = $conf->config('selfservice_server-base_url');
- $FS::Mason::Request::FSURL .= '/' unless $FS::Mason::Request::FSURL =~ /\/$/;
- $FS::Mason::Request::QUERY_STRING = $packet->{'query_string'} || '';
-
- $outbuf = '';
- $fs_interp->exec($comp, @args); #only FS for now alas...
-
- #errors? (turn off in-line error reporting?)
-
- return { 'output' => $outbuf };
-
-}
-
-#hmm
-sub _cache {
- $cache ||= new FS::ClientAPI_SessionCache( {
- 'namespace' => 'FS::ClientAPI::MyAccount',
- } );
-}
-
-1;
diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm
deleted file mode 100644
index d619e84..0000000
--- a/FS/FS/ClientAPI/MyAccount.pm
+++ /dev/null
@@ -1,2039 +0,0 @@
-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 );
-use Data::Dumper;
-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 );
-use FS::Conf;
-#use FS::UID qw(dbh);
-use FS::Record qw(qsearch qsearchs dbh);
-use FS::Msgcat qw(gettext);
-use FS::Misc qw(card_types);
-use FS::Misc::DateTime qw(parse_datetime);
-use FS::ClientAPI_SessionCache;
-use FS::svc_acct;
-use FS::svc_domain;
-use FS::svc_phone;
-use FS::svc_external;
-use FS::part_svc;
-use FS::cust_main;
-use FS::cust_bill;
-use FS::cust_main_county;
-use FS::cust_pkg;
-use FS::payby;
-use FS::acct_rt_transaction;
-use HTML::Entities;
-use FS::TicketSystem;
-use Text::CSV_XS;
-use IO::Scalar;
-use Spreadsheet::WriteExcel;
-
-$DEBUG = 0;
-$me = '[FS::ClientAPI::MyAccount]';
-
-use vars qw( @cust_main_editable_fields );
-@cust_main_editable_fields = qw(
- first last company address1 address2 city
- county state zip country daytime night fax
- ship_first ship_last ship_company ship_address1 ship_address2 ship_city
- ship_state ship_zip ship_country ship_daytime ship_night ship_fax
- payby payinfo payname paystart_month paystart_year payissue payip
- ss paytype paystate stateid stateid_state
-);
-
-sub _cache {
- $cache ||= new FS::ClientAPI_SessionCache( {
- 'namespace' => 'FS::ClientAPI::MyAccount',
- } );
-}
-
-sub skin_info {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- #return { 'error' => $session } if $context eq 'error';
-
- my $agentnum = '';
- if ( $context eq 'customer' ) {
-
- my $sth = dbh->prepare('SELECT agentnum FROM cust_main WHERE custnum = ?')
- or die dbh->errstr;
-
- $sth->execute($custnum) or die $sth->errstr;
-
- $agentnum = $sth->fetchrow_arrayref->[0]
- or die "no agentnum for custnum $custnum";
-
- #} elsif ( $context eq 'agent' ) {
- } elsif ( $p->{'agentnum'} =~ /^(\d+)$/ ) {
- $agentnum = $1;
- }
-
- my $conf = new FS::Conf;
-
- #false laziness w/Signup.pm
-
- my $skin_info_cache_agent = _cache->get("skin_info_cache_agent$agentnum");
-
- if ( $skin_info_cache_agent ) {
-
- warn "$me loading cached skin info for agentnum $agentnum\n"
- if $DEBUG > 1;
-
- } else {
-
- warn "$me populating skin info cache for agentnum $agentnum\n"
- if $DEBUG > 1;
-
- $skin_info_cache_agent = {
- 'agentnum' => $agentnum,
- ( map { $_ => scalar( $conf->config($_, $agentnum) ) }
- qw( company_name ) ),
- ( map { $_ => scalar( $conf->config("selfservice-$_", $agentnum ) ) }
- 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 ) ),
- };
-
- _cache->set("skin_info_cache_agent$agentnum", $skin_info_cache_agent);
-
- }
-
- #{ %$skin_info_cache_agent };
- $skin_info_cache_agent;
-
-}
-
-sub login_info {
- my $p = shift;
-
- my $conf = new FS::Conf;
-
- my %info = (
- %{ skin_info($p) },
- 'phone_login' => $conf->exists('selfservice_server-phone_login'),
- 'single_domain'=> scalar($conf->config('selfservice_server-single_domain')),
- );
-
- return \%info;
-
-}
-
-#false laziness w/FS::ClientAPI::passwd::passwd
-sub login {
- my $p = shift;
-
- my $conf = new FS::Conf;
-
- my $svc_x = '';
- if ( $p->{'domain'} eq 'svc_phone'
- && $conf->exists('selfservice_server-phone_login') ) {
-
- my $svc_phone = qsearchs( 'svc_phone', { 'phonenum' => $p->{'username'} } );
- return { error => 'Number not found.' } unless $svc_phone;
-
- #XXX?
- #my $pkg_svc = $svc_acct->cust_svc->pkg_svc;
- #return { error => 'Only primary user may log in.' }
- # if $conf->exists('selfservice_server-primary_only')
- # && ( ! $pkg_svc || $pkg_svc->primary_svc ne 'Y' );
-
- return { error => 'Incorrect PIN.' }
- unless $svc_phone->check_pin($p->{'password'});
-
- $svc_x = $svc_phone;
-
- } else {
-
- my $svc_domain = qsearchs('svc_domain', { 'domain' => $p->{'domain'} } )
- or return { error => 'Domain '. $p->{'domain'}. ' not found' };
-
- my $svc_acct = qsearchs( 'svc_acct', { 'username' => $p->{'username'},
- 'domsvc' => $svc_domain->svcnum, }
- );
- return { error => 'User not found.' } unless $svc_acct;
-
- if($conf->exists('selfservice_server-login_svcpart')) {
- my @svcpart = $conf->config('selfservice_server-login_svcpart');
- my $svcpart = $svc_acct->cust_svc->svcpart;
- return { error => 'Invalid user.' }
- unless grep($_ eq $svcpart, @svcpart);
- }
-
- return { error => 'Incorrect password.' }
- unless $svc_acct->check_password($p->{'password'});
-
- $svc_x = $svc_acct;
-
- }
-
- my $session = {
- 'svcnum' => $svc_x->svcnum,
- };
-
- my $cust_svc = $svc_x->cust_svc;
- my $cust_pkg = $cust_svc->cust_pkg;
- if ( $cust_pkg ) {
- my $cust_main = $cust_pkg->cust_main;
- $session->{'custnum'} = $cust_main->custnum;
- if ( $conf->exists('pkg-balances') ) {
- my @cust_pkg = grep { $_->part_pkg->freq !~ /^(0|$)/ }
- $cust_main->ncancelled_pkgs;
- $session->{'pkgnum'} = $cust_pkg->pkgnum
- if scalar(@cust_pkg) > 1;
- }
- }
-
- #my $pkg_svc = $svc_acct->cust_svc->pkg_svc;
- #return { error => 'Only primary user may log in.' }
- # if $conf->exists('selfservice_server-primary_only')
- # && ( ! $pkg_svc || $pkg_svc->primary_svc ne 'Y' );
- my $part_pkg = $cust_pkg->part_pkg;
- return { error => 'Only primary user may log in.' }
- if $conf->exists('selfservice_server-primary_only')
- && $cust_svc->svcpart != $part_pkg->svcpart([qw( svc_acct svc_phone )]);
-
- my $session_id;
- do {
- $session_id = md5_hex(md5_hex(time(). {}. rand(). $$))
- } until ( ! defined _cache->get($session_id) ); #just in case
-
- my $timeout = $conf->config('selfservice-session_timeout') || '1 hour';
- _cache->set( $session_id, $session, $timeout );
-
- return { 'error' => '',
- 'session_id' => $session_id,
- };
-}
-
-sub logout {
- my $p = shift;
- if ( $p->{'session_id'} ) {
- _cache->remove($p->{'session_id'});
- return { %{ skin_info($p) }, 'error' => '' };
- } else {
- return { %{ skin_info($p) }, 'error' => "Can't resume session" }; #better error message
- }
-}
-
-sub payment_gateway {
- # internal use only
- # takes a cust_main and a cust_payby entry, returns the payment_gateway
- my $conf = new FS::Conf;
- my $cust_main = shift;
- my $cust_payby = shift;
- my $gatewaynum = $conf->config('selfservice-payment_gateway');
- if ( $gatewaynum ) {
- my $pg = qsearchs('payment_gateway', { gatewaynum => $gatewaynum });
- die "configured gatewaynum $gatewaynum not found!" if !$pg;
- return $pg;
- }
- else {
- return '' if ! FS::payby->realtime($cust_payby);
- my $pg = $cust_main->agent->payment_gateway(
- 'method' => FS::payby->payby2bop($cust_payby),
- 'nofatal' => 1
- );
- return $pg;
- }
-}
-
-sub access_info {
- my $p = shift;
-
- my $conf = new FS::Conf;
-
- my $info = skin_info($p);
-
- use vars qw( $cust_paybys ); #cache for performance
- unless ( $cust_paybys ) {
-
- my %cust_paybys = map { $_ => 1 }
- map { FS::payby->payby2payment($_) }
- $conf->config('signup_server-payby');
-
- $cust_paybys = [ keys %cust_paybys ];
-
- }
- $info->{'cust_paybys'} = $cust_paybys;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- $info->{'hide_payment_fields'} = [
- map {
- my $pg = payment_gateway($cust_main, $_);
- $pg && $pg->gateway_namespace eq 'Business::OnlineThirdPartyPayment';
- } @{ $info->{cust_paybys} }
- ];
-
- $info->{'self_suspend_reason'} =
- $conf->config('selfservice-self_suspend_reason', $cust_main->agentnum);
-
- return { %$info,
- 'custnum' => $custnum,
- 'access_pkgnum' => $session->{'pkgnum'},
- 'access_svcnum' => $session->{'svcnum'},
- };
-}
-
-sub customer_info {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my %return;
-
- my $conf = new FS::Conf;
- if ($conf->exists('cust_main-require_address2')) {
- $return{'require_address2'} = '1';
- }else{
- $return{'require_address2'} = '';
- }
-
- if ( $custnum ) { #customer record
-
- my $search = { 'custnum' => $custnum };
- $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
- my $cust_main = qsearchs('cust_main', $search )
- or return { 'error' => "unknown custnum $custnum" };
-
- if ( $session->{'pkgnum'} ) {
- $return{balance} = $cust_main->balance_pkgnum( $session->{'pkgnum'} );
- } else {
- $return{balance} = $cust_main->balance;
- }
-
- $return{tickets} = [ ($cust_main->tickets) ];
-
- unless ( $session->{'pkgnum'} ) {
- my @open = map {
- {
- invnum => $_->invnum,
- date => time2str("%b %o, %Y", $_->_date),
- owed => $_->owed,
- };
- } $cust_main->open_cust_bill;
- $return{open_invoices} = \@open;
- }
-
- $return{small_custview} =
- small_custview( $cust_main,
- scalar($conf->config('countrydefault')),
- ( $session->{'pkgnum'} ? 1 : 0 ), #nobalance
- );
-
- $return{name} = $cust_main->first. ' '. $cust_main->get('last');
-
- for (@cust_main_editable_fields) {
- $return{$_} = $cust_main->get($_);
- }
-
- if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) {
- $return{payinfo} = $cust_main->paymask;
- @return{'month', 'year'} = $cust_main->paydate_monthyear;
- }
-
- $return{'invoicing_list'} =
- join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list );
- $return{'postal_invoicing'} =
- 0 < ( grep { $_ eq 'POST' } $cust_main->invoicing_list );
-
- if (scalar($conf->config('support_packages'))) {
- my @support_services = ();
- foreach ($cust_main->support_services) {
- my $seconds = $_->svc_x->seconds;
- my $time_remaining = (($seconds < 0) ? '-' : '' ).
- int(abs($seconds)/3600)."h".
- sprintf("%02d",(abs($seconds)%3600)/60)."m";
- my $cust_pkg = $_->cust_pkg;
- my $pkgnum = '';
- my $pkg = '';
- $pkgnum = $cust_pkg->pkgnum if $cust_pkg;
- $pkg = $cust_pkg->part_pkg->pkg if $cust_pkg;
- push @support_services, { svcnum => $_->svcnum,
- time => $time_remaining,
- pkgnum => $pkgnum,
- pkg => $pkg,
- };
- }
- $return{support_services} = \@support_services;
- }
-
- if ( $conf->config('prepayment_discounts-credit_type') ) {
- #need to eval?
- $return{discount_terms_hash} = { $cust_main->discount_terms_hash };
- }
-
- } elsif ( $session->{'svcnum'} ) { #no customer record
-
- my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $session->{'svcnum'} } )
- or die "unknown svcnum";
- $return{name} = $svc_acct->email;
-
- } else {
-
- return { 'error' => 'Expired session' }; #XXX redirect to login w/this err!
-
- }
-
- return { 'error' => '',
- 'custnum' => $custnum,
- %return,
- };
-
-}
-
-sub edit_info {
- my $p = shift;
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $custnum = $session->{'custnum'}
- or return { 'error' => "no customer record" };
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $new = new FS::cust_main { $cust_main->hash };
- $new->set( $_ => $p->{$_} )
- foreach grep { exists $p->{$_} } @cust_main_editable_fields;
-
- my $payby = '';
- if (exists($p->{'payby'})) {
- $p->{'payby'} =~ /^([A-Z]{4})$/
- or return { 'error' => "illegal_payby " . $p->{'payby'} };
- $payby = $1;
- }
-
- if ( $payby =~ /^(CARD|DCRD)$/ ) {
-
- $new->paydate($p->{'year'}. '-'. $p->{'month'}. '-01');
-
- if ( $new->payinfo eq $cust_main->paymask ) {
- $new->payinfo($cust_main->payinfo);
- } else {
- $new->payinfo($p->{'payinfo'});
- }
-
- $new->set( 'payby' => $p->{'auto'} ? 'CARD' : 'DCRD' );
-
- } elsif ( $payby =~ /^(CHEK|DCHK)$/ ) {
-
- my $payinfo;
- $p->{'payinfo1'} =~ /^([\dx]+)$/
- or return { 'error' => "illegal account number ". $p->{'payinfo1'} };
- my $payinfo1 = $1;
- $p->{'payinfo2'} =~ /^([\dx]+)$/
- or return { 'error' => "illegal ABA/routing number ". $p->{'payinfo2'} };
- my $payinfo2 = $1;
- $payinfo = $payinfo1. '@'. $payinfo2;
-
- $new->payinfo( ($payinfo eq $cust_main->paymask)
- ? $cust_main->payinfo
- : $payinfo
- );
-
- $new->set( 'payby' => $p->{'auto'} ? 'CHEK' : 'DCHK' );
-
- } elsif ( $payby =~ /^(BILL)$/ ) {
- #no-op
- } elsif ( $payby ) { #notyet ready
- return { 'error' => "unknown payby $payby" };
- }
-
- my @invoicing_list;
- if ( exists $p->{'invoicing_list'} || exists $p->{'postal_invoicing'} ) {
- #false laziness with httemplate/edit/process/cust_main.cgi
- @invoicing_list = split( /\s*\,\s*/, $p->{'invoicing_list'} );
- push @invoicing_list, 'POST' if $p->{'postal_invoicing'};
- } else {
- @invoicing_list = $cust_main->invoicing_list;
- }
-
- my $error = $new->replace($cust_main, \@invoicing_list);
- return { 'error' => $error } if $error;
- #$cust_main = $new;
-
- return { 'error' => '' };
-}
-
-sub payment_info {
- my $p = shift;
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- ##
- #generic
- ##
-
- my $conf = new FS::Conf;
- use vars qw($payment_info); #cache for performance
- unless ( $payment_info ) {
-
- my %states = map { $_->state => 1 }
- qsearch('cust_main_county', {
- 'country' => $conf->config('countrydefault') || 'US'
- } );
-
- my %cust_paybys = map { $_ => 1 }
- map { FS::payby->payby2payment($_) }
- $conf->config('signup_server-payby');
-
- my @cust_paybys = keys %cust_paybys;
-
- $payment_info = {
-
- #list all counties/states/countries
- 'cust_main_county' =>
- [ map { $_->hashref } qsearch('cust_main_county', {}) ],
-
- #shortcut for one-country folks
- 'states' =>
- [ sort { $a cmp $b } keys %states ],
-
- 'card_types' => card_types(),
-
- 'paytypes' => [ @FS::cust_main::paytypes ],
-
- 'paybys' => [ $conf->config('signup_server-payby') ],
- 'cust_paybys' => \@cust_paybys,
-
- 'stateid_label' => FS::Msgcat::_gettext('stateid'),
- 'stateid_state_label' => FS::Msgcat::_gettext('stateid_state'),
-
- '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'),
- };
-
- }
-
- ##
- #customer-specific
- ##
-
- my %return = %$payment_info;
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- $return{'hide_payment_fields'} = [
- map {
- my $pg = payment_gateway($cust_main, $_);
- $pg && $pg->gateway_namespace eq 'Business::OnlineThirdPartyPayment';
- } @{ $return{cust_paybys} }
- ];
-
- $return{balance} = $cust_main->balance; #XXX pkg-balances?
-
- $return{payname} = $cust_main->payname
- || ( $cust_main->first. ' '. $cust_main->get('last') );
-
- $return{$_} = $cust_main->get($_) for qw(address1 address2 city state zip);
-
- $return{payby} = $cust_main->payby;
- $return{stateid_state} = $cust_main->stateid_state;
-
- if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) {
- $return{card_type} = cardtype($cust_main->payinfo);
- $return{payinfo} = $cust_main->paymask;
-
- @return{'month', 'year'} = $cust_main->paydate_monthyear;
-
- }
-
- if ( $cust_main->payby =~ /^(CHEK|DCHK)$/ ) {
- my ($payinfo1, $payinfo2) = split '@', $cust_main->paymask;
- $return{payinfo1} = $payinfo1;
- $return{payinfo2} = $payinfo2;
- $return{paytype} = $cust_main->paytype;
- $return{paystate} = $cust_main->paystate;
-
- }
-
- if ( $conf->config('prepayment_discounts-credit_type') ) {
- #need to eval?
- $return{discount_terms_hash} = { $cust_main->discount_terms_hash };
- }
-
- #doubleclick protection
- my $_date = time;
- $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
-
- return { 'error' => '',
- %return,
- };
-
-};
-
-#some false laziness with httemplate/process/payment.cgi - look there for
-#ACH and CVV support stuff
-sub process_payment {
-
- my $p = shift;
-
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my %return;
-
- my $custnum = $session->{'custnum'};
-
- 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->{'discount_term'} =~ /^\s*(\d*)\s*$/
- or return { 'error' => gettext('illegal_discount_term'). ': '. $p->{'discount_term'} };
- my $discount_term = $1;
-
- $p->{'payname'} =~ /^([\w \,\.\-\']+)$/
- or return { 'error' => gettext('illegal_name'). " payname: ". $p->{'payname'} };
- my $payname = $1;
-
- $p->{'paybatch'} =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
- or return { 'error' => gettext('illegal_text'). " paybatch: ". $p->{'paybatch'} };
- my $paybatch = $1;
-
- $p->{'payby'} ||= 'CARD';
- $p->{'payby'} =~ /^([A-Z]{4})$/
- or return { 'error' => "illegal_payby " . $p->{'payby'} };
- my $payby = $1;
-
- #false laziness w/process/payment.cgi
- my $payinfo;
- my $paycvv = '';
- if ( $payby eq 'CHEK' || $payby eq 'DCHK' ) {
-
- $p->{'payinfo1'} =~ /^([\dx]+)$/
- or return { 'error' => "illegal account number ". $p->{'payinfo1'} };
- my $payinfo1 = $1;
- $p->{'payinfo2'} =~ /^([\dx]+)$/
- or return { 'error' => "illegal ABA/routing number ". $p->{'payinfo2'} };
- my $payinfo2 = $1;
- $payinfo = $payinfo1. '@'. $payinfo2;
-
- $payinfo = $cust_main->payinfo
- if $cust_main->paymask eq $payinfo;
-
- } elsif ( $payby eq 'CARD' || $payby eq 'DCRD' ) {
-
- $payinfo = $p->{'payinfo'};
-
- #more intelligent mathing will be needed here if you change
- #card_masking_method and don't remove existing paymasks
- $payinfo = $cust_main->payinfo
- if $cust_main->paymask eq $payinfo;
-
- $payinfo =~ s/\D//g;
- $payinfo =~ /^(\d{13,16})$/
- or return { 'error' => gettext('invalid_card') }; # . ": ". $self->payinfo
- $payinfo = $1;
-
- validate($payinfo)
- or return { 'error' => gettext('invalid_card') }; # . ": ". $self->payinfo
- return { 'error' => gettext('unknown_card_type') }
- if $payinfo !~ /^99\d{14}$/ && cardtype($payinfo) eq "Unknown";
-
- if ( length($p->{'paycvv'}) && $p->{'paycvv'} !~ /^\s*$/ ) {
- if ( cardtype($payinfo) eq 'American Express card' ) {
- $p->{'paycvv'} =~ /^\s*(\d{4})\s*$/
- or return { 'error' => "CVV2 (CID) for American Express cards is four digits." };
- $paycvv = $1;
- } else {
- $p->{'paycvv'} =~ /^\s*(\d{3})\s*$/
- or return { 'error' => "CVV2 (CVC2/CID) is three digits." };
- $paycvv = $1;
- }
- }
-
- } else {
- die "unknown payby $payby";
- }
-
- my %payby2fields = (
- 'CARD' => [ qw( paystart_month paystart_year payissue payip
- address1 address2 city state zip country ) ],
- 'CHEK' => [ qw( ss paytype paystate stateid stateid_state payip ) ],
- );
-
- my $error = $cust_main->realtime_bop( $FS::payby::payby2bop{$payby}, $amount,
- 'quiet' => 1,
- 'payinfo' => $payinfo,
- 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01',
- 'payname' => $payname,
- 'paybatch' => $paybatch, #this doesn't actually do anything
- 'paycvv' => $paycvv,
- 'pkgnum' => $session->{'pkgnum'},
- 'discount_term' => $discount_term,
- 'selfservice' => 1,
- map { $_ => $p->{$_} } @{ $payby2fields{$payby} }
- );
- return { 'error' => $error } if $error;
-
- $cust_main->apply_payments;
-
- if ( $p->{'save'} ) {
- my $new = new FS::cust_main { $cust_main->hash };
- if ($payby eq 'CARD' || $payby eq 'DCRD') {
- $new->set( $_ => $p->{$_} )
- foreach qw( payname paystart_month paystart_year payissue payip
- address1 address2 city state zip country );
- $new->set( 'payby' => $p->{'auto'} ? 'CARD' : 'DCRD' );
- } elsif ($payby eq 'CHEK' || $payby eq 'DCHK') {
- $new->set( $_ => $p->{$_} )
- foreach qw( payname payip paytype paystate
- stateid stateid_state );
- $new->set( 'payby' => $p->{'auto'} ? 'CHEK' : 'DCHK' );
- }
- $new->set( 'payinfo' => $cust_main->card_token || $payinfo );
- $new->set( 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01' );
- my $error = $new->replace($cust_main);
- 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' => '' };
-
-}
-
-sub realtime_collect {
- my $p = shift;
-
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $amount;
- if ( $p->{'amount'} ) {
- $amount = $p->{'amount'};
- }
- elsif ( $session->{'pkgnum'} ) {
- $amount = $cust_main->balance_pkgnum( $session->{'pkgnum'} );
- }
- else {
- $amount = $cust_main->balance;
- }
-
- my $error = $cust_main->realtime_collect(
- 'method' => $p->{'method'},
- 'amount' => $amount,
- 'pkgnum' => $session->{'pkgnum'},
- 'session_id' => $p->{'session_id'},
- 'apply' => 1,
- 'selfservice'=> 1,
- );
- return { 'error' => $error } unless ref( $error );
-
- return { 'error' => '', amount => $amount, %$error };
-}
-
-sub process_payment_order_pkg {
- my $p = shift;
-
- my $hr = process_payment($p);
- return $hr if $hr->{'error'};
-
- order_pkg($p);
-}
-
-sub process_payment_order_renew {
- my $p = shift;
-
- my $hr = process_payment($p);
- return $hr if $hr->{'error'};
-
- order_renew($p);
-}
-
-sub process_prepay {
-
- my $p = shift;
-
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my %return;
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = ( 0, 0, 0, 0, 0 );
- my $error = $cust_main->recharge_prepay( $p->{'prepaid_cardnum'},
- \$amount,
- \$seconds,
- \$upbytes,
- \$downbytes,
- \$totalbytes,
- );
-
- return { 'error' => $error } if $error;
-
- return { 'error' => '',
- 'amount' => $amount,
- 'seconds' => $seconds,
- 'duration' => duration_exact($seconds),
- 'upbytes' => $upbytes,
- 'upload' => FS::UI::bytecount::bytecount_unexact($upbytes),
- 'downbytes' => $downbytes,
- 'download' => FS::UI::bytecount::bytecount_unexact($downbytes),
- 'totalbytes'=> $totalbytes,
- 'totalload' => FS::UI::bytecount::bytecount_unexact($totalbytes),
- };
-
-}
-
-sub invoice {
- my $p = shift;
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $custnum = $session->{'custnum'};
-
- my $invnum = $p->{'invnum'};
-
- my $cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum,
- 'custnum' => $custnum } )
- or return { 'error' => "Can't find invnum" };
-
- #my %return;
-
- return { 'error' => '',
- 'invnum' => $invnum,
- 'invoice_text' => join('', $cust_bill->print_text ),
- 'invoice_html' => $cust_bill->print_html( { unsquelch_cdr => 1 } ),
- };
-
-}
-
-sub invoice_logo {
- my $p = shift;
-
- #sessioning for this? how do we get the session id to the backend invoice
- # template so it can add it to the link, blah
-
- my $agentnum = '';
- if ( $p->{'invnum'} ) {
- my $cust_bill = qsearchs('cust_bill', { 'invnum' => $p->{'invnum'} } )
- or return { 'error' => 'unknown invnum' };
- $agentnum = $cust_bill->cust_main->agentnum;
- }
-
- my $templatename = $p->{'template'} || $p->{'templatename'};
-
- #false laziness-ish w/view/cust_bill-logo.cgi
-
- my $conf = new FS::Conf;
- if ( $templatename =~ /^([^\.\/]*)$/ && $conf->exists("logo_$1.png") ) {
- $templatename = "_$1";
- } else {
- $templatename = '';
- }
-
- my $filename = "logo$templatename.png";
-
- return { 'error' => '',
- 'logo' => $conf->config_binary($filename, $agentnum),
- 'content_type' => 'image/png', #should allow gif, jpg too
- };
-}
-
-
-sub list_invoices {
- my $p = shift;
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- my @cust_bill = $cust_main->cust_bill;
-
- return { 'error' => '',
- 'invoices' => [ map { { 'invnum' => $_->invnum,
- '_date' => $_->_date,
- 'date' => time2str("%b %o, %Y", $_->_date),
- }
- } @cust_bill
- ]
- };
-}
-
-sub cancel {
- my $p = shift;
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- my @errors = $cust_main->cancel( 'quiet'=>1 );
-
- my $error = scalar(@errors) ? join(' / ', @errors) : '';
-
- return { 'error' => $error };
-
-}
-
-sub list_pkgs {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $search = { 'custnum' => $custnum };
- $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
- my $cust_main = qsearchs('cust_main', $search )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $conf = new FS::Conf;
-
-# the duplication below is necessary:
-# 1. to maintain the current buggy behaviour wrt the cust_pkg and part_pkg
-# hashes overwriting each other (setup and no_auto fields). Fixing that is a
-# non-backwards-compatible change breaking the software of anyone using the API
-# instead of the stock selfservice
-# 2. to return cancelled packages as well - for wholesale and non-wholesale
- if( $conf->exists('selfservice_server-view-wholesale') ) {
- return { 'svcnum' => $session->{'svcnum'},
- 'custnum' => $custnum,
- 'cust_pkg' => [ map {
- { $_->hash,
- part_pkg => [ map $_->hashref, $_->part_pkg ],
- part_svc =>
- [ map $_->hashref, $_->available_part_svc ],
- cust_svc =>
- [ map { my $ref = { $_->hash,
- label => [ $_->label ],
- };
- $ref->{_password} = $_->svc_x->_password
- if $context eq 'agent'
- && $conf->exists('agent-showpasswords')
- && $_->part_svc->svcdb eq 'svc_acct';
- $ref;
- } $_->cust_svc
- ],
- };
- } $cust_main->cust_pkg
- ],
- 'small_custview' =>
- small_custview( $cust_main, $conf->config('countrydefault') ),
- 'wholesale_view' => 1,
- 'login_svcpart' => [ $conf->config('selfservice_server-login_svcpart') ],
- 'date_format' => $conf->config('date_format') || '%m/%d/%Y',
- 'lnp' => $conf->exists('svc_phone-lnp'),
- };
- }
-
- { 'svcnum' => $session->{'svcnum'},
- 'custnum' => $custnum,
- 'cust_pkg' => [ map {
- { $_->hash,
- $_->part_pkg->hash,
- part_svc =>
- [ map $_->hashref, $_->available_part_svc ],
- cust_svc =>
- [ map { my $ref = { $_->hash,
- label => [ $_->label ],
- };
- $ref->{_password} = $_->svc_x->_password
- if $context eq 'agent'
- && $conf->exists('agent-showpasswords')
- && $_->part_svc->svcdb eq 'svc_acct';
- $ref;
- } $_->cust_svc
- ],
- };
- } $cust_main->ncancelled_pkgs
- ],
- 'small_custview' =>
- small_custview( $cust_main, $conf->config('countrydefault') ),
- };
-
-}
-
-sub list_svcs {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $search = { 'custnum' => $custnum };
- $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
- my $cust_main = qsearchs('cust_main', $search )
- or return { 'error' => "unknown custnum $custnum" };
-
- my @cust_svc = ();
- #foreach my $cust_pkg ( $cust_main->ncancelled_pkgs ) {
- foreach my $cust_pkg ( $p->{'ncancelled'}
- ? $cust_main->ncancelled_pkgs
- : $cust_main->unsuspended_pkgs ) {
- next if $session->{'pkgnum'} && $cust_pkg->pkgnum != $session->{'pkgnum'};
- push @cust_svc, @{[ $cust_pkg->cust_svc ]}; #@{[ ]} to force array context
- }
- if ( $p->{'svcdb'} ) {
- my $svcdb = ref($p->{'svcdb'}) eq 'HASH'
- ? $p->{'svcdb'}
- : ref($p->{'svcdb'}) eq 'ARRAY'
- ? { map { $_=>1 } @{ $p->{'svcdb'} } }
- : { $p->{'svcdb'} => 1 };
- @cust_svc = grep $svcdb->{ $_->part_svc->svcdb }, @cust_svc
- }
-
- #@svc_x = sort { $a->domain cmp $b->domain || $a->username cmp $b->username }
- # @svc_x;
-
- {
- 'svcnum' => $session->{'svcnum'},
- 'custnum' => $custnum,
- 'svcs' => [
- map {
- my $svc_x = $_->svc_x;
- my($label, $value) = $_->label;
- my $svcdb = $_->part_svc->svcdb;
- my $part_pkg = $_->cust_pkg->part_pkg;
-
- my %hash = (
- 'svcnum' => $_->svcnum,
- 'svcdb' => $svcdb,
- 'label' => $label,
- 'value' => $value,
- );
-
- if ( $svcdb eq 'svc_acct' ) {
- %hash = (
- %hash,
- 'username' => $svc_x->username,
- 'email' => $svc_x->email,
- 'seconds' => $svc_x->seconds,
- 'upbytes' => display_bytecount($svc_x->upbytes),
- 'downbytes' => display_bytecount($svc_x->downbytes),
- 'totalbytes' => display_bytecount($svc_x->totalbytes),
-
- 'recharge_amount' => $part_pkg->option('recharge_amount',1),
- 'recharge_seconds' => $part_pkg->option('recharge_seconds',1),
- 'recharge_upbytes' =>
- display_bytecount($part_pkg->option('recharge_upbytes',1)),
- 'recharge_downbytes' =>
- display_bytecount($part_pkg->option('recharge_downbytes',1)),
- 'recharge_totalbytes' =>
- display_bytecount($part_pkg->option('recharge_totalbytes',1)),
- # more...
- );
-
- } elsif ( $svcdb eq 'svc_phone' ) {
- %hash = (
- %hash,
- );
- }
-
- \%hash;
- }
- @cust_svc
- ],
- };
-
-}
-
-sub _list_svc_usage {
- my($svc_acct, $begin, $end) = @_;
- my @usage = ();
- foreach my $part_export (
- map { qsearch ( 'part_export', { 'exporttype' => $_ } ) }
- qw( sqlradius sqlradius_withdomain )
- ) {
- push @usage, @ { $part_export->usage_sessions($begin, $end, $svc_acct) };
- }
- (@usage);
-}
-
-sub list_svc_usage {
- _usage_details(\&_list_svc_usage, @_);
-}
-
-sub _list_support_usage {
- my($svc_acct, $begin, $end) = @_;
- my @usage = ();
- foreach ( grep { $begin <= $_->_date && $_->_date <= $end }
- qsearch('acct_rt_transaction', { 'svcnum' => $svc_acct->svcnum })
- ) {
- push @usage, { 'seconds' => $_->seconds,
- 'support' => $_->support,
- '_date' => $_->_date,
- 'id' => $_->transaction_id,
- 'creator' => $_->creator,
- 'subject' => $_->subject,
- 'status' => $_->status,
- 'ticketid' => $_->ticketid,
- };
- }
- (@usage);
-}
-
-sub list_support_usage {
- _usage_details(\&_list_support_usage, @_);
-}
-
-sub _list_cdr_usage {
- my($svc_phone, $begin, $end) = @_;
- map [ $_->downstream_csv('format' => 'default') ], #XXX config for format
- $svc_phone->get_cdrs( 'begin'=>$begin, 'end'=>$end, );
-}
-
-sub list_cdr_usage {
- my $p = shift;
- _usage_details( \&_list_cdr_usage, $p,
- 'svcdb' => 'svc_phone',
- );
-}
-
-sub _usage_details {
- my($callback, $p, %opt) = @_;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $search = { 'svcnum' => $p->{'svcnum'} };
- $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
-
- my $svcdb = $opt{'svcdb'} || 'svc_acct';
-
- my $svc_x = qsearchs( $svcdb, $search );
- return { 'error' => 'No service selected in list_svc_usage' }
- unless $svc_x;
-
- my $header = $svcdb eq 'svc_phone'
- ? [ split(',', FS::cdr::invoice_header('default') ) ] #XXX
- : [];
-
- my $cust_pkg = $svc_x->cust_svc->cust_pkg;
- my $freq = $cust_pkg->part_pkg->freq;
- my $start = $cust_pkg->setup;
- #my $end = $cust_pkg->bill; # or time?
- my $end = time;
-
- unless ( $p->{beginning} ) {
- $p->{beginning} = $cust_pkg->last_bill;
- $p->{ending} = $end;
- }
-
- my (@usage) = &$callback($svc_x, $p->{beginning}, $p->{ending});
-
- #kinda false laziness with FS::cust_main::bill, but perhaps
- #we should really change this bit to DateTime and DateTime::Duration
- #
- #change this bit to use Date::Manip? CAREFUL with timezones (see
- # mailing list archive)
- my ($nsec,$nmin,$nhour,$nmday,$nmon,$nyear) =
- (localtime($p->{ending}) )[0,1,2,3,4,5];
- my ($psec,$pmin,$phour,$pmday,$pmon,$pyear) =
- (localtime($p->{beginning}) )[0,1,2,3,4,5];
-
- if ( $freq =~ /^\d+$/ ) {
- $nmon += $freq;
- until ( $nmon < 12 ) { $nmon -= 12; $nyear++; }
- $pmon -= $freq;
- until ( $pmon >= 0 ) { $pmon += 12; $pyear--; }
- } elsif ( $freq =~ /^(\d+)w$/ ) {
- my $weeks = $1;
- $nmday += $weeks * 7;
- $pmday -= $weeks * 7;
- } elsif ( $freq =~ /^(\d+)d$/ ) {
- my $days = $1;
- $nmday += $days;
- $pmday -= $days;
- } elsif ( $freq =~ /^(\d+)h$/ ) {
- my $hours = $1;
- $nhour += $hours;
- $phour -= $hours;
- } else {
- return { 'error' => "unparsable frequency: ". $freq };
- }
-
- my $previous = timelocal_nocheck($psec,$pmin,$phour,$pmday,$pmon,$pyear);
- my $next = timelocal_nocheck($nsec,$nmin,$nhour,$nmday,$nmon,$nyear);
-
- {
- 'error' => '',
- 'svcnum' => $p->{svcnum},
- 'beginning' => $p->{beginning},
- 'ending' => $p->{ending},
- 'previous' => ($previous > $start) ? $previous : $start,
- 'next' => ($next < $end) ? $next : $end,
- 'header' => $header,
- 'usage' => \@usage,
- };
-}
-
-sub order_pkg {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $search = { 'custnum' => $custnum };
- $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
- my $cust_main = qsearchs('cust_main', $search )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $status = $cust_main->status;
- #false laziness w/ClientAPI/Signup.pm
-
- my $cust_pkg = new FS::cust_pkg ( {
- 'custnum' => $custnum,
- 'pkgpart' => $p->{'pkgpart'},
- } );
- my $error = $cust_pkg->check;
- return { 'error' => $error } if $error;
-
- my @svc = ();
- unless ( $p->{'svcpart'} eq 'none' ) {
-
- my $svcdb;
- my $svcpart = '';
- if ( $p->{'svcpart'} =~ /^(\d+)$/ ) {
- $svcpart = $1;
- my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
- return { 'error' => "Unknown svcpart $svcpart" } unless $part_svc;
- $svcdb = $part_svc->svcdb;
- } else {
- $svcdb = 'svc_acct';
- }
- $svcpart ||= $cust_pkg->part_pkg->svcpart($svcdb);
-
- my %fields = (
- 'svc_acct' => [ qw( username domsvc _password sec_phrase popnum ) ],
- 'svc_domain' => [ qw( domain ) ],
- 'svc_phone' => [ qw( phonenum pin sip_password phone_name ) ],
- 'svc_external' => [ qw( id title ) ],
- 'svc_pbx' => [ qw( id name ) ],
- );
-
- my $svc_x = "FS::$svcdb"->new( {
- 'svcpart' => $svcpart,
- map { $_ => $p->{$_} } @{$fields{$svcdb}}
- } );
-
- if ( $svcdb eq 'svc_acct' ) {
- my @acct_snarf;
- my $snarfnum = 1;
- while ( length($p->{"snarf_machine$snarfnum"}) ) {
- my $acct_snarf = new FS::acct_snarf ( {
- 'machine' => $p->{"snarf_machine$snarfnum"},
- 'protocol' => $p->{"snarf_protocol$snarfnum"},
- 'username' => $p->{"snarf_username$snarfnum"},
- '_password' => $p->{"snarf_password$snarfnum"},
- } );
- $snarfnum++;
- push @acct_snarf, $acct_snarf;
- }
- $svc_x->child_objects( \@acct_snarf );
- }
-
- my $y = $svc_x->setdefault; # arguably should be in new method
- return { 'error' => $y } if $y && !ref($y);
-
- $error = $svc_x->check;
- return { 'error' => $error } if $error;
-
- push @svc, $svc_x;
-
- }
-
- use Tie::RefHash;
- tie my %hash, 'Tie::RefHash';
- %hash = ( $cust_pkg => \@svc );
- #msgcat
- $error = $cust_main->order_pkgs( \%hash, '', 'noexport' => 1 );
- return { 'error' => $error } if $error;
-
- my $conf = new FS::Conf;
- if ( $conf->exists('signup_server-realtime') ) {
-
- my $bill_error = _do_bop_realtime( $cust_main, $status );
-
- if ($bill_error) {
- $cust_pkg->cancel('quiet'=>1);
- return $bill_error;
- } else {
- $cust_pkg->reexport;
- }
-
- } else {
- $cust_pkg->reexport;
- }
-
- my $svcnum = $svc[0] ? $svc[0]->svcnum : '';
-
- return { error=>'', pkgnum=>$cust_pkg->pkgnum, svcnum=>$svcnum };
-
-}
-
-sub change_pkg {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $search = { 'custnum' => $custnum };
- $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
- my $cust_main = qsearchs('cust_main', $search )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $status = $cust_main->status;
- my $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $p->{pkgnum} } )
- or return { 'error' => "unknown package $p->{pkgnum}" };
-
- my @newpkg;
- my $error = FS::cust_pkg::order( $custnum,
- [$p->{pkgpart}],
- [$p->{pkgnum}],
- \@newpkg,
- );
-
- my $conf = new FS::Conf;
- if ( $conf->exists('signup_server-realtime') ) {
-
- my $bill_error = _do_bop_realtime( $cust_main, $status );
-
- if ($bill_error) {
- $newpkg[0]->suspend;
- return $bill_error;
- } else {
- $newpkg[0]->reexport;
- }
-
- } else {
- $newpkg[0]->reexport;
- }
-
- return { error => '', pkgnum => $cust_pkg->pkgnum };
-
-}
-
-sub order_recharge {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $search = { 'custnum' => $custnum };
- $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
- my $cust_main = qsearchs('cust_main', $search )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $status = $cust_main->status;
- my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $p->{'svcnum'} } )
- or return { 'error' => "unknown service " . $p->{'svcnum'} };
-
- my $svc_x = $cust_svc->svc_x;
- my $part_pkg = $cust_svc->cust_pkg->part_pkg;
-
- my %vhash =
- map { $_ =~ /^recharge_(.*)$/; $1, $part_pkg->option($_, 1) }
- qw ( recharge_seconds recharge_upbytes recharge_downbytes
- recharge_totalbytes );
- my $amount = $part_pkg->option('recharge_amount', 1);
-
- my ($l, $v, $d) = $cust_svc->label; # blah
- my $pkg = "Recharge $v";
-
- my $bill_error = $cust_main->charge($amount, $pkg,
- "time: $vhash{seconds}, up: $vhash{upbytes}," .
- "down: $vhash{downbytes}, total: $vhash{totalbytes}",
- $part_pkg->taxclass); #meh
-
- my $conf = new FS::Conf;
- if ( $conf->exists('signup_server-realtime') && !$bill_error ) {
-
- $bill_error = _do_bop_realtime( $cust_main, $status );
-
- if ($bill_error) {
- return $bill_error;
- } else {
- my $error = $svc_x->recharge (\%vhash);
- return { 'error' => $error } if $error;
- }
-
- } else {
- my $error = $bill_error;
- $error ||= $svc_x->recharge (\%vhash);
- return { 'error' => $error } if $error;
- }
-
- return { error => '', svc => $cust_svc->part_svc->svc };
-
-}
-
-sub _do_bop_realtime {
- my ($cust_main, $status) = (shift, shift);
-
- my $old_balance = $cust_main->balance;
-
- my $bill_error = $cust_main->bill
- || $cust_main->apply_payments_and_credits
- || $cust_main->realtime_collect('selfservice' => 1);
-
- if ( $cust_main->balance > $old_balance
- && $cust_main->balance > 0
- && ( $cust_main->payby !~ /^(BILL|DCRD|DCHK)$/ ?
- 1 : $status eq 'suspended' ) ) {
- #this makes sense. credit is "un-doing" the invoice
- my $conf = new FS::Conf;
- $cust_main->credit( sprintf("%.2f", $cust_main->balance - $old_balance ),
- 'self-service decline',
- 'reason_type' => $conf->config('signup_credit_type'),
- );
- $cust_main->apply_credits( 'order' => 'newest' );
-
- return { 'error' => '_decline', 'bill_error' => $bill_error };
- }
-
- '';
-}
-
-sub renew_info {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- my @cust_pkg = sort { $a->bill <=> $b->bill }
- grep { $_->part_pkg->freq ne '0' }
- $cust_main->ncancelled_pkgs;
-
- #return { 'error' => 'No active packages to renew.' } unless @cust_pkg;
-
- my $total = $cust_main->balance;
-
- my @array = map {
- my $bill = $_->bill;
- $total += $_->part_pkg->base_recur($_, \$bill);
- my $renew_date = $_->part_pkg->add_freq($_->bill);
- {
- 'pkgnum' => $_->pkgnum,
- 'amount' => sprintf('%.2f', $total),
- 'bill_date' => $_->bill,
- 'bill_date_pretty' => time2str('%x', $_->bill),
- 'renew_date' => $renew_date,
- 'renew_date_pretty' => time2str('%x', $renew_date),
- 'expire_date' => $_->expire,
- 'expire_date_pretty' => time2str('%x', $_->expire),
- };
- }
- @cust_pkg;
-
- return { 'dates' => \@array };
-
-}
-
-sub payment_info_renew_info {
- my $p = shift;
- my $renew_info = renew_info($p);
- my $payment_info = payment_info($p);
- return { %$renew_info,
- %$payment_info,
- };
-}
-
-sub order_renew {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $date = $p->{'date'};
-
- my $now = time;
-
- #freeside-daily -n -d $date fs_daily $custnum
- $cust_main->bill_and_collect( 'time' => $date,
- 'invoice_time' => $now,
- 'actual_time' => $now,
- 'check_freq' => '1d',
- );
-
- return { 'error' => '' };
-
-}
-
-sub suspend_pkg {
- my $p = shift;
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $conf = new FS::Conf;
- my $reasonnum =
- $conf->config('selfservice-self_suspend_reason', $cust_main->agentnum)
- or return { 'error' => 'Permission denied' };
-
- my $pkgnum = $p->{'pkgnum'};
-
- my $cust_pkg = qsearchs('cust_pkg', { 'custnum' => $custnum,
- 'pkgnum' => $pkgnum, } )
- or return { 'error' => "unknown pkgnum $pkgnum" };
-
- my $error = $cust_pkg->suspend(reason => $reasonnum);
- return { 'error' => $error };
-
-}
-
-sub cancel_pkg {
- my $p = shift;
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $pkgnum = $p->{'pkgnum'};
-
- my $cust_pkg = qsearchs('cust_pkg', { 'custnum' => $custnum,
- 'pkgnum' => $pkgnum, } )
- or return { 'error' => "unknown pkgnum $pkgnum" };
-
- my $error = $cust_pkg->cancel('quiet' => 1);
- return { 'error' => $error };
-
-}
-
-sub provision_phone {
- my $p = shift;
- my @bulkdid;
- @bulkdid = @{$p->{'bulkdid'}} if $p->{'bulkdid'};
-
-# single DID LNP
- unless($p->{'lnp'}) {
- $p->{'lnp_desired_due_date'} = parse_datetime($p->{'lnp_desired_due_date'});
- $p->{'lnp_status'} = "portingin";
- return _provision( 'FS::svc_phone',
- [qw(lnp_desired_due_date lnp_other_provider
- lnp_other_provider_account phonenum countrycode lnp_status)],
- [qw(phonenum countrycode)],
- $p,
- @_
- );
- }
-
-# single DID order
- unless (scalar(@bulkdid)) {
- return _provision( 'FS::svc_phone',
- [qw(phonenum countrycode)],
- [qw(phonenum countrycode)],
- $p,
- @_
- );
- }
-
-# bulk DID order case
- my $error;
- foreach my $did ( @bulkdid ) {
- $did =~ s/[^0-9]//g;
- $error = _provision( 'FS::svc_phone',
- [qw(phonenum countrycode)],
- [qw(phonenum countrycode)],
- {
- 'pkgnum' => $p->{'pkgnum'},
- 'svcpart' => $p->{'svcpart'},
- 'phonenum' => $did,
- 'countrycode' => $p->{'countrycode'},
- 'session_id' => $p->{'session_id'},
- }
- );
- return $error if ($error->{'error'} && length($error->{'error'}) > 1);
- }
- { 'bulkdid' => [ @bulkdid ], 'svc' => $error->{'svc'} }
-}
-
-sub provision_acct {
- my $p = shift;
- warn "provision_acct called\n"
- if $DEBUG;
-
- return { 'error' => gettext('passwords_dont_match') }
- if $p->{'_password'} ne $p->{'_password2'};
- return { 'error' => gettext('empty_password') }
- unless length($p->{'_password'});
-
- if ($p->{'domsvc'}) {
- my %domains = domain_select_hash FS::svc_acct(map { $_ => $p->{$_} }
- qw ( svcpart pkgnum ) );
- return { 'error' => gettext('invalid_domain') }
- unless ($domains{$p->{'domsvc'}});
- }
-
- warn "provision_acct calling _provision\n"
- if $DEBUG;
- _provision( 'FS::svc_acct',
- [qw(username _password domsvc)],
- [qw(username _password domsvc)],
- $p,
- @_
- );
-}
-
-sub provision_external {
- my $p = shift;
- #_provision( 'FS::svc_external', [qw(id title)], [qw(id title)], $p, @_ );
- _provision( 'FS::svc_external',
- [],
- [qw(id title)],
- $p,
- @_
- );
-}
-
-sub _provision {
- my( $class, $fields, $return_fields, $p ) = splice(@_, 0, 4);
- warn "_provision called for $class\n"
- if $DEBUG;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $search = { 'custnum' => $custnum };
- $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
- my $cust_main = qsearchs('cust_main', $search )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $pkgnum = $p->{'pkgnum'};
-
- warn "searching for custnum $custnum pkgnum $pkgnum\n"
- if $DEBUG;
- my $cust_pkg = qsearchs('cust_pkg', { 'custnum' => $custnum,
- 'pkgnum' => $pkgnum,
- } )
- or return { 'error' => "unknown pkgnum $pkgnum" };
-
- warn "searching for svcpart ". $p->{'svcpart'}. "\n"
- if $DEBUG;
- my $part_svc = qsearchs('part_svc', { 'svcpart' => $p->{'svcpart'} } )
- or return { 'error' => "unknown svcpart $p->{'svcpart'}" };
-
- warn "creating $class record\n"
- if $DEBUG;
- my $svc_x = $class->new( {
- 'pkgnum' => $p->{'pkgnum'},
- 'svcpart' => $p->{'svcpart'},
- map { $_ => $p->{$_} } @$fields
- } );
- warn "inserting $class record\n"
- if $DEBUG;
- my $error = $svc_x->insert;
-
- unless ( $error ) {
- warn "finding inserted record for svcnum ". $svc_x->svcnum. "\n"
- if $DEBUG;
- $svc_x = qsearchs($svc_x->table, { 'svcnum' => $svc_x->svcnum })
- }
-
- my $return = { 'svc' => $part_svc->svc,
- 'error' => $error,
- map { $_ => $svc_x->get($_) } @$return_fields
- };
- warn "_provision returning ". Dumper($return). "\n"
- if $DEBUG;
- return $return;
-
-}
-
-sub part_svc_info {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $search = { 'custnum' => $custnum };
- $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
- my $cust_main = qsearchs('cust_main', $search )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $pkgnum = $p->{'pkgnum'};
-
- my $cust_pkg = qsearchs('cust_pkg', { 'custnum' => $custnum,
- 'pkgnum' => $pkgnum,
- } )
- or return { 'error' => "unknown pkgnum $pkgnum" };
-
- my $svcpart = $p->{'svcpart'};
-
- my $pkg_svc = qsearchs('pkg_svc', { 'pkgpart' => $cust_pkg->pkgpart,
- 'svcpart' => $svcpart, } )
- or return { 'error' => "unknown svcpart $svcpart for pkgnum $pkgnum" };
- my $part_svc = $pkg_svc->part_svc;
-
- my $conf = new FS::Conf;
-
- return {
- 'svc' => $part_svc->svc,
- 'svcdb' => $part_svc->svcdb,
- 'pkgnum' => $pkgnum,
- 'svcpart' => $svcpart,
- 'custnum' => $custnum,
-
- 'security_phrase' => 0, #XXX !
- 'svc_acct_pop' => [], #XXX !
- 'popnum' => '',
- 'init_popstate' => '',
- 'popac' => '',
- 'acstate' => '',
-
- 'small_custview' =>
- small_custview( $cust_main, $conf->config('countrydefault') ),
-
- };
-
-}
-
-sub unprovision_svc {
- my $p = shift;
-
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- my $search = { 'custnum' => $custnum };
- $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
- my $cust_main = qsearchs('cust_main', $search )
- or return { 'error' => "unknown custnum $custnum" };
-
- my $svcnum = $p->{'svcnum'};
-
- my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svcnum, } )
- or return { 'error' => "unknown svcnum $svcnum" };
-
- return { 'error' => "Service $svcnum does not belong to customer $custnum" }
- unless $cust_svc->cust_pkg->custnum == $custnum;
-
- my $conf = new FS::Conf;
-
- return { 'svc' => $cust_svc->part_svc->svc,
- 'error' => $cust_svc->cancel,
- 'small_custview' =>
- small_custview( $cust_main, $conf->config('countrydefault') ),
- };
-
-}
-
-sub myaccount_passwd {
- my $p = shift;
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- return { 'error' => "New passwords don't match." }
- if $p->{'new_password'} ne $p->{'new_password2'};
-
- return { 'error' => 'Enter new password' }
- unless length($p->{'new_password'});
-
- #my $search = { 'custnum' => $custnum };
- #$search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
- $custnum =~ /^(\d+)$/ or die "illegal custnum";
- my $search = " AND custnum = $1";
- $search .= " AND agentnum = ". $session->{'agentnum'} if $context eq 'agent';
-
- my $svc_acct = qsearchs( {
- 'table' => 'svc_acct',
- 'addl_from' => 'LEFT JOIN cust_svc USING ( svcnum ) '.
- 'LEFT JOIN cust_pkg USING ( pkgnum ) '.
- 'LEFT JOIN cust_main USING ( custnum ) ',
- 'hashref' => { 'svcnum' => $p->{'svcnum'}, },
- 'extra_sql' => $search, #important
- } )
- or return { 'error' => "Service not found" };
-
- $svc_acct->_password($p->{'new_password'});
- my $error = $svc_acct->replace();
-
- my($label, $value) = $svc_acct->cust_svc->label;
-
- return { 'error' => $error,
- 'label' => $label,
- 'value' => $value,
- };
-
-}
-
-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 did_report {
- my $p = shift;
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- return { error => 'requested format not implemented' }
- unless ($p->{'format'} eq 'csv' || $p->{'format'} eq 'xls');
-
- my $conf = new FS::Conf;
- my $age_threshold = 0;
- $age_threshold = time() - $conf->config('selfservice-recent-did-age')
- if ($p->{'recentonly'} && $conf->exists('selfservice-recent-did-age'));
-
- my $search = { 'custnum' => $custnum };
- $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent';
- my $cust_main = qsearchs('cust_main', $search )
- or return { 'error' => "unknown custnum $custnum" };
-
-# does it make more sense to just run one sql query for this instead of all the
-# insanity below? would increase performance greately for large data sets?
- my @svc_phone = ();
- foreach my $cust_pkg ( $cust_main->ncancelled_pkgs ) {
- my @part_svc = $cust_pkg->part_svc;
- foreach my $part_svc ( @part_svc ) {
- if($part_svc->svcdb eq 'svc_phone'){
- my @cust_pkg_svc = @{$part_svc->cust_pkg_svc};
- foreach my $cust_pkg_svc ( @cust_pkg_svc ) {
- push @svc_phone, $cust_pkg_svc->svc_x
- if $cust_pkg_svc->date_inserted >= $age_threshold;
- }
- }
- }
- }
-
- my $csv;
- my $xls;
- my($xls_r,$xls_c) = (0,0);
- my $xls_workbook;
- my $content = '';
- my @fields = qw( countrycode phonenum pin sip_password phone_name );
- if($p->{'format'} eq 'csv') {
- $csv = new Text::CSV_XS { 'always_quote' => 1,
- 'eol' => "\n",
- };
- return { 'error' => 'Unable to create CSV' } unless $csv->combine(@fields);
- $content .= $csv->string;
- }
- elsif($p->{'format'} eq 'xls') {
- my $XLS1 = new IO::Scalar \$content;
- $xls_workbook = Spreadsheet::WriteExcel->new($XLS1)
- or return { 'error' => "Error opening .xls file: $!" };
- $xls = $xls_workbook->add_worksheet('DIDs');
- foreach ( @fields ) {
- $xls->write(0,$xls_c++,$_);
- }
- $xls_r++;
- }
-
- foreach my $svc_phone ( @svc_phone ) {
- my @cols = map { $svc_phone->$_ } @fields;
- if($p->{'format'} eq 'csv') {
- return { 'error' => 'Unable to create CSV' }
- unless $csv->combine(@cols);
- $content .= $csv->string;
- }
- elsif($p->{'format'} eq 'xls') {
- $xls_c = 0;
- foreach ( @cols ) {
- $xls->write($xls_r,$xls_c++,$_);
- }
- $xls_r++;
- }
- }
-
- $xls_workbook->close() if $p->{'format'} eq 'xls';
-
- { content => $content, format => $p->{'format'}, };
-}
-
-sub get_ticket {
- my $p = shift;
- my($context, $session, $custnum) = _custoragent_session_custnum($p);
- return { 'error' => $session } if $context eq 'error';
-
- warn "$me get_ticket: initializing ticket system\n" if $DEBUG;
- FS::TicketSystem->init();
-
- if(length($p->{'reply'})) {
-# currently this allows anyone to correspond on any ticket as fs_selfservice
-# probably bad...
- my @err_or_res = FS::TicketSystem->correspond_ticket(
- '', #create RT session based on FS CurrentUser (fs_selfservice)
- 'ticket_id' => $p->{'ticket_id'},
- 'content' => $p->{'reply'},
- );
-
- return { 'error' => 'unable to reply to ticket' }
- unless ( $err_or_res[0] != 0 && defined $err_or_res[2] );
- }
-
- warn "$me get_ticket: getting ticket\n" if $DEBUG;
- my $err_or_ticket = FS::TicketSystem->get_ticket(
- '', #create RT session based on FS CurrentUser (fs_selfservice)
- 'ticket_id' => $p->{'ticket_id'},
- );
-
- if ( ref($err_or_ticket) ) {
-
-# since we're bypassing the RT security/permissions model by always using
-# fs_selfservice as the RT user (as opposed to a requestor, which we
-# can't do since we want all tickets linked to a cust), we check below whether
-# the requested ticket was actually linked to this customer
- my @custs = @{$err_or_ticket->{'custs'}};
- my @txns = @{$err_or_ticket->{'txns'}};
- my @filtered_txns;
-
- return { 'error' => 'no customer' } unless ( $custnum && scalar(@custs) );
-
- return { 'error' => 'invalid ticket requested' }
- unless grep($_ eq $custnum, @custs);
-
- foreach my $txn ( @txns ) {
- push @filtered_txns, $txn
- if ($txn->{'type'} eq 'EmailRecord'
- || $txn->{'type'} eq 'Correspond'
- || $txn->{'type'} eq 'Create');
- }
-
- warn "$me get_ticket: sucessful: \n"
- if $DEBUG;
- return { 'error' => '',
- 'transactions' => \@filtered_txns,
- 'ticket_id' => $p->{'ticket_id'},
- };
- } else {
- warn "$me create_ticket: unsucessful: $err_or_ticket\n"
- if $DEBUG;
- return { 'error' => $err_or_ticket };
- }
-}
-
-
-#--
-
-sub _custoragent_session_custnum {
- my $p = shift;
-
- my($context, $session, $custnum);
- if ( $p->{'session_id'} ) {
-
- $context = 'customer';
- $session = _cache->get($p->{'session_id'})
- or return ( 'error' => "Can't resume session" ); #better error message
- $custnum = $session->{'custnum'};
-
- } elsif ( $p->{'agent_session_id'} ) {
-
- $context = 'agent';
- my $agent_cache = new FS::ClientAPI_SessionCache( {
- 'namespace' => 'FS::ClientAPI::Agent',
- } );
- $session = $agent_cache->get($p->{'agent_session_id'})
- or return ( 'error' => "Can't resume session" ); #better error message
- $custnum = $p->{'custnum'};
-
- } else {
- $context = 'error';
- return ( 'error' => "Can't resume session" ); #better error message
- }
-
- ($context, $session, $custnum);
-
-}
-
-1;
-
diff --git a/FS/FS/ClientAPI/PrepaidPhone.pm b/FS/FS/ClientAPI/PrepaidPhone.pm
deleted file mode 100644
index 00bc0ff..0000000
--- a/FS/FS/ClientAPI/PrepaidPhone.pm
+++ /dev/null
@@ -1,253 +0,0 @@
-package FS::ClientAPI::PrepaidPhone;
-
-use strict;
-use vars qw($DEBUG $me);
-use FS::Record qw(qsearchs);
-use FS::rate;
-use FS::svc_phone;
-
-$DEBUG = 0;
-$me = '[FS::ClientAPI::PrepaidPhone]';
-
-#TODO:
-# - shared-secret auth? (set a conf value)
-
-=item call_time HASHREF
-
-HASHREF contains the following parameters:
-
-=over 4
-
-=item src
-
-Source number (with countrycode)
-
-=item dst
-
-Destination number (with countrycode)
-
-=back
-
-Always returns a hashref. If there is an error, the hashref contains a single
-"error" key with the error message as a value. Otherwise, returns a hashref
-with the following keys:
-
-=over 4
-
-=item custnum
-
-Empty if no customer is found associated with the number, customer number
-otherwise.
-
-=item seconds
-
-Number of seconds remaining for a call to destination number
-
-=back
-
-=cut
-
-sub call_time {
- my $packet = shift;
-
- my $src = $packet->{'src'};
- my $dst = $packet->{'dst'};
-
- my $chargeto;
- my $rateby;
- #my $conf = new FS::Conf;
- #if ( #XXX toll-free? collect?
- # $phonenum = $dst;
- #} else { #use the src to find the customer
- $chargeto = $src;
- $rateby = $dst;
- #}
-
- my( $countrycode, $phonenum );
- if ( $chargeto #an interesting regex to parse out 1&2 digit countrycodes
- =~ /^(2[078]|3[0-469]|4[013-9]|5[1-8]|6[0-6]|7|8[1-469]|9[0-58])(\d*)$/
- || $chargeto =~ /^(\d{3})(\d*)$/
- )
- {
- $countrycode = $1;
- $phonenum = $2;
- } else {
- return { 'error' => "unparsable billing number: $chargeto" };
- }
-
-
- my $svc_phone = qsearchs('svc_phone', { 'countrycode' => $countrycode,
- 'phonenum' => $phonenum,
- }
- );
-
- unless ( $svc_phone ) {
- return { 'error' => "can't find customer for +$countrycode $phonenum" };
-# return { 'custnum' => '',
-# 'seconds' => 0,
-# #'balance' => 0,
-# };
- };
-
- my $cust_pkg = $svc_phone->cust_svc->cust_pkg;
- my $cust_main = $cust_pkg->cust_main;
-
- my $part_pkg = $cust_pkg->part_pkg;
- my @part_pkg = ( $part_pkg, map $_->dst_pkg, $part_pkg->bill_part_pkg_link );
- #XXX uuh, behavior indeterminate if you have more than one voip_cdr+prefix
- #add-on, i guess.
- warn "$me ". scalar(@part_pkg). ': '.
- join('/', map { $_->plan. $_->option('rating_method') } @part_pkg )
- if $DEBUG;
- @part_pkg =
- grep { $_->plan eq 'voip_cdr' && $_->option('rating_method') eq 'prefix' }
- @part_pkg;
-
- my %return = (
- 'custnum' => $cust_pkg->custnum,
- #'balance' => $cust_pkg->cust_main->balance,
- );
-
- warn "$me: ". scalar(@part_pkg). ': '.
- join('/', map { $_->plan. $_->option('rating_method') } @part_pkg )
- if $DEBUG;
- return \%return unless @part_pkg;
-
- warn "$me searching for rate ". $part_pkg[0]->option('ratenum')
- if $DEBUG;
-
- my $rate = qsearchs('rate', { 'ratenum'=>$part_pkg[0]->option('ratenum') } );
-
- unless ( $rate ) {
- my $error = 'ratenum '. $part_pkg[0]->option('ratenum'). ' not found';
- warn "$me $error"
- if $DEBUG;
- return { 'error'=>$error };
- }
-
- warn "$me found rate ". $rate->ratenum
- if $DEBUG;
-
- #rate the call and arrive at a max # of seconds for the customer's balance
-
- my( $rate_countrycode, $rate_phonenum );
- if ( $rateby #this is an interesting regex to parse out 1&2 digit countrycodes
- =~ /^(2[078]|3[0-469]|4[013-9]|5[1-8]|6[0-6]|7|8[1-469]|9[0-58])(\d*)$/
- || $rateby =~ /^(\d{3})(\d*)$/
- )
- {
- $rate_countrycode = $1;
- $rate_phonenum = $2;
- } else {
- return { 'error' => "unparsable rating number: $rateby" };
- }
-
- my $rate_detail = $rate->dest_detail({ 'countrycode' => $rate_countrycode,
- 'phonenum' => $rate_phonenum,
- });
- unless ( $rate_detail ) {
- return { 'error'=>"can't find rate for +$rate_countrycode $rate_phonenum"};
- }
-
- unless ( $rate_detail->min_charge > 0 ) {
- #XXX no charge?? return lots of seconds, a default, 0 or what?
- #return { 'error' => '0 rate for +$rate_countrycode $rate_phonenum; prepaid service not available" };
- #customer wants no default for now# $return{'seconds'} = 1800; #half hour?!
- return \%return;
- }
-
- #XXX granularity? included minutes? another day...
- if ( $cust_main->balance >= 0 ) {
- return { 'error'=>'No balance' };
- } else {
- $return{'seconds'} = int(60 * abs($cust_main->balance) / $rate_detail->min_charge);
- }
-
- warn "$me returning seconds: ". $return{'seconds'};
-
- return \%return;
-
-}
-
-=item call_time_nanpa
-
-Like I<call_time>, except countrycode 1 is not required, and all other
-countrycodes must be prefixed with 011.
-
-=cut
-
-# - everything is assumed to be countrycode 1 unless it starts with 011(ccode)
-sub call_time_nanpa {
- my $packet = shift;
-
- foreach (qw( src dst )) {
- if ( $packet->{$_} =~ /^011(\d+)/ ) {
- $packet->{$_} = $1;
- } elsif ( $packet->{$_} !~ /^1/ ) {
- $packet->{$_} = '1'.$packet->{$_};
- }
- }
-
- call_time($packet);
-
-}
-
-=item phonenum_balance HASHREF
-
-HASHREF contains the following parameters:
-
-=over 4
-
-=item countrycode
-
-Optional countrycode. Defaults to 1.
-
-=item phonenum
-
-Phone number.
-
-=back
-
-Always returns a hashref. If there is an error, the hashref contains a single
-"error" key with the error message as a value. Otherwise, returns a hashref
-with the following keys:
-
-=over 4
-
-=item custnum
-
-Empty if no customer is found associated with the number, customer number
-otherwise.
-
-=item balance
-
-Customer balance.
-
-=back
-
-=cut
-
-sub phonenum_balance {
- my $packet = shift;
-
- my $svc_phone = qsearchs('svc_phone', {
- 'countrycode' => ( $packet->{'countrycode'} || 1 ),
- 'phonenum' => $packet->{'phonenum'},
- });
-
- unless ( $svc_phone ) {
- return { 'custnum' => '',
- 'balance' => 0,
- };
- };
-
- my $cust_pkg = $svc_phone->cust_svc->cust_pkg;
-
- return {
- 'custnum' => $cust_pkg->custnum,
- 'balance' => $cust_pkg->cust_main->balance,
- };
-
-}
-
-1;
diff --git a/FS/FS/ClientAPI/SGNG.pm b/FS/FS/ClientAPI/SGNG.pm
deleted file mode 100644
index 7f784dc..0000000
--- a/FS/FS/ClientAPI/SGNG.pm
+++ /dev/null
@@ -1,277 +0,0 @@
-#this stuff is SG-specific (i.e. multi-customer company username hack)
-
-package FS::ClientAPI::SGNG;
-
-use strict;
-use vars qw( $cache $DEBUG );
-use Time::Local qw(timelocal timelocal_nocheck);
-use Business::CreditCard;
-use FS::Record qw( qsearch qsearchs );
-use FS::Conf;
-use FS::cust_main;
-use FS::cust_pkg;
-use FS::ClientAPI::MyAccount; #qw( payment_info process_payment )
-
-$DEBUG = 0;
-
-sub _cache {
- $cache ||= new FS::ClientAPI_SessionCache( {
- 'namespace' => 'FS::ClientAPI::MyAccount', #yes, share session_ids
- } );
-}
-
-sub ping {
- #my $p = shift;
-
- return { 'pong' => '1' };
-
-}
-
-#this might almost be general-purpose
-sub decompify_pkgs {
- my $p = shift;
-
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- return { 'error' => 'Not a complimentary customer' }
- unless $cust_main->payby eq 'COMP';
-
- my $paydate =
- $cust_main->paydate =~ /^\S+$/ ? $cust_main->paydate : '2037-12-31';
-
- my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
-
- my $date = timelocal(0,0,0,$payday,--$paymonth,$payyear);
-
- foreach my $cust_pkg (
- qsearch({ 'table' => 'cust_pkg',
- 'hashref' => { 'custnum' => $custnum,
- 'bill' => '',
- },
- 'extra_sql' => ' AND '. FS::cust_pkg->active_sql,
- })
- ) {
- $cust_pkg->set('bill', $date);
- my $error = $cust_pkg->replace;
- return { 'error' => $error } if $error;
- }
-
- return { 'error' => '' };
-
-}
-
-#find old payment info
-# (should work just like MyAccount::payment_info, except returns previous info
-# too)
-# definitly sg-specific, no one else stores past customer records like this
-sub previous_payment_info {
- my $p = shift;
-
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $payment_info = FS::ClientAPI::MyAccount::payment_info($p);
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- #?
- return $payment_info if $cust_main->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/;
-
- foreach my $prev_cust_main (
- reverse _previous_cust_main( 'custnum' => $custnum,
- 'username' => $cust_main->company,
- 'with_payments' => 1,
- )
- ) {
-
- next unless $prev_cust_main->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/;
-
- if ( $prev_cust_main->payby =~ /^(CARD|DCRD)$/ ) {
-
- #card expired?
- my ($payyear,$paymonth,$payday) = split (/-/, $cust_main->paydate);
-
- my $expdate = timelocal_nocheck(0,0,0,1,$paymonth,$payyear);
-
- next if $expdate < time;
-
- } elsif ( $prev_cust_main->payby =~ /^(CHEK|DCHK)$/ ) {
-
- #any check? or just skip these in favor of cards?
-
- }
-
- return { %$payment_info,
- #$prev_cust_main->payment_info
- _cust_main_payment_info( $prev_cust_main ),
- 'previous_custnum' => $prev_cust_main->custnum,
- };
-
- }
-
- #still nothing? return an error?
- return $payment_info;
-
-}
-
-#this is really FS::cust_main::payment_info, but here for now
-sub _cust_main_payment_info {
- my $self = shift;
-
- my %return = ();
-
- $return{balance} = $self->balance;
-
- $return{payname} = $self->payname
- || ( $self->first. ' '. $self->get('last') );
-
- $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
-
- $return{payby} = $self->payby;
- $return{stateid_state} = $self->stateid_state;
-
- if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
- $return{card_type} = cardtype($self->payinfo);
- $return{payinfo} = $self->paymask;
-
- @return{'month', 'year'} = $self->paydate_monthyear;
-
- }
-
- if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
- my ($payinfo1, $payinfo2) = split '@', $self->paymask;
- $return{payinfo1} = $payinfo1;
- $return{payinfo2} = $payinfo2;
- $return{paytype} = $self->paytype;
- $return{paystate} = $self->paystate;
-
- }
-
- #doubleclick protection
- my $_date = time;
- $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
-
- %return;
-
-}
-
-#find old cust_main records (with payments)
-sub _previous_cust_main {
-
- #safety check! return nothing unless we're enabled explicitly
- return () unless FS::Conf->new->exists('sg-multicustomer_hack');
-
- my %opt = @_;
- my $custnum = $opt{'custnum'};
- my $username = $opt{'username'};
-
- my %search = ();
- if ( $opt{'with_payments'} ) {
- $search{'extra_sql'} =
- ' AND 0 < ( SELECT COUNT(*) FROM cust_pay
- WHERE cust_pay.custnum = cust_main.custnum
- )
- ';
- }
-
- qsearch( {
- 'table' => 'cust_main',
- 'hashref' => { 'company' => { op => 'ILIKE', value => $opt{'username'} },
- 'custnum' => { op => '!=', value => $opt{'custnum'} },
- },
- 'order_by' => 'ORDER BY custnum',
- %search,
- } );
-
-}
-
-#since we could be passing masked old CC data, need to look that up and
-#replace it (like regular process_payment does) w/info from old customer record
-sub previous_process_payment {
- my $p = shift;
-
- return FS::ClientAPI::MyAccount::process_payment($p)
- unless $p->{'previous_custnum'}
- && ( ( $p->{'payby'} =~ /^(CARD|DCRD)$/ && $p->{'payinfo'} =~ /x/i )
- || ( $p->{'payby'} =~ /^(CHEK|DCHK)$/ && $p->{'payinfo1'} =~ /x/i )
- );
-
- my $session = _cache->get($p->{'session_id'})
- or return { 'error' => "Can't resume session" }; #better error message
-
- my $custnum = $session->{'custnum'};
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
- or return { 'error' => "unknown custnum $custnum" };
-
- #make sure this is really a previous custnum of this customer
- my @previous_cust_main =
- grep { $_->custnum == $p->{'previous_custnum'} }
- _previous_cust_main( 'custnum' => $custnum,
- 'username' => $cust_main->company,
- 'with_payments' => 1,
- );
-
- my $previous_cust_main = $previous_cust_main[0];
-
- #causes problems with old data w/old masking method
- #if $previous_cust_main->paymask eq $payinfo;
-
- if ( $p->{'payby'} =~ /^(CHEK|DCHK)$/ && $p->{'payinfo1'} =~ /x/i ) {
- ( $p->{'payinfo1'}, $p->{'payinfo2'} ) =
- split('@', $previous_cust_main->payinfo);
- } elsif ( $p->{'payby'} =~ /^(CARD|DCRD)$/ && $p->{'payinfo'} =~ /x/i ) {
- $p->{'payinfo'} = $previous_cust_main->payinfo;
- }
-
- FS::ClientAPI::MyAccount::process_payment($p);
-
-}
-
-sub previous_payment_info_renew_info {
- my $p = shift;
- my $renew_info = renew_info($p);
- my $payment_info = previous_payment_info($p);
- return { %$renew_info,
- %$payment_info,
- };
-}
-
-sub previous_process_payment_order_pkg {
- my $p = shift;
-
- my $hr = previous_process_payment($p);
- return $hr if $hr->{'error'};
-
- order_pkg($p);
-}
-
-sub previous_process_payment_change_pkg {
- my $p = shift;
-
- my $hr = previous_process_payment($p);
- return $hr if $hr->{'error'};
-
- change_pkg($p);
-}
-
-sub previous_process_payment_order_renew {
- my $p = shift;
-
- my $hr = previous_process_payment($p);
- return $hr if $hr->{'error'};
-
- order_renew($p);
-}
-
-1;
-
diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm
deleted file mode 100644
index 488692f..0000000
--- a/FS/FS/ClientAPI/Signup.pm
+++ /dev/null
@@ -1,888 +0,0 @@
-package FS::ClientAPI::Signup;
-
-use strict;
-use vars qw( $DEBUG $me );
-use Data::Dumper;
-use Tie::RefHash;
-use FS::Conf;
-use FS::Record qw(qsearch qsearchs dbdef);
-use FS::CGI qw(popurl);
-use FS::Msgcat qw(gettext);
-use FS::Misc qw(card_types);
-use FS::ClientAPI_SessionCache;
-use FS::agent;
-use FS::cust_main_county;
-use FS::part_pkg;
-use FS::svc_acct_pop;
-use FS::cust_main;
-use FS::cust_pkg;
-use FS::svc_acct;
-use FS::svc_phone;
-use FS::acct_snarf;
-use FS::queue;
-use FS::reg_code;
-use FS::payby;
-
-$DEBUG = 0;
-$me = '[FS::ClientAPI::Signup]';
-
-sub clear_cache {
- warn "$me clear_cache called\n" if $DEBUG;
- my $cache = new FS::ClientAPI_SessionCache( {
- 'namespace' => 'FS::ClientAPI::Signup',
- } );
- $cache->clear();
- return {};
-}
-
-sub signup_info {
- my $packet = shift;
-
- warn "$me signup_info called on $packet\n" if $DEBUG;
-
- my $conf = new FS::Conf;
- my $svc_x = $conf->config('signup_server-service') || 'svc_acct';
-
- my $cache = new FS::ClientAPI_SessionCache( {
- 'namespace' => 'FS::ClientAPI::Signup',
- } );
- my $signup_info_cache = $cache->get('signup_info_cache');
-
- if ( $signup_info_cache ) {
-
- warn "$me loading cached signup info\n" if $DEBUG > 1;
-
- } else {
-
- warn "$me populating signup info cache\n" if $DEBUG > 1;
-
- my $agentnum2part_pkg =
- {
- map {
- my $agent = $_;
- my $href = $agent->pkgpart_hashref;
- $agent->agentnum =>
- [
- map { { 'payby' => [ $_->payby ],
- 'freq_pretty' => $_->freq_pretty,
- 'options' => { $_->options },
- %{$_->hashref}
- } }
- grep { $_->svcpart($svc_x)
- && ( $href->{ $_->pkgpart }
- || ( $_->agentnum
- && $_->agentnum == $agent->agentnum
- )
- )
- }
- qsearch( 'part_pkg', { 'disabled' => '' } )
- ];
- } qsearch('agent', { 'disabled' => '' })
- };
-
- my $msgcat = { map { $_=>gettext($_) }
- qw( passwords_dont_match invalid_card unknown_card_type
- not_a empty_password illegal_or_empty_text )
- };
- warn "msgcat: ". Dumper($msgcat). "\n" if $DEBUG > 2;
-
- my $label = { map { $_ => FS::Msgcat::_gettext($_) }
- qw( stateid stateid_state )
- };
- warn "label: ". Dumper($label). "\n" if $DEBUG > 2;
-
- my @agent_fields = qw( agentnum agent );
-
- my @bools = qw( emailinvoiceonly security_phrase );
-
- my @signup_bools = qw( no_company recommend_daytime recommend_email );
-
- my @signup_server_scalars = qw( default_pkgpart default_svcpart );
-
- my @selfservice_textareas = qw( head body_header body_footer );
-
- my @selfservice_scalars = 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
- );
-
- #XXX my @selfservice_bools = qw(
- # menu_skipblanks menu_skipheadings menu_nounderline
- #);
-
- #my $selfservice_binaries = qw(
- # title_left_image title_right_image
- # menu_top_image menu_body_image menu_bottom_image
- #);
-
- $signup_info_cache = {
-
- 'cust_main_county' => [ map $_->hashref,
- qsearch('cust_main_county', {} )
- ],
-
- 'agent' => [ map { my $agent = $_;
- +{ map { $_ => $agent->get($_) } @agent_fields }
- }
- qsearch('agent', { 'disabled' => '' } )
- ],
-
- 'part_referral' => [ map $_->hashref,
- qsearch('part_referral', { 'disabled' => '' } )
- ],
-
- 'agentnum2part_pkg' => $agentnum2part_pkg,
-
- 'svc_acct_pop' => [ map $_->hashref, qsearch('svc_acct_pop',{} ) ],
-
- 'emailinvoiceonly' => $conf->exists('emailinvoiceonly'),
-
- 'security_phrase' => $conf->exists('security_phrase'),
-
- 'nomadix' => $conf->exists('signup_server-nomadix'),
-
- 'payby' => [ $conf->config('signup_server-payby') ],
-
- 'payby_longname' => [ map { FS::payby->longname($_) }
- $conf->config('signup_server-payby') ],
-
- 'card_types' => card_types(),
-
- ( map { $_ => $conf->exists("signup-$_") } @signup_bools ),
-
- ( map { $_ => scalar($conf->config("signup_server-$_")) }
- @signup_server_scalars
- ),
-
- ( map { $_ => join("\n", $conf->config("selfservice-$_")) }
- @selfservice_textareas
- ),
- ( map { $_ => scalar($conf->config("selfservice-$_")) }
- @selfservice_scalars
- ),
-
- #( map { $_ => scalar($conf->config_binary("selfservice-$_")) }
- # @selfservice_binaries
- #),
-
- 'agentnum2part_pkg' => $agentnum2part_pkg,
- 'svc_acct_pop' => [ map $_->hashref, qsearch('svc_acct_pop',{} ) ],
- 'nomadix' => $conf->exists('signup_server-nomadix'),
- 'payby' => [ $conf->config('signup_server-payby') ],
- 'card_types' => card_types(),
- 'paytypes' => [ @FS::cust_main::paytypes ],
- 'cvv_enabled' => 1,
- 'stateid_enabled' => $conf->exists('show_stateid'),
- 'paystate_enabled' => $conf->exists('show_bankstate'),
- 'ship_enabled' => 1,
- 'msgcat' => $msgcat,
- 'label' => $label,
- 'statedefault' => scalar($conf->config('statedefault')) || 'CA',
- 'countrydefault' => scalar($conf->config('countrydefault')) || 'US',
- 'refnum' => scalar($conf->config('signup_server-default_refnum')),
- 'signup_service' => $svc_x,
- 'company_name' => scalar($conf->config('company_name')),
- #per-agent?
- 'agent_ship_address' => scalar($conf->exists('agent-ship_address')),
- 'require_phone' => scalar($conf->exists('cust_main-require_phone')),
- 'logo' => scalar($conf->config_binary('logo.png')),
-
- };
-
- $cache->set('signup_info_cache', $signup_info_cache);
-
- }
-
- my $signup_info = { %$signup_info_cache };
- warn "$me signup info loaded\n" if $DEBUG > 1;
- warn Dumper($signup_info). "\n" if $DEBUG > 2;
-
- my @addl = qw( signup_server-classnum2 signup_server-classnum3 );
-
- if ( grep { $conf->exists($_) } @addl ) {
-
- $signup_info->{optional_packages} = [];
-
- foreach my $addl ( @addl ) {
-
- warn "$me adding optional package info\n" if $DEBUG > 1;
-
- my $classnum = $conf->config($addl) or next;
-
- my @pkgs = map { {
- 'freq_pretty' => $_->freq_pretty,
- 'options' => { $_->options },
- %{ $_->hashref }
- };
- }
- qsearch( 'part_pkg', { classnum => $classnum } );
-
- push @{$signup_info->{optional_packages}}, \@pkgs;
-
- warn "$me done adding opt. package info for $classnum\n" if $DEBUG > 1;
-
- }
-
- }
-
- my $agentnum = $packet->{'agentnum'}
- || $conf->config('signup_server-default_agentnum');
- $agentnum =~ /^(\d*)$/ or die "illegal agentnum";
- $agentnum = $1;
-
- my $session = '';
- if ( exists $packet->{'session_id'} ) {
-
- warn "$me loading agent session\n" if $DEBUG > 1;
- my $cache = new FS::ClientAPI_SessionCache( {
- 'namespace' => 'FS::ClientAPI::Agent',
- } );
- $session = $cache->get($packet->{'session_id'});
- if ( $session ) {
- $agentnum = $session->{'agentnum'};
- } else {
- return { 'error' => "Can't resume session" }; #better error message
- }
- warn "$me done loading agent session\n" if $DEBUG > 1;
-
- } elsif ( exists $packet->{'customer_session_id'} ) {
-
- warn "$me loading customer session\n" if $DEBUG > 1;
- my $cache = new FS::ClientAPI_SessionCache( {
- 'namespace' => 'FS::ClientAPI::MyAccount',
- } );
- $session = $cache->get($packet->{'customer_session_id'});
- if ( $session ) {
- my $custnum = $session->{'custnum'};
- my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum });
- return { 'error' => "Can't find your customer record" } unless $cust_main;
- $agentnum = $cust_main->agentnum;
- } else {
- return { 'error' => "Can't resume session" }; #better error message
- }
- warn "$me done loading customer session\n" if $DEBUG > 1;
-
- }
-
- $signup_info->{'part_pkg'} = [];
-
- if ( $packet->{'reg_code'} ) {
-
- warn "$me setting package list via reg_code\n" if $DEBUG > 1;
-
- $signup_info->{'part_pkg'} =
- [ map { { 'payby' => [ $_->payby ],
- 'freq_pretty' => $_->freq_pretty,
- 'options' => { $_->options },
- %{$_->hashref}
- };
- }
- grep { $_->svcpart($svc_x) }
- map { $_->part_pkg }
- qsearchs( 'reg_code', { 'code' => $packet->{'reg_code'},
- 'agentnum' => $agentnum, } )
-
- ];
-
- $signup_info->{'error'} = 'Unknown registration code'
- unless @{ $signup_info->{'part_pkg'} };
-
- warn "$me done setting package list via reg_code\n" if $DEBUG > 1;
-
- } elsif ( $packet->{'promo_code'} ) {
-
- warn "$me setting package list via promo_code\n" if $DEBUG > 1;
-
- $signup_info->{'part_pkg'} =
- [ map { { 'payby' => [ $_->payby ],
- 'freq_pretty' => $_->freq_pretty,
- 'options' => { $_->options },
- %{$_->hashref}
- } }
- grep { $_->svcpart($svc_x) }
- qsearch( 'part_pkg', { 'promo_code' => {
- op=>'ILIKE',
- value=>$packet->{'promo_code'}
- },
- 'disabled' => '', } )
- ];
-
- $signup_info->{'error'} = 'Unknown promotional code'
- unless @{ $signup_info->{'part_pkg'} };
-
- warn "$me done setting package list via promo_code\n" if $DEBUG > 1;
- }
-
- if ( $agentnum ) {
-
- warn "$me setting agent-specific payment flag\n" if $DEBUG > 1;
- my $agent = qsearchs('agent', { 'agentnum' => $agentnum } );
- warn "$me has agent $agent\n" if $DEBUG > 1;
- if ( $agent ) { #else complain loudly?
- $signup_info->{'hide_payment_fields'} = [];
- my $gatewaynum = $conf->config('selfservice-payment_gateway');
- if ( $gatewaynum ) {
- my $pg = qsearchs('payment_gateway', { gatewaynum => $gatewaynum });
- die "configured gatewaynum $gatewaynum not found!" if !$pg;
- my $hide = $pg->gateway_namespace eq 'Business::OnlineThirdPartyPayment';
- $signup_info->{'hide_payment_fields'} = [
- map { $hide } @{$signup_info->{'payby'}}
- ];
- }
- else {
- foreach my $payby (@{$signup_info->{payby}}) {
- warn "$me checking $payby payment fields\n" if $DEBUG > 1;
- my $hide = 0;
- if ( FS::payby->realtime($payby) ) {
- my $payment_gateway =
- $agent->payment_gateway( 'method' => FS::payby->payby2bop($payby),
- 'nofatal' => 1,
- );
- if ( $payment_gateway
- && $payment_gateway->gateway_namespace
- eq 'Business::OnlineThirdPartyPayment'
- ) {
- warn "$me hiding $payby payment fields\n" if $DEBUG > 1;
- $hide = 1;
- }
- }
- push @{$signup_info->{'hide_payment_fields'}}, $hide;
- } # foreach $payby
- }
- }
- warn "$me done setting agent-specific payment flag\n" if $DEBUG > 1;
-
- warn "$me setting agent-specific package list\n" if $DEBUG > 1;
- $signup_info->{'part_pkg'} = $signup_info->{'agentnum2part_pkg'}{$agentnum}
- unless @{ $signup_info->{'part_pkg'} };
- warn "$me done setting agent-specific package list\n" if $DEBUG > 1;
-
- warn "$me setting agent-specific adv. source list\n" if $DEBUG > 1;
- $signup_info->{'part_referral'} =
- [
- map { $_->hashref }
- qsearch( {
- 'table' => 'part_referral',
- 'hashref' => { 'disabled' => '' },
- 'extra_sql' => "AND ( agentnum = $agentnum ".
- " OR agentnum IS NULL ) ",
- },
- )
- ];
- warn "$me done setting agent-specific adv. source list\n" if $DEBUG > 1;
-
- $signup_info->{'agent_name'} = $agent->agent;
-
- $signup_info->{'company_name'} = $conf->config('company_name', $agentnum);
-
- if ( $signup_info->{'agent_ship_address'} && $agent->agent_custnum ) {
- my $cust_main = $agent->agent_cust_main;
- my $prefix = length($cust_main->ship_last) ? 'ship_' : '';
- $signup_info->{"ship_$_"} = $cust_main->get("$prefix$_")
- foreach qw( address1 city county state zip country );
- }
-
- #some of the above could probably be cached, too
-
- my $signup_info_cache_agent = $cache->get("signup_info_cache_agent$agentnum");
-
- if ( $signup_info_cache_agent ) {
-
- warn "$me loading cached signup info for agentnum $agentnum\n"
- if $DEBUG > 1;
-
- } else {
-
- warn "$me populating signup info cache for agentnum $agentnum\n"
- if $DEBUG > 1;
-
- $signup_info_cache_agent = {
- #( map { $_ => scalar( $conf->config($_, $agentnum) ) }
- # qw( company_name ) ),
- ( map { $_ => scalar( $conf->config("selfservice-$_", $agentnum ) ) }
- qw( body_bgcolor box_bgcolor menu_bgcolor ) ),
- ( map { $_ => join("\n", $conf->config("selfservice-$_", $agentnum ) ) }
- qw( head body_header body_footer ) ),
- };
-
- $cache->set("signup_info_cache_agent$agentnum", $signup_info_cache_agent);
-
- }
-
- $signup_info->{$_} = $signup_info_cache_agent->{$_}
- foreach keys %$signup_info_cache_agent;
-
- }
- # else {
- # delete $signup_info->{'part_pkg'};
- #}
-
- warn "$me sorting package list\n" if $DEBUG > 1;
- $signup_info->{'part_pkg'} = [ sort { $a->{pkg} cmp $b->{pkg} } # case?
- @{ $signup_info->{'part_pkg'} }
- ];
- warn "$me done sorting package list\n" if $DEBUG > 1;
-
- if ( exists $packet->{'session_id'} ) {
- my $agent_signup_info = { %$signup_info };
- delete $agent_signup_info->{agentnum2part_pkg};
- $agent_signup_info->{'agent'} = $session->{'agent'};
- return $agent_signup_info;
- }
- elsif ( exists $packet->{'keys'} ) {
- my @keys = @{ $packet->{'keys'} };
- return { map { $_ => $signup_info->{$_} } @keys };
- }
- else {
- return $signup_info;
- }
-
-}
-
-sub domain_select_hash {
- my $packet = shift;
-
- my $response = {};
-
- if ($packet->{pkgpart}) {
- my $part_pkg = qsearchs('part_pkg' => { 'pkgpart' => $packet->{pkgpart} } );
- #$packet->{svcpart} = $part_pkg->svcpart('svc_acct')
- $packet->{svcpart} = $part_pkg->svcpart
- if $part_pkg;
- }
-
- if ($packet->{svcpart}) {
- my $part_svc = qsearchs('part_svc' => { 'svcpart' => $packet->{svcpart} } );
- $response->{'domsvc'} = $part_svc->part_svc_column('domsvc')->columnvalue
- if ($part_svc && $part_svc->part_svc_column('domsvc')->columnflag eq 'D');
- }
-
- $response->{'domains'}
- = { domain_select_hash FS::svc_acct( map { $_ => $packet->{$_} }
- qw(svcpart pkgnum)
- ) };
-
- $response;
-}
-
-sub new_customer {
- my $packet = shift;
-
- my $conf = new FS::Conf;
- my $svc_x = $conf->config('signup_server-service') || 'svc_acct';
-
- if ( $svc_x eq 'svc_acct' ) {
-
- #things that aren't necessary in base class, but are for signup server
- #return "Passwords don't match"
- # if $hashref->{'_password'} ne $hashref->{'_password2'}
- return { 'error' => gettext('empty_password') }
- unless length($packet->{'_password'});
- # a bit inefficient for large numbers of pops
- return { 'error' => gettext('no_access_number_selected') }
- unless $packet->{'popnum'} || !scalar(qsearch('svc_acct_pop',{} ));
-
- }
- elsif ( $svc_x eq 'svc_pbx' ) {
- #possibly some validation will be needed
- }
-
- my $agentnum;
- if ( exists $packet->{'session_id'} ) {
- my $cache = new FS::ClientAPI_SessionCache( {
- 'namespace' => 'FS::ClientAPI::Agent',
- } );
- my $session = $cache->get($packet->{'session_id'});
- if ( $session ) {
- $agentnum = $session->{'agentnum'};
- } else {
- return { 'error' => "Can't resume session" }; #better error message
- }
- } else {
- $agentnum = $packet->{agentnum}
- || $conf->config('signup_server-default_agentnum');
- }
-
- #shares some stuff with htdocs/edit/process/cust_main.cgi... take any
- # common that are still here and library them.
- my $cust_main = new FS::cust_main ( {
- #'custnum' => '',
- 'agentnum' => $agentnum,
- 'refnum' => $packet->{refnum}
- || $conf->config('signup_server-default_refnum'),
-
- map { $_ => $packet->{$_} } qw(
-
- last first ss company address1 address2
- city county state zip country
- daytime night fax stateid stateid_state
-
- ship_last ship_first ship_ss ship_company ship_address1 ship_address2
- ship_city ship_county ship_state ship_zip ship_country
- ship_daytime ship_night ship_fax
-
- payby
- payinfo paycvv paydate payname paystate paytype
- paystart_month paystart_year payissue
- payip
-
- referral_custnum comments
- )
-
- } );
-
- my $agent = qsearchs('agent', { 'agentnum' => $agentnum } );
- if ( $conf->exists('agent_ship_address') && $agent->agent_custnum ) {
- my $agent_cust_main = $agent->agent_cust_main;
- my $prefix = length($agent_cust_main->ship_last) ? 'ship_' : '';
- $cust_main->set("ship_$_", $agent_cust_main->get("$prefix$_") )
- foreach qw( address1 city county state zip country );
-
- $cust_main->set("ship_$_", $cust_main->get($_))
- foreach qw( last first );
-
- }
-
-
- return { 'error' => "Illegal payment type" }
- unless grep { $_ eq $packet->{'payby'} }
- $conf->config('signup_server-payby');
-
- if (FS::payby->realtime($packet->{payby})) {
- my $payby = $packet->{payby};
-
- my $agent = qsearchs('agent', { 'agentnum' => $agentnum });
- return { 'error' => "Unknown reseller" }
- unless $agent;
-
- my $gw;
- my $gatewaynum = $conf->config('selfservice-payment_gateway');
- if ( $gatewaynum ) {
- $gw = qsearchs('payment_gateway', { gatewaynum => $gatewaynum });
- die "configured gatewaynum $gatewaynum not found!" if !$gw;
- }
- else {
- $gw = $agent->payment_gateway( 'method' => FS::payby->payby2bop($payby),
- 'nofatal' => 1,
- );
- }
-
- $cust_main->payby('BILL') # MCRD better?
- if $gw && $gw->gateway_namespace eq 'Business::OnlineThirdPartyPayment';
- }
-
- $cust_main->payinfo($cust_main->daytime)
- if $cust_main->payby eq 'LECB' && ! $cust_main->payinfo;
-
- my @invoicing_list = $packet->{'invoicing_list'}
- ? split( /\s*\,\s*/, $packet->{'invoicing_list'} )
- : ();
-
- $packet->{'pkgpart'} =~ /^(\d+)$/ or '' =~ /^()$/;
- my $pkgpart = $1;
- return { 'error' => 'Please select a package' } unless $pkgpart; #msgcat
-
- my $part_pkg =
- qsearchs( 'part_pkg', { 'pkgpart' => $pkgpart } )
- or return { 'error' => "WARNING: unknown pkgpart: $pkgpart" };
- my $svcpart = $part_pkg->svcpart($svc_x);
-
- my $reg_code = '';
- if ( $packet->{'reg_code'} ) {
- $reg_code = qsearchs( 'reg_code', { 'code' => $packet->{'reg_code'},
- 'agentnum' => $agentnum, } )
- or return { 'error' => 'Unknown registration code' };
- }
-
- my $cust_pkg = new FS::cust_pkg ( {
- #later#'custnum' => $custnum,
- 'pkgpart' => $packet->{'pkgpart'},
- 'promo_code' => $packet->{'promo_code'},
- 'reg_code' => $packet->{'reg_code'},
- } );
- #my $error = $cust_pkg->check;
- #return { 'error' => $error } if $error;
-
- #should be all auto-magic and shit
- my @svc = ();
- if ( $svc_x eq 'svc_acct' ) {
-
- my $svc = new FS::svc_acct {
- 'svcpart' => $svcpart,
- map { $_ => $packet->{$_} }
- qw( username _password sec_phrase popnum ),
- };
-
- my @acct_snarf;
- my $snarfnum = 1;
- while ( exists($packet->{"snarf_machine$snarfnum"})
- && length($packet->{"snarf_machine$snarfnum"}) ) {
- my $acct_snarf = new FS::acct_snarf ( {
- 'machine' => $packet->{"snarf_machine$snarfnum"},
- 'protocol' => $packet->{"snarf_protocol$snarfnum"},
- 'username' => $packet->{"snarf_username$snarfnum"},
- '_password' => $packet->{"snarf_password$snarfnum"},
- } );
- $snarfnum++;
- push @acct_snarf, $acct_snarf;
- }
- $svc->child_objects( \@acct_snarf );
- push @svc, $svc;
-
- } elsif ( $svc_x eq 'svc_phone' ) {
-
- push @svc, new FS::svc_phone ( {
- 'svcpart' => $svcpart,
- map { $_ => $packet->{$_} }
- qw( countrycode phonenum sip_password pin ),
- } );
-
- } elsif ( $svc_x eq 'svc_pbx' ) {
-
- push @svc, new FS::svc_pbx ( {
- 'svcpart' => $svcpart,
- map { $_ => $packet->{$_} }
- qw( id title ),
- } );
-
- } else {
- die "unknown signup service $svc_x";
- }
-
- if ($packet->{'mac_addr'} && $conf->exists('signup_server-mac_addr_svcparts'))
- {
-
- my %mac_addr_svcparts = map { $_ => 1 }
- $conf->config('signup_server-mac_addr_svcparts');
- my @pkg_svc = grep { $_->quantity && $mac_addr_svcparts{$_->svcpart} }
- $cust_pkg->part_pkg->pkg_svc;
-
- return { 'error' => 'No service defined to assign mac address' }
- unless @pkg_svc;
-
- my $svc = new FS::svc_acct {
- 'svcpart' => $pkg_svc[0]->svcpart, #multiple matches? alas..
- 'username' => $packet->{'mac_addr'},
- '_password' => '', #blank as requested (set passwordmin to 0)
- };
-
- push @svc, $svc;
-
- }
-
- foreach my $svc ( @svc ) {
- my $y = $svc->setdefault; # arguably should be in new method
- return { 'error' => $y } if $y && !ref($y);
- #$error = $svc->check;
- #return { 'error' => $error } if $error;
- }
-
- #setup a job dependancy to delay provisioning
- my $placeholder = new FS::queue ( {
- 'job' => 'FS::ClientAPI::Signup::__placeholder',
- 'status' => 'locked',
- } );
- my $error = $placeholder->insert;
- return { 'error' => $error } if $error;
-
- use Tie::RefHash;
- tie my %hash, 'Tie::RefHash';
- %hash = ( $cust_pkg => \@svc );
- #msgcat
- $error = $cust_main->insert(
- \%hash,
- \@invoicing_list,
- 'depend_jobnum' => $placeholder->jobnum,
- );
- if ( $error ) {
- my $perror = $placeholder->delete;
- $error .= " (Additionally, error removing placeholder: $perror)" if $perror;
- return { 'error' => $error };
- }
-
- if ( $conf->exists('signup_server-realtime') ) {
-
- #warn "$me Billing customer...\n" if $Debug;
-
- my $bill_error = $cust_main->bill;
- #warn "$me error billing new customer: $bill_error"
- # if $bill_error;
-
- $bill_error = $cust_main->apply_payments_and_credits;
- #warn "$me error applying payments and credits for".
- # " new customer: $bill_error"
- # if $bill_error;
-
- $bill_error = $cust_main->realtime_collect(
- method => FS::payby->payby2bop( $packet->{payby} ),
- depend_jobnum => $placeholder->jobnum,
- selfservice => 1,
- );
- #warn "$me error collecting from new customer: $bill_error"
- # if $bill_error;
-
- if ($bill_error && ref($bill_error) eq 'HASH') {
- return { 'error' => '_collect',
- ( map { $_ => $bill_error->{$_} }
- qw(popup_url reference collectitems)
- ),
- amount => $cust_main->balance,
- };
- }
-
- $bill_error = $cust_main->apply_payments_and_credits;
- #warn "$me error applying payments and credits for".
- # " new customer: $bill_error"
- # if $bill_error;
-
- if ( $cust_main->balance > 0 ) {
-
- #this makes sense. credit is "un-doing" the invoice
- $cust_main->credit( $cust_main->balance, 'signup server decline',
- 'reason_type' => $conf->config('signup_credit_type'),
- );
- $cust_main->apply_credits;
-
- #should check list for errors...
- #$cust_main->suspend;
- local $FS::svc_Common::noexport_hack = 1;
- $cust_main->cancel('quiet'=>1);
-
- my $perror = $placeholder->depended_delete;
- warn "error removing provisioning jobs after decline: $perror" if $perror;
- unless ( $perror ) {
- $perror = $placeholder->delete;
- warn "error removing placeholder after decline: $perror" if $perror;
- }
-
- return { 'error' => '_decline' };
- }
-
- }
-
- if ( $reg_code ) {
- $error = $reg_code->delete;
- return { 'error' => $error } if $error;
- }
-
- $error = $placeholder->delete;
- return { 'error' => $error } if $error;
-
- my %return = ( 'error' => '',
- 'signup_service' => $svc_x,
- 'custnum' => $cust_main->custnum,
- );
-
- if ( $svc[0] ) {
-
- $return{'svcnum'} = $svc[0]->svcnum;
-
- if ( $svc_x eq 'svc_acct' ) {
- $return{$_} = $svc[0]->$_() for qw( username _password );
- } elsif ( $svc_x eq 'svc_phone' ) {
- $return{$_} = $svc[0]->$_() for qw(countrycode phonenum sip_password pin);
- } elsif ( $svc_x eq 'svc_pbx' ) {
- #$return{$_} = $svc[0]->$_() for qw( ) #nothing yet
- } else {
- return {'error' => "configuration error: unknown signup service $svc_x"};
- #die "unknown signup service $svc_x";
- # return an error that's visible to someone somewhere
- }
-
- }
-
- return \%return;
-
-}
-
-sub capture_payment {
- my $packet = shift;
-
- warn "$me capture_payment called on $packet\n" if $DEBUG;
-
- ###
- # identify processor/gateway from called back URL
- ###
-
- my $conf = new FS::Conf;
-
- my $payment_gateway;
- if ( my $gwnum = $conf->config('selfservice-payment_gateway') ) {
- $payment_gateway = qsearchs('payment_gateway', { 'gatewaynum' => $gwnum })
- or die "configured gatewaynum $gwnum not found!";
- }
- else {
- my $url = $packet->{url};
-
- $payment_gateway = qsearchs('payment_gateway',
- { 'gateway_callback_url' => popurl(0, $url) }
- );
- if (!$payment_gateway) {
-
- my ( $processor, $login, $password, $action, @bop_options ) =
- $conf->config('business-onlinepayment');
- $action ||= 'normal authorization';
- pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
- die "No real-time processor is enabled - ".
- "did you set the business-onlinepayment configuration value?\n"
- unless $processor;
-
- $payment_gateway = new FS::payment_gateway( {
- gateway_namespace => $conf->config('business-onlinepayment-namespace'),
- gateway_module => $processor,
- gateway_username => $login,
- gateway_password => $password,
- gateway_action => $action,
- options => [ ( @bop_options ) ],
- });
- }
- }
-
- die "No real-time third party processor is enabled - ".
- "did you set the business-onlinepayment configuration value?\n*"
- unless $payment_gateway->gateway_namespace eq 'Business::OnlineThirdPartyPayment';
-
- ###
- # locate pending transaction
- ###
-
- eval "use Business::OnlineThirdPartyPayment";
- die $@ if $@;
-
- my $transaction =
- new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
- @{ [ $payment_gateway->options ] },
- );
-
- my $paypendingnum = $transaction->reference($packet->{data});
-
- my $cust_pay_pending =
- qsearchs('cust_pay_pending', { paypendingnum => $paypendingnum } );
-
- unless ($cust_pay_pending) {
- my $bill_error = "No payment is being processed with id $paypendingnum".
- "; Transaction aborted.";
- return { error => '_decline', bill_error => $bill_error };
- }
-
- if ($cust_pay_pending->status ne 'pending') {
- my $bill_error = "Payment with id $paypendingnum is not pending, but ".
- $cust_pay_pending->status. "; Transaction aborted.";
- return { error => '_decline', bill_error => $bill_error };
- }
-
- my $cust_main = $cust_pay_pending->cust_main;
- my $bill_error =
- $cust_main->realtime_botpp_capture( $cust_pay_pending,
- %{$packet->{data}},
- apply => 1,
- );
-
- return { 'error' => ( $bill_error->{bill_error} ? '_decline' : '' ),
- %$bill_error,
- };
-
-}
-
-1;
diff --git a/FS/FS/ClientAPI/passwd.pm b/FS/FS/ClientAPI/passwd.pm
deleted file mode 100644
index b22d761..0000000
--- a/FS/FS/ClientAPI/passwd.pm
+++ /dev/null
@@ -1,46 +0,0 @@
-package FS::ClientAPI::passwd;
-
-use strict;
-use FS::Record qw(qsearchs);
-use FS::svc_acct;
-use FS::svc_domain;
-
-sub passwd {
- my $packet = shift;
-
- my $domain = $FS::ClientAPI::domain || $packet->{'domain'};
- my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
- or return { error => "Domain $domain not found" };
-
- my $old_password = $packet->{'old_password'};
- my $new_password = $packet->{'new_password'};
- my $new_gecos = $packet->{'new_gecos'};
- my $new_shell = $packet->{'new_shell'};
-
- #false laziness w/FS::ClientAPI::MyAccount::login
-
- my $svc_acct = qsearchs( 'svc_acct', { 'username' => $packet->{'username'},
- 'domsvc' => $svc_domain->svcnum, }
- );
- return { error => 'User not found.' } unless $svc_acct;
- return { error => 'Incorrect password.' }
- unless $svc_acct->check_password($old_password);
-
- my %hash = $svc_acct->hash;
- my $new_svc_acct = new FS::svc_acct ( \%hash );
- $new_svc_acct->setfield('_password', $new_password )
- if $new_password && $new_password ne $old_password;
- $new_svc_acct->setfield('finger',$new_gecos) if $new_gecos;
- $new_svc_acct->setfield('shell',$new_shell) if $new_shell;
- my $error = $new_svc_acct->replace($svc_acct);
-
- return { error => $error };
-
-}
-
-sub chfn {}
-
-sub chsh {}
-
-1;
-
diff --git a/FS/FS/ClientAPI_SessionCache.pm b/FS/FS/ClientAPI_SessionCache.pm
deleted file mode 100644
index d72fb39..0000000
--- a/FS/FS/ClientAPI_SessionCache.pm
+++ /dev/null
@@ -1,79 +0,0 @@
-package FS::ClientAPI_SessionCache;
-
-use strict;
-use vars qw($module);
-use FS::UID qw(datasrc);
-use FS::Conf;
-
-#ask FS::UID to run this stuff for us later
-install_callback FS::UID sub {
- my $conf = new FS::Conf;
- $module = $conf->config('selfservice_server-cache_module')
- || 'Cache::FileCache';
-};
-
-=head1 NAME
-
-FS::ClientAPI_SessionCache;
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-Minimal Cache::Cache-alike interface for storing session cache information.
-Backends to Cache::SharedMemoryCache, Cache::FileCache, or an internal
-implementation which stores information in the clientapi_session and
-clientapi_session_field database tables.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-=cut
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- unless ( $module =~ /^_Database$/ ) {
- eval "use $module;";
- die $@ if $@;
- my $self = $module->new(@_);
- $self->set_cache_root('%%%FREESIDE_CACHE%%%/clientapi_session.'.datasrc)
- if $module =~ /^Cache::FileCache$/;
- $self;
- } else {
- my $self = shift;
- bless ($self, $class);
- }
-}
-
-sub get {
- my($self, $session_id) = @_;
- die '_Database self-service session cache not yet implemented';
-}
-
-sub set {
- my($self, $session_id, $session, $expiration) = @_;
- die '_Database self-service session cache not yet implemented';
-}
-
-sub remove {
- my($self, $session_id) = @_;
- die '_Database self-service session cache not yet implemented';
-}
-
-=back
-
-=head1 BUGS
-
-Minimal documentation.
-
-=head1 SEE ALSO
-
-L<Cache::Cache>, L<FS::clientapi_session>, L<FS::clientapi_session_field>
-
-=cut
-
-1;
diff --git a/FS/FS/ClientAPI_XMLRPC.pm b/FS/FS/ClientAPI_XMLRPC.pm
deleted file mode 100644
index 48b94eb..0000000
--- a/FS/FS/ClientAPI_XMLRPC.pm
+++ /dev/null
@@ -1,148 +0,0 @@
-package FS::ClientAPI_XMLRPC;
-
-=head1 NAME
-
-FS::ClientAPI_XMLRPC - Freeside XMLRPC accessible self-service API, on the backend
-
-=head1 SYNOPSIS
-
-This module implements the self-service API offered by xmlrpc.cgi and friends,
-but on a backend machine.
-
-=head1 DESCRIPTION
-
-Use this API to implement your own client "self-service" module vi XMLRPC.
-
-Each routine described in L<FS::SelfService> is available vi XMLRPC as the
-method FS.SelfService.XMLRPC.B<method>. All values are passed to the
-selfservice-server in a struct of strings. The return values are in a
-struct as strings, arrays, or structs as appropriate for the values
-described in L<FS::SelfService>.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::SelfService::XMLRPC>, L<FS::SelfService>
-
-=cut
-
-use strict;
-
-use vars qw($DEBUG $AUTOLOAD);
-use FS::ClientAPI;
-
-$DEBUG = 0;
-$FS::ClientAPI::DEBUG = $DEBUG;
-
-sub AUTOLOAD {
- my $call = $AUTOLOAD;
- $call =~ s/^FS::(SelfService::|ClientAPI_)XMLRPC:://;
-
- warn "FS::ClientAPI_XMLRPC::AUTOLOAD $call\n" if $DEBUG;
-
- my $autoload = &ss2clientapi;
-
- if (exists($autoload->{$call})) {
- shift; #discard package name;
- #$call = "FS::SelfService::$call";
- #no strict 'refs';
- #&{$call}(@_);
- #FS::ClientAPI->dispatch($autoload->{$call}, @_);
- FS::ClientAPI->dispatch($autoload->{$call}, @_ );
- }else{
- die "No such procedure: $call";
- }
-}
-
-#terrible false laziness w/SelfService.pm
-# - fix at build time, by including some file in both selfserv and backend libs?
-# - or fix at runtime, by having selfservice client ask server for the list?
-sub ss2clientapi {
- {
- 'passwd' => 'passwd/passwd',
- 'chfn' => 'passwd/passwd',
- 'chsh' => 'passwd/passwd',
- 'login_info' => 'MyAccount/login_info',
- 'login' => 'MyAccount/login',
- 'logout' => 'MyAccount/logout',
- 'customer_info' => 'MyAccount/customer_info',
- 'edit_info' => 'MyAccount/edit_info', #add to ss cgi!
- 'invoice' => 'MyAccount/invoice',
- 'invoice_logo' => 'MyAccount/invoice_logo',
- 'list_invoices' => 'MyAccount/list_invoices', #?
- 'cancel' => 'MyAccount/cancel', #add to ss cgi!
- 'payment_info' => 'MyAccount/payment_info',
- 'payment_info_renew_info' => 'MyAccount/payment_info_renew_info',
- 'process_payment' => 'MyAccount/process_payment',
- 'process_payment_order_pkg' => 'MyAccount/process_payment_order_pkg',
- 'process_payment_change_pkg' => 'MyAccount/process_payment_change_pkg',
- 'process_payment_order_renew' => 'MyAccount/process_payment_order_renew',
- 'process_prepay' => 'MyAccount/process_prepay',
- 'realtime_collect' => 'MyAccount/realtime_collect',
- 'list_pkgs' => 'MyAccount/list_pkgs', #add to ss (added?)
- 'list_svcs' => 'MyAccount/list_svcs', #add to ss (added?)
- 'list_svc_usage' => 'MyAccount/list_svc_usage',
- 'list_cdr_usage' => 'MyAccount/list_cdr_usage',
- 'list_support_usage' => 'MyAccount/list_support_usage',
- 'order_pkg' => 'MyAccount/order_pkg', #add to ss cgi!
- 'change_pkg' => 'MyAccount/change_pkg',
- 'order_recharge' => 'MyAccount/order_recharge',
- 'renew_info' => 'MyAccount/renew_info',
- 'order_renew' => 'MyAccount/order_renew',
- 'cancel_pkg' => 'MyAccount/cancel_pkg', #add to ss cgi!
- 'suspend_pkg' => 'MyAccount/suspend_pkg', #add to ss cgi!
- 'charge' => 'MyAccount/charge', #?
- 'part_svc_info' => 'MyAccount/part_svc_info',
- 'provision_acct' => 'MyAccount/provision_acct',
- 'provision_external' => 'MyAccount/provision_external',
- 'unprovision_svc' => 'MyAccount/unprovision_svc',
- 'myaccount_passwd' => 'MyAccount/myaccount_passwd',
- 'create_ticket' => 'MyAccount/create_ticket',
- 'signup_info' => 'Signup/signup_info',
- 'skin_info' => 'MyAccount/skin_info',
- 'access_info' => 'MyAccount/access_info',
- 'domain_select_hash' => 'Signup/domain_select_hash', # expose?
- 'new_customer' => 'Signup/new_customer',
- 'capture_payment' => 'Signup/capture_payment',
- 'clear_signup_cache' => 'Signup/clear_cache',
- 'agent_login' => 'Agent/agent_login',
- 'agent_logout' => 'Agent/agent_logout',
- 'agent_info' => 'Agent/agent_info',
- 'agent_list_customers' => 'Agent/agent_list_customers',
- 'mason_comp' => 'MasonComponent/mason_comp',
- 'call_time' => 'PrepaidPhone/call_time',
- 'call_time_nanpa' => 'PrepaidPhone/call_time_nanpa',
- 'phonenum_balance' => 'PrepaidPhone/phonenum_balance',
- 'bulk_processrow' => 'Bulk/processrow',
- 'check_username' => 'Bulk/check_username',
- #sg
- 'ping' => 'SGNG/ping',
- 'decompify_pkgs' => 'SGNG/decompify_pkgs',
- 'previous_payment_info' => 'SGNG/previous_payment_info',
- 'previous_payment_info_renew_info'
- => 'SGNG/previous_payment_info_renew_info',
- 'previous_process_payment' => 'SGNG/previous_process_payment',
- 'previous_process_payment_order_pkg'
- => 'SGNG/previous_process_payment_order_pkg',
- 'previous_process_payment_change_pkg'
- => 'SGNG/previous_process_payment_change_pkg',
- 'previous_process_payment_order_renew'
- => 'SGNG/previous_process_payment_order_renew',
- };
-}
-
-
-#XXX submit patch to SOAP::Lite
-
-use XMLRPC::Transport::HTTP;
-
-package XMLRPC::Transport::HTTP::Server;
-
-@XMLRPC::Transport::HTTP::Server::ISA = qw(SOAP::Transport::HTTP::Server);
-
-sub initialize; *initialize = \&XMLRPC::Server::initialize;
-sub make_fault; *make_fault = \&XMLRPC::Transport::HTTP::CGI::make_fault;
-sub make_response; *make_response = \&XMLRPC::Transport::HTTP::CGI::make_response;
-
-1;
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
deleted file mode 100644
index fbf18cb..0000000
--- a/FS/FS/Conf.pm
+++ /dev/null
@@ -1,4235 +0,0 @@
-package FS::Conf;
-
-use vars qw($base_dir @config_items @base_items @card_types $DEBUG);
-use Carp;
-use IO::File;
-use File::Basename;
-use MIME::Base64;
-use FS::ConfItem;
-use FS::ConfDefaults;
-use FS::Conf_compat17;
-use FS::payby;
-use FS::conf;
-use FS::Record qw(qsearch qsearchs);
-use FS::UID qw(dbh datasrc use_confcompat);
-
-$base_dir = '%%%FREESIDE_CONF%%%';
-
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::Conf - Freeside configuration values
-
-=head1 SYNOPSIS
-
- use FS::Conf;
-
- $conf = new FS::Conf;
-
- $value = $conf->config('key');
- @list = $conf->config('key');
- $bool = $conf->exists('key');
-
- $conf->touch('key');
- $conf->set('key' => 'value');
- $conf->delete('key');
-
- @config_items = $conf->config_items;
-
-=head1 DESCRIPTION
-
-Read and write Freeside configuration values. Keys currently map to filenames,
-but this may change in the future.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-Create a new configuration object.
-
-=cut
-
-sub new {
- my($proto) = @_;
- my($class) = ref($proto) || $proto;
- my($self) = { 'base_dir' => $base_dir };
- bless ($self, $class);
-}
-
-=item base_dir
-
-Returns the base directory. By default this is /usr/local/etc/freeside.
-
-=cut
-
-sub base_dir {
- my($self) = @_;
- my $base_dir = $self->{base_dir};
- -e $base_dir or die "FATAL: $base_dir doesn't exist!";
- -d $base_dir or die "FATAL: $base_dir isn't a directory!";
- -r $base_dir or die "FATAL: Can't read $base_dir!";
- -x $base_dir or die "FATAL: $base_dir not searchable (executable)!";
- $base_dir =~ /^(.*)$/;
- $1;
-}
-
-=item conf KEY [ AGENTNUM [ NODEFAULT ] ]
-
-Returns the L<FS::conf> record for the key and agent.
-
-=cut
-
-sub conf {
- my $self = shift;
- $self->_config(@_);
-}
-
-=item config KEY [ AGENTNUM [ NODEFAULT ] ]
-
-Returns the configuration value or values (depending on context) for key.
-The optional agent number selects an agent specific value instead of the
-global default if one is present. If NODEFAULT is true only the agent
-specific value(s) is returned.
-
-=cut
-
-sub _usecompat {
- my ($self, $method) = (shift, shift);
- carp "NO CONFIGURATION RECORDS FOUND -- USING COMPATIBILITY MODE"
- if use_confcompat;
- my $compat = new FS::Conf_compat17 ("$base_dir/conf." . datasrc);
- $compat->$method(@_);
-}
-
-sub _config {
- my($self,$name,$agentnum,$agentonly)=@_;
- my $hashref = { 'name' => $name };
- $hashref->{agentnum} = $agentnum;
- local $FS::Record::conf = undef; # XXX evil hack prevents recursion
- my $cv = FS::Record::qsearchs('conf', $hashref);
- if (!$agentonly && !$cv && defined($agentnum) && $agentnum) {
- $hashref->{agentnum} = '';
- $cv = FS::Record::qsearchs('conf', $hashref);
- }
- return $cv;
-}
-
-sub config {
- my $self = shift;
- return $self->_usecompat('config', @_) if use_confcompat;
-
- carp "FS::Conf->config(". join(', ', @_). ") called"
- if $DEBUG > 1;
-
- my $cv = $self->_config(@_) or return;
-
- if ( wantarray ) {
- my $v = $cv->value;
- chomp $v;
- (split "\n", $v, -1);
- } else {
- (split("\n", $cv->value))[0];
- }
-}
-
-=item config_binary KEY [ AGENTNUM [ NODEFAULT ] ]
-
-Returns the exact scalar value for key.
-
-=cut
-
-sub config_binary {
- my $self = shift;
- return $self->_usecompat('config_binary', @_) if use_confcompat;
-
- my $cv = $self->_config(@_) or return;
- length($cv->value) ? decode_base64($cv->value) : '';
-}
-
-=item exists KEY [ AGENTNUM [ NODEFAULT ] ]
-
-Returns true if the specified key exists, even if the corresponding value
-is undefined.
-
-=cut
-
-sub exists {
- my $self = shift;
- return $self->_usecompat('exists', @_) if use_confcompat;
-
- my($name, $agentnum)=@_;
-
- carp "FS::Conf->exists(". join(', ', @_). ") called"
- if $DEBUG > 1;
-
- defined($self->_config(@_));
-}
-
-=item config_orbase KEY SUFFIX
-
-Returns the configuration value or values (depending on context) for
-KEY_SUFFIX, if it exists, otherwise for KEY
-
-=cut
-
-# outmoded as soon as we shift to agentnum based config values
-# well, mostly. still useful for e.g. late notices, etc. in that we want
-# these to fall back to standard values
-sub config_orbase {
- my $self = shift;
- return $self->_usecompat('config_orbase', @_) if use_confcompat;
-
- my( $name, $suffix ) = @_;
- if ( $self->exists("${name}_$suffix") ) {
- $self->config("${name}_$suffix");
- } else {
- $self->config($name);
- }
-}
-
-=item key_orbase KEY SUFFIX
-
-If the config value KEY_SUFFIX exists, returns KEY_SUFFIX, otherwise returns
-KEY. Useful for determining which exact configuration option is returned by
-config_orbase.
-
-=cut
-
-sub key_orbase {
- my $self = shift;
- #no compat for this...return $self->_usecompat('config_orbase', @_) if use_confcompat;
-
- my( $name, $suffix ) = @_;
- if ( $self->exists("${name}_$suffix") ) {
- "${name}_$suffix";
- } else {
- $name;
- }
-}
-
-=item invoice_templatenames
-
-Returns all possible invoice template names.
-
-=cut
-
-sub invoice_templatenames {
- my( $self ) = @_;
-
- my %templatenames = ();
- foreach my $item ( $self->config_items ) {
- foreach my $base ( @base_items ) {
- my( $main, $ext) = split(/\./, $base);
- $ext = ".$ext" if $ext;
- if ( $item->key =~ /^${main}_(.+)$ext$/ ) {
- $templatenames{$1}++;
- }
- }
- }
-
- map { $_ } #handle scalar context
- sort keys %templatenames;
-
-}
-
-=item touch KEY [ AGENT ];
-
-Creates the specified configuration key if it does not exist.
-
-=cut
-
-sub touch {
- my $self = shift;
- return $self->_usecompat('touch', @_) if use_confcompat;
-
- my($name, $agentnum) = @_;
- unless ( $self->exists($name, $agentnum) ) {
- $self->set($name, '', $agentnum);
- }
-}
-
-=item set KEY VALUE [ AGENTNUM ];
-
-Sets the specified configuration key to the given value.
-
-=cut
-
-sub set {
- my $self = shift;
- return $self->_usecompat('set', @_) if use_confcompat;
-
- my($name, $value, $agentnum) = @_;
- $value =~ /^(.*)$/s;
- $value = $1;
-
- warn "[FS::Conf] SET $name\n" if $DEBUG;
-
- my $old = FS::Record::qsearchs('conf', {name => $name, agentnum => $agentnum});
- my $new = new FS::conf { $old ? $old->hash
- : ('name' => $name, 'agentnum' => $agentnum)
- };
- $new->value($value);
-
- my $error;
- if ($old) {
- $error = $new->replace($old);
- } else {
- $error = $new->insert;
- }
-
- die "error setting configuration value: $error \n"
- if $error;
-
-}
-
-=item set_binary KEY VALUE [ AGENTNUM ]
-
-Sets the specified configuration key to an exact scalar value which
-can be retrieved with config_binary.
-
-=cut
-
-sub set_binary {
- my $self = shift;
- return if use_confcompat;
-
- my($name, $value, $agentnum)=@_;
- $self->set($name, encode_base64($value), $agentnum);
-}
-
-=item delete KEY [ AGENTNUM ];
-
-Deletes the specified configuration key.
-
-=cut
-
-sub delete {
- my $self = shift;
- return $self->_usecompat('delete', @_) if use_confcompat;
-
- my($name, $agentnum) = @_;
- if ( my $cv = FS::Record::qsearchs('conf', {name => $name, agentnum => $agentnum}) ) {
- warn "[FS::Conf] DELETE $name\n";
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $error = $cv->delete;
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die "error setting configuration value: $error \n"
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- }
-}
-
-=item import_config_item CONFITEM DIR
-
- Imports the item specified by the CONFITEM (see L<FS::ConfItem>) into
-the database as a conf record (see L<FS::conf>). Imports from the file
-in the directory DIR.
-
-=cut
-
-sub import_config_item {
- my ($self,$item,$dir) = @_;
- my $key = $item->key;
- if ( -e "$dir/$key" && ! use_confcompat ) {
- warn "Inserting $key\n" if $DEBUG;
- local $/;
- my $value = readline(new IO::File "$dir/$key");
- if ($item->type =~ /^(binary|image)$/ ) {
- $self->set_binary($key, $value);
- }else{
- $self->set($key, $value);
- }
- }else {
- warn "Not inserting $key\n" if $DEBUG;
- }
-}
-
-=item verify_config_item CONFITEM DIR
-
- Compares the item specified by the CONFITEM (see L<FS::ConfItem>) in
-the database to the legacy file value in DIR.
-
-=cut
-
-sub verify_config_item {
- return '' if use_confcompat;
- my ($self,$item,$dir) = @_;
- my $key = $item->key;
- my $type = $item->type;
-
- my $compat = new FS::Conf_compat17 $dir;
- my $error = '';
-
- $error .= "$key fails existential comparison; "
- if $self->exists($key) xor $compat->exists($key);
-
- if ( $type !~ /^(binary|image)$/ ) {
-
- {
- no warnings;
- $error .= "$key fails scalar comparison; "
- unless scalar($self->config($key)) eq scalar($compat->config($key));
- }
-
- my (@new) = $self->config($key);
- my (@old) = $compat->config($key);
- unless ( scalar(@new) == scalar(@old)) {
- $error .= "$key fails list comparison; ";
- }else{
- my $r=1;
- foreach (@old) { $r=0 if ($_ cmp shift(@new)); }
- $error .= "$key fails list comparison; "
- unless $r;
- }
-
- } else {
-
- no warnings 'uninitialized';
- $error .= "$key fails binary comparison; "
- unless scalar($self->config_binary($key)) eq scalar($compat->config_binary($key));
-
- }
-
-#remove deprecated config on our own terms, not freeside-upgrade's
-# if ($error =~ /existential comparison/ && $item->section eq 'deprecated') {
-# my $proto;
-# for ( @config_items ) { $proto = $_; last if $proto->key eq $key; }
-# unless ($proto->key eq $key) {
-# warn "removed config item $error\n" if $DEBUG;
-# $error = '';
-# }
-# }
-
- $error;
-}
-
-#item _orbase_items OPTIONS
-#
-#Returns all of the possible extensible config items as FS::ConfItem objects.
-#See #L<FS::ConfItem>. OPTIONS consists of name value pairs. Possible
-#options include
-#
-# dir - the directory to search for configuration option files instead
-# of using the conf records in the database
-#
-#cut
-
-#quelle kludge
-sub _orbase_items {
- my ($self, %opt) = @_;
-
- my $listmaker = sub { my $v = shift;
- $v =~ s/_/!_/g;
- if ( $v =~ /\.(png|eps)$/ ) {
- $v =~ s/\./!_%./;
- }else{
- $v .= '!_%';
- }
- map { $_->name }
- FS::Record::qsearch( 'conf',
- {},
- '',
- "WHERE name LIKE '$v' ESCAPE '!'"
- );
- };
-
- if (exists($opt{dir}) && $opt{dir}) {
- $listmaker = sub { my $v = shift;
- if ( $v =~ /\.(png|eps)$/ ) {
- $v =~ s/\./_*./;
- }else{
- $v .= '_*';
- }
- map { basename $_ } glob($opt{dir}. "/$v" );
- };
- }
-
- ( map {
- my $proto;
- my $base = $_;
- for ( @config_items ) { $proto = $_; last if $proto->key eq $base; }
- die "don't know about $base items" unless $proto->key eq $base;
-
- map { new FS::ConfItem {
- 'key' => $_,
- 'base_key' => $proto->key,
- 'section' => $proto->section,
- 'description' => 'Alternate ' . $proto->description . ' See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration#Invoice_templates">billing documentation</a> for details.',
- 'type' => $proto->type,
- };
- } &$listmaker($base);
- } @base_items,
- );
-}
-
-=item config_items
-
-Returns all of the possible global/default configuration items as
-FS::ConfItem objects. See L<FS::ConfItem>.
-
-=cut
-
-sub config_items {
- my $self = shift;
- return $self->_usecompat('config_items', @_) if use_confcompat;
-
- ( @config_items, $self->_orbase_items(@_) );
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item init-config DIR
-
-Imports the configuration items from DIR (1.7 compatible)
-to conf records in the database.
-
-=cut
-
-sub init_config {
- my $dir = shift;
-
- {
- local $FS::UID::use_confcompat = 0;
- my $conf = new FS::Conf;
- foreach my $item ( $conf->config_items(dir => $dir) ) {
- $conf->import_config_item($item, $dir);
- my $error = $conf->verify_config_item($item, $dir);
- return $error if $error;
- }
-
- my $compat = new FS::Conf_compat17 $dir;
- foreach my $item ( $compat->config_items ) {
- my $error = $conf->verify_config_item($item, $dir);
- return $error if $error;
- }
- }
-
- $FS::UID::use_confcompat = 0;
- ''; #success
-}
-
-=back
-
-=head1 BUGS
-
-If this was more than just crud that will never be useful outside Freeside I'd
-worry that config_items is freeside-specific and icky.
-
-=head1 SEE ALSO
-
-"Configuration" in the web interface (config/config.cgi).
-
-=cut
-
-#Business::CreditCard
-@card_types = (
- "VISA card",
- "MasterCard",
- "Discover card",
- "American Express card",
- "Diner's Club/Carte Blanche",
- "enRoute",
- "JCB",
- "BankCard",
- "Switch",
- "Solo",
-);
-
-@base_items = qw(
-invoice_template
-invoice_latex
-invoice_latexreturnaddress
-invoice_latexfooter
-invoice_latexsmallfooter
-invoice_latexnotes
-invoice_latexcoupon
-invoice_html
-invoice_htmlreturnaddress
-invoice_htmlfooter
-invoice_htmlnotes
-logo.png
-logo.eps
-);
-
-my %msg_template_options = (
- 'type' => 'select-sub',
- 'options_sub' => sub {
- my @templates = qsearch({
- 'table' => 'msg_template',
- 'hashref' => { 'disabled' => '' },
- 'extra_sql' => ' AND '.
- $FS::CurrentUser::CurrentUser->agentnums_sql(null => 1),
- });
- map { $_->msgnum, $_->msgname } @templates;
- },
- 'option_sub' => sub {
- my $msg_template = FS::msg_template->by_key(shift);
- $msg_template ? $msg_template->msgname : ''
- },
- 'per_agent' => 1,
-);
-
-my $_gateway_name = sub {
- my $g = shift;
- return '' if !$g;
- ($g->gateway_username . '@' . $g->gateway_module);
-};
-
-my %payment_gateway_options = (
- 'type' => 'select-sub',
- 'options_sub' => sub {
- my @gateways = qsearch({
- 'table' => 'payment_gateway',
- 'hashref' => { 'disabled' => '' },
- });
- map { $_->gatewaynum, $_gateway_name->($_) } @gateways;
- },
- 'option_sub' => sub {
- my $gateway = FS::payment_gateway->by_key(shift);
- $_gateway_name->($gateway);
- },
-);
-
-#Billing (81 items)
-#Invoicing (50 items)
-#UI (69 items)
-#Self-service (29 items)
-#...
-#Unclassified (77 items)
-
-@config_items = map { new FS::ConfItem $_ } (
-
- {
- 'key' => 'address',
- 'section' => 'deprecated',
- 'description' => 'This configuration option is no longer used. See <a href="#invoice_template">invoice_template</a> instead.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'alert_expiration',
- 'section' => 'notification',
- 'description' => 'Enable alerts about billing method expiration (i.e. expiring credit cards).',
- 'type' => 'checkbox',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'alerter_template',
- 'section' => 'deprecated',
- 'description' => 'Template file for billing method expiration alerts (i.e. expiring credit cards).',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'alerter_msgnum',
- 'section' => 'notification',
- 'description' => 'Template to use for credit card expiration alerts.',
- %msg_template_options,
- },
-
- {
- 'key' => 'apacheip',
- #not actually deprecated yet
- #'section' => 'deprecated',
- #'description' => '<b>DEPRECATED</b>, add an <i>apache</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be the current IP address to assign to new virtual hosts',
- 'section' => '',
- 'description' => 'IP address to assign to new virtual hosts',
- 'type' => 'text',
- },
-
- {
- 'key' => 'encryption',
- 'section' => 'billing',
- 'description' => 'Enable encryption of credit cards.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'encryptionmodule',
- 'section' => 'billing',
- 'description' => 'Use which module for encryption?',
- 'type' => 'text',
- },
-
- {
- 'key' => 'encryptionpublickey',
- 'section' => 'billing',
- 'description' => 'Your RSA Public Key - Required if Encryption is turned on.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'encryptionprivatekey',
- 'section' => 'billing',
- 'description' => 'Your RSA Private Key - Including this will enable the "Bill Now" feature. However if the system is compromised, a hacker can use this key to decode the stored credit card information. This is generally not a good idea.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'billco-url',
- 'section' => 'billing',
- 'description' => 'The url to use for performing uploads to the invoice mailing service.',
- 'type' => 'text',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'billco-username',
- 'section' => 'billing',
- 'description' => 'The login name to use for uploads to the invoice mailing service.',
- 'type' => 'text',
- 'per_agent' => 1,
- 'agentonly' => 1,
- },
-
- {
- 'key' => 'billco-password',
- 'section' => 'billing',
- 'description' => 'The password to use for uploads to the invoice mailing service.',
- 'type' => 'text',
- 'per_agent' => 1,
- 'agentonly' => 1,
- },
-
- {
- 'key' => 'billco-clicode',
- 'section' => 'billing',
- 'description' => 'The clicode to use for uploads to the invoice mailing service.',
- 'type' => 'text',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'business-onlinepayment',
- 'section' => 'billing',
- 'description' => '<a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a> support, at least three lines: processor, login, and password. An optional fourth line specifies the action or actions (multiple actions are separated with `,\': for example: `Authorization Only, Post Authorization\'). Optional additional lines are passed to Business::OnlinePayment as %processor_options.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'business-onlinepayment-ach',
- 'section' => 'billing',
- 'description' => 'Alternate <a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a> support for ACH transactions (defaults to regular <b>business-onlinepayment</b>). At least three lines: processor, login, and password. An optional fourth line specifies the action or actions (multiple actions are separated with `,\': for example: `Authorization Only, Post Authorization\'). Optional additional lines are passed to Business::OnlinePayment as %processor_options.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'business-onlinepayment-namespace',
- 'section' => 'billing',
- 'description' => 'Specifies which perl module namespace (which group of collection routines) is used by default.',
- 'type' => 'select',
- 'select_hash' => [
- 'Business::OnlinePayment' => 'Direct API (Business::OnlinePayment)',
- 'Business::OnlineThirdPartyPayment' => 'Web API (Business::ThirdPartyPayment)',
- ],
- },
-
- {
- 'key' => 'business-onlinepayment-description',
- 'section' => 'billing',
- 'description' => 'String passed as the description field to <a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a>. Evaluated as a double-quoted perl string, with the following variables available: <code>$agent</code> (the agent name), and <code>$pkgs</code> (a comma-separated list of packages for which these charges apply - not available in all situations)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'business-onlinepayment-email-override',
- 'section' => 'billing',
- 'description' => 'Email address used instead of customer email address when submitting a BOP transaction.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'business-onlinepayment-email_customer',
- 'section' => 'billing',
- 'description' => 'Controls the "email_customer" flag used by some Business::OnlinePayment processors to enable customer receipts.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'business-onlinepayment-test_transaction',
- 'section' => 'billing',
- 'description' => 'Turns on the Business::OnlinePayment test_transaction flag. Note that not all gateway modules support this flag; if yours does not, transactions will still be sent live.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'countrydefault',
- 'section' => 'UI',
- 'description' => 'Default two-letter country code (if not supplied, the default is `US\')',
- 'type' => 'text',
- },
-
- {
- 'key' => 'date_format',
- 'section' => 'UI',
- 'description' => 'Format for displaying dates',
- 'type' => 'select',
- 'select_hash' => [
- '%m/%d/%Y' => 'MM/DD/YYYY',
- '%d/%m/%Y' => 'DD/MM/YYYY',
- '%Y/%m/%d' => 'YYYY/MM/DD',
- ],
- },
-
- {
- 'key' => 'deletecustomers',
- 'section' => 'UI',
- 'description' => 'Enable customer deletions. Be very careful! Deleting a customer will remove all traces that the customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customers\' packages if they cancel service.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'deleteinvoices',
- 'section' => 'UI',
- 'description' => 'Enable invoices deletions. Be very careful! Deleting an invoice will remove all traces that the invoice ever existed! Normally, you would apply a credit against the invoice instead.', #invoice voiding?
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'deletepayments',
- 'section' => 'billing',
- 'description' => 'Enable deletion of unclosed payments. Really, with voids this is pretty much not recommended in any situation anymore. Be very careful! Only delete payments that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted.',
- 'type' => [qw( checkbox text )],
- },
-
- {
- 'key' => 'deletecredits',
- #not actually deprecated yet
- #'section' => 'deprecated',
- #'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted.',
- 'section' => '',
- 'description' => 'One or more comma-separated email addresses to be notified when a credit is deleted.',
- 'type' => [qw( checkbox text )],
- },
-
- {
- 'key' => 'deleterefunds',
- 'section' => 'billing',
- 'description' => 'Enable deletion of unclosed refunds. Be very careful! Only delete refunds that were data-entry errors, not adjustments.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'unapplypayments',
- 'section' => 'deprecated',
- 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable "unapplication" of unclosed payments.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'unapplycredits',
- 'section' => 'deprecated',
- 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to nable "unapplication" of unclosed credits.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'dirhash',
- 'section' => 'shell',
- 'description' => 'Optional numeric value to control directory hashing. If positive, hashes directories for the specified number of levels from the front of the username. If negative, hashes directories for the specified number of levels from the end of the username. Some examples: <ul><li>1: user -> <a href="#home">/home</a>/u/user<li>2: user -> <a href="#home">/home</a>/u/s/user<li>-1: user -> <a href="#home">/home</a>/r/user<li>-2: user -> <a href="#home">home</a>/r/e/user</ul>',
- 'type' => 'text',
- },
-
- {
- 'key' => 'disable_cust_attachment',
- 'section' => '',
- 'description' => 'Disable customer file attachments',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'max_attachment_size',
- 'section' => '',
- 'description' => 'Maximum size for customer file attachments (leave blank for unlimited)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'disable_customer_referrals',
- 'section' => 'UI',
- 'description' => 'Disable new customer-to-customer referrals in the web interface',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'editreferrals',
- 'section' => 'UI',
- 'description' => 'Enable advertising source modification for existing customers',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'emailinvoiceonly',
- 'section' => 'invoicing',
- 'description' => 'Disables postal mail invoices',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'disablepostalinvoicedefault',
- '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' => 'invoicing',
- 'description' => 'Automatically adds new accounts to the email invoice list',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'emailinvoiceautoalways',
- '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' => 'invoicing',
- 'description' => 'Allows the apostrophe (single quote) character in the email addresses in the email invoice list.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'exclude_ip_addr',
- 'section' => '',
- 'description' => 'Exclude these from the list of available broadband service IP addresses. (One per line)',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'auto_router',
- 'section' => '',
- 'description' => 'Automatically choose the correct router/block based on supplied ip address when possible while provisioning broadband services',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'hidecancelledpackages',
- 'section' => 'UI',
- 'description' => 'Prevent cancelled packages from showing up in listings (though they will still be in the database)',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'hidecancelledcustomers',
- 'section' => 'UI',
- 'description' => 'Prevent customers with only cancelled packages from showing up in listings (though they will still be in the database)',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'home',
- 'section' => 'shell',
- 'description' => 'For new users, prefixed to username to create a directory name. Should have a leading but not a trailing slash.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'invoice_from',
- 'section' => 'required',
- 'description' => 'Return address on email invoices',
- 'type' => 'text',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'invoice_subject',
- '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,
- },
-
- {
- 'key' => 'invoice_usesummary',
- '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' => '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' => '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',
- },
-
- {
- 'key' => 'invoice_htmlnotes',
- 'section' => 'invoicing',
- 'description' => 'Notes section for HTML invoices. Defaults to the same data in invoice_latexnotes if not specified.',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'invoice_htmlfooter',
- 'section' => 'invoicing',
- 'description' => 'Footer for HTML invoices. Defaults to the same data in invoice_latexfooter if not specified.',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'invoice_htmlsummary',
- 'section' => 'invoicing',
- 'description' => 'Summary initial page for HTML invoices.',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'invoice_htmlreturnaddress',
- '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' => '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_latextopmargin',
- 'section' => 'invoicing',
- 'description' => 'Optional LaTeX invoice topmargin setting. Include units.',
- 'type' => 'text',
- 'per_agent' => 1,
- 'validate' => sub { shift =~
- /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/
- ? '' : 'Invalid LaTex length';
- },
- },
-
- {
- 'key' => 'invoice_latexheadsep',
- 'section' => 'invoicing',
- 'description' => 'Optional LaTeX invoice headsep setting. Include units.',
- 'type' => 'text',
- 'per_agent' => 1,
- 'validate' => sub { shift =~
- /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/
- ? '' : 'Invalid LaTex length';
- },
- },
-
- {
- 'key' => 'invoice_latexaddresssep',
- 'section' => 'invoicing',
- 'description' => 'Optional LaTeX invoice separation between invoice header
-and customer address. Include units.',
- 'type' => 'text',
- 'per_agent' => 1,
- 'validate' => sub { shift =~
- /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/
- ? '' : 'Invalid LaTex length';
- },
- },
-
- {
- 'key' => 'invoice_latextextheight',
- 'section' => 'invoicing',
- 'description' => 'Optional LaTeX invoice textheight setting. Include units.',
- 'type' => 'text',
- 'per_agent' => 1,
- 'validate' => sub { shift =~
- /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/
- ? '' : 'Invalid LaTex length';
- },
- },
-
- {
- 'key' => 'invoice_latexnotes',
- 'section' => 'invoicing',
- 'description' => 'Notes section for LaTeX typeset PostScript invoices.',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'invoice_latexfooter',
- 'section' => 'invoicing',
- 'description' => 'Footer for LaTeX typeset PostScript invoices.',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'invoice_latexsummary',
- 'section' => 'invoicing',
- 'description' => 'Summary initial page for LaTeX typeset PostScript invoices.',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'invoice_latexcoupon',
- 'section' => 'invoicing',
- 'description' => 'Remittance coupon for LaTeX typeset PostScript invoices.',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'invoice_latexextracouponspace',
- 'section' => 'invoicing',
- 'description' => 'Optional LaTeX invoice textheight space to reserve for a tear off coupon. Include units.',
- 'type' => 'text',
- 'per_agent' => 1,
- 'validate' => sub { shift =~
- /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/
- ? '' : 'Invalid LaTex length';
- },
- },
-
- {
- 'key' => 'invoice_latexcouponfootsep',
- 'section' => 'invoicing',
- 'description' => 'Optional LaTeX invoice separation between tear off coupon and footer. Include units.',
- 'type' => 'text',
- 'per_agent' => 1,
- 'validate' => sub { shift =~
- /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/
- ? '' : 'Invalid LaTex length';
- },
- },
-
- {
- 'key' => 'invoice_latexcouponamountenclosedsep',
- 'section' => 'invoicing',
- 'description' => 'Optional LaTeX invoice separation between total due and amount enclosed line. Include units.',
- 'type' => 'text',
- 'per_agent' => 1,
- 'validate' => sub { shift =~
- /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/
- ? '' : 'Invalid LaTex length';
- },
- },
- {
- 'key' => 'invoice_latexcoupontoaddresssep',
- 'section' => 'invoicing',
- 'description' => 'Optional LaTeX invoice separation between invoice data and the to address (usually invoice_latexreturnaddress). Include units.',
- 'type' => 'text',
- 'per_agent' => 1,
- 'validate' => sub { shift =~
- /^-?\d*\.?\d+(in|mm|cm|pt|em|ex|pc|bp|dd|cc|sp)$/
- ? '' : 'Invalid LaTex length';
- },
- },
-
- {
- 'key' => 'invoice_latexreturnaddress',
- 'section' => 'invoicing',
- 'description' => 'Return address for LaTeX typeset PostScript invoices.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_latexverticalreturnaddress',
- 'section' => 'invoicing',
- 'description' => 'Place the return address under the company logo rather than beside it.',
- 'type' => 'checkbox',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'invoice_latexcouponaddcompanytoaddress',
- 'section' => 'invoicing',
- 'description' => 'Add the company name to the To address on the remittance coupon because the return address does not contain it.',
- 'type' => 'checkbox',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'invoice_latexsmallfooter',
- 'section' => 'invoicing',
- 'description' => 'Optional small footer for multi-page LaTeX typeset PostScript invoices.',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'invoice_email_pdf',
- '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' => 'invoicing',
- 'description' => 'If defined, this text will replace the default plain text invoice as the body of emailed PDF invoices.',
- 'type' => 'textarea'
- },
-
- {
- 'key' => 'invoice_print_pdf',
- 'section' => 'invoicing',
- 'description' => 'Store postal invoices for download in PDF format rather than printing them directly.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'invoice_default_terms',
- '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 21', 'Net 30', 'Net 45', 'Net 60', 'Net 90' ],
- },
-
- {
- 'key' => 'invoice_show_prior_due_date',
- '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' => 'invoicing',
- 'description' => 'Show an aging line after the prior balance section. Only valud when invoice_sections is enabled.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'invoice_sections',
- 'section' => 'invoicing',
- 'description' => 'Split invoice into sections and label according to package category when enabled.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'usage_class_as_a_section',
- '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' => 'invoicing',
- 'description' => 'Create a section for each svc_phone when enabled. Only valid when invoice_sections is enabled.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'finance_pkgclass',
- 'section' => 'billing',
- 'description' => 'The default package class for late fee charges, used if the fee event does not specify a package class itself.',
- 'type' => 'select-pkg_class',
- },
-
- {
- 'key' => 'separate_usage',
- 'section' => 'invoicing',
- 'description' => 'Split the rated call usage into a separate line from the recurring charges.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'invoice_send_receipts',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, this used to send an invoice copy on payments and credits. See the payment_receipt_email and XXXX instead.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'payment_receipt',
- 'section' => 'notification',
- 'description' => 'Send payment receipts.',
- 'type' => 'checkbox',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'payment_receipt_msgnum',
- 'section' => 'notification',
- 'description' => 'Template to use for payment receipts.',
- %msg_template_options,
- },
-
- {
- 'key' => 'payment_receipt_email',
- 'section' => 'deprecated',
- 'description' => 'Template file for payment receipts. Payment receipts are sent to the customer email invoice destination(s) when a payment is received.',
- 'type' => [qw( checkbox textarea )],
- },
-
- {
- 'key' => 'payment_receipt-trigger',
- 'section' => 'notification',
- 'description' => 'When payment receipts are triggered. Defaults to when payment is made.',
- 'type' => 'select',
- 'select_hash' => [
- 'cust_pay' => 'When payment is made.',
- 'cust_bill_pay_pkg' => 'When payment is applied.',
- ],
- 'per_agent' => 1,
- },
-
- {
- '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\'',
- 'type' => 'text',
- },
-
- {
- 'key' => 'lpr-postscript_prefix',
- 'section' => 'billing',
- 'description' => 'Raw printer commands prepended to the beginning of postscript print jobs (evaluated as a double-quoted perl string - backslash escapes are available)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'lpr-postscript_suffix',
- 'section' => 'billing',
- 'description' => 'Raw printer commands added to the end of postscript print jobs (evaluated as a double-quoted perl string - backslash escapes are available)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'money_char',
- 'section' => '',
- 'description' => 'Currency symbol - defaults to `$\'',
- 'type' => 'text',
- },
-
- {
- 'key' => 'defaultrecords',
- 'section' => 'BIND',
- 'description' => 'DNS entries to add automatically when creating a domain',
- 'type' => 'editlist',
- 'editlist_parts' => [ { type=>'text' },
- { type=>'immutable', value=>'IN' },
- { type=>'select',
- select_enum => {
- map { $_=>$_ }
- #@{ FS::domain_record->rectypes }
- qw(A AAAA CNAME MX NS PTR SPF SRV TXT)
- },
- },
- { type=> 'text' }, ],
- },
-
- {
- 'key' => 'passwordmin',
- 'section' => 'password',
- 'description' => 'Minimum password length (default 6)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'passwordmax',
- 'section' => 'password',
- 'description' => 'Maximum password length (default 8) (don\'t set this over 12 if you need to import or export crypt() passwords)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'password-noampersand',
- 'section' => 'password',
- 'description' => 'Disallow ampersands in passwords',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'password-noexclamation',
- 'section' => 'password',
- 'description' => 'Disallow exclamations in passwords (Not setting this could break old text Livingston or Cistron Radius servers)',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'default-password-encoding',
- 'section' => 'password',
- 'description' => 'Default storage format for passwords',
- 'type' => 'select',
- 'select_hash' => [
- 'plain' => 'Plain text',
- 'crypt-des' => 'Unix password (DES encrypted)',
- 'crypt-md5' => 'Unix password (MD5 digest)',
- 'ldap-plain' => 'LDAP (plain text)',
- 'ldap-crypt' => 'LDAP (DES encrypted)',
- 'ldap-md5' => 'LDAP (MD5 digest)',
- 'ldap-sha1' => 'LDAP (SHA1 digest)',
- 'legacy' => 'Legacy mode',
- ],
- },
-
- {
- 'key' => 'referraldefault',
- 'section' => 'UI',
- 'description' => 'Default referral, specified by refnum',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::part_referral;
- map { $_->refnum => $_->referral }
- FS::Record::qsearch( 'part_referral',
- { 'disabled' => '' }
- );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::part_referral;
- my $part_referral = FS::Record::qsearchs(
- 'part_referral', { 'refnum'=>shift } );
- $part_referral ? $part_referral->referral : '';
- },
- },
-
-# {
-# 'key' => 'registries',
-# 'section' => 'required',
-# 'description' => 'Directory which contains domain registry information. Each registry is a directory.',
-# },
-
- {
- 'key' => 'report_template',
- 'section' => 'deprecated',
- 'description' => 'Deprecated template file for reports.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'maxsearchrecordsperpage',
- 'section' => 'UI',
- 'description' => 'If set, number of search records to return per page.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'session-start',
- 'section' => 'session',
- 'description' => 'If defined, the command which is executed on the Freeside machine when a session begins. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'session-stop',
- 'section' => 'session',
- 'description' => 'If defined, the command which is executed on the Freeside machine when a session ends. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'shells',
- 'section' => 'shell',
- 'description' => 'Legal shells (think /etc/shells). You probably want to `cut -d: -f7 /etc/passwd | sort | uniq\' initially so that importing doesn\'t fail with `Illegal shell\' errors, then remove any special entries afterwords. A blank line specifies that an empty shell is permitted.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'showpasswords',
- 'section' => 'UI',
- 'description' => 'Display unencrypted user passwords in the backend (employee) web interface',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'report-showpasswords',
- 'section' => 'UI',
- 'description' => 'This is a terrible idea. Do not enable it. STRONGLY NOT RECOMMENDED. Enables display of passwords on services reports.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'signupurl',
- 'section' => 'UI',
- 'description' => 'if you are using customer-to-customer referrals, and you enter the URL of your <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Self-Service_Installation">signup server CGI</a>, the customer view screen will display a customized link to the signup server with the appropriate customer as referral',
- 'type' => 'text',
- },
-
- {
- 'key' => 'smtpmachine',
- 'section' => 'required',
- 'description' => 'SMTP relay for Freeside\'s outgoing mail',
- 'type' => 'text',
- },
-
- {
- '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.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'soaemail',
- 'section' => 'BIND',
- 'description' => 'SOA email for new domains, in BIND form (`.\' instead of `@\'), with trailing `.\'',
- 'type' => 'text',
- },
-
- {
- 'key' => 'soaexpire',
- 'section' => 'BIND',
- 'description' => 'SOA expire for new domains',
- 'type' => 'text',
- },
-
- {
- 'key' => 'soamachine',
- 'section' => 'BIND',
- 'description' => 'SOA machine for new domains, with trailing `.\'',
- 'type' => 'text',
- },
-
- {
- 'key' => 'soarefresh',
- 'section' => 'BIND',
- 'description' => 'SOA refresh for new domains',
- 'type' => 'text',
- },
-
- {
- 'key' => 'soaretry',
- 'section' => 'BIND',
- 'description' => 'SOA retry for new domains',
- 'type' => 'text',
- },
-
- {
- 'key' => 'statedefault',
- 'section' => 'UI',
- 'description' => 'Default state or province (if not supplied, the default is `CA\')',
- 'type' => 'text',
- },
-
- {
- 'key' => 'unsuspendauto',
- 'section' => 'billing',
- 'description' => 'Enables the automatic unsuspension of suspended packages when a customer\'s balance due changes from positive to zero or negative as the result of a payment or credit',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'unsuspend-always_adjust_next_bill_date',
- 'section' => 'billing',
- 'description' => 'Global override that causes unsuspensions to always adjust the next bill date under any circumstances. This is now controlled on a per-package bases - probably best not to use this option unless you are a legacy installation that requires this behaviour.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'usernamemin',
- 'section' => 'username',
- 'description' => 'Minimum username length (default 2)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'usernamemax',
- 'section' => 'username',
- 'description' => 'Maximum username length',
- 'type' => 'text',
- },
-
- {
- 'key' => 'username-ampersand',
- 'section' => 'username',
- 'description' => 'Allow the ampersand character (&amp;) in usernames. Be careful when using this option in conjunction with <a href="../browse/part_export.cgi">exports</a> which execute shell commands, as the ampersand will be interpreted by the shell if not quoted.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-letter',
- 'section' => 'username',
- 'description' => 'Usernames must contain at least one letter',
- 'type' => 'checkbox',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'username-letterfirst',
- 'section' => 'username',
- 'description' => 'Usernames must start with a letter',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-noperiod',
- 'section' => 'username',
- 'description' => 'Disallow periods in usernames',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-nounderscore',
- 'section' => 'username',
- 'description' => 'Disallow underscores in usernames',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-nodash',
- 'section' => 'username',
- 'description' => 'Disallow dashes in usernames',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-uppercase',
- 'section' => 'username',
- 'description' => 'Allow uppercase characters in usernames. Not recommended for use with FreeRADIUS with MySQL backend, which is case-insensitive by default.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-percent',
- 'section' => 'username',
- 'description' => 'Allow the percent character (%) in usernames.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-colon',
- 'section' => 'username',
- 'description' => 'Allow the colon character (:) in usernames.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-slash',
- 'section' => 'username',
- 'description' => 'Allow the slash character (/) in usernames. When using, make sure to set "Home directory" to fixed and blank in all svc_acct service definitions.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-equals',
- 'section' => 'username',
- 'description' => 'Allow the equal sign character (=) in usernames.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'safe-part_bill_event',
- 'section' => 'UI',
- 'description' => 'Validates invoice event expressions against a preset list. Useful for webdemos, annoying to powerusers.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'show_ss',
- 'section' => 'UI',
- 'description' => 'Turns on display/collection of social security numbers in the web interface. Sometimes required by electronic check (ACH) processors.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'show_stateid',
- 'section' => 'UI',
- 'description' => "Turns on display/collection of driver's license/state issued id numbers in the web interface. Sometimes required by electronic check (ACH) processors.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'show_bankstate',
- 'section' => 'UI',
- 'description' => "Turns on display/collection of state for bank accounts in the web interface. Sometimes required by electronic check (ACH) processors.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'agent_defaultpkg',
- 'section' => 'UI',
- 'description' => 'Setting this option will cause new packages to be available to all agent types by default.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'legacy_link',
- 'section' => 'UI',
- 'description' => 'Display options in the web interface to link legacy pre-Freeside services.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'legacy_link-steal',
- 'section' => 'UI',
- 'description' => 'Allow "stealing" an already-audited service from one customer (or package) to another using the link function.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'queue_dangerous_controls',
- 'section' => 'UI',
- 'description' => 'Enable queue modification controls on account pages and for new jobs. Unless you are a developer working on new export code, you should probably leave this off to avoid causing provisioning problems.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'security_phrase',
- 'section' => 'password',
- 'description' => 'Enable the tracking of a "security phrase" with each account. Not recommended, as it is vulnerable to social engineering.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'locale',
- 'section' => 'UI',
- 'description' => 'Message locale',
- 'type' => 'select',
- 'select_enum' => [ qw(en_US) ],
- },
-
- {
- 'key' => 'signup_server-payby',
- '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-payment_gateway',
- 'section' => 'self-service',
- 'description' => 'Force the use of this payment gateway for self-service.',
- %payment_gateway_options,
- },
-
- {
- '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' => 'self-service',
- 'description' => 'Default agent for the signup server',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::agent;
- map { $_->agentnum => $_->agent }
- FS::Record::qsearch('agent', { disabled=>'' } );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::agent;
- my $agent = FS::Record::qsearchs(
- 'agent', { 'agentnum'=>shift }
- );
- $agent ? $agent->agent : '';
- },
- },
-
- {
- 'key' => 'signup_server-default_refnum',
- 'section' => 'self-service',
- 'description' => 'Default advertising source for the signup server',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::part_referral;
- map { $_->refnum => $_->referral }
- FS::Record::qsearch( 'part_referral',
- { 'disabled' => '' }
- );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::part_referral;
- my $part_referral = FS::Record::qsearchs(
- 'part_referral', { 'refnum'=>shift } );
- $part_referral ? $part_referral->referral : '';
- },
- },
-
- {
- 'key' => 'signup_server-default_pkgpart',
- 'section' => 'self-service',
- 'description' => 'Default package for the signup server',
- 'type' => 'select-part_pkg',
- },
-
- {
- 'key' => 'signup_server-default_svcpart',
- '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' => 'self-service',
- 'description' => 'Service definitions which can receive mac addresses (current mapped to username for svc_acct).',
- 'type' => 'select-part_svc',
- 'multiple' => 1,
- },
-
- {
- 'key' => 'signup_server-nomadix',
- 'section' => 'self-service',
- 'description' => 'Signup page Nomadix integration',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'signup_server-service',
- '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' => [
- 'svc_acct' => 'Account (svc_acct)',
- 'svc_phone' => 'Phone number (svc_phone)',
- 'svc_pbx' => 'PBX (svc_pbx)',
- ],
- },
-
- {
- 'key' => 'selfservice_server-base_url',
- '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',
- },
-
- {
- 'key' => 'show-msgcat-codes',
- 'section' => 'UI',
- 'description' => 'Show msgcat codes in error messages. Turn this option on before reporting errors to the mailing list.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'signup_server-realtime',
- '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' => 'self-service',
- 'description' => 'Package Class for first optional purchase',
- 'type' => 'select-pkg_class',
- },
-
- {
- 'key' => 'signup_server-classnum3',
- 'section' => 'self-service',
- 'description' => 'Package Class for second optional purchase',
- 'type' => 'select-pkg_class',
- },
-
- {
- 'key' => 'selfservice-xmlrpc',
- 'section' => 'self-service',
- 'description' => 'Run a standalone self-service XML-RPC server on the backend (on port 8080).',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'backend-realtime',
- 'section' => 'billing',
- 'description' => 'Run billing for backend signups immediately.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'decline_msgnum',
- 'section' => 'notification',
- 'description' => 'Template to use for credit card and electronic check decline messages.',
- %msg_template_options,
- },
-
- {
- 'key' => 'declinetemplate',
- 'section' => 'deprecated',
- 'description' => 'Template file for credit card and electronic check decline emails.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'emaildecline',
- 'section' => 'notification',
- 'description' => 'Enable emailing of credit card and electronic check decline notices.',
- 'type' => 'checkbox',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'emaildecline-exclude',
- 'section' => 'notification',
- 'description' => 'List of error messages that should not trigger email decline notices, one per line.',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'cancel_msgnum',
- 'section' => 'notification',
- 'description' => 'Template to use for cancellation emails.',
- %msg_template_options,
- },
-
- {
- 'key' => 'cancelmessage',
- 'section' => 'deprecated',
- 'description' => 'Template file for cancellation emails.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'cancelsubject',
- 'section' => 'deprecated',
- 'description' => 'Subject line for cancellation emails.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'emailcancel',
- 'section' => 'notification',
- 'description' => 'Enable emailing of cancellation notices. Make sure to select the template in the cancel_msgnum option.',
- 'type' => 'checkbox',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'bill_usage_on_cancel',
- 'section' => 'billing',
- 'description' => 'Enable automatic generation of an invoice for usage when a package is cancelled. Not all packages can do this. Usage data must already be available.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'require_cardname',
- 'section' => 'billing',
- 'description' => 'Require an "Exact name on card" to be entered explicitly; don\'t default to using the first and last name.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'enable_taxclasses',
- 'section' => 'billing',
- 'description' => 'Enable per-package tax classes',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'require_taxclasses',
- 'section' => 'billing',
- 'description' => 'Require a taxclass to be entered for every package',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'enable_taxproducts',
- 'section' => 'billing',
- 'description' => 'Enable per-package mapping to vendor tax data from CCH or elsewhere.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'taxdatadirectdownload',
- 'section' => 'billing', #well
- 'description' => 'Enable downloading tax data directly from the vendor site. at least three lines: URL, username, and password.j',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'ignore_incalculable_taxes',
- 'section' => 'billing',
- 'description' => 'Prefer to invoice without tax over not billing at all',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'welcome_msgnum',
- 'section' => 'notification',
- 'description' => 'Template to use for welcome messages when a svc_acct record is created.',
- %msg_template_options,
- },
-
- {
- 'key' => 'welcome_email',
- 'section' => 'deprecated',
- 'description' => 'Template file for welcome email. Welcome emails are sent to the customer email invoice destination(s) each time a svc_acct record is created.',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'welcome_email-from',
- 'section' => 'deprecated',
- 'description' => 'From: address header for welcome email',
- 'type' => 'text',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'welcome_email-subject',
- 'section' => 'deprecated',
- 'description' => 'Subject: header for welcome email',
- 'type' => 'text',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'welcome_email-mimetype',
- 'section' => 'deprecated',
- 'description' => 'MIME type for welcome email',
- 'type' => 'select',
- 'select_enum' => [ 'text/plain', 'text/html' ],
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'welcome_letter',
- 'section' => '',
- 'description' => 'Optional LaTex template file for a printed welcome letter. A welcome letter is printed the first time a cust_pkg record is created. See the <a href="http://search.cpan.org/dist/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation and the billing documentation for details on the template substitution language. A variable exists for each fieldname in the customer record (<code>$first, $last, etc</code>). The following additional variables are available<ul><li><code>$payby</code> - a friendler represenation of the field<li><code>$payinfo</code> - the masked payment information<li><code>$expdate</code> - the time at which the payment method expires (a UNIX timestamp)<li><code>$returnaddress</code> - the invoice return address for this customer\'s agent</ul>',
- 'type' => 'textarea',
- },
-
-# {
-# 'key' => 'warning_msgnum',
-# 'section' => 'notification',
-# 'description' => 'Template to use for warning messages, sent to the customer email invoice destination(s) when a svc_acct record has its usage drop below a threshold.',
-# %msg_template_options,
-# },
-
- {
- 'key' => 'warning_email',
- 'section' => 'notification',
- 'description' => 'Template file for warning email. Warning emails are sent to the customer email invoice destination(s) each time a svc_acct record has its usage drop below a threshold or 0. See the <a href="http://search.cpan.org/dist/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitution language. The following variables are available<ul><li><code>$username</code> <li><code>$password</code> <li><code>$first</code> <li><code>$last</code> <li><code>$pkg</code> <li><code>$column</code> <li><code>$amount</code> <li><code>$threshold</code></ul>',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'warning_email-from',
- 'section' => 'notification',
- 'description' => 'From: address header for warning email',
- 'type' => 'text',
- },
-
- {
- 'key' => 'warning_email-cc',
- 'section' => 'notification',
- 'description' => 'Additional recipient(s) (comma separated) for warning email when remaining usage reaches zero.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'warning_email-subject',
- 'section' => 'notification',
- 'description' => 'Subject: header for warning email',
- 'type' => 'text',
- },
-
- {
- 'key' => 'warning_email-mimetype',
- 'section' => 'notification',
- 'description' => 'MIME type for warning email',
- 'type' => 'select',
- 'select_enum' => [ 'text/plain', 'text/html' ],
- },
-
- {
- 'key' => 'payby',
- 'section' => 'billing',
- 'description' => 'Available payment types.',
- 'type' => 'selectmultiple',
- 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB BILL CASH WEST MCRD COMP) ],
- },
-
- {
- 'key' => 'payby-default',
- 'section' => 'UI',
- 'description' => 'Default payment type. HIDE disables display of billing information and sets customers to BILL.',
- 'type' => 'select',
- 'select_enum' => [ '', qw(CARD DCRD CHEK DCHK LECB BILL CASH WEST MCRD COMP HIDE) ],
- },
-
- {
- 'key' => 'paymentforcedtobatch',
- 'section' => 'deprecated',
- 'description' => 'See batch-enable_payby and realtime-disable_payby. Used to (for CHEK): Cause per customer payment entry to be forced to a batch processor rather than performed realtime.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-notes',
- 'section' => 'deprecated',
- 'description' => 'Extra HTML to be displayed on the Account View screen.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'radius-password',
- 'section' => '',
- 'description' => 'RADIUS attribute for plain-text passwords.',
- 'type' => 'select',
- 'select_enum' => [ 'Password', 'User-Password', 'Cleartext-Password' ],
- },
-
- {
- 'key' => 'radius-ip',
- 'section' => '',
- 'description' => 'RADIUS attribute for IP addresses.',
- 'type' => 'select',
- 'select_enum' => [ 'Framed-IP-Address', 'Framed-Address' ],
- },
-
- #http://dev.coova.org/svn/coova-chilli/doc/dictionary.chillispot
- {
- 'key' => 'radius-chillispot-max',
- 'section' => '',
- 'description' => 'Enable ChilliSpot (and CoovaChilli) Max attributes, specifically ChilliSpot-Max-{Input,Output,Total}-{Octets,Gigawords}.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-alldomains',
- 'section' => '',
- 'description' => 'Allow accounts to select any domain in the database. Normally accounts can only select from the domain set in the service definition and those purchased by the customer.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'dump-scpdest',
- 'section' => '',
- 'description' => 'destination for scp database dumps: user@host:/path',
- 'type' => 'text',
- },
-
- {
- 'key' => 'dump-pgpid',
- 'section' => '',
- 'description' => "Optional PGP public key user or key id for database dumps. The public key should exist on the freeside user's public keyring, and the gpg binary and GnuPG perl module should be installed.",
- 'type' => 'text',
- },
-
- {
- 'key' => 'users-allow_comp',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, enable the <i>Complimentary customer</i> access right instead. Was: Usernames (Freeside users, created with <a href="../docs/man/bin/freeside-adduser.html">freeside-adduser</a>) which can create complimentary customers, one per line. If no usernames are entered, all users can create complimentary accounts.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'credit_card-recurring_billing_flag',
- 'section' => 'billing',
- 'description' => 'This controls when the system passes the "recurring_billing" flag on credit card transactions. If supported by your processor (and the Business::OnlinePayment processor module), passing the flag indicates this is a recurring transaction and may turn off the CVV requirement. ',
- 'type' => 'select',
- 'select_hash' => [
- 'actual_oncard' => 'Default/classic behavior: set the flag if a customer has actual previous charges on the card.',
- 'transaction_is_recur' => 'Set the flag if the transaction itself is recurring, irregardless of previous charges on the card.',
- ],
- },
-
- {
- 'key' => 'credit_card-recurring_billing_acct_code',
- 'section' => 'billing',
- 'description' => 'When the "recurring billing" flag is set, also set the "acct_code" to "rebill". Useful for reporting purposes with supported gateways (PlugNPay, others?)',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cvv-save',
- 'section' => 'billing',
- 'description' => 'Save CVV2 information after the initial transaction for the selected credit card types. Enabling this option may be in violation of your merchant agreement(s), so please check them carefully before enabling this option for any credit card types.',
- 'type' => 'selectmultiple',
- 'select_enum' => \@card_types,
- },
-
- {
- 'key' => 'manual_process-pkgpart',
- 'section' => 'billing',
- 'description' => 'Package to add to each manual credit card and ACH payments entered from the backend. Enabling this option may be in violation of your merchant agreement(s), so please check them carefully before enabling this option.',
- 'type' => 'select-part_pkg',
- },
-
- {
- 'key' => 'manual_process-display',
- 'section' => 'billing',
- 'description' => 'When using manual_process-pkgpart, add the fee to the amount entered (default), or subtract the fee from the amount entered.',
- 'type' => 'select',
- 'select_hash' => [
- 'add' => 'Add fee to amount entered',
- 'subtract' => 'Subtract fee from amount entered',
- ],
- },
-
- {
- 'key' => 'manual_process-skip_first',
- 'section' => 'billing',
- 'description' => "When using manual_process-pkgpart, omit the fee if it is the customer's first payment.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'allow_negative_charges',
- 'section' => 'billing',
- 'description' => 'Allow negative charges. Normally not used unless importing data from a legacy system that requires this.',
- 'type' => 'checkbox',
- },
- {
- 'key' => 'auto_unset_catchall',
- 'section' => '',
- 'description' => 'When canceling a svc_acct that is the email catchall for one or more svc_domains, automatically set their catchall fields to null. If this option is not set, the attempt will simply fail.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'system_usernames',
- 'section' => 'username',
- 'description' => 'A list of system usernames that cannot be edited or removed, one per line. Use a bare username to prohibit modification/deletion of the username in any domain, or username@domain to prohibit modification/deletetion of a specific username and domain.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'cust_pkg-change_svcpart',
- 'section' => '',
- 'description' => "When changing packages, move services even if svcparts don't match between old and new pacakge definitions.",
- 'type' => 'checkbox',
- },
-
- {
- '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 based on the package must be present at all times.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'disable_autoreverse',
- 'section' => 'BIND',
- 'description' => 'Disable automatic synchronization of reverse-ARPA entries.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_www-enable_subdomains',
- 'section' => '',
- 'description' => 'Enable selection of specific subdomains for virtual host creation.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_www-usersvc_svcpart',
- 'section' => '',
- 'description' => 'Allowable service definition svcparts for virtual hosts, one per line.',
- 'type' => 'select-part_svc',
- 'multiple' => 1,
- },
-
- {
- 'key' => 'selfservice_server-primary_only',
- 'section' => 'self-service',
- 'description' => 'Only allow primary accounts to access self-service functionality.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'selfservice_server-phone_login',
- 'section' => 'self-service',
- 'description' => 'Allow login to self-service with phone number and PIN.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'selfservice_server-single_domain',
- 'section' => 'self-service',
- 'description' => 'If specified, only use this one domain for self-service access.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'selfservice_server-login_svcpart',
- 'section' => 'self-service',
- 'description' => 'If specified, only allow the specified svcparts to login to self-service.',
- 'type' => 'select-part_svc',
- 'multiple' => 1,
- },
-
- {
- 'key' => 'selfservice-recent-did-age',
- 'section' => 'self-service',
- 'description' => 'If specified, defines "recent", in number of seconds, for "Download recently allocated DIDs" in self-service.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'selfservice_server-view-wholesale',
- 'section' => 'self-service',
- 'description' => 'If enabled, use a wholesale package view in the self-service.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'selfservice-agent_signup',
- 'section' => 'self-service',
- 'description' => 'Allow agent signup via self-service.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'selfservice-agent_signup-agent_type',
- 'section' => 'self-service',
- 'description' => 'Agent type when allowing agent signup via self-service.',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::agent_type;
- map { $_->typenum => $_->atype }
- FS::Record::qsearch('agent_type', {} ); # disabled=>'' } );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::agent_type;
- my $agent = FS::Record::qsearchs(
- 'agent_type', { 'typenum'=>shift }
- );
- $agent_type ? $agent_type->atype : '';
- },
- },
-
- {
- 'key' => 'selfservice-agent_login',
- 'section' => 'self-service',
- 'description' => 'Allow agent login via self-service.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'selfservice-self_suspend_reason',
- 'section' => 'self-service',
- 'description' => 'Suspend reason when customers suspend their own packages. Set to nothing to disallow self-suspension.',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::reason;
- my $type = qsearchs('reason_type',
- { class => 'S' })
- or return ();
- map { $_->reasonnum => $_->reason }
- FS::Record::qsearch('reason',
- { reason_type => $type->typenum }
- );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::reason;
- my $reason = FS::Record::qsearchs(
- 'reason', { 'reasonnum' => shift }
- );
- $reason ? $reason->reason : '';
- },
-
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'card_refund-days',
- 'section' => 'billing',
- 'description' => 'After a payment, the number of days a refund link will be available for that payment. Defaults to 120.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'agent-showpasswords',
- 'section' => '',
- 'description' => 'Display unencrypted user passwords in the agent (reseller) interface',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'global_unique-username',
- 'section' => 'username',
- 'description' => 'Global username uniqueness control: none (usual setting - check uniqueness per exports), username (all usernames are globally unique, regardless of domain or exports), or username@domain (all username@domain pairs are globally unique, regardless of exports). disabled turns off duplicate checking completely and is STRONGLY NOT RECOMMENDED unless you REALLY need to turn this off.',
- 'type' => 'select',
- 'select_enum' => [ 'none', 'username', 'username@domain', 'disabled' ],
- },
-
- {
- 'key' => 'global_unique-phonenum',
- 'section' => '',
- 'description' => 'Global phone number uniqueness control: none (usual setting - check countrycode+phonenumun uniqueness per exports), or countrycode+phonenum (all countrycode+phonenum pairs are globally unique, regardless of exports). disabled turns off duplicate checking completely and is STRONGLY NOT RECOMMENDED unless you REALLY need to turn this off.',
- 'type' => 'select',
- 'select_enum' => [ 'none', 'countrycode+phonenum', 'disabled' ],
- },
-
- {
- 'key' => 'global_unique-pbx_title',
- 'section' => '',
- 'description' => 'Global phone number uniqueness control: none (check uniqueness per exports), enabled (check across all services), or disabled (no duplicate checking).',
- 'type' => 'select',
- 'select_enum' => [ 'enabled', 'disabled' ],
- },
-
- {
- 'key' => 'global_unique-pbx_id',
- 'section' => '',
- 'description' => 'Global PBX id uniqueness control: none (check uniqueness per exports), enabled (check across all services), or disabled (no duplicate checking).',
- 'type' => 'select',
- 'select_enum' => [ 'enabled', 'disabled' ],
- },
-
- {
- 'key' => 'svc_external-skip_manual',
- 'section' => 'UI',
- 'description' => 'When provisioning svc_external services, skip manual entry of id and title fields in the UI. Usually used in conjunction with an export that populates these fields (i.e. artera_turbo).',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_external-display_type',
- 'section' => 'UI',
- 'description' => 'Select a specific svc_external type to enable some UI changes specific to that type (i.e. artera_turbo).',
- 'type' => 'select',
- 'select_enum' => [ 'generic', 'artera_turbo', ],
- },
-
- {
- 'key' => 'ticket_system',
- 'section' => '',
- 'description' => 'Ticketing system integration. <b>RT_Internal</b> uses the built-in RT ticketing system (see the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:RT_Installation">integrated ticketing installation instructions</a>). <b>RT_External</b> accesses an external RT installation in a separate database (local or remote).',
- 'type' => 'select',
- #'select_enum' => [ '', qw(RT_Internal RT_Libs RT_External) ],
- 'select_enum' => [ '', qw(RT_Internal RT_External) ],
- },
-
- {
- 'key' => 'ticket_system-default_queueid',
- 'section' => '',
- 'description' => 'Default queue used when creating new customer tickets.',
- '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-force_default_queueid',
- 'section' => '',
- 'description' => 'Disallow queue selection when creating new tickets from customer view.',
- 'type' => 'checkbox',
- },
- {
- '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.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'ticket_system-custom_priority_field',
- 'section' => '',
- 'description' => 'Custom field from the ticketing system to use as a custom priority classification.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'ticket_system-custom_priority_field-values',
- 'section' => '',
- 'description' => 'Values for the custom field from the ticketing system to break down and sort customer ticket lists.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'ticket_system-custom_priority_field_queue',
- 'section' => '',
- 'description' => 'Ticketing system queue in which the custom field specified in ticket_system-custom_priority_field is located.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'ticket_system-rt_external_datasrc',
- 'section' => '',
- 'description' => 'With external RT integration, the DBI data source for the external RT installation, for example, <code>DBI:Pg:user=rt_user;password=rt_word;host=rt.example.com;dbname=rt</code>',
- 'type' => 'text',
-
- },
-
- {
- 'key' => 'ticket_system-rt_external_url',
- 'section' => '',
- 'description' => 'With external RT integration, the URL for the external RT installation, for example, <code>https://rt.example.com/rt</code>',
- 'type' => 'text',
- },
-
- {
- 'key' => 'company_name',
- 'section' => 'required',
- 'description' => 'Your company name',
- 'type' => 'text',
- 'per_agent' => 1, #XXX just FS/FS/ClientAPI/Signup.pm
- },
-
- {
- 'key' => 'company_address',
- 'section' => 'required',
- 'description' => 'Your company address',
- 'type' => 'textarea',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'echeck-void',
- 'section' => 'deprecated',
- 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable local-only voiding of echeck payments in addition to refunds against the payment gateway',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cc-void',
- 'section' => 'deprecated',
- 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable local-only voiding of credit card payments in addition to refunds against the payment gateway',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'unvoid',
- 'section' => 'deprecated',
- 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable unvoiding of voided payments',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'address1-search',
- 'section' => 'UI',
- 'description' => 'Enable the ability to search the address1 field from the quick customer search. Not recommended in most cases as it tends to bring up too many search results - use explicit address searching from the advanced customer search instead.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'address2-search',
- 'section' => 'UI',
- 'description' => 'Enable a "Unit" search box which searches the second address field. Useful for multi-tenant applications. See also: cust_main-require_address2',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-require_address2',
- 'section' => 'UI',
- 'description' => 'Second address field is required (on service address only, if billing and service addresses differ). Also enables "Unit" labeling of address2 on customer view and edit pages. Useful for multi-tenant applications. See also: address2-search',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'agent-ship_address',
- 'section' => '',
- 'description' => "Use the agent's master service address as the service address (only ship_address2 can be entered, if blank on the master address). Useful for multi-tenant applications.",
- 'type' => 'checkbox',
- },
-
- { 'key' => 'referral_credit',
- 'section' => 'deprecated',
- 'description' => "Used to enable one-time referral credits in the amount of one month <i>referred</i> customer's recurring fee (irregardless of frequency). Replace with a billing event on appropriate packages.",
- 'type' => 'checkbox',
- },
-
- { 'key' => 'selfservice_server-cache_module',
- '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' ],
- },
-
- {
- 'key' => 'hylafax',
- 'section' => 'billing',
- 'description' => 'Options for a HylaFAX server to enable the FAX invoice destination. They should be in the form of a space separated list of arguments to the Fax::Hylafax::Client::sendfax subroutine. You probably shouldn\'t override things like \'docfile\'. *Note* Only supported when using typeset invoices (see the invoice_latex configuration option).',
- 'type' => [qw( checkbox textarea )],
- },
-
- {
- 'key' => 'cust_bill-ftpformat',
- 'section' => 'invoicing',
- 'description' => 'Enable FTP of raw invoice data - format.',
- 'type' => 'select',
- 'select_enum' => [ '', 'default', 'billco', ],
- },
-
- {
- 'key' => 'cust_bill-ftpserver',
- 'section' => 'invoicing',
- 'description' => 'Enable FTP of raw invoice data - server.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_bill-ftpusername',
- 'section' => 'invoicing',
- 'description' => 'Enable FTP of raw invoice data - server.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_bill-ftppassword',
- 'section' => 'invoicing',
- 'description' => 'Enable FTP of raw invoice data - server.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_bill-ftpdir',
- 'section' => 'invoicing',
- 'description' => 'Enable FTP of raw invoice data - server.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_bill-spoolformat',
- 'section' => 'invoicing',
- 'description' => 'Enable spooling of raw invoice data - format.',
- 'type' => 'select',
- 'select_enum' => [ '', 'default', 'billco', ],
- },
-
- {
- 'key' => 'cust_bill-spoolagent',
- 'section' => 'invoicing',
- 'description' => 'Enable per-agent spooling of raw invoice data.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-usage_suspend',
- 'section' => 'billing',
- 'description' => 'Suspends the package an account belongs to when svc_acct.seconds or a bytecount is decremented to 0 or below (accounts with an empty seconds and up|down|totalbytes value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-usage_unsuspend',
- 'section' => 'billing',
- 'description' => 'Unuspends the package an account belongs to when svc_acct.seconds or a bytecount is incremented from 0 or below to a positive value (accounts with an empty seconds and up|down|totalbytes value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-usage_threshold',
- 'section' => 'billing',
- 'description' => 'The threshold (expressed as percentage) of acct.seconds or acct.up|down|totalbytes at which a warning message is sent to a service holder. Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'overlimit_groups',
- 'section' => '',
- 'description' => 'RADIUS group (or comma-separated groups) to assign to svc_acct which has exceeded its bandwidth or time limit.',
- 'type' => 'text',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'cust-fields',
- 'section' => 'UI',
- 'description' => 'Which customer fields to display on reports by default',
- 'type' => 'select',
- 'select_hash' => [ FS::ConfDefaults->cust_fields_avail() ],
- },
-
- {
- 'key' => 'cust_pkg-display_times',
- 'section' => 'UI',
- 'description' => 'Display full timestamps (not just dates) for customer packages. Useful if you are doing real-time things like hourly prepaid.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_pkg-always_show_location',
- 'section' => 'UI',
- 'description' => "Always display package locations, even when they're all the default service address.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_pkg-group_by_location',
- 'section' => 'UI',
- 'description' => "Group packages by location.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_pkg-show_fcc_voice_grade_equivalent',
- 'section' => 'UI',
- 'description' => "Show a field on package definitions for assigning a DSO equivalency number suitable for use on FCC form 477.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_pkg-large_pkg_size',
- 'section' => 'UI',
- 'description' => "In customer view, summarize packages with more than this many services. Set to zero to never summarize packages.",
- 'type' => 'text',
- },
-
- {
- 'key' => 'svc_acct-edit_uid',
- 'section' => 'shell',
- 'description' => 'Allow UID editing.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-edit_gid',
- 'section' => 'shell',
- 'description' => 'Allow GID editing.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'zone-underscore',
- 'section' => 'BIND',
- 'description' => 'Allow underscores in zone names. As underscores are illegal characters in zone names, this option is not recommended.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'echeck-nonus',
- 'section' => 'billing',
- 'description' => 'Disable ABA-format account checking for Electronic Check payment info',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'voip-cust_cdr_spools',
- 'section' => '',
- 'description' => 'Enable the per-customer option for individual CDR spools.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'voip-cust_cdr_squelch',
- 'section' => '',
- 'description' => 'Enable the per-customer option for not printing CDR on invoices.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'voip-cdr_email',
- 'section' => '',
- 'description' => 'Include the call details on emailed invoices (and HTML invoices viewed in the backend), even if the customer is configured for not printing them on the invoices.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'voip-cust_email_csv_cdr',
- 'section' => '',
- 'description' => 'Enable the per-customer option for including CDR information as a CSV attachment on emailed invoices.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cgp_rule-domain_templates',
- 'section' => '',
- 'description' => 'Communigate Pro rule templates for domains, one per line, "svcnum Name"',
- 'type' => 'textarea',
- },
-
- {
- '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.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'tax-ship_address',
- 'section' => 'billing',
- 'description' => 'By default, tax calculations are done based on the billing address. Enable this switch to calculate tax based on the shipping address instead.',
- 'type' => 'checkbox',
- }
-,
- {
- 'key' => 'tax-pkg_address',
- 'section' => 'billing',
- 'description' => 'By default, tax calculations are done based on the billing address. Enable this switch to calculate tax based on the package address instead (when present).',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'invoice-ship_address',
- 'section' => 'invoicing',
- 'description' => 'Include the shipping address on invoices.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'invoice-unitprice',
- 'section' => 'invoicing',
- 'description' => 'Enable unit pricing on invoices.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'invoice-smallernotes',
- 'section' => 'invoicing',
- 'description' => 'Display the notes section in a smaller font on invoices.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'invoice-smallerfooter',
- 'section' => 'invoicing',
- 'description' => 'Display footers in a smaller font on invoices.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'postal_invoice-fee_pkgpart',
- 'section' => 'billing',
- 'description' => 'This allows selection of a package to insert on invoices for customers with postal invoices selected.',
- 'type' => 'select-part_pkg',
- },
-
- {
- 'key' => 'postal_invoice-recurring_only',
- 'section' => 'billing',
- 'description' => 'The postal invoice fee is omitted on invoices without reucrring charges when this is set.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'batch-enable',
- 'section' => 'deprecated', #make sure batch-enable_payby is set for
- #everyone before removing
- 'description' => 'Enable credit card and/or ACH batching - leave disabled for real-time installations.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'batch-enable_payby',
- 'section' => 'billing',
- 'description' => 'Enable batch processing for the specified payment types.',
- 'type' => 'selectmultiple',
- 'select_enum' => [qw( CARD CHEK )],
- },
-
- {
- 'key' => 'realtime-disable_payby',
- 'section' => 'billing',
- 'description' => 'Disable realtime processing for the specified payment types.',
- 'type' => 'selectmultiple',
- 'select_enum' => [qw( CARD CHEK )],
- },
-
- {
- 'key' => 'batch-default_format',
- 'section' => 'billing',
- 'description' => 'Default format for batches.',
- 'type' => 'select',
- 'select_enum' => [ 'csv-td_canada_trust-merchant_pc_batch',
- 'csv-chase_canada-E-xactBatch', 'BoM', 'PAP',
- 'paymentech', 'ach-spiritone', 'RBC'
- ]
- },
-
- #lists could be auto-generated from pay_batch info
- {
- 'key' => 'batch-fixed_format-CARD',
- 'section' => 'billing',
- 'description' => 'Fixed (unchangeable) format for credit card batches.',
- 'type' => 'select',
- 'select_enum' => [ 'csv-td_canada_trust-merchant_pc_batch', 'BoM', 'PAP' ,
- 'csv-chase_canada-E-xactBatch', 'paymentech' ]
- },
-
- {
- 'key' => 'batch-fixed_format-CHEK',
- 'section' => 'billing',
- 'description' => 'Fixed (unchangeable) format for electronic check batches.',
- 'type' => 'select',
- 'select_enum' => [ 'csv-td_canada_trust-merchant_pc_batch', 'BoM', 'PAP',
- 'paymentech', 'ach-spiritone', 'RBC'
- ]
- },
-
- {
- 'key' => 'batch-increment_expiration',
- 'section' => 'billing',
- 'description' => 'Increment expiration date years in batches until cards are current. Make sure this is acceptable to your batching provider before enabling.',
- 'type' => 'checkbox'
- },
-
- {
- 'key' => 'batchconfig-BoM',
- 'section' => 'billing',
- 'description' => 'Configuration for Bank of Montreal batching, seven lines: 1. Origin ID, 2. Datacenter, 3. Typecode, 4. Short name, 5. Long name, 6. Bank, 7. Bank account',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'batchconfig-PAP',
- 'section' => 'billing',
- 'description' => 'Configuration for PAP batching, seven lines: 1. Origin ID, 2. Datacenter, 3. Typecode, 4. Short name, 5. Long name, 6. Bank, 7. Bank account',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'batchconfig-csv-chase_canada-E-xactBatch',
- 'section' => 'billing',
- 'description' => 'Gateway ID for Chase Canada E-xact batching',
- 'type' => 'text',
- },
-
- {
- 'key' => 'batchconfig-paymentech',
- 'section' => 'billing',
- 'description' => 'Configuration for Chase Paymentech batching, five lines: 1. BIN, 2. Terminal ID, 3. Merchant ID, 4. Username, 5. Password (for batch uploads)',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'batchconfig-RBC',
- 'section' => 'billing',
- 'description' => 'Configuration for Royal Bank of Canada PDS batching, four lines: 1. Client number, 2. Short name, 3. Long name, 4. Transaction code.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'batchconfig-td_eft1464',
- 'section' => 'billing',
- 'description' => 'Configuration for TD Bank EFT1464 batching, five lines: 1. Originator ID, 2. Datacenter Code, 3. Short name, 4. Long name, 5. Returned payment branch number, 6. Returned payment account, 7. Transaction code.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'batch-manual_approval',
- 'section' => 'billing',
- 'description' => 'Allow manual batch closure, which will approve all payments that do not yet have a status. This is not advised, but is needed for payment processors that provide a report of rejected rather than approved payments.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'payment_history-years',
- 'section' => 'UI',
- 'description' => 'Number of years of payment history to show by default. Currently defaults to 2.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'change_history-years',
- 'section' => 'UI',
- 'description' => 'Number of years of change history to show by default. Currently defaults to 0.5.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_main-packages-years',
- 'section' => 'UI',
- 'description' => 'Number of years to show old (cancelled and one-time charge) packages by default. Currently defaults to 2.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_main-use_comments',
- 'section' => 'UI',
- 'description' => 'Display free form comments on the customer edit screen. Useful as a scratch pad.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-disable_notes',
- 'section' => 'UI',
- 'description' => 'Disable new style customer notes - timestamped and user identified customer notes. Useful in tracking who did what.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main_note-display_times',
- 'section' => 'UI',
- 'description' => 'Display full timestamps (not just dates) for customer notes.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-ticket_statuses',
- 'section' => 'UI',
- 'description' => 'Show tickets with these statuses on the customer view page.',
- 'type' => 'selectmultiple',
- 'select_enum' => [qw( new open stalled resolved rejected deleted )],
- },
-
- {
- 'key' => 'cust_main-max_tickets',
- 'section' => 'UI',
- 'description' => 'Maximum number of tickets to show on the customer view page.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_main-skeleton_tables',
- 'section' => '',
- 'description' => 'Tables which will have skeleton records inserted into them for each customer. Syntax for specifying tables is unfortunately a tricky perl data structure for now.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'cust_main-skeleton_custnum',
- 'section' => '',
- 'description' => 'Customer number specifying the source data to copy into skeleton tables for new customers.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_main-enable_birthdate',
- 'section' => 'UI',
- 'descritpion' => 'Enable tracking of a birth date with each customer record',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'support-key',
- 'section' => '',
- 'description' => 'A support key enables access to commercial services delivered over the network, such as the payroll module, access to the internal ticket system, priority support and optional backups.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'card-types',
- 'section' => 'billing',
- 'description' => 'Select one or more card types to enable only those card types. If no card types are selected, all card types are available.',
- 'type' => 'selectmultiple',
- 'select_enum' => \@card_types,
- },
-
- {
- 'key' => 'disable-fuzzy',
- 'section' => 'UI',
- 'description' => 'Disable fuzzy searching. Speeds up searching for large sites, but only shows exact matches.',
- 'type' => 'checkbox',
- },
-
- { 'key' => 'pkg_referral',
- 'section' => '',
- 'description' => 'Enable package-specific advertising sources.',
- 'type' => 'checkbox',
- },
-
- { 'key' => 'pkg_referral-multiple',
- 'section' => '',
- 'description' => 'In addition, allow multiple advertising sources to be associated with a single package.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'dashboard-install_welcome',
- 'section' => 'UI',
- 'description' => 'New install welcome screen.',
- 'type' => 'select',
- 'select_enum' => [ '', 'ITSP_fsinc_hosted', ],
- },
-
- {
- 'key' => 'dashboard-toplist',
- 'section' => 'UI',
- 'description' => 'List of items to display on the top of the front page',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'impending_recur_msgnum',
- 'section' => 'notification',
- 'description' => 'Template to use for alerts about first-time recurring billing.',
- %msg_template_options,
- },
-
- {
- 'key' => 'impending_recur_template',
- 'section' => 'deprecated',
- 'description' => 'Template file for alerts about looming first time recurrant billing. See the <a href="http://search.cpan.org/dist/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitition language. Also see packages with a <a href="../browse/part_pkg.cgi">flat price plan</a> The following variables are available<ul><li><code>$packages</code> allowing <code>$packages->[0]</code> thru <code>$packages->[n]</code> <li><code>$package</code> the first package, same as <code>$packages->[0]</code> <li><code>$recurdates</code> allowing <code>$recurdates->[0]</code> thru <code>$recurdates->[n]</code> <li><code>$recurdate</code> the first recurdate, same as <code>$recurdate->[0]</code> <li><code>$first</code> <li><code>$last</code></ul>',
-# <li><code>$payby</code> <li><code>$expdate</code> most likely only confuse
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'logo.png',
- '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
- #old-style editor anyway...?
- },
-
- {
- 'key' => 'logo.eps',
- 'section' => 'invoicing',
- 'description' => 'Company logo for printed and PDF invoices, in EPS format.',
- 'type' => 'image',
- 'per_agent' => 1, #XXX as above, kinda
- },
-
- {
- 'key' => 'selfservice-ignore_quantity',
- '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' => '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', ],
- },
-
- {
- 'key' => 'disable_setup_suspended_pkgs',
- 'section' => 'billing',
- 'description' => 'Disables charging of setup fees for suspended packages.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'password-generated-allcaps',
- 'section' => 'password',
- 'description' => 'Causes passwords automatically generated to consist entirely of capital letters',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'datavolume-forcemegabytes',
- 'section' => 'UI',
- 'description' => 'All data volumes are expressed in megabytes',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'datavolume-significantdigits',
- 'section' => 'UI',
- 'description' => 'number of significant digits to use to represent data volumes',
- 'type' => 'text',
- },
-
- {
- 'key' => 'disable_void_after',
- 'section' => 'billing',
- 'description' => 'Number of seconds after which freeside won\'t attempt to VOID a payment first when performing a refund.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'disable_line_item_date_ranges',
- 'section' => 'billing',
- 'description' => 'Prevent freeside from automatically generating date ranges on invoice line items.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'support_packages',
- 'section' => '',
- 'description' => 'A list of packages eligible for RT ticket time transfer, one pkgpart per line.', #this should really be a select multiple, or specified in the packages themselves...
- 'type' => 'select-part_pkg',
- 'multiple' => 1,
- },
-
- {
- 'key' => 'cust_main-require_phone',
- 'section' => '',
- 'description' => 'Require daytime or night phone for all customer records.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-require_invoicing_list_email',
- 'section' => '',
- 'description' => 'Email address field is required: require at least one invoicing email address for all customer records.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-display_paid_time_remaining',
- 'section' => '',
- 'description' => 'Show paid time remaining in addition to time remaining.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cancel_credit_type',
- 'section' => 'billing',
- 'description' => 'The group to use for new, automatically generated credit reasons resulting from cancellation.',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::reason_type;
- map { $_->typenum => $_->type }
- FS::Record::qsearch('reason_type', { class=>'R' } );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::reason_type;
- my $reason_type = FS::Record::qsearchs(
- 'reason_type', { 'typenum' => shift }
- );
- $reason_type ? $reason_type->type : '';
- },
- },
-
- {
- 'key' => 'referral_credit_type',
- 'section' => 'deprecated',
- 'description' => 'Used to be the group to use for new, automatically generated credit reasons resulting from referrals. Now set in a package billing event for the referral.',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::reason_type;
- map { $_->typenum => $_->type }
- FS::Record::qsearch('reason_type', { class=>'R' } );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::reason_type;
- my $reason_type = FS::Record::qsearchs(
- 'reason_type', { 'typenum' => shift }
- );
- $reason_type ? $reason_type->type : '';
- },
- },
-
- {
- 'key' => 'signup_credit_type',
- '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;
- require FS::reason_type;
- map { $_->typenum => $_->type }
- FS::Record::qsearch('reason_type', { class=>'R' } );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::reason_type;
- my $reason_type = FS::Record::qsearchs(
- 'reason_type', { 'typenum' => shift }
- );
- $reason_type ? $reason_type->type : '';
- },
- },
-
- {
- 'key' => 'prepayment_discounts-credit_type',
- 'section' => 'billing',
- 'description' => 'Enables the offering of prepayment discounts and establishes the credit reason type.',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::reason_type;
- map { $_->typenum => $_->type }
- FS::Record::qsearch('reason_type', { class=>'R' } );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::reason_type;
- my $reason_type = FS::Record::qsearchs(
- 'reason_type', { 'typenum' => shift }
- );
- $reason_type ? $reason_type->type : '';
- },
-
- },
-
- {
- 'key' => 'cust_main-agent_custid-format',
- 'section' => '',
- 'description' => 'Enables searching of various formatted values in cust_main.agent_custid',
- 'type' => 'select',
- 'select_hash' => [
- '' => 'Numeric only',
- 'ww?d+' => 'Numeric with one or two letter prefix',
- ],
- },
-
- {
- 'key' => 'card_masking_method',
- 'section' => 'UI',
- 'description' => 'Digits to display when masking credit cards. Note that the first six digits are necessary to canonically identify the credit card type (Visa/MC, Amex, Discover, Maestro, etc.) in all cases. The first four digits can identify the most common credit card types in most cases (Visa/MC, Amex, and Discover). The first two digits can distinguish between Visa/MC and Amex. Note: You should manually remove stored paymasks if you change this value on an existing database, to avoid problems using stored cards.',
- 'type' => 'select',
- 'select_hash' => [
- '' => '123456xxxxxx1234',
- 'first6last2' => '123456xxxxxxxx12',
- 'first4last4' => '1234xxxxxxxx1234',
- 'first4last2' => '1234xxxxxxxxxx12',
- 'first2last4' => '12xxxxxxxxxx1234',
- 'first2last2' => '12xxxxxxxxxxxx12',
- 'first0last4' => 'xxxxxxxxxxxx1234',
- 'first0last2' => 'xxxxxxxxxxxxxx12',
- ],
- },
-
- {
- 'key' => 'disable_previous_balance',
- 'section' => 'invoicing',
- 'description' => 'Disable inclusion of previous balance, payment, and credit lines on invoices',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'previous_balance-exclude_from_total',
- 'section' => 'invoicing',
- 'description' => 'Do not include previous balance in the \'Total\' line. Only meaningful when invoice_sections is false. Optionally provide text to override the Total New Charges description',
- 'type' => [ qw(checkbox text) ],
- },
-
- {
- 'key' => 'previous_balance-summary_only',
- 'section' => 'invoicing',
- 'description' => 'Only show a single line summarizing the total previous balance rather than one line per invoice.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'balance_due_below_line',
- 'section' => 'invoicing',
- 'description' => 'Place the balance due message below a line. Only meaningful when when invoice_sections is false.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'usps_webtools-userid',
- 'section' => 'UI',
- 'description' => 'Production UserID for USPS web tools. Enables USPS address standardization. See the <a href="http://www.usps.com/webtools/">USPS website</a>, register and agree not to use the tools for batch purposes.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'usps_webtools-password',
- 'section' => 'UI',
- 'description' => 'Production password for USPS web tools. Enables USPS address standardization. See <a href="http://www.usps.com/webtools/">USPS website</a>, register and agree not to use the tools for batch purposes.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_main-auto_standardize_address',
- 'section' => 'UI',
- 'description' => 'When using USPS web tools, automatically standardize the address without asking.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-require_censustract',
- 'section' => 'UI',
- 'description' => 'Customer is required to have a census tract. Useful for FCC form 477 reports. See also: cust_main-auto_standardize_address',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'census_year',
- 'section' => 'UI',
- 'description' => 'The year to use in census tract lookups',
- 'type' => 'select',
- 'select_enum' => [ qw( 2010 2009 2008 ) ],
- },
-
- {
- 'key' => 'company_latitude',
- 'section' => 'UI',
- 'description' => 'Your company latitude (-90 through 90)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'company_longitude',
- 'section' => 'UI',
- 'description' => 'Your company longitude (-180 thru 180)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'disable_acl_changes',
- 'section' => '',
- 'description' => 'Disable all ACL changes, for demos.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'disable_settings_changes',
- 'section' => '',
- 'description' => 'Disable all settings changes, for demos, except for the usernames given in the comma-separated list.',
- 'type' => [qw( checkbox text )],
- },
-
- {
- 'key' => 'cust_main-edit_agent_custid',
- 'section' => 'UI',
- 'description' => 'Enable editing of the agent_custid field.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-default_agent_custid',
- 'section' => 'UI',
- 'description' => 'Display the agent_custid field when available instead of the custnum field.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-title-display_custnum',
- 'section' => 'UI',
- 'description' => 'Add the display_custom (agent_custid or custnum) to the title on customer view pages.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_bill-default_agent_invid',
- 'section' => 'UI',
- 'description' => 'Display the agent_invid field when available instead of the invnum field.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-auto_agent_custid',
- 'section' => 'UI',
- 'description' => 'Automatically assign an agent_custid - select format',
- 'type' => 'select',
- 'select_hash' => [ '' => 'No',
- '1YMMXXXXXXXX' => '1YMMXXXXXXXX',
- ],
- },
-
- {
- 'key' => 'cust_main-default_areacode',
- 'section' => 'UI',
- 'description' => 'Default area code for customers.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'order_pkg-no_start_date',
- 'section' => 'UI',
- 'description' => 'Don\'t set a default start date for new packages.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'mcp_svcpart',
- 'section' => '',
- 'description' => 'Master Control Program svcpart. Leave this blank.',
- 'type' => 'text', #select-part_svc
- },
-
- {
- 'key' => 'cust_bill-max_same_services',
- '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' => 'invoicing',
- 'description' => 'Consolidate service display into fewer lines on invoices rather than one per service.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'suspend_email_admin',
- 'section' => '',
- 'description' => 'Destination admin email address to enable suspension notices',
- 'type' => 'text',
- },
-
- {
- 'key' => 'email_report-subject',
- 'section' => '',
- 'description' => 'Subject for reports emailed by freeside-fetch. Defaults to "Freeside report".',
- 'type' => 'text',
- },
-
- {
- 'key' => 'selfservice-head',
- '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,
- },
-
-
- {
- 'key' => 'selfservice-body_header',
- 'section' => 'self-service',
- 'description' => 'HTML header for the self-service interface',
- 'type' => 'textarea', #htmlarea?
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'selfservice-body_footer',
- 'section' => 'self-service',
- 'description' => 'HTML footer for the self-service interface',
- 'type' => 'textarea', #htmlarea?
- 'per_agent' => 1,
- },
-
-
- {
- 'key' => 'selfservice-body_bgcolor',
- 'section' => 'self-service',
- 'description' => 'HTML background color for the self-service interface, for example, #FFFFFF',
- 'type' => 'text',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'selfservice-box_bgcolor',
- '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' => 'deprecated',
- 'description' => 'Parameter arrangement for selfservice bulk features',
- 'type' => 'select',
- 'select_enum' => [ '', 'izoom-soap', 'izoom-ftp' ],
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'selfservice-bulk_ftp_dir',
- 'section' => 'deprecated',
- 'description' => 'Enable bulk ftp provisioning in this folder',
- 'type' => 'text',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'signup-no_company',
- 'section' => 'self-service',
- 'description' => "Don't display a field for company name on signup.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'signup-recommend_email',
- 'section' => 'self-service',
- 'description' => 'Encourage the entry of an invoicing email address on signup.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'signup-recommend_daytime',
- 'section' => 'self-service',
- 'description' => 'Encourage the entry of a daytime phone number invoicing email address on signup.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_phone-radius-default_password',
- 'section' => '',
- 'description' => 'Default password when exporting svc_phone records to RADIUS',
- 'type' => 'text',
- },
-
- {
- 'key' => 'svc_phone-allow_alpha_phonenum',
- 'section' => '',
- 'description' => 'Allow letters in phone numbers.',
- 'type' => 'checkbox',
- },
-
- {
- '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' => 'svc_phone-lnp',
- 'section' => '',
- 'description' => 'Enables Number Portability features for svc_phone',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'default_phone_countrycode',
- 'section' => '',
- 'description' => 'Default countrcode',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cdr-charged_party-field',
- 'section' => '',
- 'description' => 'Set the charged_party field of CDRs to this field.',
- 'type' => 'select-sub',
- 'options_sub' => sub { my $fields = FS::cdr->table_info->{'fields'};
- map { $_ => $fields->{$_}||$_ }
- grep { $_ !~ /^(acctid|charged_party)$/ }
- FS::Schema::dbdef->table('cdr')->columns;
- },
- 'option_sub' => sub { my $f = shift;
- FS::cdr->table_info->{'fields'}{$f} || $f;
- },
- },
-
- #probably deprecate in favor of cdr-charged_party-field above
- {
- 'key' => 'cdr-charged_party-accountcode',
- 'section' => '',
- 'description' => 'Set the charged_party field of CDRs to the accountcode.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cdr-charged_party-accountcode-trim_leading_0s',
- 'section' => '',
- 'description' => 'When setting the charged_party field of CDRs to the accountcode, trim any leading zeros.',
- 'type' => 'checkbox',
- },
-
-# {
-# 'key' => 'cdr-charged_party-truncate_prefix',
-# 'section' => '',
-# 'description' => 'If the charged_party field has this prefix, truncate it to the length in cdr-charged_party-truncate_length.',
-# 'type' => 'text',
-# },
-#
-# {
-# 'key' => 'cdr-charged_party-truncate_length',
-# 'section' => '',
-# 'description' => 'If the charged_party field has the prefix in cdr-charged_party-truncate_prefix, truncate it to this length.',
-# 'type' => 'text',
-# },
-
- {
- 'key' => 'cdr-charged_party_rewrite',
- 'section' => '',
- 'description' => 'Do charged party rewriting in the freeside-cdrrewrited daemon; useful if CDRs are being dropped off directly in the database and require special charged_party processing such as cdr-charged_party-accountcode or cdr-charged_party-truncate*.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cdr-taqua-da_rewrite',
- 'section' => '',
- 'description' => 'For the Taqua CDR format, a comma-separated list of directory assistance 800 numbers. Any CDRs with these numbers as "BilledNumber" will be rewritten to the "CallingPartyNumber" (and CallType "12") on import.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_pkg-show_autosuspend',
- 'section' => 'UI',
- 'description' => 'Show package auto-suspend dates. Use with caution for now; can slow down customer view for large insallations.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cdr-asterisk_forward_rewrite',
- 'section' => '',
- 'description' => 'Enable special processing for CDRs representing forwarded calls: For CDRs that have a dcontext that starts with "Local/" but does not match dst, set charged_party to dst, parse a new dst from dstchannel, and set amaflags to "2" ("BILL"/"BILLING").',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'sg-multicustomer_hack',
- 'section' => '',
- 'description' => "Don't use this.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'sg-ping_username',
- 'section' => '',
- 'description' => "Don't use this.",
- 'type' => 'text',
- },
-
- {
- 'key' => 'sg-ping_password',
- 'section' => '',
- 'description' => "Don't use this.",
- 'type' => 'text',
- },
-
- {
- 'key' => 'sg-login_username',
- 'section' => '',
- 'description' => "Don't use this.",
- 'type' => 'text',
- },
-
- {
- 'key' => 'mc-outbound_packages',
- 'section' => '',
- 'description' => "Don't use this.",
- 'type' => 'select-part_pkg',
- 'multiple' => 1,
- },
-
- {
- 'key' => 'disable-cust-pkg_class',
- 'section' => 'UI',
- 'description' => 'Disable the two-step dropdown for selecting package class and package, and return to the classic single dropdown.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'queued-max_kids',
- 'section' => '',
- 'description' => 'Maximum number of queued processes. Defaults to 10.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'queued-sleep_time',
- 'section' => '',
- 'description' => 'Time to sleep between attempts to find new jobs to process in the queue. Defaults to 10. Installations doing real-time CDR processing for prepaid may want to set it lower.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cancelled_cust-noevents',
- 'section' => 'billing',
- 'description' => "Don't run events for cancelled customers",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'agent-invoice_template',
- 'section' => 'invoicing',
- 'description' => 'Enable display/edit of old-style per-agent invoice template selection',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_broadband-manage_link',
- 'section' => 'UI',
- 'description' => 'URL for svc_broadband "Manage Device" link. The following substitutions are available: $ip_addr.',
- 'type' => 'text',
- },
-
- #more fine-grained, service def-level control could be useful eventually?
- {
- 'key' => 'svc_broadband-allow_null_ip_addr',
- 'section' => '',
- 'description' => '',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'tax-report_groups',
- 'section' => '',
- 'description' => 'List of grouping possibilities for tax names on reports, one per line, "label op value" (op can be = or !=).',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'tax-cust_exempt-groups',
- 'section' => '',
- 'description' => 'List of grouping possibilities for tax names, for per-customer exemption purposes, one tax name per line. For example, "GST" would indicate the ability to exempt customers individually from taxes named "GST" (but not other taxes).',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'cust_main-default_view',
- 'section' => 'UI',
- 'description' => 'Default customer view, for users who have not selected a default view in their preferences.',
- 'type' => 'select',
- 'select_hash' => [
- #false laziness w/view/cust_main.cgi and pref/pref.html
- 'basics' => 'Basics',
- 'notes' => 'Notes',
- 'tickets' => 'Tickets',
- 'packages' => 'Packages',
- 'payment_history' => 'Payment History',
- 'change_history' => 'Change History',
- 'jumbo' => 'Jumbo',
- ],
- },
-
- {
- 'key' => 'enable_tax_adjustments',
- 'section' => 'billing',
- 'description' => 'Enable the ability to add manual tax adjustments.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'rt-crontool',
- 'section' => '',
- 'description' => 'Enable the RT CronTool extension.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'pkg-balances',
- 'section' => 'billing',
- 'description' => 'Enable experimental package balances. Not recommended for general use.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'pkg-addon_classnum',
- 'section' => 'billing',
- 'description' => 'Enable the ability to restrict additional package orders based on package class.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-edit_signupdate',
- 'section' => 'UI',
- 'descritpion' => 'Enable manual editing of the signup date.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-disable_access_number',
- 'section' => 'UI',
- 'descritpion' => 'Disable access number selection.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_bill_pay_pkg-manual',
- 'section' => 'UI',
- 'description' => 'Allow manual application of payments to line items.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_credit_bill_pkg-manual',
- 'section' => 'UI',
- 'description' => 'Allow manual application of credits to line items.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'breakage-days',
- 'section' => 'billing',
- 'description' => 'If set to a number of days, after an account goes that long without activity, recognizes any outstanding payments and credits as "breakage" by creating a breakage charge and invoice.',
- 'type' => 'text',
- 'per_agent' => 1,
- },
-
- {
- 'key' => 'breakage-pkg_class',
- 'section' => 'billing',
- 'description' => 'Package class to use for breakage reconciliation.',
- 'type' => 'select-pkg_class',
- },
-
- {
- 'key' => 'disable_cron_billing',
- 'section' => 'billing',
- 'description' => 'Disable billing and collection from being run by freeside-daily and freeside-monthly, while still allowing other actions to run, such as notifications and backup.',
- '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' => 'cust_main-exports',
- 'section' => '',
- 'description' => 'Export(s) to call on cust_main insert, modification and deletion.',
- 'type' => 'select-sub',
- 'multiple' => 1,
- 'options_sub' => sub {
- require FS::Record;
- require FS::part_export;
- my @part_export =
- map { qsearch( 'part_export', {exporttype => $_ } ) }
- keys %{FS::part_export::export_info('cust_main')};
- map { $_->exportnum => $_->exporttype.' to '.$_->machine } @part_export;
- },
- 'option_sub' => sub {
- require FS::Record;
- require FS::part_export;
- my $part_export = FS::Record::qsearchs(
- 'part_export', { 'exportnum' => shift }
- );
- $part_export
- ? $part_export->exporttype.' to '.$part_export->machine
- : '';
- },
- },
-
- {
- 'key' => 'cust_tag-location',
- 'section' => 'UI',
- 'description' => 'Location where customer tags are displayed.',
- 'type' => 'select',
- 'select_enum' => [ 'misc_info', 'top' ],
- },
-
- {
- 'key' => 'maestro-status_test',
- 'section' => 'UI',
- 'description' => 'Display a link to the maestro status test page on the customer view page',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-custom_link',
- 'section' => 'UI',
- 'description' => 'URL to use as source for the "Custom" tab in the View Customer page. The custnum will be appended.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_main-custom_title',
- 'section' => 'UI',
- 'description' => 'Title for the "Custom" tab in the View Customer page.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'part_pkg-default_suspend_bill',
- 'section' => 'billing',
- 'description' => 'Default the "Continue recurring billing while suspended" flag to on for new package definitions.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'qual-alt-address-format',
- 'section' => 'UI',
- 'description' => 'Enable the alternate address format (location type, number, and kind) on qualifications',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'note-classes',
- 'section' => 'UI',
- 'description' => 'Use customer note classes',
- 'type' => 'select',
- 'select_hash' => [
- 0 => 'Disabled',
- 1 => 'Enabled',
- 2 => 'Enabled, with tabs',
- ],
- },
-
- {
- 'key' => 'svc_acct-cf_privatekey-message',
- 'section' => '',
- 'description' => 'For internal use: HTML displayed when cf_privatekey field is set.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'menu-prepend_links',
- 'section' => 'UI',
- 'description' => 'Links to prepend to the main menu, one per line, with format "URL Link Label (optional ALT popup)".',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'cust_main-external_links',
- 'section' => 'UI',
- 'description' => 'External links available in customer view, one per line, with format "URL Link Label (optional ALT popup)". The URL will have custnum appended.',
- 'type' => 'textarea',
- },
-
- { 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" },
- { key => "bindprimary", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "bindsecondaries", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "bsdshellmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "cyrus", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "cp_app", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "erpcdmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "icradiusmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "icradius_mysqldest", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "icradius_mysqlsource", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "icradius_secrets", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "maildisablecatchall", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "mxmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "nsmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "arecords", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "cnamerecords", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "nismachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "qmailmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "radiusmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "sendmailconfigpath", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "sendmailmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "sendmailrestart", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "shellmachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "shellmachine-useradd", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "shellmachine-userdel", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "shellmachine-usermod", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "shellmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "radiusprepend", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "textradiusprepend", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "username_policy", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "vpopmailmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "vpopmailrestart", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "safe-part_pkg", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "selfservice_server-quiet", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "signup_server-quiet", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "signup_server-email", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "vonage-username", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "vonage-password", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
- { key => "vonage-fromnumber", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
-
-);
-
-1;
-
diff --git a/FS/FS/ConfDefaults.pm b/FS/FS/ConfDefaults.pm
deleted file mode 100644
index de65b44..0000000
--- a/FS/FS/ConfDefaults.pm
+++ /dev/null
@@ -1,86 +0,0 @@
-package FS::ConfDefaults;
-
-=head1 NAME
-
-FS::ConfDefaults - Freeside configuration default and available values
-
-=head1 SYNOPSIS
-
- use FS::ConfDefaults;
-
- @avail_cust_fields = FS::ConfDefaults->cust_fields_avail();
-
-=head1 DESCRIPTION
-
-Just a small class to keep config default and available values
-
-=head1 METHODS
-
-=over 4
-
-=item cust_fields_avail
-
-Returns a list, suitable for assigning to a hash, of available values and
-labels for customer fields values.
-
-=cut
-
-# XXX should use msgcat for "Day phone" and "Night phone", but how?
-sub cust_fields_avail { (
-
- 'Cust. Status | Customer' =>
- 'Status | Last, First or Company (Last, First)',
- 'Cust# | Cust. Status | Customer' =>
- 'custnum | Status | Last, First or Company (Last, First)',
-
- 'Cust. Status | Name | Company' =>
- 'Status | Last, First | Company',
- 'Cust# | Cust. Status | Name | Company' =>
- 'custnum | Status | Last, First | Company',
-
- 'Cust. Status | (bill) Customer | (service) Customer' =>
- 'Status | Last, First or Company (Last, First) | (same for service contact if present)',
- 'Cust# | Cust. Status | (bill) Customer | (service) Customer' =>
- 'custnum | Status | Last, First or Company (Last, First) | (same for service contact if present)',
-
- 'Cust. Status | (bill) Name | (bill) Company | (service) Name | (service) Company' =>
- 'Status | Last, First | Company | (same for service contact if present)',
- 'Cust# | Cust. Status | (bill) Name | (bill) Company | (service) Name | (service) Company' =>
- 'custnum | Status | Last, First | Company | (same for service contact if present)',
-
- 'Cust# | Cust. Status | Name | Company | Address 1 | Address 2 | City | State | Zip | Country | Day phone | Night phone | Invoicing email(s)' =>
- 'custnum | Status | Last, First | Company | (address) | Day phone | Night phone | Invoicing email(s)',
-
- 'Cust# | Cust. Status | Name | Company | Address 1 | Address 2 | City | State | Zip | Country | Day phone | Night phone | Fax number | Invoicing email(s) | Payment Type' =>
- 'custnum | Status | Last, First | Company | (address) | (all phones) | Invoicing email(s) | Payment Type',
-
- 'Cust# | Cust. Status | Name | Company | Address 1 | Address 2 | City | State | Zip | Country | Day phone | Night phone | Fax number | Invoicing email(s) | Payment Type | Current Balance' =>
- 'custnum | Status | Last, First | Company | (address) | (all phones) | Invoicing email(s) | Payment Type | Current Balance',
-
- 'Cust# | Cust. Status | (bill) Name | (bill) Company | (bill) Address 1 | (bill) Address 2 | (bill) City | (bill) State | (bill) Zip | (bill) Country | (bill) Day phone | (bill) Night phone | (service) Name | (service) Company | (service) Address 1 | (service) Address 2 | (service) City | (service) State | (service) Zip | (service) Country | (service) Day phone | (service) Night phone | Invoicing email(s)' =>
- 'custnum | Status | Last, First | Company | (address) | Day phone | Night phone | (service address) | Invoicing email(s)',
-
- 'Cust# | Cust. Status | (bill) Name | (bill) Company | (bill) Address 1 | (bill) Address 2 | (bill) City | (bill) State | (bill) Zip | (bill) Country | (bill) Day phone | (bill) Night phone | (bill) Fax number | (service) Name | (service) Company | (service) Address 1 | (service) Address 2 | (service) City | (service) State | (service) Zip | (service) Country | (service) Day phone | (service) Night phone | (service) Fax number | Invoicing email(s) | Payment Type' =>
- 'custnum | Status | Last, First | Company | (address) | (all phones) | (service address) | Invoicing email(s) | Payment Type',
-
- 'Cust# | Cust. Status | (bill) Name | (bill) Company | (bill) Address 1 | (bill) Address 2 | (bill) City | (bill) State | (bill) Zip | (bill) Country | (bill) Day phone | (bill) Night phone | (bill) Fax number | (service) Name | (service) Company | (service) Address 1 | (service) Address 2 | (service) City | (service) State | (service) Zip | (service) Country | (service) Day phone | (service) Night phone | (service) Fax number | Invoicing email(s) | Payment Type | Current Balance' =>
- 'custnum | Status | Last, First | Company | (address) | (all phones) | (service address) | Invoicing email(s) | Payment Type | Current Balance',
-
- 'Invoicing email(s)' => 'Invoicing email(s)',
- 'Cust# | Invoicing email(s)' => 'custnum | Invoicing email(s)',
-
-); }
-
-=back
-
-=head1 BUGS
-
-Not yet.
-
-=head1 SEE ALSO
-
-L<FS::Conf>
-
-=cut
-
-1;
diff --git a/FS/FS/ConfItem.pm b/FS/FS/ConfItem.pm
deleted file mode 100644
index a0e997a..0000000
--- a/FS/FS/ConfItem.pm
+++ /dev/null
@@ -1,63 +0,0 @@
-package FS::ConfItem;
-
-=head1 NAME
-
-FS::ConfItem - Configuration option meta-data.
-
-=head1 SYNOPSIS
-
- use FS::Conf;
- @config_items = $conf->config_items;
-
- foreach $item ( @config_items ) {
- $key = $item->key;
- $section = $item->section;
- $description = $item->description;
- }
-
-=head1 DESCRIPTION
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-=cut
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = @_ ? shift : {};
- bless ($self, $class);
-}
-
-=item key
-
-=item section
-
-=item description
-
-=cut
-
-sub AUTOLOAD {
- my $self = shift;
- my $field = $AUTOLOAD;
- $field =~ s/.*://;
- $self->{$field};
-}
-
-=back
-
-=head1 BUGS
-
-Terse docs.
-
-=head1 SEE ALSO
-
-L<FS::Conf>
-
-=cut
-
-1;
-
diff --git a/FS/FS/Conf_compat17.pm b/FS/FS/Conf_compat17.pm
deleted file mode 100644
index 15d4738..0000000
--- a/FS/FS/Conf_compat17.pm
+++ /dev/null
@@ -1,2520 +0,0 @@
-package FS::Conf_compat17;
-
-use vars qw($default_dir $base_dir @config_items @card_types $DEBUG );
-use IO::File;
-use File::Basename;
-use FS::ConfItem;
-use FS::ConfDefaults;
-
-$base_dir = '%%%FREESIDE_CONF%%%';
-$default_dir = '%%%FREESIDE_CONF%%%';
-
-
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::Conf - Freeside configuration values
-
-=head1 SYNOPSIS
-
- use FS::Conf;
-
- $conf = new FS::Conf "/config/directory";
-
- $FS::Conf::default_dir = "/config/directory";
- $conf = new FS::Conf;
-
- $dir = $conf->dir;
-
- $value = $conf->config('key');
- @list = $conf->config('key');
- $bool = $conf->exists('key');
-
- $conf->touch('key');
- $conf->set('key' => 'value');
- $conf->delete('key');
-
- @config_items = $conf->config_items;
-
-=head1 DESCRIPTION
-
-Read and write Freeside configuration values. Keys currently map to filenames,
-but this may change in the future.
-
-=head1 METHODS
-
-=over 4
-
-=item new [ DIRECTORY ]
-
-Create a new configuration object. A directory arguement is required if
-$FS::Conf::default_dir has not been set.
-
-=cut
-
-sub new {
- my($proto,$dir) = @_;
- my($class) = ref($proto) || $proto;
- my($self) = { 'dir' => $dir || $default_dir,
- 'base_dir' => $base_dir,
- };
- bless ($self, $class);
-}
-
-=item dir
-
-Returns the conf directory.
-
-=cut
-
-sub dir {
- my($self) = @_;
- my $dir = $self->{dir};
- -e $dir or die "FATAL: $dir doesn't exist!";
- -d $dir or die "FATAL: $dir isn't a directory!";
- -r $dir or die "FATAL: Can't read $dir!";
- -x $dir or die "FATAL: $dir not searchable (executable)!";
- $dir =~ /^(.*)$/;
- $1;
-}
-
-=item base_dir
-
-Returns the base directory. By default this is /usr/local/etc/freeside.
-
-=cut
-
-sub base_dir {
- my($self) = @_;
- my $base_dir = $self->{base_dir};
- -e $base_dir or die "FATAL: $base_dir doesn't exist!";
- -d $base_dir or die "FATAL: $base_dir isn't a directory!";
- -r $base_dir or die "FATAL: Can't read $base_dir!";
- -x $base_dir or die "FATAL: $base_dir not searchable (executable)!";
- $base_dir =~ /^(.*)$/;
- $1;
-}
-
-=item config KEY
-
-Returns the configuration value or values (depending on context) for key.
-
-=cut
-
-sub config {
- my($self,$file)=@_;
- my($dir)=$self->dir;
- my $fh = new IO::File "<$dir/$file" or return;
- if ( wantarray ) {
- map {
- /^(.*)$/
- or die "Illegal line (array context) in $dir/$file:\n$_\n";
- $1;
- } <$fh>;
- } else {
- <$fh> =~ /^(.*)$/
- or die "Illegal line (scalar context) in $dir/$file:\n$_\n";
- $1;
- }
-}
-
-=item config_binary KEY
-
-Returns the exact scalar value for key.
-
-=cut
-
-sub config_binary {
- my($self,$file)=@_;
- my($dir)=$self->dir;
- my $fh = new IO::File "<$dir/$file" or return;
- local $/;
- my $content = <$fh>;
- $content;
-}
-
-=item exists KEY
-
-Returns true if the specified key exists, even if the corresponding value
-is undefined.
-
-=cut
-
-sub exists {
- my($self,$file)=@_;
- my($dir) = $self->dir;
- -e "$dir/$file";
-}
-
-=item config_orbase KEY SUFFIX
-
-Returns the configuration value or values (depending on context) for
-KEY_SUFFIX, if it exists, otherwise for KEY
-
-=cut
-
-sub config_orbase {
- my( $self, $file, $suffix ) = @_;
- if ( $self->exists("${file}_$suffix") ) {
- $self->config("${file}_$suffix");
- } else {
- $self->config($file);
- }
-}
-
-=item touch KEY
-
-Creates the specified configuration key if it does not exist.
-
-=cut
-
-sub touch {
- my($self, $file) = @_;
- my $dir = $self->dir;
- unless ( $self->exists($file) ) {
- warn "[FS::Conf] TOUCH $file\n" if $DEBUG;
- system('touch', "$dir/$file");
- }
-}
-
-=item set KEY VALUE
-
-Sets the specified configuration key to the given value.
-
-=cut
-
-sub set {
- my($self, $file, $value) = @_;
- my $dir = $self->dir;
- $value =~ /^(.*)$/s;
- $value = $1;
- unless ( join("\n", @{[ $self->config($file) ]}) eq $value ) {
- warn "[FS::Conf] SET $file\n" if $DEBUG;
-# warn "$dir" if is_tainted($dir);
-# warn "$dir" if is_tainted($file);
- chmod 0644, "$dir/$file";
- my $fh = new IO::File ">$dir/$file" or return;
- chmod 0644, "$dir/$file";
- print $fh "$value\n";
- }
-}
-#sub is_tainted {
-# return ! eval { join('',@_), kill 0; 1; };
-# }
-
-=item delete KEY
-
-Deletes the specified configuration key.
-
-=cut
-
-sub delete {
- my($self, $file) = @_;
- my $dir = $self->dir;
- if ( $self->exists($file) ) {
- warn "[FS::Conf] DELETE $file\n";
- unlink "$dir/$file";
- }
-}
-
-=item config_items
-
-Returns all of the possible configuration items as FS::ConfItem objects. See
-L<FS::ConfItem>.
-
-=cut
-
-sub config_items {
- my $self = shift;
- #quelle kludge
- @config_items,
- ( map {
- my $basename = basename($_);
- $basename =~ /^(.*)$/;
- $basename = $1;
- new FS::ConfItem {
- 'key' => $basename,
- 'section' => 'billing',
- 'description' => 'Alternate template file for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
- 'type' => 'textarea',
- }
- } glob($self->dir. '/invoice_template_*')
- ),
- ( map {
- my $basename = basename($_);
- $basename =~ /^(.*)$/;
- $basename = $1;
- new FS::ConfItem {
- 'key' => $basename,
- 'section' => 'billing',
- 'description' => 'Alternate HTML template for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
- 'type' => 'textarea',
- }
- } glob($self->dir. '/invoice_html_*')
- ),
- ( map {
- my $basename = basename($_);
- $basename =~ /^(.*)$/;
- $basename = $1;
- ($latexname = $basename ) =~ s/latex/html/;
- new FS::ConfItem {
- 'key' => $basename,
- 'section' => 'billing',
- 'description' => "Alternate Notes section for HTML invoices. Defaults to the same data in $latexname if not specified.",
- 'type' => 'textarea',
- }
- } glob($self->dir. '/invoice_htmlnotes_*')
- ),
- ( map {
- my $basename = basename($_);
- $basename =~ /^(.*)$/;
- $basename = $1;
- new FS::ConfItem {
- 'key' => $basename,
- 'section' => 'billing',
- 'description' => 'Alternate LaTeX template for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
- 'type' => 'textarea',
- }
- } glob($self->dir. '/invoice_latex_*')
- ),
- ( map {
- my $basename = basename($_);
- $basename =~ /^(.*)$/;
- $basename = $1;
- new FS::ConfItem {
- 'key' => $basename,
- 'section' => 'billing',
- 'description' => 'Alternate Notes section for LaTeX typeset PostScript invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
- 'type' => 'textarea',
- }
- } glob($self->dir. '/invoice_latexnotes_*')
- );
-}
-
-=back
-
-=head1 BUGS
-
-If this was more than just crud that will never be useful outside Freeside I'd
-worry that config_items is freeside-specific and icky.
-
-=head1 SEE ALSO
-
-"Configuration" in the web interface (config/config.cgi).
-
-httemplate/docs/config.html
-
-=cut
-
-#Business::CreditCard
-@card_types = (
- "VISA card",
- "MasterCard",
- "Discover card",
- "American Express card",
- "Diner's Club/Carte Blanche",
- "enRoute",
- "JCB",
- "BankCard",
- "Switch",
- "Solo",
-);
-
-@config_items = map { new FS::ConfItem $_ } (
-
- {
- 'key' => 'address',
- 'section' => 'deprecated',
- 'description' => 'This configuration option is no longer used. See <a href="#invoice_template">invoice_template</a> instead.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'alerter_template',
- 'section' => 'billing',
- 'description' => 'Template file for billing method expiration alerts. See the <a href="../docs/billing.html#invoice_template">billing documentation</a> for details.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'apacheroot',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>www_shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. The directory containing Apache virtual hosts',
- 'type' => 'text',
- },
-
- {
- 'key' => 'apacheip',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add an <i>apache</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be the current IP address to assign to new virtual hosts',
- 'type' => 'text',
- },
-
- {
- 'key' => 'apachemachine',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>www_shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. A machine with the apacheroot directory and user home directories. The existance of this file enables setup of virtual host directories, and, in conjunction with the `home\' configuration file, symlinks into user home directories.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'apachemachines',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add an <i>apache</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be Apache machines, one per line. This enables export of `/etc/apache/vhosts.conf\', which can be included in your Apache configuration via the <a href="http://www.apache.org/docs/mod/core.html#include">Include</a> directive.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'bindprimary',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>bind</i> <a href="../browse/part_export.cgi">export</a> instead. Your BIND primary nameserver. This enables export of /var/named/named.conf and zone files into /var/named',
- 'type' => 'text',
- },
-
- {
- 'key' => 'bindsecondaries',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>bind_slave</i> <a href="../browse/part_export.cgi">export</a> instead. Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'encryption',
- 'section' => 'billing',
- 'description' => 'Enable encryption of credit cards.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'encryptionmodule',
- 'section' => 'billing',
- 'description' => 'Use which module for encryption?',
- 'type' => 'text',
- },
-
- {
- 'key' => 'encryptionpublickey',
- 'section' => 'billing',
- 'description' => 'Your RSA Public Key - Required if Encryption is turned on.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'encryptionprivatekey',
- 'section' => 'billing',
- 'description' => 'Your RSA Private Key - Including this will enable the "Bill Now" feature. However if the system is compromised, a hacker can use this key to decode the stored credit card information. This is generally not a good idea.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'business-onlinepayment',
- 'section' => 'billing',
- 'description' => '<a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a> support, at least three lines: processor, login, and password. An optional fourth line specifies the action or actions (multiple actions are separated with `,\': for example: `Authorization Only, Post Authorization\'). Optional additional lines are passed to Business::OnlinePayment as %processor_options.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'business-onlinepayment-ach',
- 'section' => 'billing',
- 'description' => 'Alternate <a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a> support for ACH transactions (defaults to regular <b>business-onlinepayment</b>). At least three lines: processor, login, and password. An optional fourth line specifies the action or actions (multiple actions are separated with `,\': for example: `Authorization Only, Post Authorization\'). Optional additional lines are passed to Business::OnlinePayment as %processor_options.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'business-onlinepayment-description',
- 'section' => 'billing',
- 'description' => 'String passed as the description field to <a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a>. Evaluated as a double-quoted perl string, with the following variables available: <code>$agent</code> (the agent name), and <code>$pkgs</code> (a comma-separated list of packages for which these charges apply)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'business-onlinepayment-email-override',
- 'section' => 'billing',
- 'description' => 'Email address used instead of customer email address when submitting a BOP transaction.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'bsdshellmachines',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>bsdshell</i> <a href="../browse/part_export.cgi">export</a> instead. Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/master.passwd\'.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'business-onlinepayment-email_customer',
- 'section' => 'billing',
- 'description' => 'Controls the "email_customer" flag used by some Business::OnlinePayment processors to enable customer receipts.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'countrydefault',
- 'section' => 'UI',
- 'description' => 'Default two-letter country code (if not supplied, the default is `US\')',
- 'type' => 'text',
- },
-
- {
- 'key' => 'date_format',
- 'section' => 'UI',
- 'description' => 'Format for displaying dates',
- 'type' => 'select',
- 'select_hash' => [
- '%m/%d/%Y' => 'MM/DD/YYYY',
- '%Y/%m/%d' => 'YYYY/MM/DD',
- ],
- },
-
- {
- 'key' => 'cyrus',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>cyrus</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to integrate with <a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>, three lines: IMAP server, admin username, and admin password. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'cp_app',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>cp</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to integrate with <a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>, four lines: "host:port", username, password, and workgroup (for new users).',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'deletecustomers',
- 'section' => 'UI',
- 'description' => 'Enable customer deletions. Be very careful! Deleting a customer will remove all traces that the customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customers\' packages if they cancel service.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'deleteinvoices',
- 'section' => 'UI',
- 'description' => 'Enable invoices deletions. Be very careful! Deleting an invoice will remove all traces that the invoice ever existed! Normally, you would apply a credit against the invoice instead.', #invoice voiding?
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'deletepayments',
- 'section' => 'billing',
- 'description' => 'Enable deletion of unclosed payments. Really, with voids this is pretty much not recommended in any situation anymore. Be very careful! Only delete payments that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted.',
- 'type' => [qw( checkbox text )],
- },
-
- {
- 'key' => 'deletecredits',
- 'section' => 'deprecated',
- 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted.',
- 'type' => [qw( checkbox text )],
- },
-
- {
- 'key' => 'deleterefunds',
- 'section' => 'billing',
- 'description' => 'Enable deletion of unclosed refunds. Be very careful! Only delete refunds that were data-entry errors, not adjustments.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'unapplypayments',
- 'section' => 'deprecated',
- 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable "unapplication" of unclosed payments.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'unapplycredits',
- 'section' => 'deprecated',
- 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to nable "unapplication" of unclosed credits.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'dirhash',
- 'section' => 'shell',
- 'description' => 'Optional numeric value to control directory hashing. If positive, hashes directories for the specified number of levels from the front of the username. If negative, hashes directories for the specified number of levels from the end of the username. Some examples: <ul><li>1: user -> <a href="#home">/home</a>/u/user<li>2: user -> <a href="#home">/home</a>/u/s/user<li>-1: user -> <a href="#home">/home</a>/r/user<li>-2: user -> <a href="#home">home</a>/r/e/user</ul>',
- 'type' => 'text',
- },
-
- {
- 'key' => 'disable_customer_referrals',
- 'section' => 'UI',
- 'description' => 'Disable new customer-to-customer referrals in the web interface',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'editreferrals',
- 'section' => 'UI',
- 'description' => 'Enable advertising source modification for existing customers',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'emailinvoiceonly',
- 'section' => 'billing',
- 'description' => 'Disables postal mail invoices',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'disablepostalinvoicedefault',
- 'section' => 'billing',
- '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',
- 'description' => 'Automatically adds new accounts to the email invoice list',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'emailinvoiceautoalways',
- 'section' => 'billing',
- 'description' => 'Automatically adds new accounts to the email invoice list even when the list contains email addresses',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'exclude_ip_addr',
- 'section' => '',
- 'description' => 'Exclude these from the list of available broadband service IP addresses. (One per line)',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'erpcdmachines',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, ERPCD is no longer supported. Used to be ERPCD authentication machines, one per line. This enables export of `/usr/annex/acp_passwd\' and `/usr/annex/acp_dialup\'',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'hidecancelledpackages',
- 'section' => 'UI',
- 'description' => 'Prevent cancelled packages from showing up in listings (though they will still be in the database)',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'hidecancelledcustomers',
- 'section' => 'UI',
- 'description' => 'Prevent customers with only cancelled packages from showing up in listings (though they will still be in the database)',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'home',
- 'section' => 'required',
- 'description' => 'For new users, prefixed to username to create a directory name. Should have a leading but not a trailing slash.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'icradiusmachines',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the <a href="http://rootwood.haze.st/aspside/config/config-view.cgi#icradius_secrets">icradius_secrets</a> config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option. <blockquote><b>ADDITIONAL DEPRECATED FUNCTIONALITY</b> (instead use <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">MySQL replication</a> or point icradius_secrets to the external database) - your <a href="ftp://ftp.cheapnet.net/pub/icradius">ICRADIUS</a> machines or <a href="http://www.freeradius.org/">FreeRADIUS</a> (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: <CODE>"radius.isp.tld&nbsp;radius_db&nbsp;radius_user&nbsp;passw0rd"</CODE></blockquote>',
- 'type' => [qw( checkbox textarea )],
- },
-
- {
- 'key' => 'icradius_mysqldest',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be the destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".',
- 'type' => 'text',
- },
-
- {
- 'key' => 'icradius_mysqlsource',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be the source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".',
- 'type' => 'text',
- },
-
- {
- 'key' => 'icradius_secrets',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to specify a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_from',
- 'section' => 'required',
- 'description' => 'Return address on email invoices',
- 'type' => 'text',
- },
-
- {
- 'key' => 'invoice_subject',
- 'section' => 'billing',
- 'description' => 'Subject: header on email invoices. Defaults to "Invoice". The following substitutions are available: $name, $name_short, $invoice_number, and $invoice_date.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'invoice_template',
- 'section' => 'required',
- 'description' => 'Required template file for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_html',
- 'section' => 'billing',
- 'description' => 'Optional HTML template for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
-
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_htmlnotes',
- 'section' => 'billing',
- 'description' => 'Notes section for HTML invoices. Defaults to the same data in invoice_latexnotes if not specified.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_htmlfooter',
- 'section' => 'billing',
- 'description' => 'Footer for HTML invoices. Defaults to the same data in invoice_latexfooter if not specified.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_htmlreturnaddress',
- 'section' => 'billing',
- 'description' => 'Return address for HTML invoices. Defaults to the same data in invoice_latexreturnaddress if not specified.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_latex',
- 'section' => 'billing',
- 'description' => 'Optional LaTeX template for typeset PostScript invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_latexnotes',
- 'section' => 'billing',
- 'description' => 'Notes section for LaTeX typeset PostScript invoices.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_latexfooter',
- 'section' => 'billing',
- 'description' => 'Footer for LaTeX typeset PostScript invoices.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_latexcoupon',
- 'section' => 'billing',
- 'description' => 'Remittance coupon for LaTeX typeset PostScript invoices.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_latexreturnaddress',
- 'section' => 'billing',
- 'description' => 'Return address for LaTeX typeset PostScript invoices.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_latexsmallfooter',
- 'section' => 'billing',
- 'description' => 'Optional small footer for multi-page LaTeX typeset PostScript invoices.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'invoice_email_pdf',
- 'section' => 'billing',
- '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',
- 'description' => 'If defined, this text will replace the default plain text invoice as the body of emailed PDF invoices.',
- 'type' => 'textarea'
- },
-
-
- {
- 'key' => 'invoice_default_terms',
- 'section' => 'billing',
- '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 30', 'Net 45', 'Net 60' ],
- },
-
- {
- 'key' => 'invoice_send_receipts',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, this used to send an invoice copy on payments and credits. See the payment_receipt_email and XXXX instead.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'payment_receipt_email',
- 'section' => 'billing',
- 'description' => 'Template file for payment receipts. Payment receipts are sent to the customer email invoice destination(s) when a payment is received. See the <a href="http://search.cpan.org/~mjd/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitution language. The following variables are available: <ul><li><code>$date</code> <li><code>$name</code> <li><code>$paynum</code> - Freeside payment number <li><code>$paid</code> - Amount of payment <li><code>$payby</code> - Payment type (Card, Check, Electronic check, etc.) <li><code>$payinfo</code> - Masked credit card number or check number <li><code>$balance</code> - New balance</ul>',
- 'type' => [qw( checkbox textarea )],
- },
-
- {
- 'key' => 'lpr',
- 'section' => 'required',
- 'description' => 'Print command for paper invoices, for example `lpr -h\'',
- 'type' => 'text',
- },
-
- {
- 'key' => 'maildisablecatchall',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, now the default. Turning this option on used to disable the requirement that each virtual domain have a catch-all mailbox.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'lpr-postscript_prefix',
- 'section' => 'billing',
- 'description' => 'Raw printer commands prepended to the beginning of postscript print jobs (evaluated as a double-quoted perl string - backslash escapes are available)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'lpr-postscript_suffix',
- 'section' => 'billing',
- 'description' => 'Raw printer commands added to the end of postscript print jobs (evaluated as a double-quoted perl string - backslash escapes are available)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'money_char',
- 'section' => '',
- 'description' => 'Currency symbol - defaults to `$\'',
- 'type' => 'text',
- },
-
- {
- 'key' => 'mxmachines',
- 'section' => 'deprecated',
- 'description' => 'MX entries for new domains, weight and machine, one per line, with trailing `.\'',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'nsmachines',
- 'section' => 'deprecated',
- 'description' => 'NS nameservers for new domains, one per line, with trailing `.\'',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'defaultrecords',
- 'section' => 'BIND',
- 'description' => 'DNS entries to add automatically when creating a domain',
- 'type' => 'editlist',
- 'editlist_parts' => [ { type=>'text' },
- { type=>'immutable', value=>'IN' },
- { type=>'select',
- select_enum=>{ map { $_=>$_ } qw(A CNAME MX NS TXT)} },
- { type=> 'text' }, ],
- },
-
- {
- 'key' => 'arecords',
- 'section' => 'deprecated',
- 'description' => 'A list of tab seperated CNAME records to add automatically when creating a domain',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'cnamerecords',
- 'section' => 'deprecated',
- 'description' => 'A list of tab seperated CNAME records to add automatically when creating a domain',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'nismachines',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>. Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd\' and `/etc/global/shadow\'.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'passwordmin',
- 'section' => 'password',
- 'description' => 'Minimum password length (default 6)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'passwordmax',
- 'section' => 'password',
- 'description' => 'Maximum password length (default 8) (don\'t set this over 12 if you need to import or export crypt() passwords)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'password-noampersand',
- 'section' => 'password',
- 'description' => 'Disallow ampersands in passwords',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'password-noexclamation',
- 'section' => 'password',
- 'description' => 'Disallow exclamations in passwords (Not setting this could break old text Livingston or Cistron Radius servers)',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'qmailmachines',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add <i>qmail</i> and <i>shellcommands</i> <a href="../browse/part_export.cgi">exports</a> instead. This option used to export `/var/qmail/control/virtualdomains\', `/var/qmail/control/recipientmap\', and `/var/qmail/control/rcpthosts\'. Setting this option (even if empty) also turns on user `.qmail-extension\' file maintenance in conjunction with the <b>shellmachine</b> option.',
- 'type' => [qw( checkbox textarea )],
- },
-
- {
- 'key' => 'radiusmachines',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to export to be: your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users\'.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'referraldefault',
- 'section' => 'UI',
- 'description' => 'Default referral, specified by refnum',
- 'type' => 'text',
- },
-
-# {
-# 'key' => 'registries',
-# 'section' => 'required',
-# 'description' => 'Directory which contains domain registry information. Each registry is a directory.',
-# },
-
- {
- 'key' => 'report_template',
- 'section' => 'deprecated',
- 'description' => 'Deprecated template file for reports.',
- 'type' => 'textarea',
- },
-
-
- {
- 'key' => 'maxsearchrecordsperpage',
- 'section' => 'UI',
- 'description' => 'If set, number of search records to return per page.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'sendmailconfigpath',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>sendmail</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be sendmail configuration file path. Defaults to `/etc\'. Many newer distributions use `/etc/mail\'.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'sendmailmachines',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>sendmail</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be sendmail machines, one per line. This enables export of `/etc/virtusertable\' and `/etc/sendmail.cw\'.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'sendmailrestart',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>sendmail</i> <a href="../browse/part_export.cgi">export</a> instead. Used to define the command which is run on sendmail machines after files are copied.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'session-start',
- 'section' => 'session',
- 'description' => 'If defined, the command which is executed on the Freeside machine when a session begins. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'session-stop',
- 'section' => 'session',
- 'description' => 'If defined, the command which is executed on the Freeside machine when a session ends. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'shellmachine',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain a single machine with user home directories mounted. This enables home directory creation, renaming and archiving/deletion. In conjunction with `qmailmachines\', it also enables `.qmail-extension\' file maintenance.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'shellmachine-useradd',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain command(s) to run on shellmachine when an account is created. If the <b>shellmachine</b> option is set but this option is not, <code>useradd -d $dir -m -s $shell -u $uid $username</code> is the default. If this option is set but empty, <code>cp -pr /etc/skel $dir; chown -R $uid.$gid $dir</code> is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: <code>$username</code>, <code>$uid</code>, <code>$gid</code>, <code>$dir</code>, and <code>$shell</code>.',
- 'type' => [qw( checkbox text )],
- },
-
- {
- 'key' => 'shellmachine-userdel',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain command(s) to run on shellmachine when an account is deleted. If the <b>shellmachine</b> option is set but this option is not, <code>userdel $username</code> is the default. If this option is set but empty, <code>rm -rf $dir</code> is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: <code>$username</code> and <code>$dir</code>.',
- 'type' => [qw( checkbox text )],
- },
-
- {
- 'key' => 'shellmachine-usermod',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain command(s) to run on shellmachine when an account is modified. If the <b>shellmachine</b> option is set but this option is empty, <code>[ -d $old_dir ] &amp;&amp; mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $uid.$gid $new_dir; rm -rf $old_dir )</code> is the default. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$old_dir</code>, <code>$new_dir</code>, <code>$uid</code> and <code>$gid</code>.',
- #'type' => [qw( checkbox text )],
- 'type' => 'text',
- },
-
- {
- 'key' => 'shellmachines',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>sysvshell</i> <a href="../browse/part_export.cgi">export</a> instead. Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/shadow\' files.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'shells',
- 'section' => 'required',
- 'description' => 'Legal shells (think /etc/shells). You probably want to `cut -d: -f7 /etc/passwd | sort | uniq\' initially so that importing doesn\'t fail with `Illegal shell\' errors, then remove any special entries afterwords. A blank line specifies that an empty shell is permitted.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'showpasswords',
- 'section' => 'UI',
- 'description' => 'Display unencrypted user passwords in the backend (employee) web interface',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'signupurl',
- 'section' => 'UI',
- 'description' => 'if you are using customer-to-customer referrals, and you enter the URL of your <a href="../docs/signup.html">signup server CGI</a>, the customer view screen will display a customized link to the signup server with the appropriate customer as referral',
- 'type' => 'text',
- },
-
- {
- 'key' => 'smtpmachine',
- 'section' => 'required',
- 'description' => 'SMTP relay for Freeside\'s outgoing mail',
- 'type' => 'text',
- },
-
- {
- 'key' => 'soadefaultttl',
- 'section' => 'BIND',
- 'description' => 'SOA default TTL for new domains.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'soaemail',
- 'section' => 'BIND',
- 'description' => 'SOA email for new domains, in BIND form (`.\' instead of `@\'), with trailing `.\'',
- 'type' => 'text',
- },
-
- {
- 'key' => 'soaexpire',
- 'section' => 'BIND',
- 'description' => 'SOA expire for new domains',
- 'type' => 'text',
- },
-
- {
- 'key' => 'soamachine',
- 'section' => 'BIND',
- 'description' => 'SOA machine for new domains, with trailing `.\'',
- 'type' => 'text',
- },
-
- {
- 'key' => 'soarefresh',
- 'section' => 'BIND',
- 'description' => 'SOA refresh for new domains',
- 'type' => 'text',
- },
-
- {
- 'key' => 'soaretry',
- 'section' => 'BIND',
- 'description' => 'SOA retry for new domains',
- 'type' => 'text',
- },
-
- {
- 'key' => 'statedefault',
- 'section' => 'UI',
- 'description' => 'Default state or province (if not supplied, the default is `CA\')',
- 'type' => 'text',
- },
-
- {
- 'key' => 'radiusprepend',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, real-time text radius now edits an existing file in place - just (turn off freeside-queued and) edit your RADIUS users file directly. The contents used to be be prepended to the top of the RADIUS users file (text exports only).',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'textradiusprepend',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, use RADIUS check attributes instead. The contents used to be prepended to the first line of a user\'s RADIUS entry in text exports.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'unsuspendauto',
- 'section' => 'billing',
- 'description' => 'Enables the automatic unsuspension of suspended packages when a customer\'s balance due changes from positive to zero or negative as the result of a payment or credit',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'unsuspend-always_adjust_next_bill_date',
- 'section' => 'billing',
- 'description' => 'Global override that causes unsuspensions to always adjust the next bill date under any circumstances. This is now controlled on a per-package bases - probably best not to use this option unless you are a legacy installation that requires this behaviour.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'usernamemin',
- 'section' => 'username',
- 'description' => 'Minimum username length (default 2)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'usernamemax',
- 'section' => 'username',
- 'description' => 'Maximum username length',
- 'type' => 'text',
- },
-
- {
- 'key' => 'username-ampersand',
- 'section' => 'username',
- 'description' => 'Allow the ampersand character (&amp;) in usernames. Be careful when using this option in conjunction with <a href="../browse/part_export.cgi">exports</a> which execute shell commands, as the ampersand will be interpreted by the shell if not quoted.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-letter',
- 'section' => 'username',
- 'description' => 'Usernames must contain at least one letter',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-letterfirst',
- 'section' => 'username',
- 'description' => 'Usernames must start with a letter',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-noperiod',
- 'section' => 'username',
- 'description' => 'Disallow periods in usernames',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-nounderscore',
- 'section' => 'username',
- 'description' => 'Disallow underscores in usernames',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-nodash',
- 'section' => 'username',
- 'description' => 'Disallow dashes in usernames',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-uppercase',
- 'section' => 'username',
- 'description' => 'Allow uppercase characters in usernames',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-percent',
- 'section' => 'username',
- 'description' => 'Allow the percent character (%) in usernames.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username_policy',
- 'section' => 'deprecated',
- 'description' => 'This file controls the mechanism for preventing duplicate usernames in passwd/radius files exported from svc_accts. This should be one of \'prepend domsvc\' \'append domsvc\' \'append domain\' or \'append @domain\'',
- 'type' => 'select',
- 'select_enum' => [ 'prepend domsvc', 'append domsvc', 'append domain', 'append @domain' ],
- #'type' => 'text',
- },
-
- {
- 'key' => 'vpopmailmachines',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>vpopmail</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain your vpopmail pop toasters, one per line. Each line is of the form "machinename vpopdir vpopuid vpopgid". For example: <code>poptoaster.domain.tld /home/vpopmail 508 508</code> Note: vpopuid and vpopgid are values taken from the vpopmail machine\'s /etc/passwd',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'vpopmailrestart',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, add a <i>vpopmail</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to define the shell commands to run on vpopmail machines after files are copied. An example can be found in eg/vpopmailrestart of the source distribution.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'safe-part_pkg',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, obsolete. Used to validate package definition setup and recur expressions against a preset list. Useful for webdemos, annoying to powerusers.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'username-colon',
- 'section' => 'username',
- 'description' => 'Allow the colon character (:) in usernames.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'safe-part_bill_event',
- 'section' => 'UI',
- 'description' => 'Validates invoice event expressions against a preset list. Useful for webdemos, annoying to powerusers.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'show_ss',
- 'section' => 'UI',
- 'description' => 'Turns on display/collection of SS# in the web interface.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'show_stateid',
- 'section' => 'UI',
- 'description' => "Turns on display/collection of driver's license/state issued id numbers in the web interface. Sometimes required by electronic check (ACH) processors.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'show_bankstate',
- 'section' => 'UI',
- 'description' => "Turns on display/collection of state for bank accounts in the web interface. Sometimes required by electronic check (ACH) processors.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'agent_defaultpkg',
- 'section' => 'UI',
- 'description' => 'Setting this option will cause new packages to be available to all agent types by default.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'legacy_link',
- 'section' => 'UI',
- 'description' => 'Display options in the web interface to link legacy pre-Freeside services.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'legacy_link-steal',
- 'section' => 'UI',
- 'description' => 'Allow "stealing" an already-audited service from one customer (or package) to another using the link function.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'queue_dangerous_controls',
- 'section' => 'UI',
- 'description' => 'Enable queue modification controls on account pages and for new jobs. Unless you are a developer working on new export code, you should probably leave this off to avoid causing provisioning problems.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'security_phrase',
- 'section' => 'password',
- 'description' => 'Enable the tracking of a "security phrase" with each account. Not recommended, as it is vulnerable to social engineering.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'locale',
- 'section' => 'UI',
- 'description' => 'Message locale',
- 'type' => 'select',
- 'select_enum' => [ qw(en_US) ],
- },
-
- {
- 'key' => 'selfservice_server-quiet',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, the self-service server no longer sends superfluous decline and cancel emails. Used to disable decline and cancel emails generated by transactions initiated by the selfservice server.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'signup_server-quiet',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, the signup server is now part of the self-service server and no longer sends superfluous decline and cancel emails. Used to disable decline and cancel emails generated by transactions initiated by the signup server. Does not disable welcome emails.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'signup_server-payby',
- 'section' => '',
- 'description' => 'Acceptable payment types for the signup server',
- 'type' => 'selectmultiple',
- 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB PREPAY BILL COMP) ],
- },
-
- {
- 'key' => 'signup_server-email',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, this feature is no longer available. See the ***fill me in*** report instead. Used to contain a comma-separated list of email addresses to receive notification of signups via the signup server.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'signup_server-default_agentnum',
- 'section' => '',
- 'description' => 'Default agent for the signup server',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::agent;
- map { $_->agentnum => $_->agent }
- FS::Record::qsearch('agent', { disabled=>'' } );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::agent;
- my $agent = FS::Record::qsearchs(
- 'agent', { 'agentnum'=>shift }
- );
- $agent ? $agent->agent : '';
- },
- },
-
- {
- 'key' => 'signup_server-default_refnum',
- 'section' => '',
- 'description' => 'Default advertising source for the signup server',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::part_referral;
- map { $_->refnum => $_->referral }
- FS::Record::qsearch( 'part_referral',
- { 'disabled' => '' }
- );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::part_referral;
- my $part_referral = FS::Record::qsearchs(
- 'part_referral', { 'refnum'=>shift } );
- $part_referral ? $part_referral->referral : '';
- },
- },
-
- {
- 'key' => 'signup_server-default_pkgpart',
- 'section' => '',
- 'description' => 'Default pakcage for the signup server',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::part_pkg;
- map { $_->pkgpart => $_->pkg.' - '.$_->comment }
- FS::Record::qsearch( 'part_pkg',
- { 'disabled' => ''}
- );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::part_pkg;
- my $part_pkg = FS::Record::qsearchs(
- 'part_pkg', { 'pkgpart'=>shift }
- );
- $part_pkg
- ? $part_pkg->pkg.' - '.$part_pkg->comment
- : '';
- },
- },
-
- {
- 'key' => 'show-msgcat-codes',
- 'section' => 'UI',
- 'description' => 'Show msgcat codes in error messages. Turn this option on before reporting errors to the mailing list.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'signup_server-realtime',
- 'section' => '',
- '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' => '',
- 'description' => 'Package Class for first optional purchase',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::pkg_class;
- map { $_->classnum => $_->classname }
- FS::Record::qsearch('pkg_class', {} );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::pkg_class;
- my $pkg_class = FS::Record::qsearchs(
- 'pkg_class', { 'classnum'=>shift }
- );
- $pkg_class ? $pkg_class->classname : '';
- },
- },
-
- {
- 'key' => 'signup_server-classnum3',
- 'section' => '',
- 'description' => 'Package Class for second optional purchase',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::pkg_class;
- map { $_->classnum => $_->classname }
- FS::Record::qsearch('pkg_class', {} );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::pkg_class;
- my $pkg_class = FS::Record::qsearchs(
- 'pkg_class', { 'classnum'=>shift }
- );
- $pkg_class ? $pkg_class->classname : '';
- },
- },
-
- {
- 'key' => 'backend-realtime',
- 'section' => '',
- 'description' => 'Run billing for backend signups immediately.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'declinetemplate',
- 'section' => 'billing',
- 'description' => 'Template file for credit card decline emails.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'emaildecline',
- 'section' => 'billing',
- 'description' => 'Enable emailing of credit card decline notices.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'emaildecline-exclude',
- 'section' => 'billing',
- 'description' => 'List of error messages that should not trigger email decline notices, one per line.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'cancelmessage',
- 'section' => 'billing',
- 'description' => 'Template file for cancellation emails.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'cancelsubject',
- 'section' => 'billing',
- 'description' => 'Subject line for cancellation emails.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'emailcancel',
- 'section' => 'billing',
- 'description' => 'Enable emailing of cancellation notices.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'require_cardname',
- 'section' => 'billing',
- 'description' => 'Require an "Exact name on card" to be entered explicitly; don\'t default to using the first and last name.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'enable_taxclasses',
- 'section' => 'billing',
- 'description' => 'Enable per-package tax classes',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'require_taxclasses',
- 'section' => 'billing',
- 'description' => 'Require a taxclass to be entered for every package',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'welcome_email',
- 'section' => '',
- 'description' => 'Template file for welcome email. Welcome emails are sent to the customer email invoice destination(s) each time a svc_acct record is created. See the <a href="http://search.cpan.org/~mjd/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitution language. The following variables are available<ul><li><code>$username</code> <li><code>$password</code> <li><code>$first</code> <li><code>$last</code> <li><code>$pkg</code></ul>',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'welcome_email-from',
- 'section' => '',
- 'description' => 'From: address header for welcome email',
- 'type' => 'text',
- },
-
- {
- 'key' => 'welcome_email-subject',
- 'section' => '',
- 'description' => 'Subject: header for welcome email',
- 'type' => 'text',
- },
-
- {
- 'key' => 'welcome_email-mimetype',
- 'section' => '',
- 'description' => 'MIME type for welcome email',
- 'type' => 'select',
- 'select_enum' => [ 'text/plain', 'text/html' ],
- },
-
- {
- 'key' => 'welcome_letter',
- 'section' => '',
- 'description' => 'Optional LaTex template file for a printed welcome letter. A welcome letter is printed the first time a cust_pkg record is created. See the <a href="http://search.cpan.org/~mjd/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation and the billing documentation for details on the template substitution language. A variable exists for each fieldname in the customer record (<code>$first, $last, etc</code>). The following additional variables are available<ul><li><code>$payby</code> - a friendler represenation of the field<li><code>$payinfo</code> - the masked payment information<li><code>$expdate</code> - the time at which the payment method expires (a UNIX timestamp)<li><code>$returnaddress</code> - the invoice return address for this customer\'s agent</ul>',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'warning_email',
- 'section' => '',
- 'description' => 'Template file for warning email. Warning emails are sent to the customer email invoice destination(s) each time a svc_acct record has its usage drop below a threshold or 0. See the <a href="http://search.cpan.org/~mjd/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitution language. The following variables are available<ul><li><code>$username</code> <li><code>$password</code> <li><code>$first</code> <li><code>$last</code> <li><code>$pkg</code> <li><code>$column</code> <li><code>$amount</code> <li><code>$threshold</code></ul>',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'warning_email-from',
- 'section' => '',
- 'description' => 'From: address header for warning email',
- 'type' => 'text',
- },
-
- {
- 'key' => 'warning_email-cc',
- 'section' => '',
- 'description' => 'Additional recipient(s) (comma separated) for warning email when remaining usage reaches zero.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'warning_email-subject',
- 'section' => '',
- 'description' => 'Subject: header for warning email',
- 'type' => 'text',
- },
-
- {
- 'key' => 'warning_email-mimetype',
- 'section' => '',
- 'description' => 'MIME type for warning email',
- 'type' => 'select',
- 'select_enum' => [ 'text/plain', 'text/html' ],
- },
-
- {
- 'key' => 'payby',
- 'section' => 'billing',
- 'description' => 'Available payment types.',
- 'type' => 'selectmultiple',
- 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB BILL CASH WEST MCRD COMP) ],
- },
-
- {
- 'key' => 'payby-default',
- 'section' => 'UI',
- 'description' => 'Default payment type. HIDE disables display of billing information and sets customers to BILL.',
- 'type' => 'select',
- 'select_enum' => [ '', qw(CARD DCRD CHEK DCHK LECB BILL CASH WEST MCRD COMP HIDE) ],
- },
-
- {
- 'key' => 'paymentforcedtobatch',
- 'section' => 'deprecated',
- 'description' => 'See batch-enable_payby and realtime-disable_payby. Used to (for CHEK): Cause per customer payment entry to be forced to a batch processor rather than performed realtime.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-notes',
- 'section' => 'UI',
- 'description' => 'Extra HTML to be displayed on the Account View screen.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'radius-password',
- 'section' => '',
- 'description' => 'RADIUS attribute for plain-text passwords.',
- 'type' => 'select',
- 'select_enum' => [ 'Password', 'User-Password' ],
- },
-
- {
- 'key' => 'radius-ip',
- 'section' => '',
- 'description' => 'RADIUS attribute for IP addresses.',
- 'type' => 'select',
- 'select_enum' => [ 'Framed-IP-Address', 'Framed-Address' ],
- },
-
- #http://dev.coova.org/svn/coova-chilli/doc/dictionary.chillispot
- {
- 'key' => 'radius-chillispot-max',
- 'section' => '',
- 'description' => 'Enable ChilliSpot (and CoovaChilli) Max attributes, specifically ChilliSpot-Max-{Input,Output,Total}-{Octets,Gigawords}.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-alldomains',
- 'section' => '',
- 'description' => 'Allow accounts to select any domain in the database. Normally accounts can only select from the domain set in the service definition and those purchased by the customer.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'dump-scpdest',
- 'section' => '',
- 'description' => 'destination for scp database dumps: user@host:/path',
- 'type' => 'text',
- },
-
- {
- 'key' => 'dump-pgpid',
- 'section' => '',
- 'description' => "Optional PGP public key user or key id for database dumps. The public key should exist on the freeside user's public keyring, and the gpg binary and GnuPG perl module should be installed.",
- 'type' => 'text',
- },
-
- {
- 'key' => 'users-allow_comp',
- 'section' => 'deprecated',
- 'description' => '<b>DEPRECATED</b>, enable the <i>Complimentary customer</i> access right instead. Was: Usernames (Freeside users, created with <a href="../docs/man/bin/freeside-adduser.html">freeside-adduser</a>) which can create complimentary customers, one per line. If no usernames are entered, all users can create complimentary accounts.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'credit_card-recurring_billing_flag',
- 'section' => 'billing',
- 'description' => 'This controls when the system passes the "recurring_billing" flag on credit card transactions. If supported by your processor (and the Business::OnlinePayment processor module), passing the flag indicates this is a recurring transaction and may turn off the CVV requirement. ',
- 'type' => 'select',
- 'select_hash' => [
- 'actual_oncard' => 'Default/classic behavior: set the flag if a customer has actual previous charges on the card.',
- 'transaction_is_recur' => 'Set the flag if the transaction itself is recurring, irregardless of previous charges on the card.',
- ],
- },
-
- {
- 'key' => 'credit_card-recurring_billing_acct_code',
- 'section' => 'billing',
- 'description' => 'When the "recurring billing" flag is set, also set the "acct_code" to "rebill". Useful for reporting purposes with supported gateways (PlugNPay, others?)',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cvv-save',
- 'section' => 'billing',
- 'description' => 'Save CVV2 information after the initial transaction for the selected credit card types. Enabling this option may be in violation of your merchant agreement(s), so please check them carefully before enabling this option for any credit card types.',
- 'type' => 'selectmultiple',
- 'select_enum' => \@card_types,
- },
-
- {
- 'key' => 'allow_negative_charges',
- 'section' => 'billing',
- 'description' => 'Allow negative charges. Normally not used unless importing data from a legacy system that requires this.',
- 'type' => 'checkbox',
- },
- {
- 'key' => 'auto_unset_catchall',
- 'section' => '',
- 'description' => 'When canceling a svc_acct that is the email catchall for one or more svc_domains, automatically set their catchall fields to null. If this option is not set, the attempt will simply fail.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'system_usernames',
- 'section' => 'username',
- 'description' => 'A list of system usernames that cannot be edited or removed, one per line. Use a bare username to prohibit modification/deletion of the username in any domain, or username@domain to prohibit modification/deletetion of a specific username and domain.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'cust_pkg-change_svcpart',
- 'section' => '',
- 'description' => "When changing packages, move services even if svcparts don't match between old and new pacakge definitions.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'disable_autoreverse',
- 'section' => 'BIND',
- 'description' => 'Disable automatic synchronization of reverse-ARPA entries.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_www-enable_subdomains',
- 'section' => '',
- 'description' => 'Enable selection of specific subdomains for virtual host creation.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_www-usersvc_svcpart',
- 'section' => '',
- 'description' => 'Allowable service definition svcparts for virtual hosts, one per line.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'selfservice_server-primary_only',
- 'section' => '',
- 'description' => 'Only allow primary accounts to access self-service functionality.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'card_refund-days',
- 'section' => 'billing',
- 'description' => 'After a payment, the number of days a refund link will be available for that payment. Defaults to 120.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'agent-showpasswords',
- 'section' => '',
- 'description' => 'Display unencrypted user passwords in the agent (reseller) interface',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'global_unique-username',
- 'section' => 'username',
- 'description' => 'Global username uniqueness control: none (usual setting - check uniqueness per exports), username (all usernames are globally unique, regardless of domain or exports), or username@domain (all username@domain pairs are globally unique, regardless of exports). disabled turns off duplicate checking completely and is STRONGLY NOT RECOMMENDED unless you REALLY need to turn this off.',
- 'type' => 'select',
- 'select_enum' => [ 'none', 'username', 'username@domain', 'disabled' ],
- },
-
- {
- 'key' => 'svc_external-skip_manual',
- 'section' => 'UI',
- 'description' => 'When provisioning svc_external services, skip manual entry of id and title fields in the UI. Usually used in conjunction with an export that populates these fields (i.e. artera_turbo).',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_external-display_type',
- 'section' => 'UI',
- 'description' => 'Select a specific svc_external type to enable some UI changes specific to that type (i.e. artera_turbo).',
- 'type' => 'select',
- 'select_enum' => [ 'generic', 'artera_turbo', ],
- },
-
- {
- 'key' => 'ticket_system',
- 'section' => '',
- 'description' => 'Ticketing system integration. <b>RT_Internal</b> uses the built-in RT ticketing system (see the <a href="../docs/install-rt">integrated ticketing installation instructions</a>). <b>RT_External</b> accesses an external RT installation in a separate database (local or remote).',
- 'type' => 'select',
- #'select_enum' => [ '', qw(RT_Internal RT_Libs RT_External) ],
- 'select_enum' => [ '', qw(RT_Internal RT_External) ],
- },
-
- {
- 'key' => 'ticket_system-default_queueid',
- 'section' => '',
- 'description' => 'Default queue used when creating new customer tickets.',
- '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-custom_priority_field',
- 'section' => '',
- 'description' => 'Custom field from the ticketing system to use as a custom priority classification.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'ticket_system-custom_priority_field-values',
- 'section' => '',
- 'description' => 'Values for the custom field from the ticketing system to break down and sort customer ticket lists.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'ticket_system-custom_priority_field_queue',
- 'section' => '',
- 'description' => 'Ticketing system queue in which the custom field specified in ticket_system-custom_priority_field is located.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'ticket_system-rt_external_datasrc',
- 'section' => '',
- 'description' => 'With external RT integration, the DBI data source for the external RT installation, for example, <code>DBI:Pg:user=rt_user;password=rt_word;host=rt.example.com;dbname=rt</code>',
- 'type' => 'text',
-
- },
-
- {
- 'key' => 'ticket_system-rt_external_url',
- 'section' => '',
- 'description' => 'With external RT integration, the URL for the external RT installation, for example, <code>https://rt.example.com/rt</code>',
- 'type' => 'text',
- },
-
- {
- 'key' => 'company_name',
- 'section' => 'required',
- 'description' => 'Your company name',
- 'type' => 'text',
- },
-
- {
- 'key' => 'echeck-void',
- 'section' => 'deprecated',
- 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable local-only voiding of echeck payments in addition to refunds against the payment gateway',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cc-void',
- 'section' => 'deprecated',
- 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable local-only voiding of credit card payments in addition to refunds against the payment gateway',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'unvoid',
- 'section' => 'deprecated',
- 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable unvoiding of voided payments',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'address2-search',
- 'section' => 'UI',
- 'description' => 'Enable a "Unit" search box which searches the second address field',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-require_address2',
- 'section' => 'UI',
- 'description' => 'Second address field is required (on service address only, if billing and service addresses differ). Also enables "Unit" labeling of address2 on customer view and edit pages. Useful for multi-tenant applications. See also: address2-search',
- 'type' => 'checkbox',
- },
-
- { 'key' => 'referral_credit',
- 'section' => 'billing',
- 'description' => "Enables one-time referral credits in the amount of one month <i>referred</i> customer's recurring fee (irregardless of frequency).",
- 'type' => 'checkbox',
- },
-
- { 'key' => 'selfservice_server-cache_module',
- 'section' => '',
- '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' ],
- },
-
- {
- 'key' => 'hylafax',
- 'section' => 'billing',
- 'description' => 'Options for a HylaFAX server to enable the FAX invoice destination. They should be in the form of a space separated list of arguments to the Fax::Hylafax::Client::sendfax subroutine. You probably shouldn\'t override things like \'docfile\'. *Note* Only supported when using typeset invoices (see the invoice_latex configuration option).',
- 'type' => [qw( checkbox textarea )],
- },
-
- {
- 'key' => 'cust_bill-ftpformat',
- 'section' => 'billing',
- 'description' => 'Enable FTP of raw invoice data - format.',
- 'type' => 'select',
- 'select_enum' => [ '', 'default', 'billco', ],
- },
-
- {
- 'key' => 'cust_bill-ftpserver',
- 'section' => 'billing',
- 'description' => 'Enable FTP of raw invoice data - server.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_bill-ftpusername',
- 'section' => 'billing',
- 'description' => 'Enable FTP of raw invoice data - server.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_bill-ftppassword',
- 'section' => 'billing',
- 'description' => 'Enable FTP of raw invoice data - server.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_bill-ftpdir',
- 'section' => 'billing',
- 'description' => 'Enable FTP of raw invoice data - server.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_bill-spoolformat',
- 'section' => 'billing',
- 'description' => 'Enable spooling of raw invoice data - format.',
- 'type' => 'select',
- 'select_enum' => [ '', 'default', 'billco', ],
- },
-
- {
- 'key' => 'cust_bill-spoolagent',
- 'section' => 'billing',
- 'description' => 'Enable per-agent spooling of raw invoice data.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-usage_suspend',
- 'section' => 'billing',
- 'description' => 'Suspends the package an account belongs to when svc_acct.seconds or a bytecount is decremented to 0 or below (accounts with an empty seconds and up|down|totalbytes value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-usage_unsuspend',
- 'section' => 'billing',
- 'description' => 'Unuspends the package an account belongs to when svc_acct.seconds or a bytecount is incremented from 0 or below to a positive value (accounts with an empty seconds and up|down|totalbytes value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-usage_threshold',
- 'section' => 'billing',
- 'description' => 'The threshold (expressed as percentage) of acct.seconds or acct.up|down|totalbytes at which a warning message is sent to a service holder. Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd. Defaults to 80.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust-fields',
- 'section' => 'UI',
- 'description' => 'Which customer fields to display on reports by default',
- 'type' => 'select',
- 'select_hash' => [ FS::ConfDefaults->cust_fields_avail() ],
- },
-
- {
- 'key' => 'cust_pkg-display_times',
- 'section' => 'UI',
- 'description' => 'Display full timestamps (not just dates) for customer packages. Useful if you are doing real-time things like hourly prepaid.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-edit_uid',
- 'section' => 'shell',
- 'description' => 'Allow UID editing.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_acct-edit_gid',
- 'section' => 'shell',
- 'description' => 'Allow GID editing.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'zone-underscore',
- 'section' => 'BIND',
- 'description' => 'Allow underscores in zone names. As underscores are illegal characters in zone names, this option is not recommended.',
- 'type' => 'checkbox',
- },
-
- #these should become per-user...
- {
- 'key' => 'vonage-username',
- 'section' => '',
- 'description' => 'Vonage Click2Call username (see <a href="https://secure.click2callu.com/">https://secure.click2callu.com/</a>)',
- 'type' => 'text',
- },
- {
- 'key' => 'vonage-password',
- 'section' => '',
- 'description' => 'Vonage Click2Call username (see <a href="https://secure.click2callu.com/">https://secure.click2callu.com/</a>)',
- 'type' => 'text',
- },
- {
- 'key' => 'vonage-fromnumber',
- 'section' => '',
- 'description' => 'Vonage Click2Call number (see <a href="https://secure.click2callu.com/">https://secure.click2callu.com/</a>)',
- 'type' => 'text',
- },
-
- {
- 'key' => 'echeck-nonus',
- 'section' => 'billing',
- 'description' => 'Disable ABA-format account checking for Electronic Check payment info',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'voip-cust_cdr_spools',
- 'section' => '',
- 'description' => 'Enable the per-customer option for individual CDR spools.',
- '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.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'tax-ship_address',
- 'section' => 'billing',
- 'description' => 'By default, tax calculations are done based on the billing address. Enable this switch to calculate tax based on the shipping address instead. Note: Tax reports can take a long time when enabled.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'invoice-ship_address',
- 'section' => 'billing',
- 'description' => 'Enable this switch to include the ship address on the invoice.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'invoice-unitprice',
- 'section' => 'billing',
- 'description' => 'This switch enables unit pricing on the invoice.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'postal_invoice-fee_pkgpart',
- 'section' => 'billing',
- 'description' => 'This allows selection of a package to insert on invoices for customers with postal invoices selected.',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::part_pkg;
- map { $_->pkgpart => $_->pkg }
- FS::Record::qsearch('part_pkg', { disabled=>'' } );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::part_pkg;
- my $part_pkg = FS::Record::qsearchs(
- 'part_pkg', { 'pkgpart'=>shift }
- );
- $part_pkg ? $part_pkg->pkg : '';
- },
- },
-
- {
- 'key' => 'postal_invoice-recurring_only',
- 'section' => 'billing',
- 'description' => 'The postal invoice fee is omitted on invoices without recurring charges when this is set',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'batch-enable',
- 'section' => 'deprecated', #make sure batch-enable_payby is set for
- #everyone before removing
- 'description' => 'Enable credit card and/or ACH batching - leave disabled for real-time installations.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'batch-enable_payby',
- 'section' => 'billing',
- 'description' => 'Enable batch processing for the specified payment types.',
- 'type' => 'selectmultiple',
- 'select_enum' => [qw( CARD CHEK )],
- },
-
- {
- 'key' => 'realtime-disable_payby',
- 'section' => 'billing',
- 'description' => 'Disable realtime processing for the specified payment types.',
- 'type' => 'selectmultiple',
- 'select_enum' => [qw( CARD CHEK )],
- },
-
- {
- 'key' => 'batch-default_format',
- 'section' => 'billing',
- 'description' => 'Default format for batches.',
- 'type' => 'select',
- 'select_enum' => [ 'csv-td_canada_trust-merchant_pc_batch',
- 'csv-chase_canada-E-xactBatch', 'BoM', 'PAP',
- 'ach-spiritone',
- ]
- },
-
- {
- 'key' => 'batch-fixed_format-CARD',
- 'section' => 'billing',
- 'description' => 'Fixed (unchangeable) format for credit card batches.',
- 'type' => 'select',
- 'select_enum' => [ 'csv-td_canada_trust-merchant_pc_batch', 'BoM', 'PAP' ,
- 'csv-chase_canada-E-xactBatch', 'BoM', 'PAP' ]
- },
-
- {
- 'key' => 'batch-fixed_format-CHEK',
- 'section' => 'billing',
- 'description' => 'Fixed (unchangeable) format for electronic check batches.',
- 'type' => 'select',
- 'select_enum' => [ 'csv-td_canada_trust-merchant_pc_batch', 'BoM', 'PAP',
- 'ach-spiritone',
- ]
- },
-
- {
- 'key' => 'batch-increment_expiration',
- 'section' => 'billing',
- 'description' => 'Increment expiration date years in batches until cards are current. Make sure this is acceptable to your batching provider before enabling.',
- 'type' => 'checkbox'
- },
-
- {
- 'key' => 'batchconfig-BoM',
- 'section' => 'billing',
- 'description' => 'Configuration for Bank of Montreal batching, seven lines: 1. Origin ID, 2. Datacenter, 3. Typecode, 4. Short name, 5. Long name, 6. Bank, 7. Bank account',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'batchconfig-PAP',
- 'section' => 'billing',
- 'description' => 'Configuration for PAP batching, seven lines: 1. Origin ID, 2. Datacenter, 3. Typecode, 4. Short name, 5. Long name, 6. Bank, 7. Bank account',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'batchconfig-csv-chase_canada-E-xactBatch',
- 'section' => 'billing',
- 'description' => 'Gateway ID for Chase Canada E-xact batching',
- 'type' => 'text',
- },
-
- {
- 'key' => 'payment_history-years',
- 'section' => 'UI',
- 'description' => 'Number of years of payment history to show by default. Currently defaults to 2.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_main-use_comments',
- 'section' => 'UI',
- 'description' => 'Display free form comments on the customer edit screen. Useful as a scratch pad.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-disable_notes',
- 'section' => 'UI',
- 'description' => 'Disable new style customer notes - timestamped and user identified customer notes. Useful in tracking who did what.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main_note-display_times',
- 'section' => 'UI',
- 'description' => 'Display full timestamps (not just dates) for customer notes.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-ticket_statuses',
- 'section' => 'UI',
- 'description' => 'Show tickets with these statuses on the customer view page.',
- 'type' => 'selectmultiple',
- 'select_enum' => [qw( new open stalled resolved rejected deleted )],
- },
-
- {
- 'key' => 'cust_main-max_tickets',
- 'section' => 'UI',
- 'description' => 'Maximum number of tickets to show on the customer view page.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_main-skeleton_tables',
- 'section' => '',
- 'description' => 'Tables which will have skeleton records inserted into them for each customer. Syntax for specifying tables is unfortunately a tricky perl data structure for now.',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'cust_main-skeleton_custnum',
- 'section' => '',
- 'description' => 'Customer number specifying the source data to copy into skeleton tables for new customers.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_main-enable_birthdate',
- 'section' => 'UI',
- 'descritpion' => 'Enable tracking of a birth date with each customer record',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'support-key',
- 'section' => '',
- 'description' => 'A support key enables access to commercial services delivered over the network, such as the payroll module, access to the internal ticket system, priority support and optional backups.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'card-types',
- 'section' => 'billing',
- 'description' => 'Select one or more card types to enable only those card types. If no card types are selected, all card types are available.',
- 'type' => 'selectmultiple',
- 'select_enum' => \@card_types,
- },
-
- {
- 'key' => 'dashboard-toplist',
- 'section' => 'UI',
- 'description' => 'List of items to display on the top of the front page',
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'impending_recur_template',
- 'section' => 'billing',
- 'description' => 'Template file for alerts about looming first time recurrant billing. See the <a href="http://search.cpan.org/~mjd/Text-Template.pm">Text::Template</a> documentation for details on the template substitition language. Also see packages with a <a href="../browse/part_pkg.cgi">flat price plan</a> The following variables are available<ul><li><code>$packages</code> allowing <code>$packages->[0]</code> thru <code>$packages->[n]</code> <li><code>$package</code> the first package, same as <code>$packages->[0]</code> <li><code>$recurdates</code> allowing <code>$recurdates->[0]</code> thru <code>$recurdates->[n]</code> <li><code>$recurdate</code> the first recurdate, same as <code>$recurdate->[0]</code> <li><code>$first</code> <li><code>$last</code></ul>',
-# <li><code>$payby</code> <li><code>$expdate</code> most likely only confuse
- 'type' => 'textarea',
- },
-
- {
- 'key' => 'selfservice-session_timeout',
- 'section' => '',
- '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', ],
- },
-
- {
- 'key' => 'disable_setup_suspended_pkgs',
- 'section' => 'billing',
- 'description' => 'Disables charging of setup fees for suspended packages.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'password-generated-allcaps',
- 'section' => 'password',
- 'description' => 'Causes passwords automatically generated to consist entirely of capital letters',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'datavolume-forcemegabytes',
- 'section' => 'UI',
- 'description' => 'All data volumes are expressed in megabytes',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'datavolume-significantdigits',
- 'section' => 'UI',
- 'description' => 'number of significant digits to use to represent data volumes',
- 'type' => 'text',
- },
-
- {
- 'key' => 'disable_void_after',
- 'section' => 'billing',
- 'description' => 'Number of seconds after which freeside won\'t attempt to VOID a payment first when performing a refund.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'disable_line_item_date_ranges',
- 'section' => 'billing',
- 'description' => 'Prevent freeside from automatically generating date ranges on invoice line items.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-require_phone',
- 'section' => '',
- 'description' => 'Require daytime or night for all customer records.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-require_invoicing_list_email',
- 'section' => '',
- 'description' => 'Email address field is required: require at least one invoicing email address for all customer records.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cancel_credit_type',
- 'section' => 'billing',
- 'description' => 'The group to use for new, automatically generated credit reasons resulting from cancellation.',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::reason_type;
- map { $_->typenum => $_->type }
- FS::Record::qsearch('reason_type', { class=>'R' } );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::reason_type;
- my $reason_type = FS::Record::qsearchs(
- 'reason_type', { 'typenum' => shift }
- );
- $reason_type ? $reason_type->type : '';
- },
- },
-
- {
- 'key' => 'referral_credit_type',
- 'section' => 'billing',
- 'description' => 'The group to use for new, automatically generated credit reasons resulting from referrals.',
- 'type' => 'select-sub',
- 'options_sub' => sub { require FS::Record;
- require FS::reason_type;
- map { $_->typenum => $_->type }
- FS::Record::qsearch('reason_type', { class=>'R' } );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::reason_type;
- my $reason_type = FS::Record::qsearchs(
- 'reason_type', { 'typenum' => shift }
- );
- $reason_type ? $reason_type->type : '';
- },
- },
-
- {
- 'key' => 'signup_credit_type',
- 'section' => 'billing',
- '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;
- require FS::reason_type;
- map { $_->typenum => $_->type }
- FS::Record::qsearch('reason_type', { class=>'R' } );
- },
- 'option_sub' => sub { require FS::Record;
- require FS::reason_type;
- my $reason_type = FS::Record::qsearchs(
- 'reason_type', { 'typenum' => shift }
- );
- $reason_type ? $reason_type->type : '';
- },
- },
-
- {
- 'key' => 'cust_main-agent_custid-format',
- 'section' => '',
- 'description' => 'Enables searching of various formatted values in cust_main.agent_custid',
- 'type' => 'select',
- 'select_hash' => [
- '' => 'Numeric only',
- 'ww?d+' => 'Numeric with one or two letter prefix',
- ],
- },
-
- {
- 'key' => 'card_masking_method',
- 'section' => 'UI',
- 'description' => 'Digits to display when masking credit cards. Note that the first six digits are necessary to canonically identify the credit card type (Visa/MC, Amex, Discover, Maestro, etc.) in all cases. The first four digits can identify the most common credit card types in most cases (Visa/MC, Amex, and Discover). The first two digits can distinguish between Visa/MC and Amex.',
- 'type' => 'select',
- 'select_hash' => [
- '' => '123456xxxxxx1234',
- 'first6last2' => '123456xxxxxxxx12',
- 'first4last4' => '1234xxxxxxxx1234',
- 'first4last2' => '1234xxxxxxxxxx12',
- 'first2last4' => '12xxxxxxxxxx1234',
- 'first2last2' => '12xxxxxxxxxxxx12',
- 'first0last4' => 'xxxxxxxxxxxx1234',
- 'first0last2' => 'xxxxxxxxxxxxxx12',
- ],
- },
-
- {
- 'key' => 'disable_previous_balance',
- 'section' => 'billing',
- 'description' => 'Disable inclusion of previous balance lines on invoices',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'disable_acl_changes',
- 'section' => '',
- 'description' => 'Disable all ACL changes, for demos.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-edit_agent_custid',
- 'section' => 'UI',
- 'description' => 'Enable editing of the agent_custid field.',
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'cust_main-default_areacode',
- 'section' => 'UI',
- 'description' => 'Default area code for customers.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cust_bill-max_same_services',
- 'section' => 'billing',
- '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' => 'suspend_email_admin',
- 'section' => '',
- 'description' => 'Destination admin email address to enable suspension notices',
- 'type' => 'text',
- },
-
- {
- 'key' => 'email_report-subject',
- 'section' => '',
- 'description' => 'Subject for reports emailed by freeside-fetch. Defaults to "Freeside report".',
- 'type' => 'text',
- },
-
- {
- 'key' => 'sg-multicustomer_hack',
- 'section' => '',
- 'description' => "Don't use this.",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'sg-ping_username',
- 'section' => '',
- 'description' => "Don't use this.",
- 'type' => 'text',
- },
-
- {
- 'key' => 'sg-ping_password',
- 'section' => '',
- 'description' => "Don't use this.",
- 'type' => 'text',
- },
-
- {
- 'key' => 'sg-login_username',
- 'section' => '',
- 'description' => "Don't use this.",
- 'type' => 'text',
- },
-
- {
- 'key' => 'queued-max_kids',
- 'section' => '',
- 'description' => 'Maximum number of queued processes. Defaults to 10.',
- 'type' => 'text',
- },
-
- {
- 'key' => 'cancelled_cust-noevents',
- 'section' => 'billing',
- 'description' => "Don't run events for cancelled customers",
- 'type' => 'checkbox',
- },
-
- {
- 'key' => 'svc_broadband-manage_link',
- 'section' => 'UI',
- 'description' => 'URL for svc_broadband "Manage Device" link. The following substitutions are available: $ip_addr.',
- 'type' => 'text',
- },
-
-);
-
-1;
-
diff --git a/FS/FS/Cron/alert_expiration.pm b/FS/FS/Cron/alert_expiration.pm
deleted file mode 100644
index eb53ea8..0000000
--- a/FS/FS/Cron/alert_expiration.pm
+++ /dev/null
@@ -1,189 +0,0 @@
-package FS::Cron::alert_expiration;
-
-use vars qw( @ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(qsearch qsearchs);
-use FS::Conf;
-use FS::cust_main;
-use FS::Misc;
-use Time::Local;
-use Date::Parse qw(str2time);
-
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( alert_expiration );
-
-my $warning_time = 30 * 24 * 60 * 60;
-my $urgent_time = 15 * 24 * 60 * 60;
-my $panic_time = 5 * 24 * 60 * 60;
-my $window_time = 24 * 60 * 60;
-
-sub alert_expiration {
- my $conf = new FS::Conf;
- my $smtpmachine = $conf->config('smtpmachine');
-
- my %opt = @_;
- my ($_date) = $opt{'d'} ? str2time($opt{'d'}) : $^T;
- $_date += $opt{'y'} * 86400 if $opt{'y'};
- my ($sec, $min, $hour, $mday, $mon, $year) = (localtime($_date)) [0..5];
- $mon++;
-
- my $debug = 0;
- $debug = 1 if $opt{'v'};
- $debug = $opt{'l'} if $opt{'l'};
-
- $FS::cust_main::DEBUG = $debug;
-
- # Get a list of customers.
-
- my %limit;
- $limit{'agentnum'} = $opt{'a'} if $opt{'a'};
- $limit{'payby'} = $opt{'p'} if $opt{'p'};
-
- my @customers;
-
- if(my @custnums = @ARGV) {
- # We're given an explicit list of custnums, so select those. Then check against
- # -a and -p to avoid doing anything unexpected.
- foreach (@custnums) {
- my $customer = FS::cust_main->by_key($_);
- if($customer and (!$opt{'a'} or $customer->agentnum == $opt{'a'})
- and (!$opt{'p'} or $customer->payby eq $opt{'p'}) ) {
- push @customers, $customer;
- }
- }
- }
- else { # no @ARGV
- @customers = qsearch('cust_main', \%limit);
- }
- return if(!@customers);
- foreach my $customer (@customers) {
- next if !($customer->ncancelled_pkgs); # skip inactive customers
- my $paydate = $customer->paydate;
- next if $paydate =~ /^\s*$/; # skip empty expiration dates
-
- my $custnum = $customer->custnum;
- my $first = $customer->first;
- my $last = $customer->last;
- my $company = $customer->company;
- my $payby = $customer->payby;
- my $payinfo = $customer->payinfo;
- my $daytime = $customer->daytime;
- my $night = $customer->night;
-
- my ($paymonth, $payyear) = $customer->paydate_monthyear;
- $paymonth--; # localtime() convention
- $payday = 1; # This is enforced by FS::cust_main::check.
- my $expire_time;
- if($payby eq 'CARD' || $payby eq 'DCRD') {
- # Credit cards expire at the end of the month/year.
- if($paymonth == 11) {
- $payyear++;
- $paymonth = 0;
- } else {
- $paymonth++;
- }
- $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear) - 1;
- }
- else {
- $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
- }
-
- if (grep { $expire_time < $_date + $_ &&
- $expire_time > $_date + $_ - $window_time }
- ($warning_time, $urgent_time, $panic_time) ) {
- # Send an expiration notice.
- my $agentnum = $customer->agentnum;
- my $error = '';
-
- my $msgnum = $conf->config('alerter_msgnum', $agentnum);
- if ( $msgnum ) { # new hotness
- my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
- $customer->setfield('expdate', $expire_time);
- $error = $msg_template->send('cust_main' => $customer);
- }
- else { #!$msgnum, the hard way
- $mail_sender = $conf->config('invoice_from', $agentnum);
- $failure_recipient = $conf->config('invoice_from', $agentnum)
- || 'postmaster';
-
- my @alerter_template = $conf->config('alerter_template', $agentnum)
- or die 'cannot load config file alerter_template';
-
- my $alerter = new Text::Template(TYPE => 'ARRAY',
- SOURCE => [
- map "$_\n", @alerter_template
- ])
- or die "can't create Text::Template object: $Text::Template::ERROR";
-
- $alerter->compile()
- or die "can't compile template: $Text::Template::ERROR";
-
- my @invoicing_list = $customer->invoicing_list;
- my @to_addrs = grep { $_ ne 'POST' } @invoicing_list;
- if(@to_addrs) {
- # Set up template fields.
- my %fill_in;
- $fill_in{$_} = $customer->getfield($_)
- foreach(qw(first last company));
- $fill_in{'expdate'} = $expire_time;
- $fill_in{'company_name'} = $conf->config('company_name', $agentnum);
- $fill_in{'company_address'} =
- join("\n",$conf->config('company_address',$agentnum))."\n";
- if($payby eq 'CARD' || $payby eq 'DCRD') {
- $fill_in{'payby'} = "credit card (".
- substr($customer->payinfo, 0, 2) . "xxxxxxxxxx" .
- substr($payinfo, -4) . ")";
- }
- elsif($payby eq 'COMP') {
- $fill_in{'payby'} = 'complimentary account';
- }
- else {
- $fill_in{'payby'} = 'current method';
- }
- # Send it already!
- $error = FS::Misc::send_email (
- from => $mail_sender,
- to => [ @to_addrs ],
- subject => 'Billing Arrangement Expiration',
- body => [ $alerter->fill_in( HASH => \%fill_in ) ],
- );
- }
- else { # if(@to_addrs)
- push @{$agent_failure_body{$customer->agentnum}},
- sprintf(qq{%5d %-32.32s %4s %10s %12s %12s},
- $custnum,
- $first . " " . $last . " " . $company,
- $payby,
- $paydate,
- $daytime,
- $night );
- }
- } # if($msgnum)
-
-# should we die here rather than report failure as below?
- die "can't send expiration alert: $error"
- if $error;
-
- } # if(expired)
- } # foreach(@customers)
-
- # Failure notification
- foreach my $agentnum (keys %agent_failure_body) {
- $mail_sender = $conf->config('invoice_from', $agentnum)
- if($conf->exists('invoice_from', $agentnum));
- $failure_recipient = $conf->config('invoice_from', $agentnum)
- if($conf->exists('invoice_from', $agentnum));
- my $error = FS::Misc::send_email (
- from => $mail_sender,
- to => $failure_recipient,
- subject => 'Unnotified Billing Arrangement Expirations',
- body => [ @{$agent_failure_body{$agentnum}} ],
- );
- die "can't send alerter failure email to $failure_recipient: $error"
- if $error;
- }
-
-}
-
-1;
diff --git a/FS/FS/Cron/backup.pm b/FS/FS/Cron/backup.pm
deleted file mode 100644
index 9d88261..0000000
--- a/FS/FS/Cron/backup.pm
+++ /dev/null
@@ -1,45 +0,0 @@
-package FS::Cron::backup;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK );
-use Exporter;
-use Date::Format;
-use FS::UID qw(driver_name datasrc);
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( backup_scp );
-
-sub backup_scp {
- my $conf = new FS::Conf;
- my $dest = $conf->config('dump-scpdest');
- if ( $dest ) {
- $dest .= time2str('/%Y%m%d%H%M%S',time);
- datasrc =~ /dbname=([\w\.]+)$/ or die "unparsable datasrc ". datasrc;
- my $database = $1;
- eval "use Net::SCP qw(scp);";
- die $@ if $@;
- if ( driver_name eq 'Pg' ) {
- system("pg_dump $database >/var/tmp/$database.sql")
- } else {
- die "database dumps not yet supported for ". driver_name;
- }
- if ( $conf->config('dump-pgpid') ) {
- eval 'use GnuPG;';
- die $@ if $@;
- my $gpg = new GnuPG;
- $gpg->encrypt( plaintext => "/var/tmp/$database.sql",
- output => "/var/tmp/$database.gpg",
- recipient => $conf->config('dump-pgpid'),
- );
- chmod 0600, '/var/tmp/$database.gpg';
- scp("/var/tmp/$database.gpg", "$dest.gpg");
- unlink "/var/tmp/$database.gpg" or die $!;
- } else {
- chmod 0600, '/var/tmp/$database.sql';
- scp("/var/tmp/$database.sql", "$dest.sql");
- }
- unlink "/var/tmp/$database.sql" or die $!;
- }
-}
-
-1;
diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm
deleted file mode 100644
index 7388733..0000000
--- a/FS/FS/Cron/bill.pm
+++ /dev/null
@@ -1,245 +0,0 @@
-package FS::Cron::bill;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK );
-use Exporter;
-use Date::Parse;
-use DBI 1.33; #The "clone" method was added in DBI 1.33.
-use FS::UID qw( dbh driver_name );
-use FS::Record qw( qsearch qsearchs );
-use FS::queue;
-use FS::cust_main;
-use FS::part_event;
-use FS::part_event_condition;
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw ( bill bill_where );
-
-#freeside-daily %opt:
-# -s: re-charge setup fees
-# -v: enable debugging
-# -l: debugging level
-# -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing.
-# -r: Multi-process mode dry run option
-# -g: Don't bill these pkgparts
-
-sub bill {
- my %opt = @_;
-
- my $check_freq = $opt{'check_freq'} || '1d';
-
- my $debug = 0;
- $debug = 1 if $opt{'v'};
- $debug = $opt{'l'} if $opt{'l'};
- $FS::cust_main::DEBUG = $debug;
- #$FS::cust_event::DEBUG = $opt{'l'} if $opt{'l'};
-
- my $conf = new FS::Conf;
- if ( $conf->exists('disable_cron_billing') ) {
- warn "disable_cron_billing set, skipping billing\n" if $debug;
- return;
- }
-
- #we're at now now (and later).
- $opt{'time'} = $opt{'d'} ? str2time($opt{'d'}) : $^T;
- $opt{'time'} += $opt{'y'} * 86400 if $opt{'y'};
-
- $opt{'invoice_time'} = $opt{'n'} ? $^T : $opt{'time'};
-
- #hashref here doesn't work with -m
- #my $not_pkgpart = $opt{g} ? { map { $_=>1 } split(/,\s*/, $opt{g}) }
- # : {};
-
- ###
- # get a list of custnums
- ###
-
- my $cursor_dbh = dbh->clone;
-
- my $select = 'SELECT custnum FROM cust_main WHERE '. bill_where( %opt );
-
- unless ( driver_name =~ /^mysql/ ) {
- $cursor_dbh->do( "DECLARE cron_bill_cursor CURSOR FOR $select" )
- or die $cursor_dbh->errstr;
- }
-
- while ( 1 ) {
-
- my $sql = (driver_name =~ /^mysql/)
- ? $select
- : 'FETCH 100 FROM cron_bill_cursor';
-
- my $sth = $cursor_dbh->prepare($sql);
-
- $sth->execute or die $sth->errstr;
-
- my @custnums = map { $_->[0] } @{ $sth->fetchall_arrayref };
-
- last unless scalar(@custnums);
-
- ###
- # for each custnum, queue or make one customer object and bill
- # (one at a time, to reduce memory footprint with large #s of customers)
- ###
-
- foreach my $custnum ( @custnums ) {
-
- my %args = (
- 'time' => $opt{'time'},
- 'invoice_time' => $opt{'invoice_time'},
- 'actual_time' => $^T, #when freeside-bill was started
- #(not, when using -m, freeside-queued)
- 'check_freq' => $check_freq,
- 'resetup' => ( $opt{'s'} ? $opt{'s'} : 0 ),
- 'not_pkgpart' => $opt{'g'}, #$not_pkgpart,
- );
-
- if ( $opt{'m'} ) {
-
- if ( $opt{'r'} ) {
- warn "DRY RUN: would add custnum $custnum for queued_bill\n";
- } else {
-
- #avoid queuing another job if there's one still waiting to run
- next if qsearch( 'queue', { 'job' => 'FS::cust_main::queued_bill',
- 'custnum' => $custnum,
- 'status' => 'new',
- }
- );
-
- #add job to queue that calls bill_and_collect with options
- my $queue = new FS::queue {
- 'job' => 'FS::cust_main::queued_bill',
- 'secure' => 'Y',
- 'priority' => 99, #don't get in the way of provisioning jobs
- };
- my $error = $queue->insert( 'custnum'=>$custnum, %args );
-
- }
-
- } else {
-
- my $cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } );
- $cust_main->bill_and_collect( %args, 'debug' => $debug );
-
- }
-
- }
-
- last if driver_name =~ /^mysql/;
-
- }
-
- $cursor_dbh->commit or die $cursor_dbh->errstr;
-
-}
-
-# freeside-daily %opt:
-# -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with,
-# but be careful.
-#
-# -y: In addition to -d, which specifies an absolute date, the -y switch
-# specifies an offset, in days. For example, "-y 15" would increment the
-# "pretend date" 15 days from whatever was specified by the -d switch
-# (or now, if no -d switch was given).
-#
-# -n: When used with "-d" and/or "-y", specifies that invoices should be dated
-# with today's date, irregardless of the pretend date used to pre-generate
-# the invoices.
-#
-# -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>)
-#
-# -a: Only process customers with the specified agentnum
-#
-# -v: enable debugging
-#
-# -l: debugging level
-
-sub bill_where {
- my( %opt ) = @_;
-
- my $time = $opt{'time'};
- my $invoice_time = $opt{'invoice_time'};
-
- my $check_freq = $opt{'check_freq'} || '1d';
-
- my @search = ();
-
- push @search, "( cust_main.archived != 'Y' OR archived IS NULL )"; #disable?
-
- push @search, "cust_main.payby = '". $opt{'p'}. "'"
- if $opt{'p'};
- push @search, "cust_main.agentnum IN ( ". $opt{'a'}. " ) "
- if $opt{'a'};
-
- #it would be useful if i recognized $opt{g} / $not_pkgpart...
-
- if ( @ARGV ) {
- push @search, "( ".
- join(' OR ', map "cust_main.custnum = $_", @ARGV ).
- " )";
- }
-
- ###
- # generate where_pkg/where_event search clause
- ###
-
- # select * from cust_main where
- my $where_pkg = <<"END";
- EXISTS(
- SELECT 1 FROM cust_pkg
- WHERE cust_main.custnum = cust_pkg.custnum
- AND ( cancel IS NULL OR cancel = 0 )
- AND ( ( ( setup IS NULL OR setup = 0 )
- AND ( start_date IS NULL OR start_date = 0
- OR ( start_date IS NOT NULL AND start_date <= $^T )
- )
- )
- OR bill IS NULL OR bill <= $time
- OR ( expire IS NOT NULL AND expire <= $^T )
- OR ( adjourn IS NOT NULL AND adjourn <= $^T )
- )
- )
-END
-
- #some false laziness w/cust_main::Billing due_cust_event
- my $where_event = join(' OR ', map {
- my $eventtable = $_;
-
- my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
- my $where = FS::part_event_condition->where_conditions_sql( $eventtable,
- 'time'=>$time,
- );
- $where = $where ? "AND $where" : '';
-
- my $are_part_event =
- "EXISTS ( SELECT 1 FROM part_event $join
- WHERE check_freq = '$check_freq'
- AND eventtable = '$eventtable'
- AND ( disabled = '' OR disabled IS NULL )
- $where
- )
- ";
-
- if ( $eventtable eq 'cust_main' ) {
- $are_part_event;
- } else {
- "EXISTS ( SELECT 1 FROM $eventtable
- WHERE cust_main.custnum = $eventtable.custnum
- AND $are_part_event
- )
- ";
- }
-
- } FS::part_event->eventtables);
-
- push @search, "( $where_pkg OR $where_event )";
-
- warn "searching for customers:\n". join("\n", @search). "\n"
- if $opt{'v'} || $opt{'l'};
-
- join(' AND ', @search);
-
-}
-
-1;
diff --git a/FS/FS/Cron/breakage.pm b/FS/FS/Cron/breakage.pm
deleted file mode 100644
index 6dd904d..0000000
--- a/FS/FS/Cron/breakage.pm
+++ /dev/null
@@ -1,84 +0,0 @@
-package FS::Cron::breakage;
-
-use strict;
-use base 'Exporter';
-use vars qw( @EXPORT_OK );
-use FS::Conf;
-use FS::Record qw(qsearch);
-use FS::agent;
-use FS::cust_main;
-
-@EXPORT_OK = qw ( reconcile_breakage );
-
-#freeside-daily %opt
-# -v: enable debugging
-# -l: debugging level
-
-sub reconcile_breakage {
- my %opt = @_;
-
- my $conf = new FS::Conf;
-
- foreach my $agent (qsearch('agent', {})) {
-
- my $days = $conf->config('breakage-days', $agent->agentnum)
- or next;
-
- my $since = int( $^T - ($days * 86400) );
-
- warn 'searching '. $agent->agent. " for customers with unapplied payments more than $days days old\n"
- if $opt{'v'};
-
- #find customers w/negative balance older than $days (and no activity since)
- # and no activity (invoices/payments/credits/refunds) newer than $since
- # (XXX except antother breakage invoice???)
-
- my $extra_sql =
- ' AND 0 > '. FS::cust_main->balance_sql.
- ' AND '. join(' AND ', map {
- " NOT EXISTS (
- SELECT 1 FROM $_
- WHERE $_.custnum = cust_main.custnum
- AND _date >= $since
- ) "
- } qw( cust_bill cust_pay cust_credit cust_refund )
- );
-
- my @customers = qsearch({
- 'table' => 'cust_main',
- 'hashref' => { 'agentnum' => $agent->agentnum,
- 'payby' => { op=>'!=', value=>'COMP', },
- },
- 'extra_sql' => $extra_sql,
- });
-
- #and then create a "breakage" charge & invoice for them
-
- foreach my $cust_main ( @customers ) {
-
- warn 'reconciling breakage for customer '. $cust_main->custnum.
- ': '. $cust_main->name. "\n"
- if $opt{'v'};
-
- my $error =
- $cust_main->charge({
- 'amount' => sprintf('%.2f', 0 - $cust_main->balance ),
- 'pkg' => 'Breakage',
- 'comment' => 'breakage reconciliation',
- 'classnum' => scalar($conf->config('breakage-pkg_class')),
- 'setuptax' => 'Y',
- 'bill_now' => 1,
- })
- || $cust_main->apply_payments_and_credits;
-
- if ( $error ) {
- warn "error charging for breakage reconciliation: $error\n";
- }
-
- }
-
- }
-
-}
-
-1;
diff --git a/FS/FS/Cron/check.pm b/FS/FS/Cron/check.pm
deleted file mode 100644
index 9d3ffbd..0000000
--- a/FS/FS/Cron/check.pm
+++ /dev/null
@@ -1,200 +0,0 @@
-package FS::Cron::check;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK $DEBUG $FS_RUN $error_msg
- $SELFSERVICE_USER $SELFSERVICE_MACHINES @SELFSERVICE_MACHINES
- );
-use Exporter;
-use LWP::UserAgent;
-use HTTP::Request;
-use URI::Escape;
-use Email::Send;
-use FS::Conf;
-use FS::Record qw(qsearch);
-use FS::cust_pay_pending;
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw(
- check_queued check_selfservice check_apache check_bop_failures
- check_sg check_sg_login check_sgng
- alert error_msg
-);
-
-$DEBUG = 0;
-
-$FS_RUN = '/var/run';
-
-sub check_queued {
- _check_fsproc('queued');
-}
-
-$SELFSERVICE_USER = '%%%SELFSERVICE_USER%%%';
-
-$SELFSERVICE_MACHINES = '%%%SELFSERVICE_MACHINES%%%'; #substituted by Makefile
-$SELFSERVICE_MACHINES =~ s/^\s+//;
-$SELFSERVICE_MACHINES =~ s/\s+$//;
-@SELFSERVICE_MACHINES = split(/\s+/, $SELFSERVICE_MACHINES);
-@SELFSERVICE_MACHINES = ()
- if scalar(@SELFSERVICE_MACHINES) == 1
- && $SELFSERVICE_MACHINES[0] eq '%%%'.'SELFSERVICE_MACHINES'.'%%%';
-
-sub check_selfservice {
- foreach my $machine ( @SELFSERVICE_MACHINES ) {
- unless ( _check_fsproc("selfservice-server.$SELFSERVICE_USER.$machine") ) {
- $error_msg = "Self-service daemon not running for $machine";
- return 0;
- }
- }
- return 1;
-}
-
-sub check_sg {
- my $conf = new FS::Conf;
- #different trigger if they ever stop using multicustomer_hack ?
- return 1 unless $conf->exists('sg-multicustomer_hack');
-
- my $ua = new LWP::UserAgent;
- $ua->agent("FreesideCronCheck/0.1 " . $ua->agent);
-
- my $USER = $conf->config('sg-ping_username');
- my $PASS = $conf->config('sg-ping_password');
- my $req = new HTTP::Request GET=>"https://$USER:$PASS\@localhost/sg/ping.cgi";
- my $res = $ua->request($req);
-
- return 1 if $res->is_success
- && $res->content =~ /OK/
- && $res->content !~ /error/i; #doh, the error message includes "OK"
-
- $error_msg = $res->is_success ? $res->content : $res->status_line;
- return 0;
-}
-
-sub check_sg_login {
- my $conf = new FS::Conf;
- #different trigger if they ever stop using multicustomer_hack ?
- return 1 unless $conf->exists('sg-multicustomer_hack');
-
- my $ua = new LWP::UserAgent;
- $ua->agent("FreesideCronCheck/0.1 " . $ua->agent);
-
- my $USER = $conf->config('sg-ping_username');
- my $PASS = $conf->config('sg-ping_password');
- my $USERNAME = $conf->config('sg-login_username');
- my $req = new HTTP::Request
- GET=>"https://$USER:$PASS\@localhost/sg/start.cgi?".
- 'username='. uri_escape($USERNAME);
- my $res = $ua->request($req);
-
- return 1 if $res->is_success
- && $res->content =~ /[\da-f]{32}/i #session_id
- && $res->content !~ /error/i;
-
- $error_msg = $res->is_success ? $res->content : $res->status_line;
- return 0;
-}
-
-sub check_sgng {
- my $conf = new FS::Conf;
- #different trigger if they ever stop using multicustomer_hack ?
- return 1 unless $conf->exists('sg-multicustomer_hack');
-
- eval 'use RPC::XML; use RPC::XML::Client;';
- if ($@) { $error_msg = $@; return 0; };
-
- my $cli = RPC::XML::Client->new('https://localhost/selfservice/xmlrpc.cgi');
- my $resp = $cli->send_request('FS.SelfService.XMLRPC.ping');
-
- return 1 if ref($resp)
- && ! $resp->is_fault
- && ref($resp->value)
- && $resp->value->{'pong'} == 1;
-
- #hua
- $error_msg = ref($resp)
- ? ( $resp->is_fault
- ? $resp->string
- : ( ref($resp->value) ? $resp->value->{'error'}
- : $resp->value
- )
- )
- : $resp;
- return 0;
-}
-
-sub _check_fsproc {
- my $arg = shift;
- _check_pidfile( "freeside-$arg.pid" );
-}
-
-sub _check_pidfile {
- my $pidfile = shift;
- open(PID, "$FS_RUN/$pidfile") or return 0;
- chomp( my $pid = scalar(<PID>) );
- close PID; # or return 0;
-
- $pid && kill 0, $pid;
-}
-
-sub check_apache {
- my $ua = new LWP::UserAgent;
- $ua->agent("FreesideCronCheck/0.1 " . $ua->agent);
-
- my $req = new HTTP::Request GET => 'https://localhost/';
- my $res = $ua->request($req);
-
- return 1 if $res->is_success || $res->status_line =~ /^403/;
- $error_msg = $res->status_line;
- return 0;
-
-}
-
-#and now for something entirely different...
-my $num_consecutive_bop_failures = 60;
-sub check_bop_failures {
-
- return 1 if grep { $_->statustext eq 'captured' }
- qsearch({
- 'table' => 'cust_pay_pending',
- 'hashref' => { 'status' => 'done' },
- 'order_by' => 'ORDER BY paypendingnum DESC'.
- " LIMIT $num_consecutive_bop_failures",
- });
- $error_msg = "Last $num_consecutive_bop_failures real-time payments failed";
- return 0;
-}
-
-#
-
-sub error_msg {
- $error_msg;
-}
-
-sub alert {
- my( $alert, @emails ) = @_;
-
- my $conf = new FS::Conf;
- my $smtpmachine = $conf->config('smtpmachine');
- my $company_name = $conf->config('company_name');
-
- foreach my $email (@emails) {
- warn "warning $email about $alert\n" if $DEBUG;
-
- my $message = <<"__MESSAGE__";
-From: support\@freeside.biz
-To: $email
-Subject: FREESIDE ALERT for $company_name
-
-FREESIDE ALERT: $alert
-
-__MESSAGE__
-
- my $sender = Email::Send->new({ mailer => 'SMTP' });
- $sender->mailer_args([ Host => $smtpmachine ]);
- $sender->send($message);
-
- }
-
-}
-
-1;
-
diff --git a/FS/FS/Cron/expire_user_pref.pm b/FS/FS/Cron/expire_user_pref.pm
deleted file mode 100644
index 3226927..0000000
--- a/FS/FS/Cron/expire_user_pref.pm
+++ /dev/null
@@ -1,20 +0,0 @@
-package FS::Cron::expire_user_pref;
-
-use vars qw( @ISA @EXPORT_OK);
-use Exporter;
-use FS::UID qw(dbh);
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( expire_user_pref );
-
-sub expire_user_pref {
- my $sql = "DELETE FROM access_user_pref WHERE expiration IS NOT NULL".
- " AND expiration < ?";
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute(time) or die $sth->errstr;
-
- dbh->commit or die dbh->errstr if $FS::UID::AutoCommit
-
-}
-
-1;
diff --git a/FS/FS/Cron/notify.pm b/FS/FS/Cron/notify.pm
deleted file mode 100644
index 3d427b2..0000000
--- a/FS/FS/Cron/notify.pm
+++ /dev/null
@@ -1,159 +0,0 @@
-package FS::Cron::notify;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK $DEBUG );
-use Exporter;
-use FS::UID qw( dbh driver_name );
-use FS::Record qw(qsearch qsearchs);
-use FS::cust_main;
-use FS::cust_pkg;
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw ( notify_flat_delay );
-$DEBUG = 0;
-
-sub notify_flat_delay {
-
- my %opt = @_;
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- $DEBUG = 1 if $opt{'v'};
-
- #we're at now now (and later).
- my($time) = $^T;
- my $conf = new FS::Conf;
- my $error = '';
-
- my $integer = driver_name =~ /^mysql/ ? 'SIGNED' : 'INTEGER';
-
- # select * from cust_pkg where
- my $where_pkg = <<"END";
- where ( cancel is null or cancel = 0 )
- and ( bill > 0 )
- and
- 0 < ( select count(*) from part_pkg
- where cust_pkg.pkgpart = part_pkg.pkgpart
- and part_pkg.plan = 'flat_delayed'
- and 0 < ( select count(*) from part_pkg_option
- where part_pkg.pkgpart = part_pkg_option.pkgpart
- and part_pkg_option.optionname = 'recur_notify'
- and CAST( part_pkg_option.optionvalue AS $integer ) > 0
- and 0 <= ( $time
- + CAST( part_pkg_option.optionvalue AS $integer )
- * 86400
- - cust_pkg.bill
- )
- and ( cust_pkg.expire is null
- or cust_pkg.expire > ( $time
- + CAST( part_pkg_option.optionvalue AS $integer )
- * 86400
- )
-END
-
-#/* and ( cust_pkg.adjourn is null
-# or cust_pkg.adjourn > $time
-#-- Should notify suspended ones + cast(part_pkg_option.optionvalue as $integer)
-# * 86400
-#*/
-
- $where_pkg .= <<"END";
- )
- )
- )
- and
- 0 = ( select count(*) from cust_pkg_option
- where cust_pkg.pkgnum = cust_pkg_option.pkgnum
- and cust_pkg_option.optionname = 'impending_recur_notification_sent'
- and CAST( cust_pkg_option.optionvalue AS $integer ) = 1
- )
-END
-
- if ($opt{a}) {
- $where_pkg .= <<END;
- and 0 < ( select count(*) from cust_main
- where cust_pkg.custnum = cust_main.custnum
- and cust_main.agentnum = $opt{a}
- )
-END
- }
-
- my @cust_pkg;
- if ( @ARGV ) {
- $where_pkg .= "and ( " . join( "OR ", map { "custnum = $_" } @ARGV) . " )";
- }
-
- my $orderby = "order by custnum, bill";
-
- my $extra_sql = "$where_pkg $orderby";
-
- @cust_pkg = qsearch('cust_pkg', {}, '', $extra_sql );
-
- my @packages = ();
- my @recurdates = ();
- my @cust_pkgs = ();
- while ( scalar(@cust_pkg) ) {
- my $cust_main = $cust_pkg[0]->cust_main;
- my $custnum = $cust_pkg[0]->custnum;
- warn "working on $custnum" if $DEBUG;
- while (scalar(@cust_pkg)){
- last if ($cust_pkg[0]->custnum != $custnum);
- warn "storing information on " . $cust_pkg[0]->pkgnum if $DEBUG;
- push @packages, $cust_pkg[0]->part_pkg->pkg;
- push @recurdates, $cust_pkg[0]->bill;
- push @cust_pkgs, $cust_pkg[0];
- shift @cust_pkg;
- }
- my $msgnum = $conf->config('impending_recur_msgnum',$cust_main->agentnum);
- if ( $msgnum ) {
- my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
- $cust_main->setfield('packages', \\@packages);
- $cust_main->setfield('recurdates', \\@recurdates);
- $error = $msg_template->send('cust_main' => $cust_main);
- }
- else {
- $error = $cust_main->notify( 'impending_recur_template',
- 'extra_fields' => { 'packages' => \@packages,
- 'recurdates' => \@recurdates,
- 'package' => $packages[0],
- 'recurdate' => $recurdates[0],
- },
- );
- } #if $msgnum
- warn "Error notifying, custnum ". $cust_main->custnum. ": $error" if $error;
-
- unless ($error) {
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- for (@cust_pkgs) {
- my %options = ($_->options, 'impending_recur_notification_sent' => 1 );
- $error = $_->replace( $_, options => \%options );
- if ($error){
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die "Error updating package options for customer". $cust_main->custnum.
- ": $error" if $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- }
-
- @packages = ();
- @recurdates = ();
- @cust_pkgs = ();
-
- }
-
- dbh->commit or die dbh->errstr if $oldAutoCommit;
-
-}
-
-1;
diff --git a/FS/FS/Cron/upload.pm b/FS/FS/Cron/upload.pm
deleted file mode 100644
index fea3d2c..0000000
--- a/FS/FS/Cron/upload.pm
+++ /dev/null
@@ -1,176 +0,0 @@
-package FS::Cron::upload;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK $me $DEBUG );
-use Exporter;
-use Date::Format;
-use FS::UID qw(dbh);
-use FS::Record qw( qsearch qsearchs );
-use FS::Conf;
-use FS::queue;
-use FS::agent;
-use LWP::UserAgent;
-use HTTP::Request;
-use HTTP::Request::Common;
-use HTTP::Response;
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw ( upload );
-$DEBUG = 0;
-$me = '[FS::Cron::upload]';
-
-#freeside-daily %opt:
-# -v: enable debugging
-# -l: debugging level
-# -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing.
-# -r: Multi-process mode dry run option
-# -a: Only process customers with the specified agentnum
-
-
-sub upload {
- my %opt = @_;
-
- my $debug = 0;
- $debug = 1 if $opt{'v'};
- $debug = $opt{'l'} if $opt{'l'};
-
- local $DEBUG = $debug if $debug;
-
- warn "$me upload called\n" if $DEBUG;
-
- my $conf = new FS::Conf;
- my @agent = grep { $conf->config( 'billco-username', $_->agentnum, 1 ) }
- grep { $conf->config( 'billco-password', $_->agentnum, 1 ) }
- qsearch( 'agent', {} );
-
- my $date = time2str('%Y%m%d%H%M%S', $^T); # more?
-
- @agent = grep { $_ == $opt{'a'} } @agent if $opt{'a'};
-
- foreach my $agent ( @agent ) {
-
- my $agentnum = $agent->agentnum;
-
- if ( $opt{'m'} ) {
-
- if ( $opt{'r'} ) {
- warn "DRY RUN: would add agent $agentnum for queued upload\n";
- } else {
-
- my $queue = new FS::queue {
- 'job' => 'FS::Cron::upload::billco_upload',
- };
- my $error = $queue->insert(
- 'agentnum' => $agentnum,
- 'date' => $date,
- 'l' => $opt{'l'} || '',
- 'm' => $opt{'m'} || '',
- 'v' => $opt{'v'} || '',
- );
-
- }
-
- } else {
-
- eval "&billco_upload( 'agentnum' => $agentnum, 'date' => $date );";
- warn "billco_upload failed: $@\n"
- if ( $@ );
-
- }
-
- }
-
-}
-
-sub billco_upload {
- my %opt = @_;
-
- warn "$me billco_upload called\n" if $DEBUG;
- my $conf = new FS::Conf;
- my $dir = '%%%FREESIDE_EXPORT%%%/export.'. $FS::UID::datasrc. '/cust_bill';
-
- my $agentnum = $opt{agentnum} or die "no agentnum provided\n";
- my $url = $conf->config( 'billco-url', $agentnum )
- or die "no url for agent $agentnum\n";
- my $username = $conf->config( 'billco-username', $agentnum, 1 )
- or die "no username for agent $agentnum\n";
- my $password = $conf->config( 'billco-password', $agentnum, 1 )
- or die "no password for agent $agentnum\n";
- my $clicode = $conf->config( 'billco-clicode', $agentnum )
- or die "no clicode for agent $agentnum\n";
-
- die "no date provided\n" unless $opt{date};
- my $zipfile = "$dir/agentnum$agentnum-$opt{date}.zip";
-
- 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 $agent = qsearchs( 'agent', { agentnum => $agentnum } )
- or die "no such agent: $agentnum";
- $agent->select_for_update; #mutex
-
- unless ( -f "$dir/agentnum$agentnum-header.csv" ||
- -f "$dir/agentnum$agentnum-detail.csv" )
- {
- warn "$me neither $dir/agentnum$agentnum-header.csv nor ".
- "$dir/agentnum$agentnum-detail.csv found\n" if $DEBUG;
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return;
- }
-
- # a better way?
- if ($opt{m}) {
- my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ".
- "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?";
- my $sth = $dbh->prepare($sql) or die $dbh->errstr;
- while (1) {
- $sth->execute( $agentnum )
- or die "Unexpected error executing statement $sql: ". $sth->errstr;
- last if $sth->fetchow_arrayref->[0];
- sleep 300;
- }
- }
-
- foreach ( qw ( header detail ) ) {
- rename "$dir/agentnum$agentnum-$_.csv",
- "$dir/agentnum$agentnum-$opt{date}-$_.csv";
- }
-
- my $command = "cd $dir; zip $zipfile ".
- "agentnum$agentnum-$opt{date}-header.csv ".
- "agentnum$agentnum-$opt{date}-detail.csv";
-
- system($command) and die "$command failed\n";
-
- unlink "agentnum$agentnum-$opt{date}-header.csv",
- "agentnum$agentnum-$opt{date}-detail.csv";
-
- my $ua = new LWP::UserAgent;
- my $res = $ua->request( POST( $url,
- 'Content_Type' => 'form-data',
- 'Content' => [ 'username' => $username,
- 'pass' => $password,
- 'custid' => $username,
- 'clicode' => $clicode,
- 'file1' => [ $zipfile ],
- ],
- )
- );
-
- die "upload failed: ". $res->status_line. "\n"
- unless $res->is_success;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-1;
diff --git a/FS/FS/Cron/vacuum.pm b/FS/FS/Cron/vacuum.pm
deleted file mode 100644
index 075572d..0000000
--- a/FS/FS/Cron/vacuum.pm
+++ /dev/null
@@ -1,23 +0,0 @@
-package FS::Cron::vacuum;
-
-use vars qw( @ISA @EXPORT_OK);
-use Exporter;
-use FS::UID qw(driver_name dbh);
-use FS::Schema qw(dbdef);
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( vacuum );
-
-sub vacuum {
-
- if ( driver_name eq 'Pg' ) {
- dbh->{AutoCommit} = 1; #so we can vacuum
- foreach my $table ( dbdef->tables ) {
- my $sth = dbh->prepare("VACUUM ANALYZE $table") or die dbh->errstr;
- $sth->execute or die $sth->errstr;
- }
- }
-
-}
-
-1;
diff --git a/FS/FS/CurrentUser.pm b/FS/FS/CurrentUser.pm
deleted file mode 100644
index bcd337d..0000000
--- a/FS/FS/CurrentUser.pm
+++ /dev/null
@@ -1,67 +0,0 @@
-package FS::CurrentUser;
-
-use vars qw($CurrentUser $upgrade_hack);
-
-#not at compile-time, circular dependancey causes trouble
-#use FS::Record qw(qsearchs);
-#use FS::access_user;
-
-$upgrade_hack = 0;
-
-=head1 NAME
-
-FS::CurrentUser - Package representing the current user
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-=cut
-
-sub load_user {
- my( $class, $user ) = @_; #, $pass
-
- if ( $upgrade_hack ) {
- return $CurrentUser = new FS::CurrentUser::BootstrapUser;
- }
-
- #return "" if $user =~ /^fs_(queue|selfservice)$/;
-
- #not the best thing in the world...
- eval "use FS::Record qw(qsearchs);";
- die $@ if $@;
- eval "use FS::access_user;";
- die $@ if $@;
-
- $CurrentUser = qsearchs('access_user', {
- 'username' => $user,
- #'_password' =>
- 'disabled' => '',
- } );
-
- die "unknown user: $user" unless $CurrentUser; # or bad password
-
- $CurrentUser;
-}
-
-=head1 BUGS
-
-Creepy crawlies
-
-=head1 SEE ALSO
-
-=cut
-
-package FS::CurrentUser::BootstrapUser;
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self, $class);
-}
-
-sub AUTOLOAD { 1 };
-
-1;
-
diff --git a/FS/FS/Daemon.pm b/FS/FS/Daemon.pm
deleted file mode 100644
index b58cde4..0000000
--- a/FS/FS/Daemon.pm
+++ /dev/null
@@ -1,120 +0,0 @@
-package FS::Daemon;
-
-use vars qw( @ISA @EXPORT_OK );
-use vars qw( $pid_dir $me $pid_file $sigint $sigterm $NOSIG $logfile );
-use Exporter;
-use Fcntl qw(:flock);
-use POSIX qw(setsid);
-use IO::File;
-use File::Basename;
-use File::Slurp qw(slurp);
-use Date::Format;
-
-#this is a simple refactoring of the stuff from freeside-queued, just to
-#avoid duplicate code. eventually this should use something from CPAN.
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(
- daemonize1 drop_root daemonize2 myexit logfile sigint sigterm
-);
-%EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
-
-$pid_dir = '/var/run';
-
-$NOSIG = 0;
-$PID_NEWSTYLE = 0;
-
-sub daemonize1 {
- $me = shift;
-
- $pid_file = $pid_dir;
- if ( $PID_NEWSTYLE ) {
- $pid_file .= '/freeside';
- mkdir $pid_file unless -d $pid_file;
- chown $FS::UID::freeside_uid, -1, $pid_file;
- }
- $pid_file .= "/$me";
- $pid_file .= '.'.shift if scalar(@_);
- $pid_file .= '.pid';
-
- chdir "/" or die "Can't chdir to /: $!";
- open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
- defined(my $pid = fork) or die "Can't fork: $!";
- if ( $pid ) {
- print "$me started with pid $pid\n"; #logging to $log_file\n";
- exit unless $pid_file;
- my $pidfh = new IO::File ">$pid_file" or exit;
- chown $FS::UID::freeside_uid, -1, $pid_file;
- print $pidfh "$pid\n";
- exit;
- }
-
- #sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; }
- #$SIG{CHLD} = \&REAPER;
- $sigterm = 0;
- $sigint = 0;
- unless ( $NOSIG ) {
- $SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; };
- $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; };
- }
-}
-
-sub drop_root {
- my $freeside_gid = scalar(getgrnam('freeside'))
- or die "can't find freeside group\n";
- $) = $freeside_gid;
- $( = $freeside_gid;
- #if freebsd can't setuid(), presumably it can't setgid() either. grr fleabsd
- ($(,$)) = ($),$();
- $) = $freeside_gid;
-
- $> = $FS::UID::freeside_uid;
- $< = $FS::UID::freeside_uid;
- #freebsd is sofa king broken, won't setuid()
- ($<,$>) = ($>,$<);
- $> = $FS::UID::freeside_uid;
-}
-
-sub daemonize2 {
- open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
- setsid or die "Can't start a new session: $!";
- open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
-
- $SIG{__DIE__} = \&_die;
- $SIG{__WARN__} = \&_logmsg;
-
- warn "$me starting\n";
-}
-
-sub sigint { $sigint; }
-sub sigterm { $sigterm; }
-
-sub logfile { $logfile = shift; } #_logmsg('test'); }
-
-sub myexit {
- chomp( my $pid = slurp($pid_file) );
- unlink $pid_file if -e $pid_file && $$ == $pid;
- exit;
-}
-
-sub _die {
- die @_ if $^S; # $^S = 1 during an eval(), don't break exception handling
- my $msg = shift;
-
- chomp( my $pid = slurp($pid_file) );
- unlink $pid_file if -e $pid_file && $$ == $pid;
-
- _logmsg($msg);
-}
-
-sub _logmsg {
- chomp( my $msg = shift );
- my $log = new IO::File ">>$logfile";
- flock($log, LOCK_EX);
- seek($log, 0, 2);
- print $log "[". time2str("%a %b %e %T %Y",time). "] [$$] $msg\n";
- flock($log, LOCK_UN);
- close $log;
-}
-
-1;
diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm
deleted file mode 100644
index 5038cf3..0000000
--- a/FS/FS/InitHandler.pm
+++ /dev/null
@@ -1,91 +0,0 @@
-package FS::InitHandler;
-
-# this leaks memory under graceful restarts and i wouldn't use it on any
-# modern server. useful for very slow machines with memory to spare, just
-# always do a full restart
-
-use strict;
-use vars qw($DEBUG);
-use FS::UID qw(adminsuidsetup);
-use FS::Record;
-
-$DEBUG = 1;
-
-sub handler {
-
- use Date::Format;
- use Date::Parse;
- use Tie::IxHash;
- use HTML::Entities;
- use IO::Handle;
- use IO::File;
- use String::Approx;
- use HTML::Widgets::SelectLayers 0.02;
- #use FS::UID;
- #use FS::Record;
- use FS::Conf;
- use FS::CGI;
- use FS::Msgcat;
-
- use FS::agent;
- use FS::agent_type;
- use FS::domain_record;
- use FS::cust_bill;
- use FS::cust_bill_pay;
- use FS::cust_credit;
- use FS::cust_credit_bill;
- use FS::cust_main;
- use FS::cust_main_county;
- use FS::cust_pay;
- use FS::cust_pkg;
- use FS::cust_refund;
- use FS::cust_svc;
- use FS::nas;
- use FS::part_bill_event;
- use FS::part_pkg;
- use FS::part_referral;
- use FS::part_svc;
- use FS::pkg_svc;
- use FS::port;
- use FS::queue;
- use FS::raddb;
- use FS::session;
- use FS::svc_acct;
- use FS::svc_acct_pop;
- use FS::svc_domain;
- use FS::svc_forward;
- use FS::svc_www;
- use FS::type_pkgs;
- use FS::part_export;
- use FS::part_export_option;
- use FS::export_svc;
- use FS::msgcat;
-
- warn "[FS::InitHandler] handler called\n" if $DEBUG;
-
- #this is sure to be broken on freebsd
- $> = $FS::UID::freeside_uid;
-
- open(MAPSECRETS,"<$FS::UID::conf_dir/mapsecrets")
- or die "can't read $FS::UID::conf_dir/mapsecrets: $!";
-
- my %seen;
- while (<MAPSECRETS>) {
- next if /^\s*(#|$)/;
- /^([\w\-\.]+)\s(.*)$/
- or do { warn "strange line in mapsecrets: $_"; next; };
- my($user, $datasrc) = ($1, $2);
- next if $seen{$datasrc}++;
- warn "[FS::InitHandler] preloading $datasrc for $user\n" if $DEBUG;
- adminsuidsetup($user);
- }
-
- close MAPSECRETS;
-
- #lalala probably broken on freebsd
- ($<, $>) = ($>, $<);
- $< = 0;
-
-}
-
-1;
diff --git a/FS/FS/Maestro.pm b/FS/FS/Maestro.pm
deleted file mode 100644
index 84f278c..0000000
--- a/FS/FS/Maestro.pm
+++ /dev/null
@@ -1,248 +0,0 @@
-package FS::Maestro;
-
-use strict;
-use Date::Format;
-use FS::Conf;
-use FS::Record qw( qsearchs );
-use FS::cust_main;
-use FS::cust_pkg;
-use FS::part_svc;
-
-#i guess this is kind of deprecated in favor of service_status, but keeping it
-#around until they say they don't need it.
-sub customer_status {
- my( $custnum ) = shift; #@_;
- my $svcnum = @_ ? shift : '';
-
- my $curuser = $FS::CurrentUser::CurrentUser;
-
- my $cust_main = qsearchs({
- 'table' => 'cust_main',
- 'hashref' => { 'custnum' => $custnum },
- 'extra_sql' => ' AND '. $curuser->agentnums_sql,
- })
- or return { 'status' => 'E',
- 'error' => "custnum $custnum not found" };
-
- return service_status($svcnum) if $svcnum;
-
- ###
- # regular customer to maestro (single package)
- ###
-
- my %result = ();
-
- my @cust_pkg = $cust_main->cust_pkg;
-
- #things specific to the non-reseller scenario
-
- $result{'status'} = substr($cust_main->ucfirst_status,0,1);
-
- $result{'products'} =
- [ map $_->pkgpart, grep !$_->get('cancel'), @cust_pkg ];
-
- #find svc_pbx
-
- my @cust_svc = map $_->cust_svc, @cust_pkg;
-
- my @cust_svc_pbx =
- grep { my($n,$l,$t) = $_->label; $t eq 'svc_pbx' }
- @cust_svc;
-
- if ( ! @cust_svc_pbx ) {
- return { 'status' => 'E',
- 'error' => "customer $custnum has no conference service" };
- } elsif ( scalar(@cust_svc_pbx) > 1 ) {
- return { 'status' => 'E',
- 'error' =>
- "customer $custnum has more than one conference".
- " service (reseller?); specify a svcnum as a second argument",
- };
- }
-
- my $cust_svc_pbx = $cust_svc_pbx[0];
-
- my $svc_pbx = $cust_svc_pbx->svc_x;
-
- # find "outbound service" y/n
-
- my $conf = new FS::Conf;
- my %outbound_pkgs = map { $_=>1 } $conf->config('mc-outbound_packages');
- $result{'outbound_service'} =
- scalar( grep { $outbound_pkgs{ $_->pkgpart }
- && !$_->get('cancel')
- }
- @cust_pkg
- )
- ? 1 : 0;
-
- # find "good till" date/time stamp
-
- my @active_cust_pkg =
- sort { $a->bill <=> $b->bill }
- grep { !$_->get('cancel') && $_->part_pkg->freq ne '0' }
- @cust_pkg;
- $result{'good_till'} = time2str('%c', $active_cust_pkg[0]->bill || time );
-
- return {
- 'name' => $cust_main->name,
- 'email' => $cust_main->invoicing_list_emailonly_scalar,
- #'agentnum' => $cust_main->agentnum,
- #'agent' => $cust_main->agent->agent,
- 'max_lines' => $svc_pbx ? $svc_pbx->max_extensions : '',
- 'max_simultaneous' => $svc_pbx ? $svc_pbx->max_simultaneous : '',
- %result,
- };
-
-}
-
-sub service_status {
- my $svcnum = shift;
-
- my $svc_pbx = qsearchs({
- 'table' => 'svc_pbx',
- 'addl_from' => ' LEFT JOIN cust_svc USING ( svcnum ) '.
- ' LEFT JOIN cust_pkg USING ( pkgnum ) ',
- 'hashref' => { 'svcnum' => $svcnum },
- #'extra_sql' => " AND custnum = $custnum",
- })
- or return { 'status' => 'E',
- 'error' => "svcnum $svcnum not found" };
-
- my $cust_pkg = $svc_pbx->cust_svc->cust_pkg;
- my $cust_main = $cust_pkg->cust_main;
-
- my %result = ();
-
- #status in the reseller scenario
- $result{'status'} = substr($cust_pkg->ucfirst_status,0,1);
-
- # find "outbound service" y/n
- my @cust_pkg = $cust_main->cust_pkg;
- #XXX what about outbound service per-reseller ?
- my $conf = new FS::Conf;
- my %outbound_pkgs = map { $_=>1 } $conf->config('mc-outbound_packages');
- $result{'outbound_service'} =
- scalar( grep { $outbound_pkgs{ $_->pkgpart }
- && !$_->get('cancel')
- }
- @cust_pkg
- )
- ? 1 : 0;
-
- # find "good till" date/time stamp (this package)
- $result{'good_till'} = time2str('%c', $cust_pkg->bill || time );
-
- return {
- 'custnum' => $cust_main->custnum,
- 'name' => $cust_main->name,
- 'email' => $cust_main->invoicing_list_emailonly_scalar,
- #'agentnum' => $cust_main->agentnum,
- #'agent' => $cust_main->agent->agent,
- 'max_lines' => $svc_pbx->max_extensions,
- 'max_simultaneous' => $svc_pbx->max_simultaneous,
- %result,
- };
-
-}
-
-#some false laziness w/ MyAccount order_pkg
-sub order_pkg {
- my $opt = ref($_[0]) ? shift : { @_ };
-
- $opt->{'title'} = delete $opt->{'name'}
- if !exists($opt->{'title'}) && exists($opt->{'name'});
-
- my $custnum = $opt->{'custnum'};
-
- my $curuser = $FS::CurrentUser::CurrentUser;
-
- my $cust_main = qsearchs({
- 'table' => 'cust_main',
- 'hashref' => { 'custnum' => $custnum },
- 'extra_sql' => ' AND '. $curuser->agentnums_sql,
- })
- or return { 'error' => "custnum $custnum not found" };
-
- my $status = $cust_main->status;
- #false laziness w/ClientAPI/Signup.pm
-
- my $cust_pkg = new FS::cust_pkg ( {
- 'custnum' => $custnum,
- 'pkgpart' => $opt->{'pkgpart'},
- } );
- my $error = $cust_pkg->check;
- return { 'error' => $error } if $error;
-
- my @svc = ();
- unless ( $opt->{'svcpart'} eq 'none' ) {
-
- my $svcpart = '';
- if ( $opt->{'svcpart'} =~ /^(\d+)$/ ) {
- $svcpart = $1;
- } else {
- $svcpart = $cust_pkg->part_pkg->svcpart; #($svcdb);
- }
-
- my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
- return { 'error' => "Unknown svcpart $svcpart" } unless $part_svc;
-
- my $svcdb = $part_svc->svcdb;
-
- my %fields = (
- 'svc_acct' => [ qw( username domsvc _password sec_phrase popnum ) ],
- 'svc_domain' => [ qw( domain ) ],
- 'svc_phone' => [ qw( phonenum pin sip_password phone_name ) ],
- 'svc_external' => [ qw( id title ) ],
- 'svc_pbx' => [ qw( id title ) ],
- );
-
- my $svc_x = "FS::$svcdb"->new( {
- 'svcpart' => $svcpart,
- map { $_ => $opt->{$_} } @{$fields{$svcdb}}
- } );
-
- #snarf processing not necessary here (or probably at all, anymore)
-
- my $y = $svc_x->setdefault; # arguably should be in new method
- return { 'error' => $y } if $y && !ref($y);
-
- $error = $svc_x->check;
- return { 'error' => $error } if $error;
-
- push @svc, $svc_x;
-
- }
-
- use Tie::RefHash;
- tie my %hash, 'Tie::RefHash';
- %hash = ( $cust_pkg => \@svc );
- #msgcat
- $error = $cust_main->order_pkgs( \%hash, '', 'noexport' => 1 );
- return { 'error' => $error } if $error;
-
-# currently they're using this in the reseller scenario, so don't
-# bill the package immediately
-# my $conf = new FS::Conf;
-# if ( $conf->exists('signup_server-realtime') ) {
-#
-# my $bill_error = _do_bop_realtime( $cust_main, $status );
-#
-# if ($bill_error) {
-# $cust_pkg->cancel('quiet'=>1);
-# return $bill_error;
-# } else {
-# $cust_pkg->reexport;
-# }
-#
-# } else {
- $cust_pkg->reexport;
-# }
-
- my $svcnum = $svc[0] ? $svc[0]->svcnum : '';
-
- return { error=>'', pkgnum=>$cust_pkg->pkgnum, svcnum=>$svcnum };
-
-}
-
-1;
diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
deleted file mode 100644
index 9b010e8..0000000
--- a/FS/FS/Mason.pm
+++ /dev/null
@@ -1,555 +0,0 @@
-package FS::Mason;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK $addl_handler_use );
-use Exporter;
-use Carp;
-use File::Slurp qw( slurp );
-use HTML::Mason 1.27; #http://www.masonhq.com/?ApacheModPerl2Redirect
-use HTML::Mason::Interp;
-use HTML::Mason::Compiler::ToObject;
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( mason_interps );
-
-=head1 NAME
-
-FS::Mason - Initialize the Mason environment
-
-=head1 SYNOPSIS
-
- use FS::Mason qw( mason_interps );
-
- my( $fs_interp, $rt_interp ) = mason_interps('apache');
-
- #OR
-
- my( $fs_interp, $rt_interp ) = mason_interps('standalone'); #XXX name?
-
-=head1 DESCRIPTION
-
-Initializes the Mason environment, loads all Freeside and RT libraries, etc.
-
-=cut
-
-$addl_handler_use = '';
-my $addl_handler_use_file = '%%%FREESIDE_CONF%%%/addl_handler_use.pl';
-if ( -e $addl_handler_use_file ) {
- $addl_handler_use = slurp( $addl_handler_use_file );
-}
-
-# List of modules that you want to use from components (see Admin
-# manual for details)
-{
- package HTML::Mason::Commands;
-
- use strict;
- use vars qw( %session );
- use CGI 3.29 qw(-private_tempfiles); #3.29 to fix RT attachment problems
-
- #breaks quick payment entry
- #http://rt.cpan.org/Public/Bug/Display.html?id=37365
- die "CGI.pm v3.38 is broken, use any other version >= 3.29".
- " (Debian 5.0? aptitude remove libcgi-pm-perl)"
- if $CGI::VERSION == 3.38;
-
- #use CGI::Carp qw(fatalsToBrowser);
- use CGI::Cookie;
- use List::Util qw( max min );
- use Data::Dumper;
- use Date::Format;
- use Time::Local;
- use Time::HiRes;
- use Time::Duration;
- use DateTime;
- use DateTime::Format::Strptime;
- use FS::Misc::DateTime qw( parse_datetime );
- use Lingua::EN::Inflect qw(PL);
- Lingua::EN::Inflect::classical names=>0; #Categorys
- use Tie::IxHash;
- use URI;
- use URI::Escape;
- use HTML::Entities;
- use HTML::TreeBuilder;
- use HTML::TableExtract qw(tree);
- use HTML::FormatText;
- use HTML::Defang;
- use JSON;
-# use XMLRPC::Transport::HTTP;
-# use XMLRPC::Lite; # for XMLRPC::Serializer
- use MIME::Base64;
- use IO::Handle;
- use IO::File;
- use IO::Scalar;
- #not actually using this yet anyway...# use IPC::Run3 0.036;
- use Net::Whois::Raw qw(whois);
- if ( $] < 5.006 ) {
- eval "use Net::Whois::Raw 0.32 qw(whois)";
- die $@ if $@;
- }
- use Text::CSV_XS;
- use Spreadsheet::WriteExcel;
- use Spreadsheet::WriteExcel::Utility;
- use Business::CreditCard 0.30; #for mask-aware cardtype()
- use NetAddr::IP;
- use Net::Ping;
- use Net::Ping::External;
- #if CPAN #7815 ever gets fixed# if ( $Net::Ping::External::VERSION <= 0.12 )
- {
- no warnings 'redefine';
- eval 'sub Net::Ping::External::_ping_linux {
- my %args = @_;
- my $command = "ping -s $args{size} -c $args{count} -w $args{timeout} $args{host}";
- return Net::Ping::External::_ping_system($command, 0);
- }
- ';
- die $@ if $@;
- }
- use String::Approx qw(amatch);
- use Chart::LinesPoints;
- use Chart::Mountain;
- use Chart::Bars;
- use Color::Scheme;
- use HTML::Widgets::SelectLayers 0.07; #should go away in favor of
- #selectlayers.html
- use Locale::Country;
- use Business::US::USPS::WebTools::AddressStandardization;
- use LWP::UserAgent;
- use Storable qw( nfreeze thaw );
- use FS;
- use FS::UID qw( getotaker dbh datasrc driver_name );
- use FS::Record qw( qsearch qsearchs fields dbdef
- str2time_sql str2time_sql_closing
- );
- use FS::Conf;
- use FS::CGI qw(header menubar table itable ntable idiot
- eidiot myexit http_header);
- use FS::UI::Web qw(svc_url);
- use FS::UI::Web::small_custview qw(small_custview);
- use FS::UI::bytecount;
- use FS::Msgcat qw(gettext geterror);
- use FS::Misc qw( send_email send_fax ocr_image
- states_hash counties cities state_label
- );
- use FS::Misc::eps2png qw( eps2png );
- use FS::Report::FCC_477;
- use FS::Report::Table::Monthly;
- use FS::TicketSystem;
- use FS::Tron qw( tron_lint );
-
- use FS::agent;
- use FS::agent_type;
- use FS::domain_record;
- use FS::cust_bill;
- use FS::cust_bill_pay;
- use FS::cust_credit;
- use FS::cust_credit_bill;
- use FS::cust_main;
- use FS::cust_main::Search qw(smart_search);
- use FS::cust_main::Import;
- use FS::cust_main_county;
- use FS::cust_location;
- use FS::cust_pay;
- use FS::cust_pkg;
- use FS::cust_pkg::Import;
- use FS::part_pkg_taxclass;
- use FS::cust_pkg_reason;
- use FS::cust_refund;
- use FS::cust_credit_refund;
- use FS::cust_pay_refund;
- use FS::cust_svc;
- use FS::nas;
- use FS::part_bill_event;
- use FS::part_event;
- use FS::part_event_condition;
- use FS::part_pkg;
- use FS::part_referral;
- use FS::part_svc;
- use FS::part_svc_router;
- use FS::part_virtual_field;
- use FS::pay_batch;
- use FS::pkg_svc;
- use FS::port;
- use FS::queue qw(joblisting);
- use FS::raddb;
- use FS::session;
- use FS::svc_acct;
- use FS::svc_acct_pop qw(popselector);
- use FS::acct_rt_transaction;
- use FS::svc_domain;
- use FS::svc_forward;
- use FS::svc_www;
- use FS::router;
- use FS::addr_block;
- use FS::svc_broadband;
- use FS::svc_external;
- use FS::type_pkgs;
- 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;
- use FS::rate_prefix;
- use FS::rate_detail;
- use FS::usage_class;
- use FS::payment_gateway;
- use FS::agent_payment_gateway;
- use FS::XMLRPC;
- use FS::payby;
- use FS::cdr;
- use FS::cdr_batch;
- use FS::inventory_class;
- use FS::inventory_item;
- use FS::pkg_category;
- use FS::pkg_class;
- use FS::access_user;
- use FS::access_user_pref;
- use FS::access_group;
- use FS::access_usergroup;
- use FS::access_groupagent;
- use FS::access_right;
- use FS::AccessRight;
- use FS::svc_phone;
- use FS::phone_device;
- use FS::part_device;
- use FS::reason_type;
- use FS::reason;
- use FS::cust_main_note;
- use FS::tax_class;
- use FS::cust_tax_location;
- use FS::part_pkg_taxproduct;
- use FS::part_pkg_taxoverride;
- use FS::part_pkg_taxrate;
- use FS::tax_rate;
- use FS::part_pkg_report_option;
- use FS::cust_attachment;
- use FS::h_cust_pkg;
- use FS::h_inventory_item;
- use FS::h_svc_acct;
- use FS::h_svc_broadband;
- use FS::h_svc_domain;
- #use FS::h_domain_record;
- use FS::h_svc_external;
- use FS::h_svc_forward;
- use FS::h_svc_phone;
- #use FS::h_phone_device;
- use FS::h_svc_www;
- use FS::cust_statement;
- use FS::cust_class;
- use FS::cust_category;
- use FS::prospect_main;
- use FS::contact;
- use FS::svc_pbx;
- use FS::discount;
- use FS::cust_pkg_discount;
- use FS::cust_bill_pkg_discount;
- use FS::svc_mailinglist;
- use FS::cgp_rule;
- use FS::cgp_rule_condition;
- use FS::cgp_rule_action;
- use FS::bill_batch;
- use FS::cust_bill_batch;
- use FS::rate_time;
- use FS::rate_time_interval;
- use FS::msg_template;
- use FS::part_tag;
- use FS::acct_snarf;
- use FS::part_pkg_discount;
- use FS::svc_cert;
- use FS::svc_dsl;
- use FS::qual;
- use FS::qual_option;
- use FS::dsl_note;
- use FS::part_pkg_vendor;
- use FS::cust_note_class;
- # Sammath Naur
-
- if ( $FS::Mason::addl_handler_use ) {
- eval $FS::Mason::addl_handler_use;
- die $@ if $@;
- }
-
- if ( %%%RT_ENABLED%%% ) {
- eval '
- use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
- use vars qw($Nobody $SystemUser);
- use RT;
- use RT::Util;
- use RT::Tickets;
- 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;
-
- #blah. manually updated from RT::Interface::Web::Handler
- use RT::Interface::Web;
- use MIME::Entity;
- use Text::Wrapper;
- use Time::ParseDate;
- use Time::HiRes;
- use HTML::Scrubber;
-
- #blah. not even in RT::Interface::Web::Handler, just in
- #html/NoAuth/css/dhandler and rt-test-dependencies. ask for it here
- #to throw a real error instead of just a mysterious unstyled RT
- use CSS::Squish 0.06;
-
- use RT::Interface::Web::Request;
-
- #nother undeclared web UI dep (for ticket links graph)
- use IPC::Run::SafeHandles;
-
- #slow, unreliable, segfaults and is optional
- #see rt/html/Ticket/Elements/ShowTransactionAttachments
- #use Text::Quoted;
-
- #?#use File::Path qw( rmtree );
- #?#use File::Glob qw( bsd_glob );
- #?#use File::Spec::Unix;
-
- ';
- die $@ if $@;
- }
-
- *CGI::redirect = sub {
- my $self = shift;
- my $cookie = '';
- if ( $_[0] eq '-cookie' ) { #this isn't actually used at the moment
- (my $x, $cookie) = (shift, shift);
- $HTML::Mason::r->err_headers_out->add( 'Set-cookie' => $cookie );
- }
- my $location = shift;
-
- use vars qw($m);
-
- # false laziness w/below
- if ( defined(@DBIx::Profile::ISA) ) {
-
- if ( $FS::CurrentUser::CurrentUser->option('show_db_profile') ) {
-
- #profiling redirect
-
- my $page =
- qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
- '<BR><BR><PRE>'.
- ( UNIVERSAL::can(dbh, 'sprintProfile')
- ? encode_entities(dbh->sprintProfile())
- : 'DBIx::Profile missing sprintProfile method;'.
- 'unpatched or too old?' ).
- #"\n\n". &sprintAutoProfile(). '</PRE>'.
- "\n\n". '</PRE>'.
- '</BODY></HTML>';
-
-
- dbh->{'private_profile'} = {};
- return $page;
-
- } else {
-
- #clear db profile, but normal redirect
- dbh->{'private_profile'} = {};
- $m->redirect($location);
- '';
-
- }
-
- } else { #normal redirect
-
- $m->redirect($location);
- '';
-
- }
-
- };
-
- sub include {
- use vars qw($m);
- #carp #should just switch to <& &> syntax
- $m->scomp(@_);
- }
-
- sub errorpage {
- use vars qw($m);
- $m->comp('/elements/errorpage.html', @_);
- }
-
- sub errorpage_popup {
- use vars qw($m);
- $m->comp('/elements/errorpage-popup.html', @_);
- }
-
- sub redirect {
- my( $location ) = @_;
- use vars qw($m);
- $m->clear_buffer;
- #false laziness w/above
- if ( defined(@DBIx::Profile::ISA) ) {
-
- if ( $FS::CurrentUser::CurrentUser->option('show_db_profile') ) {
-
- #profiling redirect
-
- $m->print(
- qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
- '<BR><BR><PRE>'.
- ( UNIVERSAL::can(dbh, 'sprintProfile')
- ? encode_entities(dbh->sprintProfile())
- : 'DBIx::Profile missing sprintProfile method;'.
- 'unpatched or too old?' ).
- #"\n\n". &sprintAutoProfile(). '</PRE>'.
- "\n\n". '</PRE>'.
- '</BODY></HTML>'
- );
-
- dbh->{'private_profile'} = {};
-
- } else {
-
- #clear db profile, but normal redirect
- dbh->{'private_profile'} = {};
- $m->redirect($location);
-
- }
-
- } else { #normal redirect
-
- $m->redirect($location);
-
- }
-
- }
-
-} # end package HTML::Mason::Commands;
-
-=head1 SUBROUTINE
-
-=over 4
-
-=item mason_interps [ MODE [ OPTION => VALUE ... ] ]
-
-Returns a list consisting of two HTML::Mason::Interp objects, the first for
-Freeside pages, and the second for RT pages.
-
-MODE can be 'apache' or 'standalone'. If not specified, defaults to 'apache'.
-
-Options and values can be passed following mode. Currently available options
-are:
-
-I<outbuf> should be set to a scalar reference in standalone mode.
-
-=cut
-
-my %defang_opts = ( attribs_to_callback => ['src'], attribs_callback => sub { 1 });
-
-sub mason_interps {
- my $mode = shift || 'apache';
- my %opt = @_;
-
- #my $request_class = 'HTML::Mason::Request'.
- #( $mode eq 'apache' ? '::ApacheHandler' : '' );
- my $request_class = 'FS::Mason::Request';
-
- #not entirely sure it belongs here, but what the hey
- if ( %%%RT_ENABLED%%% && $mode ne 'standalone' ) {
- RT::LoadConfig();
- }
-
- # A hook supporting strange legacy ways people (well, SG) have added stuff on
-
- my @addl_comp_root = ();
- my $addl_comp_root_file = '%%%FREESIDE_CONF%%%/addl_comp_root.pl';
- if ( -e $addl_comp_root_file ) {
- warn "reading $addl_comp_root_file\n";
- my $text = slurp( $addl_comp_root_file );
- my @addl = eval $text;
- if ( @addl && ! $@ ) {
- @addl_comp_root = @addl;
- } elsif ($@) {
- warn "error parsing $addl_comp_root_file: $@\n";
- }
- }
-
- my $fs_comp_root =
- scalar(@addl_comp_root)
- ? [
- [ 'freeside'=>'%%%FREESIDE_DOCUMENT_ROOT%%%' ],
- @addl_comp_root,
- ]
- : '%%%FREESIDE_DOCUMENT_ROOT%%%';
-
- my %interp = (
- request_class => $request_class,
- data_dir => '%%%MASONDATA%%%',
- error_mode => 'output',
- error_format => 'html',
- ignore_warnings_expr => '.',
- );
-
- $interp{out_method} = $opt{outbuf} if $mode eq 'standalone' && $opt{outbuf};
-
- my $html_defang = new HTML::Defang (%defang_opts);
-
- my $js_string_sub = sub {
- #${$_[0]} =~ s/(['\\\n])/'\\'.($1 eq "\n" ? 'n' : $1)/ge;
- ${$_[0]} =~ s/(['\\])/\\$1/g;
- ${$_[0]} =~ s/\r/\\r/g;
- ${$_[0]} =~ s/\n/\\n/g;
- ${$_[0]} = "'". ${$_[0]}. "'";
- };
-
- my $fs_interp = new HTML::Mason::Interp (
- %interp,
- comp_root => $fs_comp_root,
- escape_flags => { 'js_string' => $js_string_sub,
- 'defang' => sub {
- ${$_[0]} = $html_defang->defang(${$_[0]});
- },
- },
- compiler => HTML::Mason::Compiler::ToObject->new(
- allow_globals => [qw(%session)],
- ),
- );
-
- my $rt_interp = new HTML::Mason::Interp (
- %interp,
- comp_root => [
- [ 'rt' => '%%%FREESIDE_DOCUMENT_ROOT%%%/rt' ],
- [ 'freeside' => '%%%FREESIDE_DOCUMENT_ROOT%%%' ],
- ],
- escape_flags => { 'h' => \&RT::Interface::Web::EscapeUTF8,
- 'js_string' => $js_string_sub,
- },
- compiler => HTML::Mason::Compiler::ToObject->new(
- default_escape_flags => 'h',
- allow_globals => [qw(%session)],
- ),
- );
-
- ( $fs_interp, $rt_interp );
-
-}
-
-=back
-
-=head1 BUGS
-
-Lurking in the darkness...
-
-=head1 SEE ALSO
-
-L<HTML::Mason>, L<FS>, L<RT>
-
-=cut
-
-1;
diff --git a/FS/FS/Mason/Request.pm b/FS/FS/Mason/Request.pm
deleted file mode 100644
index 95c8027..0000000
--- a/FS/FS/Mason/Request.pm
+++ /dev/null
@@ -1,87 +0,0 @@
-package FS::Mason::Request;
-
-use strict;
-use warnings;
-use vars qw( $FSURL $QUERY_STRING );
-use base 'HTML::Mason::Request';
-
-$FSURL = 'http://Set/FS_Mason_Request_FSURL/in_standalone_mode/';
-$QUERY_STRING = '';
-
-sub new {
- my $class = shift;
-
- my $superclass = $HTML::Mason::ApacheHandler::VERSION ?
- 'HTML::Mason::Request::ApacheHandler' :
- $HTML::Mason::CGIHandler::VERSION ?
- 'HTML::Mason::Request::CGI' :
- 'HTML::Mason::Request';
-
- $class->alter_superclass( $superclass );
-
- #huh... shouldn't alter_superclass take care of this for us?
- __PACKAGE__->valid_params( %{ $superclass->valid_params() } );
-
- my %opt = @_;
- my $mode = $superclass =~ /Apache/i ? 'apache' : 'standalone';
- freeside_setup($opt{'comp'}, $mode);
-
- $class->SUPER::new(@_);
-
-}
-
-#override alter_superclass ala RT::Interface::Web::Request ??
-# for Mason 1.39 vs. Perl 5.10.0
-
-sub freeside_setup {
-
- my( $filename, $mode ) = @_;
-
- if ( $filename =~ qr(/REST/\d+\.\d+/NoAuth/) ) {
-
- package HTML::Mason::Commands; #?
- use FS::UID qw( adminsuidsetup );
-
- #need to log somebody in for the mail gw
-
- ##old installs w/fs_selfs or selfserv??
- #&adminsuidsetup('fs_selfservice');
-
- &adminsuidsetup('fs_queue');
-
- } else {
-
- package HTML::Mason::Commands;
- use vars qw( $cgi $p $fsurl );
- use FS::UID qw( cgisuidsetup );
- use FS::CGI qw( popurl rooturl );
-
- if ( $mode eq 'apache' ) {
- $cgi = new CGI;
- &cgisuidsetup($cgi);
- #&cgisuidsetup($r);
- $fsurl = rooturl();
- $p = popurl(2);
- } elsif ( $mode eq 'standalone' ) {
- $cgi = new CGI $FS::Mason::Request::QUERY_STRING; #better keep setting
- #if you set it once
- $FS::UID::cgi = $cgi;
- $fsurl = $FS::Mason::Request::FSURL; #kludgy, but what the hell
- $p = popurl(2, "$fsurl$filename");
- } else {
- die "unknown mode $mode";
- }
-
- }
-
-}
-
-sub callback {
- RT::Interface::Web::Request::callback(@_);
-}
-
-sub request_path {
- RT::Interface::Web::Request::request_path(@_);
-}
-
-1;
diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm
deleted file mode 100644
index fe8ac60..0000000
--- a/FS/FS/Misc.pm
+++ /dev/null
@@ -1,904 +0,0 @@
-package FS::Misc;
-
-use strict;
-use vars qw ( @ISA @EXPORT_OK $DEBUG );
-use Exporter;
-use Carp;
-use Data::Dumper;
-use IPC::Run qw( run timeout ); # for _pslatex
-use IPC::Run3; # for do_print... should just use IPC::Run i guess
-use File::Temp;
-use Tie::IxHash;
-#do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
-#until on client machine) dependancy loops. put them in FS::Misc::Something
-#instead
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( send_email generate_email send_fax
- states_hash counties cities state_label
- card_types
- pkg_freqs
- generate_ps generate_pdf do_print
- csv_from_fixed
- ocr_image
- );
-
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::Misc - Miscellaneous subroutines
-
-=head1 SYNOPSIS
-
- use FS::Misc qw(send_email);
-
- send_email();
-
-=head1 DESCRIPTION
-
-Miscellaneous subroutines. This module contains miscellaneous subroutines
-called from multiple other modules. These are not OO or necessarily related,
-but are collected here to eliminate code duplication.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item send_email OPTION => VALUE ...
-
-Options:
-
-=over 4
-
-=item from
-
-(required)
-
-=item to
-
-(required) comma-separated scalar or arrayref of recipients
-
-=item subject
-
-(required)
-
-=item content-type
-
-(optional) MIME type for the body
-
-=item body
-
-(required unless I<nobody> is true) arrayref of body text lines
-
-=item mimeparts
-
-(optional, but required if I<nobody> is true) arrayref of MIME::Entity->build PARAMHASH refs or MIME::Entity objects. These will be passed as arguments to MIME::Entity->attach().
-
-=item nobody
-
-(optional) when set true, send_email will ignore the I<body> option and simply construct a message with the given I<mimeparts>. In this case,
-I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
-
-=item content-encoding
-
-(optional) when using nobody, optional top-level MIME
-encoding which, if specified, overrides the default "7bit".
-
-=item type
-
-(optional) type parameter for multipart/related messages
-
-=back
-
-=cut
-
-use vars qw( $conf );
-use Date::Format;
-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 {
- $conf = new FS::Conf;
-} );
-
-sub send_email {
- my(%options) = @_;
- if ( $DEBUG ) {
- my %doptions = %options;
- $doptions{'body'} = '(full body not shown in debug)';
- warn "FS::Misc::send_email called with options:\n ". Dumper(\%doptions);
-# join("\n", map { " $_: ". $options{$_} } keys %options ). "\n"
- }
-
- my @to = ref($options{to}) ? @{ $options{to} } : ( $options{to} );
-
- my @mimeargs = ();
- my @mimeparts = ();
- if ( $options{'nobody'} ) {
-
- croak "'mimeparts' option required when 'nobody' option given\n"
- unless $options{'mimeparts'};
-
- @mimeparts = @{$options{'mimeparts'}};
-
- @mimeargs = (
- 'Type' => ( $options{'content-type'} || 'multipart/mixed' ),
- 'Encoding' => ( $options{'content-encoding'} || '7bit' ),
- );
-
- } else {
-
- @mimeparts = @{$options{'mimeparts'}}
- if ref($options{'mimeparts'}) eq 'ARRAY';
-
- if (scalar(@mimeparts)) {
-
- @mimeargs = (
- 'Type' => 'multipart/mixed',
- 'Encoding' => '7bit',
- );
-
- unshift @mimeparts, {
- 'Type' => ( $options{'content-type'} || 'text/plain' ),
- 'Data' => $options{'body'},
- 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
- 'Disposition' => 'inline',
- };
-
- } else {
-
- @mimeargs = (
- 'Type' => ( $options{'content-type'} || 'text/plain' ),
- 'Data' => $options{'body'},
- 'Encoding' => ( $options{'content-type'} ? '-SUGGEST' : '7bit' ),
- );
-
- }
-
- }
-
- my $domain;
- if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) {
- $domain = $1;
- } else {
- warn 'no domain found in invoice from address '. $options{'from'}.
- '; constructing Message-ID (and saying HELO) @example.com';
- $domain = 'example.com';
- }
- my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain";
-
- my $message = MIME::Entity->build(
- 'From' => $options{'from'},
- 'To' => join(', ', @to),
- 'Sender' => $options{'from'},
- 'Reply-To' => $options{'from'},
- 'Date' => time2str("%a, %d %b %Y %X %z", time),
- 'Subject' => $options{'subject'},
- 'Message-ID' => "<$message_id>",
- @mimeargs,
- );
-
- if ( $options{'type'} ) {
- #false laziness w/cust_bill::generate_email
- $message->head->replace('Content-type',
- $message->mime_type.
- '; boundary="'. $message->head->multipart_boundary. '"'.
- '; type='. $options{'type'}
- );
- }
-
- foreach my $part (@mimeparts) {
-
- if ( UNIVERSAL::isa($part, 'MIME::Entity') ) {
-
- warn "attaching MIME part from MIME::Entity object\n"
- if $DEBUG;
- $message->add_part($part);
-
- } elsif ( ref($part) eq 'HASH' ) {
-
- warn "attaching MIME part from hashref:\n".
- join("\n", map " $_: ".$part->{$_}, keys %$part ). "\n"
- if $DEBUG;
- $message->attach(%$part);
-
- } else {
- croak "mimepart $part isn't a hashref or MIME::Entity object!";
- }
-
- }
-
- #send the email
-
- my %smtp_opt = ( 'host' => $conf->config('smtpmachine'),
- 'helo' => $domain,
- );
-
- my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') );
- $smtp_opt{'port'} = $port;
-
- 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 );
- }
-
- push @to, $options{bcc} if defined($options{bcc});
- local $@; # just in case
- eval { sendmail($message, { transport => $transport,
- from => $options{from},
- to => \@to }) };
-
- if(ref($@) and $@->isa('Email::Sender::Failure')) {
- return ($@->code ? $@->code.' ' : '').$@->message
- }
- else {
- return $@;
- }
-}
-
-=item generate_email OPTION => VALUE ...
-
-Options:
-
-=over 4
-
-=item from
-
-Sender address, required
-
-=item to
-
-Recipient address, required
-
-=item bcc
-
-Blind copy address, optional
-
-=item subject
-
-email subject, required
-
-=item html_body
-
-Email body (HTML alternative). Arrayref of lines, or scalar.
-
-Will be placed inside an HTML <BODY> tag.
-
-=item text_body
-
-Email body (Text alternative). Arrayref of lines, or scalar.
-
-=back
-
-Constructs a multipart message from text_body and html_body.
-
-=cut
-
-#false laziness w/FS::cust_bill::generate_email
-
-use MIME::Entity;
-use HTML::Entities;
-
-sub generate_email {
- my %args = @_;
-
- my $me = '[FS::Misc::generate_email]';
-
- my %return = (
- 'from' => $args{'from'},
- 'to' => $args{'to'},
- 'bcc' => $args{'bcc'},
- 'subject' => $args{'subject'},
- );
-
- #if (ref($args{'to'}) eq 'ARRAY') {
- # $return{'to'} = $args{'to'};
- #} else {
- # $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
- # $self->cust_main->invoicing_list
- # ];
- #}
-
- warn "$me creating HTML/text multipart message"
- if $DEBUG;
-
- $return{'nobody'} = 1;
-
- my $alternative = build MIME::Entity
- 'Type' => 'multipart/alternative',
- 'Encoding' => '7bit',
- 'Disposition' => 'inline'
- ;
-
- my $data;
- if ( ref($args{'text_body'}) eq 'ARRAY' ) {
- $data = $args{'text_body'};
- } else {
- $data = [ split(/\n/, $args{'text_body'}) ];
- }
-
- $alternative->attach(
- 'Type' => 'text/plain',
- #'Encoding' => 'quoted-printable',
- 'Encoding' => '7bit',
- 'Data' => $data,
- 'Disposition' => 'inline',
- );
-
- my @html_data;
- if ( ref($args{'html_body'}) eq 'ARRAY' ) {
- @html_data = @{ $args{'html_body'} };
- } else {
- @html_data = split(/\n/, $args{'html_body'});
- }
-
- $alternative->attach(
- 'Type' => 'text/html',
- 'Encoding' => 'quoted-printable',
- 'Data' => [ '<html>',
- ' <head>',
- ' <title>',
- ' '. encode_entities($return{'subject'}),
- ' </title>',
- ' </head>',
- ' <body bgcolor="#e8e8e8">',
- @html_data,
- ' </body>',
- '</html>',
- ],
- 'Disposition' => 'inline',
- #'Filename' => 'invoice.pdf',
- );
-
- #no other attachment:
- # multipart/related
- # multipart/alternative
- # text/plain
- # text/html
-
- $return{'content-type'} = 'multipart/related';
- $return{'mimeparts'} = [ $alternative ];
- $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
- #$return{'disposition'} = 'inline';
-
- %return;
-
-}
-
-=item process_send_email OPTION => VALUE ...
-
-Takes arguments as per generate_email() and sends the message. This
-will die on any error and can be used in the job queue.
-
-=cut
-
-sub process_send_email {
- my %message = @_;
- my $error = send_email(generate_email(%message));
- die "$error\n" if $error;
- '';
-}
-
-=item send_fax OPTION => VALUE ...
-
-Options:
-
-I<dialstring> - (required) 10-digit phone number w/ area code
-
-I<docdata> - (required) Array ref containing PostScript or TIFF Class F document
-
--or-
-
-I<docfile> - (required) Filename of PostScript TIFF Class F document
-
-...any other options will be passed to L<Fax::Hylafax::Client::sendfax>
-
-
-=cut
-
-sub send_fax {
-
- my %options = @_;
-
- die 'HylaFAX support has not been configured.'
- unless $conf->exists('hylafax');
-
- eval {
- require Fax::Hylafax::Client;
- };
-
- if ($@) {
- if ($@ =~ /^Can't locate Fax.*/) {
- die "You must have Fax::Hylafax::Client installed to use invoice faxing."
- } else {
- die $@;
- }
- }
-
- my %hylafax_opts = map { split /\s+/ } $conf->config('hylafax');
-
- die 'Called send_fax without a \'dialstring\'.'
- unless exists($options{'dialstring'});
-
- if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- my $fh = new File::Temp(
- TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
- DIR => $dir,
- UNLINK => 0,
- ) or die "can't open temp file: $!\n";
-
- $options{docfile} = $fh->filename;
-
- print $fh @{$options{'docdata'}};
- close $fh;
-
- delete $options{'docdata'};
- }
-
- die 'Called send_fax without a \'docfile\' or \'docdata\'.'
- unless exists($options{'docfile'});
-
- #FIXME: Need to send canonical dialstring to HylaFAX, but this only
- # works in the US.
-
- $options{'dialstring'} =~ s/[^\d\+]//g;
- if ($options{'dialstring'} =~ /^\d{10}$/) {
- $options{dialstring} = '+1' . $options{'dialstring'};
- } else {
- return 'Invalid dialstring ' . $options{'dialstring'} . '.';
- }
-
- my $faxjob = &Fax::Hylafax::Client::sendfax(%options, %hylafax_opts);
-
- if ($faxjob->success) {
- warn "Successfully queued fax to '$options{dialstring}' with jobid " .
- $faxjob->jobid
- if $DEBUG;
- return '';
- } else {
- return 'Error while sending FAX: ' . $faxjob->trace;
- }
-
-}
-
-=item states_hash COUNTRY
-
-Returns a list of key/value pairs containing state (or other sub-country
-division) abbriviations and names.
-
-=cut
-
-use FS::Record qw(qsearch);
-use Locale::SubCountry;
-
-sub states_hash {
- my($country) = @_;
-
- my @states =
-# sort
- map { s/[\n\r]//g; $_; }
- map { $_->state; }
- qsearch({
- 'select' => 'state',
- 'table' => 'cust_main_county',
- 'hashref' => { 'country' => $country },
- 'extra_sql' => 'GROUP BY state',
- });
-
- #it could throw a fatal "Invalid country code" error (for example "AX")
- my $subcountry = eval { new Locale::SubCountry($country) }
- or return ( '', '(n/a)' );
-
- #"i see your schwartz is as big as mine!"
- map { ( $_->[0] => $_->[1] ) }
- sort { $a->[1] cmp $b->[1] }
- map { [ $_ => state_label($_, $subcountry) ] }
- @states;
-}
-
-=item counties STATE COUNTRY
-
-Returns a list of counties for this state and country.
-
-=cut
-
-sub counties {
- my( $state, $country ) = @_;
-
- map { $_ } #return num_counties($state, $country) unless wantarray;
- sort map { s/[\n\r]//g; $_; }
- map { $_->county }
- qsearch({
- 'select' => 'DISTINCT county',
- 'table' => 'cust_main_county',
- 'hashref' => { 'state' => $state,
- 'country' => $country,
- },
- });
-}
-
-=item cities COUNTY STATE COUNTRY
-
-Returns a list of cities for this county, state and country.
-
-=cut
-
-sub cities {
- my( $county, $state, $country ) = @_;
-
- map { $_ } #return num_cities($county, $state, $country) unless wantarray;
- sort map { s/[\n\r]//g; $_; }
- map { $_->city }
- qsearch({
- 'select' => 'DISTINCT city',
- 'table' => 'cust_main_county',
- 'hashref' => { 'county' => $county,
- 'state' => $state,
- 'country' => $country,
- },
- });
-}
-
-=item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
-
-=cut
-
-sub state_label {
- my( $state, $country ) = @_;
-
- unless ( ref($country) ) {
- $country = eval { new Locale::SubCountry($country) }
- or return'(n/a)';
-
- }
-
- # US kludge to avoid changing existing behaviour
- # also we actually *use* the abbriviations...
- my $full_name = $country->country_code eq 'US'
- ? ''
- : $country->full_name($state);
-
- $full_name = '' if $full_name eq 'unknown';
- $full_name =~ s/\(see also.*\)\s*$//;
- $full_name .= " ($state)" if $full_name;
-
- $full_name || $state || '(n/a)';
-
-}
-
-=item card_types
-
-Returns a hash reference of the accepted credit card types. Keys are shorter
-identifiers and values are the longer strings used by the system (see
-L<Business::CreditCard>).
-
-=cut
-
-#$conf from above
-
-sub card_types {
- my $conf = new FS::Conf;
-
- my %card_types = (
- #displayname #value (Business::CreditCard)
- "VISA" => "VISA card",
- "MasterCard" => "MasterCard",
- "Discover" => "Discover card",
- "American Express" => "American Express card",
- "Diner's Club/Carte Blanche" => "Diner's Club/Carte Blanche",
- "enRoute" => "enRoute",
- "JCB" => "JCB",
- "BankCard" => "BankCard",
- "Switch" => "Switch",
- "Solo" => "Solo",
- );
- my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
- if ( @conf_card_types ) {
- #perhaps the hash is backwards for this, but this way works better for
- #usage in selfservice
- %card_types = map { $_ => $card_types{$_} }
- grep {
- my $d = $_;
- grep { $card_types{$d} eq $_ } @conf_card_types
- }
- keys %card_types;
- }
-
- \%card_types;
-}
-
-=item pkg_freqs
-
-Returns a hash reference of allowed package billing frequencies.
-
-=cut
-
-sub pkg_freqs {
- tie my %freq, 'Tie::IxHash', (
- '0' => '(no recurring fee)',
- '1h' => 'hourly',
- '1d' => 'daily',
- '2d' => 'every two days',
- '3d' => 'every three days',
- '1w' => 'weekly',
- '2w' => 'biweekly (every 2 weeks)',
- '1' => 'monthly',
- '45d' => 'every 45 days',
- '2' => 'bimonthly (every 2 months)',
- '3' => 'quarterly (every 3 months)',
- '4' => 'every 4 months',
- '137d' => 'every 4 1/2 months (137 days)',
- '6' => 'semiannually (every 6 months)',
- '12' => 'annually',
- '13' => 'every 13 months (annually +1 month)',
- '24' => 'biannually (every 2 years)',
- '36' => 'triannually (every 3 years)',
- '48' => '(every 4 years)',
- '60' => '(every 5 years)',
- '120' => '(every 10 years)',
- ) ;
- \%freq;
-}
-
-=item generate_ps FILENAME
-
-Returns an postscript rendition of the LaTex file, as a scalar.
-FILENAME does not contain the .tex suffix and is unlinked by this function.
-
-=cut
-
-use String::ShellQuote;
-
-sub generate_ps {
- my $file = shift;
-
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- chdir($dir);
-
- _pslatex($file);
-
- system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
- or die "dvips failed";
-
- open(POSTSCRIPT, "<$file.ps")
- or die "can't open $file.ps: $! (error in LaTeX template?)\n";
-
- unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
-
- my $ps = '';
-
- if ( $conf->exists('lpr-postscript_prefix') ) {
- my $prefix = $conf->config('lpr-postscript_prefix');
- $ps .= eval qq("$prefix");
- }
-
- while (<POSTSCRIPT>) {
- $ps .= $_;
- }
-
- close POSTSCRIPT;
-
- if ( $conf->exists('lpr-postscript_suffix') ) {
- my $suffix = $conf->config('lpr-postscript_suffix');
- $ps .= eval qq("$suffix");
- }
-
- return $ps;
-
-}
-
-=item generate_pdf FILENAME
-
-Returns an PDF rendition of the LaTex file, as a scalar. FILENAME does not
-contain the .tex suffix and is unlinked by this function.
-
-=cut
-
-use String::ShellQuote;
-
-sub generate_pdf {
- my $file = shift;
-
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- chdir($dir);
-
- #system('pdflatex', "$file.tex");
- #system('pdflatex', "$file.tex");
- #! LaTeX Error: Unknown graphics extension: .eps.
-
- _pslatex($file);
-
- my $sfile = shell_quote $file;
-
- #system('dvipdf', "$file.dvi", "$file.pdf" );
- system(
- "dvips -q -t letter -f $sfile.dvi ".
- "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
- " -c save pop -"
- ) == 0
- or die "dvips | gs failed: $!";
-
- open(PDF, "<$file.pdf")
- or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
-
- unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
-
- my $pdf = '';
- while (<PDF>) {
- $pdf .= $_;
- }
-
- close PDF;
-
- return $pdf;
-
-}
-
-sub _pslatex {
- my $file = shift;
-
- #my $sfile = shell_quote $file;
-
- my @cmd = (
- 'latex',
- '-interaction=batchmode',
- '\AtBeginDocument{\RequirePackage{pslatex}}',
- '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
- '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
- '\PSLATEXTMP',
- "$file.tex"
- );
-
- my $timeout = 30; #? should be more than enough
-
- for ( 1, 2 ) {
-
- local($SIG{CHLD}) = sub {};
- run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
- or die "pslatex $file.tex failed; see $file.log for details?\n";
-
- }
-
-}
-
-=item print ARRAYREF
-
-Sends the lines in ARRAYREF to the printer.
-
-=cut
-
-sub do_print {
- my $data = shift;
-
- my $lpr = $conf->config('lpr');
-
- my $outerr = '';
- run3 $lpr, $data, \$outerr, \$outerr;
- if ( $? ) {
- $outerr = ": $outerr" if length($outerr);
- die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
- }
-
-}
-
-=item csv_from_fixed, FILEREF COUNTREF, [ LENGTH_LISTREF, [ CALLBACKS_LISTREF ] ]
-
-Converts the filehandle referenced by FILEREF from fixed length record
-lines to a CSV file according to the lengths specified in LENGTH_LISTREF.
-The CALLBACKS_LISTREF refers to a correpsonding list of coderefs. Each
-should return the value to be substituted in place of its single argument.
-
-Returns false on success or an error if one occurs.
-
-=cut
-
-sub csv_from_fixed {
- my( $fhref, $countref, $lengths, $callbacks) = @_;
-
- eval { require Text::CSV_XS; };
- return $@ if $@;
-
- my $ofh = $$fhref;
- my $unpacker = new Text::CSV_XS;
- my $total = 0;
- my $template = join('', map {$total += $_; "A$_"} @$lengths) if $lengths;
-
- my $dir = "%%%FREESIDE_CACHE%%%/cache.$FS::UID::datasrc";
- my $fh = new File::Temp( TEMPLATE => "FILE.csv.XXXXXXXX",
- DIR => $dir,
- UNLINK => 0,
- ) or return "can't open temp file: $!\n"
- if $template;
-
- while ( defined(my $line=<$ofh>) ) {
- $$countref++;
- if ( $template ) {
- my $column = 0;
-
- chomp $line;
- return "unexpected input at line $$countref: $line".
- " -- expected $total but received ". length($line)
- unless length($line) == $total;
-
- $unpacker->combine( map { my $i = $column++;
- defined( $callbacks->[$i] )
- ? &{ $callbacks->[$i] }( $_ )
- : $_
- } unpack( $template, $line )
- )
- or return "invalid data for CSV: ". $unpacker->error_input;
-
- print $fh $unpacker->string(), "\n"
- or return "can't write temp file: $!\n";
- }
- }
-
- if ( $template ) { close $$fhref; $$fhref = $fh }
-
- seek $$fhref, 0, 0;
- '';
-}
-
-=item ocr_image IMAGE_SCALAR
-
-Runs OCR on the provided image data and returns a list of text lines.
-
-=cut
-
-sub ocr_image {
- my $logo_data = shift;
-
- #XXX use conf dir location from Makefile
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- my $fh = new File::Temp(
- TEMPLATE => 'bizcard.XXXXXXXX',
- SUFFIX => '.png', #XXX assuming, but should handle jpg, gif, etc. too
- DIR => $dir,
- UNLINK => 0,
- ) or die "can't open temp file: $!\n";
-
- my $filename = $fh->filename;
-
- print $fh $logo_data;
- close $fh;
-
- run( [qw(ocroscript recognize), $filename], '>'=>"$filename.hocr" )
- or die "ocroscript recognize failed\n";
-
- run( [qw(ocroscript hocr-to-text), "$filename.hocr"], '>pipe'=>\*OUT )
- or die "ocroscript hocr-to-text failed\n";
-
- my @lines = split(/\n/, <OUT> );
-
- foreach (@lines) { s/\.c0m\s*$/.com/; }
-
- @lines;
-}
-
-=back
-
-=head1 BUGS
-
-This package exists.
-
-=head1 SEE ALSO
-
-L<FS::UID>, L<FS::CGI>, L<FS::Record>, the base documentation.
-
-L<Fax::Hylafax::Client>
-
-=cut
-
-1;
diff --git a/FS/FS/Misc/DateTime.pm b/FS/FS/Misc/DateTime.pm
deleted file mode 100644
index a32c15a..0000000
--- a/FS/FS/Misc/DateTime.pm
+++ /dev/null
@@ -1,64 +0,0 @@
-package FS::Misc::DateTime;
-
-use base qw( Exporter );
-use vars qw( @EXPORT_OK );
-use Carp;
-use Date::Parse;
-use DateTime::Format::Natural;
-use FS::Conf;
-
-@EXPORT_OK = qw( parse_datetime );
-
-=head1 NAME
-
-FS::Misc::DateTime - Date and time subroutines
-
-=head1 SYNOPSIS
-
-use FS::Misc::DateTime qw( parse_datetime );
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item parse_datetime STRING
-
-Parses a date (and possibly time) from the supplied string and returns
-the date as an integer UNIX timestamp.
-
-=cut
-
-sub parse_datetime {
- my $string = shift;
- return '' unless $string =~ /\S/;
-
- my $conf = new FS::Conf;
- my $format = $conf->config('date_format') || '%m/%d/%Y';
-
- if ( $format eq '%d/%m/%Y' ) { # =~ /\%d.*\%m/ ) {
- #$format =~ s/\%//g;
- my $parser = DateTime::Format::Natural->new( 'time_zone' => 'local',
- #'format'=>'d/m/y',#lc($format)
- );
- $dt = $parser->parse_datetime($string);
- if ( $parser->success ) {
- return $dt->epoch;
- } else {
- #carp "WARNING: can't parse date: ". $parser->error;
- #return '';
- #huh, very common, we still need the "partially" (fully enough for our purposes) parsed date.
- $dt->epoch;
- }
- } else {
- return str2time($string);
- }
-
-}
-
-=back
-
-=head1 BUGS
-
-=cut
-
-1;
diff --git a/FS/FS/Misc/eps2png.pm b/FS/FS/Misc/eps2png.pm
deleted file mode 100644
index aa8e572..0000000
--- a/FS/FS/Misc/eps2png.pm
+++ /dev/null
@@ -1,278 +0,0 @@
-package FS::Misc::eps2png;
-
-#based on eps2png by Johan Vromans
-#Copyright 1994,2008 by Johan Vromans.
-#This program is free software; you can redistribute it and/or
-#modify it under the terms of the Perl Artistic License or the
-#GNU General Public License as published by the Free Software
-#Foundation; either version 2 of the License, or (at your option) any
-#later version.
-
-use strict;
-use vars qw( @ISA @EXPORT_OK );
-use Exporter;
-use File::Temp;
-use File::Slurp qw( slurp );
-#use FS::UID;
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( eps2png );
-
-################ Program parameters ################
-
-# Some GhostScript programs can produce GIF directly.
-# If not, we need the PBM package for the conversion.
-# NOTE: This will be changed upon install.
-my $use_pbm = 0;
-
-my $res = 82; # default resolution
-my $scale = 1; # default scaling
-my $mono = 0; # produce BW images if non-zero
-my $format; # output format
-my $gs_format; # GS output type
-my $output; # output, defaults to STDOUT
-my $antialias = 4; # antialiasing
-my $DEF_width; # desired widht
-my $DEF_height; # desired height
-#my $DEF_width = 90; # desired widht
-#my $DEF_height = 36; # desired height
-
-my ($verbose,$trace,$test,$debug) = (0,0,0,0);
-#handle_options ();
-set_out_type ('png'); # unless defined $format;
-warn "Producing $format ($gs_format) image.\n" if $verbose;
-
-$trace |= $test | $debug;
-$verbose |= $trace;
-
-################ Presets ################
-
-################ The Process ################
-
-my $err = 0;
-
-sub eps2png {
- my( $eps, %options ) = @_; #well, no options yet
-
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- my $eps_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX',
- DIR => $dir,
- SUFFIX => '.eps',
- #UNLINK => 0,
- ) or die "can't open temp file: $!\n";
- print $eps_file $eps;
- close $eps_file;
-
- my @eps = split(/\r?\n/, $eps);
-
- warn "converting eps (". length($eps). " bytes, ". scalar(@eps). " lines)\n"
- if $verbose;
-
- my $line = shift @eps; #<EPS>;
- unless ( $eps =~ /^%!PS-Adobe.*EPSF-/ ) {
- warn "not EPS file (no %!PS-Adobe header)\n";
- return; #empty png file?
- }
-
- my $ps = ""; # PostScript input data
- my $xscale;
- my $yscale;
- my $gotbb;
-
- # Prevent derived values from propagating.
- my $width = $DEF_width;
- my $height = $DEF_height;
-
- while ( @eps ) {
-
- $line = shift(@eps)."\n";
-
- # Search for BoundingBox.
- if ( $line =~ /^%%BoundingBox:\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/i ) {
- $gotbb++;
- warn "$eps_file: x0=$1, y0=$2, w=", $3-$1, ", h=", $4-$2
- if $verbose;
-
- if ( defined $width ) {
- $res = 72;
- $xscale = $width / ($3 - $1);
- if ( defined $height ) {
- $yscale = $height / ($4 - $2);
- }
- else {
- $yscale = $xscale;
- $height = ($4 - $2) * $yscale;
- }
- }
- elsif ( defined $height ) {
- $res = 72;
- $yscale = $height / ($4 - $2);
- if ( defined $width ) {
- $xscale = $width / ($3 - $1);
- }
- else {
- $xscale = $yscale;
- $width = ($3 - $1) * $xscale;
- }
- }
- unless ( defined $xscale ) {
- $xscale = $yscale = $scale;
- # Calculate actual width.
- $width = $3 - $1;
- $height = $4 - $2;
- # Normal PostScript resolution is 72.
- $width *= $res/72 * $xscale;
- $height *= $res/72 * $yscale;
- # Round up.
- $width = int ($width + 0.5) + 1;
- $height = int ($height + 0.5) + 1;
- }
- warn ", width=$width, height=$height\n" if $verbose;
-
- # Scale.
- $ps .= "$xscale $yscale scale\n"
- if $xscale != 1 || $yscale != 1;
-
- # Create PostScript code to translate coordinates.
- $ps .= (0-$1) . " " . (0-$2) . " translate\n"
- unless $1 == 0 && $2 == 0;
-
- # Include the image, show and quit.
- $ps .= "($eps_file) run\n".
- "showpage\n".
- "quit\n";
-
- last;
- }
- elsif ( $line =~ /^%%EndComments/i ) {
- last;
- }
- }
-
- unless ( $gotbb ) {
- warn "No bounding box in $eps_file\n";
- return;
- }
-
- #it would be better to ask gs to spit out files on stdout, but c'est la vie
-
- #my $out_file; # output file
- #my $pbm_file; # temporary file for PBM conversion
-
- my $out_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX',
- DIR => $dir,
- SUFFIX => '.png',
- #UNLINK => 0,
- ) or die "can't open temp file: $!\n";
-
- my $pbm_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX',
- DIR => $dir,
- SUFFIX => '.pbm',
- #UNLINK => 0,
- ) or die "can't open temp file: $!\n";
-
- # Note the temporary PBM file is created where the output file is
- # located, since that will guarantee accessibility (and a valid
- # filename).
- warn "Creating $out_file\n" if $verbose;
-
- my $gs0 = "gs -q -dNOPAUSE -r$res -g${width}x$height";
- my $gs1 = "-";
- $gs0 .= " -dTextAlphaBits=$antialias -dGraphicsAlphaBits=$antialias"
- if $antialias;
- if ( $format eq 'png' ) {
- mysystem ("$gs0 -sDEVICE=". ($mono ? "pngmono" : $gs_format).
- " -sOutputFile=$out_file $gs1", $ps);
- }
- elsif ( $format eq 'jpg' ) {
- mysystem ("$gs0 -sDEVICE=". ($mono ? "jpeggray" : $gs_format).
- " -sOutputFile=$out_file $gs1", $ps);
- }
- elsif ( $format eq 'gif' ) {
- if ( $use_pbm ) {
- # Convert to PPM and use some of the PBM converters.
- mysystem ("$gs0 -sDEVICE=". ($mono ? "pbm" : "ppm").
- " -sOutputFile=$pbm_file $gs1", $ps);
- # mysystem ("pnmcrop $pbm_file | ppmtogif > $out_file");
- mysystem ("ppmtogif $pbm_file > $out_file");
- unlink ($pbm_file);
- }
- else {
- # GhostScript has GIF drivers built-in.
- mysystem ("$gs0 -sDEVICE=". ($mono ? "gifmono" : "gif8").
- " -sOutputFile=$out_file $gs1", $ps);
- }
- }
- else {
- warn "ASSERT ERROR: Unhandled output type: $format\n";
- exit (1);
- }
-
-# unless ( -s $out_file ) {
-# warn "Problem creating $out_file for $eps_file\n";
-# $err++;
-# }
-
- slurp($out_file);
-
-}
-
-exit 1 if $err;
-
-################ Subroutines ################
-
-sub mysystem {
- my ($cmd, $data) = @_;
- warn "+ $cmd\n" if $trace;
- if ( $data ) {
- if ( $trace ) {
- my $dp = ">> " . $data;
- $dp =~ s/\n(.)/\n>> $1/g;
- warn "$dp";
- }
- open (CMD, "|$cmd") or die ("$cmd: $!\n");
- print CMD $data;
- close CMD or die ("$cmd close: $!\n");
- }
- else {
- system ($cmd);
- }
-}
-
-sub set_out_type {
- my ($opt) = lc (shift (@_));
- if ( $opt =~ /^png(mono|gray|16|256|16m|alpha)?$/ ) {
- $format = 'png';
- $gs_format = $format.(defined $1 ? $1 : '16m');
- }
- elsif ( $opt =~ /^gif(mono)?$/ ) {
- $format = 'gif';
- $gs_format = $format.(defined $1 ? $1 : '');
- }
- elsif ( $opt =~ /^(jpg|jpeg)(gray)?$/ ) {
- $format = 'jpg';
- $gs_format = 'jpeg'.(defined $2 ? $2 : '');
- }
- else {
- warn "ASSERT ERROR: Invalid value to set_out_type: $opt\n";
- exit (1);
- }
-}
-
-# 'antialias|aa=i' => \$antialias,
-# 'noantialias|noaa' => sub { $antialias = 0 },
-# 'scale=f' => \$scale,
-# 'width=i' => \$width,
-# 'height=i' => \$height,
-# 'resolution=i' => \$res,
-
-# die ("Antialias value must be 0, 1, 2, 4, or 8\n")
-
-# -width XXX desired with
-# -height XXX desired height
-# -resolution XXX resolution (default = $res)
-# -scale XXX scaling factor
-# -antialias XX antialias factor (must be 0, 1, 2, 4 or 8; default: 4)
-# -noantialias no antialiasing (same as -antialias 0)
-
-1;
diff --git a/FS/FS/Misc/prune.pm b/FS/FS/Misc/prune.pm
deleted file mode 100644
index 3f0c79d..0000000
--- a/FS/FS/Misc/prune.pm
+++ /dev/null
@@ -1,131 +0,0 @@
-package FS::Misc::prune;
-
-use strict;
-use vars qw ( @ISA @EXPORT_OK $DEBUG );
-use Exporter;
-use FS::Record qw(dbh qsearch);
-use FS::cust_credit_refund;
-#use FS::cust_credit_bill;
-#use FS::cust_bill_pay;
-#use FS::cust_pay_refund;
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( prune_applications );
-
-=head1 NAME
-
-FS::Misc::prune - misc. pruning subroutines
-
-=head1 SYNOPSIS
-
-use FS::Misc::prune qw(prune_applications);
-
-prune_applications();
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item prune_applications OPTION_HASH
-
-Removes applications of credits to refunds in the event that the database
-is corrupt and either the credits or refunds are missing (see
-L<FS::cust_credit>, L<FS::cust_refund>, and L<FS::cust_credit_refund>).
-If the OPTION_HASH contains the element 'dry_run' then a report of
-affected records is returned rather than actually deleting the records.
-
-=cut
-
-sub prune_applications {
- my $options = shift;
- my $dbh = dbh;
-
- local $DEBUG = 1 if exists($options->{debug});
-
- my $ccr = <<EOW;
- WHERE
- 0 = (select count(*) from cust_credit
- where cust_credit_refund.crednum = cust_credit.crednum)
- or
- 0 = (select count(*) from cust_refund
- where cust_credit_refund.refundnum = cust_refund.refundnum)
-EOW
- my $ccb = <<EOW;
- WHERE
- 0 = (select count(*) from cust_credit
- where cust_credit_bill.crednum = cust_credit.crednum)
- or
- 0 = (select count(*) from cust_bill
- where cust_credit_bill.invnum = cust_bill.invnum)
-EOW
- my $cbp = <<EOW;
- WHERE
- 0 = (select count(*) from cust_bill
- where cust_bill_pay.invnum = cust_bill.invnum)
- or
- 0 = (select count(*) from cust_pay
- where cust_bill_pay.paynum = cust_pay.paynum)
-EOW
- my $cpr = <<EOW;
- WHERE
- 0 = (select count(*) from cust_pay
- where cust_pay_refund.paynum = cust_pay.paynum)
- or
- 0 = (select count(*) from cust_refund
- where cust_pay_refund.refundnum = cust_refund.refundnum)
-EOW
-
- my %strays = (
- 'cust_credit_refund' => { clause => $ccr,
- link1 => 'crednum',
- link2 => 'refundnum',
- },
-# 'cust_credit_bill' => { clause => $ccb,
-# link1 => 'crednum',
-# link2 => 'refundnum',
-# },
-# 'cust_bill_pay' => { clause => $cbp,
-# link1 => 'crednum',
-# link2 => 'refundnum',
-# },
-# 'cust_pay_refund' => { clause => $cpr,
-# link1 => 'crednum',
-# link2 => 'refundnum',
-# },
- );
-
- if ( exists($options->{dry_run}) ) {
- my @response = ();
- foreach my $table (keys %strays) {
- my $clause = $strays{$table}->{clause};
- my $link1 = $strays{$table}->{link1};
- my $link2 = $strays{$table}->{link2};
- my @rec = qsearch($table, {}, '', $clause);
- my $keyname = $rec[0]->primary_key if $rec[0];
- foreach (@rec) {
- push @response, "$table " .$_->$keyname . " claims attachment to ".
- "$link1 " . $_->$link1 . " and $link2 " . $_->$link2 . "\n";
- }
- }
- return (@response);
- } else {
- foreach (keys %strays) {
- my $statement = "DELETE FROM $_ " . $strays{$_}->{clause};
- warn $statement if $DEBUG;
- my $sth = $dbh->prepare($statement)
- or die $dbh->errstr;
- $sth->execute
- or die $sth->errstr;
- }
- return ();
- }
-}
-
-=back
-
-=head1 BUGS
-
-=cut
-
-1;
-
diff --git a/FS/FS/Msgcat.pm b/FS/FS/Msgcat.pm
deleted file mode 100644
index 70933b2..0000000
--- a/FS/FS/Msgcat.pm
+++ /dev/null
@@ -1,100 +0,0 @@
-package FS::Msgcat;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK $conf $locale $debug );
-use Exporter;
-use FS::UID;
-#use FS::Record qw( qsearchs ); # wtf? won't import...
-use FS::Record;
-#use FS::Conf; #wtf? causes dependency loops too.
-use FS::msgcat;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw( gettext geterror );
-
-FS::UID->install_callback( sub {
- eval "use FS::Conf;";
- die $@ if $@;
- $conf = new FS::Conf;
- $locale = $conf->config('locale') || 'en_US';
- $debug = $conf->exists('show-msgcat-codes')
-});
-
-=head1 NAME
-
-FS::Msgcat - Message catalog functions
-
-=head1 SYNOPSIS
-
- use FS::Msgcat qw(gettext geterror);
-
- #simple interface for retreiving messages...
- $message = gettext('msgcode');
- #or errors (includes the error code)
- $message = geterror('msgcode');
-
-=head1 DESCRIPTION
-
-FS::Msgcat provides functions to use the message catalog. If you want to
-maintain the message catalog database, see L<FS::msgcat> instead.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item gettext MSGCODE
-
-Returns the full message for the supplied message code.
-
-=cut
-
-sub gettext {
- $debug ? geterror(@_) : _gettext(@_);
-}
-
-sub _gettext {
- my $msgcode = shift;
- my $msgcat = FS::Record::qsearchs('msgcat', {
- 'msgcode' => $msgcode,
- 'locale' => $locale
- } );
- if ( $msgcat ) {
- $msgcat->msg;
- } else {
- warn "WARNING: message for msgcode $msgcode in locale $locale not found";
- $msgcode;
- }
-
-}
-
-=item geterror MSGCODE
-
-Returns the full message for the supplied message code, including the message
-code.
-
-=cut
-
-sub geterror {
- my $msgcode = shift;
- my $msg = _gettext($msgcode);
- if ( $msg eq $msgcode ) {
- "Error code $msgcode (message for locale $locale not found)";
- } else {
- "$msg (error code $msgcode)";
- }
-}
-
-=back
-
-=head1 BUGS
-
-i18n/l10n, eek
-
-=head1 SEE ALSO
-
-L<FS::msgcat>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/Pony.pm b/FS/FS/Pony.pm
deleted file mode 100644
index c37dd78..0000000
--- a/FS/FS/Pony.pm
+++ /dev/null
@@ -1,23 +0,0 @@
-package FS::Pony;
-
-=head1 NAME
-
-FS::Pony - A pony
-
-=head1 SYNOPSYS
-
-use FS::Pony; # <-- yours!
-
-=head1 DESCRIPTION
-
-We told you it came with a pony.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-http://420.am/~ivan/nopony.jpg
-
-=cut
-
-1;
diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
deleted file mode 100644
index 2e2612e..0000000
--- a/FS/FS/Record.pm
+++ /dev/null
@@ -1,3157 +0,0 @@
-package FS::Record;
-
-use strict;
-use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
- $conf $conf_encryption $me
- %virtual_fields_cache
- $nowarn_identical $nowarn_classload
- $no_update_diff $no_check_foreign
- );
-use Exporter;
-use Carp qw(carp cluck croak confess);
-use Scalar::Util qw( blessed );
-use File::CounterFile;
-use Locale::Country;
-use Text::CSV_XS;
-use File::Slurp qw( slurp );
-use DBI qw(:sql_types);
-use DBIx::DBSchema 0.38;
-use FS::UID qw(dbh getotaker datasrc driver_name);
-use FS::CurrentUser;
-use FS::Schema qw(dbdef);
-use FS::SearchCache;
-use FS::Msgcat qw(gettext);
-#use FS::Conf; #dependency loop bs, in install_callback below instead
-
-use FS::part_virtual_field;
-
-use Tie::IxHash;
-
-@ISA = qw(Exporter);
-
-#export dbdef for now... everything else expects to find it here
-@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch
- str2time_sql str2time_sql_closing regexp_sql not_regexp_sql );
-
-$DEBUG = 0;
-$me = '[FS::Record]';
-
-$nowarn_identical = 0;
-$nowarn_classload = 0;
-$no_update_diff = 0;
-$no_check_foreign = 0;
-
-my $rsa_module;
-my $rsa_loaded;
-my $rsa_encrypt;
-my $rsa_decrypt;
-
-$conf = '';
-$conf_encryption = '';
-FS::UID->install_callback( sub {
- eval "use FS::Conf;";
- die $@ if $@;
- $conf = FS::Conf->new;
- $conf_encryption = $conf->exists('encryption');
- $File::CounterFile::DEFAULT_DIR = $conf->base_dir . "/counters.". datasrc;
- if ( driver_name eq 'Pg' ) {
- eval "use DBD::Pg ':pg_types'";
- die $@ if $@;
- } else {
- eval "sub PG_BYTEA { die 'guru meditation #9: calling PG_BYTEA when not running Pg?'; }";
- }
-} );
-
-=head1 NAME
-
-FS::Record - Database record objects
-
-=head1 SYNOPSIS
-
- use FS::Record;
- use FS::Record qw(dbh fields qsearch qsearchs);
-
- $record = new FS::Record 'table', \%hash;
- $record = new FS::Record 'table', { 'column' => 'value', ... };
-
- $record = qsearchs FS::Record 'table', \%hash;
- $record = qsearchs FS::Record 'table', { 'column' => 'value', ... };
- @records = qsearch FS::Record 'table', \%hash;
- @records = qsearch FS::Record 'table', { 'column' => 'value', ... };
-
- $table = $record->table;
- $dbdef_table = $record->dbdef_table;
-
- $value = $record->get('column');
- $value = $record->getfield('column');
- $value = $record->column;
-
- $record->set( 'column' => 'value' );
- $record->setfield( 'column' => 'value' );
- $record->column('value');
-
- %hash = $record->hash;
-
- $hashref = $record->hashref;
-
- $error = $record->insert;
-
- $error = $record->delete;
-
- $error = $new_record->replace($old_record);
-
- # external use deprecated - handled by the database (at least for Pg, mysql)
- $value = $record->unique('column');
-
- $error = $record->ut_float('column');
- $error = $record->ut_floatn('column');
- $error = $record->ut_number('column');
- $error = $record->ut_numbern('column');
- $error = $record->ut_snumber('column');
- $error = $record->ut_snumbern('column');
- $error = $record->ut_money('column');
- $error = $record->ut_text('column');
- $error = $record->ut_textn('column');
- $error = $record->ut_alpha('column');
- $error = $record->ut_alphan('column');
- $error = $record->ut_phonen('column');
- $error = $record->ut_anything('column');
- $error = $record->ut_name('column');
-
- $quoted_value = _quote($value,'table','field');
-
- #deprecated
- $fields = hfields('table');
- if ( $fields->{Field} ) { # etc.
-
- @fields = fields 'table'; #as a subroutine
- @fields = $record->fields; #as a method call
-
-
-=head1 DESCRIPTION
-
-(Mostly) object-oriented interface to database records. Records are currently
-implemented on top of DBI. FS::Record is intended as a base class for
-table-specific classes to inherit from, i.e. FS::cust_main.
-
-=head1 CONSTRUCTORS
-
-=over 4
-
-=item new [ TABLE, ] HASHREF
-
-Creates a new record. It doesn't store it in the database, though. See
-L<"insert"> for that.
-
-Note that the object stores this 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.
-
-TABLE can only be omitted when a dervived class overrides the table method.
-
-=cut
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self, $class);
-
- unless ( defined ( $self->table ) ) {
- $self->{'Table'} = shift;
- carp "warning: FS::Record::new called with table name ". $self->{'Table'}
- unless $nowarn_classload;
- }
-
- $self->{'Hash'} = shift;
-
- foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
- $self->{'Hash'}{$field}='';
- }
-
- $self->_rebless if $self->can('_rebless');
-
- $self->{'modified'} = 0;
-
- $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
-
- $self;
-}
-
-sub new_or_cached {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self, $class);
-
- $self->{'Table'} = shift unless defined ( $self->table );
-
- my $hashref = $self->{'Hash'} = shift;
- my $cache = shift;
- if ( defined( $cache->cache->{$hashref->{$cache->key}} ) ) {
- my $obj = $cache->cache->{$hashref->{$cache->key}};
- $obj->_cache($hashref, $cache) if $obj->can('_cache');
- $obj;
- } else {
- $cache->cache->{$hashref->{$cache->key}} = $self->new($hashref, $cache);
- }
-
-}
-
-sub create {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self, $class);
- if ( defined $self->table ) {
- cluck "create constructor is deprecated, use new!";
- $self->new(@_);
- } else {
- croak "FS::Record::create called (not from a subclass)!";
- }
-}
-
-=item qsearch PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
-
-Searches the database for all records matching (at least) the key/value pairs
-in HASHREF. Returns all the records found as `FS::TABLE' objects if that
-module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record
-objects.
-
-The preferred usage is to pass a hash reference of named parameters:
-
- @records = qsearch( {
- 'table' => 'table_name',
- 'hashref' => { 'field' => 'value'
- 'field' => { 'op' => '<',
- 'value' => '420',
- },
- },
-
- #these are optional...
- 'select' => '*',
- 'extra_sql' => 'AND field = ? AND intfield = ?',
- 'extra_param' => [ 'value', [ 5, 'int' ] ],
- 'order_by' => 'ORDER BY something',
- #'cache_obj' => '', #optional
- 'addl_from' => 'LEFT JOIN othtable USING ( field )',
- 'debug' => 1,
- }
- );
-
-Much code still uses old-style positional parameters, this is also probably
-fine in the common case where there are only two parameters:
-
- my @records = qsearch( 'table', { 'field' => 'value' } );
-
-Also possible is an experimental LISTREF of PARAMS_HASHREFs for a UNION of
-the individual PARAMS_HASHREF queries
-
-###oops, argh, FS::Record::new only lets us create database fields.
-#Normal behaviour if SELECT is not specified is `*', as in
-#C<SELECT * FROM table WHERE ...>. However, there is an experimental new
-#feature where you can specify SELECT - remember, the objects returned,
-#although blessed into the appropriate `FS::TABLE' package, will only have the
-#fields you specify. This might have unwanted results if you then go calling
-#regular FS::TABLE methods
-#on it.
-
-=cut
-
-my %TYPE = (); #for debugging
-
-sub _bind_type {
- my($type, $value) = @_;
-
- my $bind_type = { TYPE => SQL_VARCHAR };
-
- if ( $type =~ /(big)?(int|serial)/i && $value =~ /^\d+(\.\d+)?$/ ) {
-
- $bind_type = { TYPE => SQL_INTEGER };
-
- } elsif ( $type =~ /^bytea$/i || $type =~ /(blob|varbinary)/i ) {
-
- if ( driver_name eq 'Pg' ) {
- no strict 'subs';
- $bind_type = { pg_type => PG_BYTEA };
- #} else {
- # $bind_type = ? #SQL_VARCHAR could be fine?
- }
-
- #DBD::Pg 1.49: Cannot bind ... unknown sql_type 6 with SQL_FLOAT
- #fixed by DBD::Pg 2.11.8
- #can change back to SQL_FLOAT in early-mid 2010, once everyone's upgraded
- #(make a Tron test first)
- } elsif ( _is_fs_float( $type, $value ) ) {
-
- $bind_type = { TYPE => SQL_DECIMAL };
-
- }
-
- $bind_type;
-
-}
-
-sub _is_fs_float {
- my($type, $value) = @_;
- if ( ( $type =~ /(numeric)/i && $value =~ /^[+-]?\d+(\.\d+)?$/ ) ||
- ( $type =~ /(real|float4)/i && $value =~ /[-+]?\d*\.?\d+([eE][-+]?\d+)?/)
- ) {
- return 1;
- }
- '';
-}
-
-sub qsearch {
- my( @stable, @record, @cache );
- my( @select, @extra_sql, @extra_param, @order_by, @addl_from );
- my @debug = ();
- my %union_options = ();
- if ( ref($_[0]) eq 'ARRAY' ) {
- my $optlist = shift;
- %union_options = @_;
- foreach my $href ( @$optlist ) {
- push @stable, ( $href->{'table'} or die "table name is required" );
- push @record, ( $href->{'hashref'} || {} );
- push @select, ( $href->{'select'} || '*' );
- push @extra_sql, ( $href->{'extra_sql'} || '' );
- push @extra_param, ( $href->{'extra_param'} || [] );
- push @order_by, ( $href->{'order_by'} || '' );
- push @cache, ( $href->{'cache_obj'} || '' );
- push @addl_from, ( $href->{'addl_from'} || '' );
- push @debug, ( $href->{'debug'} || '' );
- }
- die "at least one hashref is required" unless scalar(@stable);
- } elsif ( ref($_[0]) eq 'HASH' ) {
- my $opt = shift;
- $stable[0] = $opt->{'table'} or die "table name is required";
- $record[0] = $opt->{'hashref'} || {};
- $select[0] = $opt->{'select'} || '*';
- $extra_sql[0] = $opt->{'extra_sql'} || '';
- $extra_param[0] = $opt->{'extra_param'} || [];
- $order_by[0] = $opt->{'order_by'} || '';
- $cache[0] = $opt->{'cache_obj'} || '';
- $addl_from[0] = $opt->{'addl_from'} || '';
- $debug[0] = $opt->{'debug'} || '';
- } else {
- ( $stable[0],
- $record[0],
- $select[0],
- $extra_sql[0],
- $cache[0],
- $addl_from[0]
- ) = @_;
- $select[0] ||= '*';
- }
- my $cache = $cache[0];
-
- my @statement = ();
- my @value = ();
- my @bind_type = ();
- my $dbh = dbh;
- foreach my $stable ( @stable ) {
- #stop altering the caller's hashref
- my $record = { %{ shift(@record) || {} } };#and be liberal in receipt
- my $select = shift @select;
- my $extra_sql = shift @extra_sql;
- my $extra_param = shift @extra_param;
- my $order_by = shift @order_by;
- my $cache = shift @cache;
- my $addl_from = shift @addl_from;
- my $debug = shift @debug;
-
- #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table";
- #for jsearch
- $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable";
- $stable = $1;
-
- my $table = $cache ? $cache->table : $stable;
- my $dbdef_table = dbdef->table($table)
- or die "No schema for table $table found - ".
- "do you need to run freeside-upgrade?";
- my $pkey = $dbdef_table->primary_key;
-
- my @real_fields = grep exists($record->{$_}), real_fields($table);
- my @virtual_fields;
- if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
- @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields;
- } else {
- cluck "warning: FS::$table not loaded; virtual fields not searchable"
- unless $nowarn_classload;
- @virtual_fields = ();
- }
-
- my $statement .= "SELECT $select FROM $stable";
- $statement .= " $addl_from" if $addl_from;
- if ( @real_fields or @virtual_fields ) {
- $statement .= ' WHERE '. join(' AND ',
- get_real_fields($table, $record, \@real_fields) ,
- get_virtual_fields($table, $pkey, $record, \@virtual_fields),
- );
- }
-
- $statement .= " $extra_sql" if defined($extra_sql);
- $statement .= " $order_by" if defined($order_by);
-
- push @statement, $statement;
-
- warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
-
-
- foreach my $field (
- grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
- ) {
-
- my $value = $record->{$field};
- my $op = (ref($value) && $value->{op}) ? $value->{op} : '=';
- $value = $value->{'value'} if ref($value);
- my $type = dbdef->table($table)->column($field)->type;
-
- my $bind_type = _bind_type($type, $value);
-
- #if ( $DEBUG > 2 ) {
- # no strict 'refs';
- # %TYPE = map { &{"DBI::$_"}() => $_ } @{ $DBI::EXPORT_TAGS{sql_types} }
- # unless keys %TYPE;
- # warn " bind_param $bind (for field $field), $value, TYPE $TYPE{$TYPE}\n";
- #}
-
- push @value, $value;
- push @bind_type, $bind_type;
-
- }
-
- foreach my $param ( @$extra_param ) {
- my $bind_type = { TYPE => SQL_VARCHAR };
- my $value = $param;
- if ( ref($param) ) {
- $value = $param->[0];
- my $type = $param->[1];
- $bind_type = _bind_type($type, $value);
- }
- push @value, $value;
- push @bind_type, $bind_type;
- }
- }
-
- my $statement = join( ' ) UNION ( ', @statement );
- $statement = "( $statement )" if scalar(@statement) > 1;
- $statement .= " $union_options{order_by}" if $union_options{order_by};
-
- my $sth = $dbh->prepare($statement)
- or croak "$dbh->errstr doing $statement";
-
- my $bind = 1;
- foreach my $value ( @value ) {
- my $bind_type = shift @bind_type;
- $sth->bind_param($bind++, $value, $bind_type );
- }
-
-# $sth->execute( map $record->{$_},
-# grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
-# ) or croak "Error executing \"$statement\": ". $sth->errstr;
-
- $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
-
- # virtual fields and blessings are nonsense in a heterogeneous UNION, right?
- my $table = $stable[0];
- my $pkey = '';
- $table = '' if grep { $_ ne $table } @stable;
- $pkey = dbdef->table($table)->primary_key if $table;
-
- my @virtual_fields = ();
- if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
- @virtual_fields = "FS::$table"->virtual_fields;
- } else {
- cluck "warning: FS::$table not loaded; virtual fields not returned either"
- unless $nowarn_classload;
- @virtual_fields = ();
- }
-
- my %result;
- tie %result, "Tie::IxHash";
- my @stuff = @{ $sth->fetchall_arrayref( {} ) };
- if ( $pkey && scalar(@stuff) && $stuff[0]->{$pkey} ) {
- %result = map { $_->{$pkey}, $_ } @stuff;
- } else {
- @result{@stuff} = @stuff;
- }
-
- $sth->finish;
-
- if ( keys(%result) and @virtual_fields ) {
- $statement =
- "SELECT virtual_field.recnum, part_virtual_field.name, ".
- "virtual_field.value ".
- "FROM part_virtual_field JOIN virtual_field USING (vfieldpart) ".
- "WHERE part_virtual_field.dbtable = '$table' AND ".
- "virtual_field.recnum IN (".
- join(',', keys(%result)). ") AND part_virtual_field.name IN ('".
- join(q!', '!, @virtual_fields) . "')";
- warn "[debug]$me $statement\n" if $DEBUG > 1;
- $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement";
- $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
-
- foreach (@{ $sth->fetchall_arrayref({}) }) {
- my $recnum = $_->{recnum};
- my $name = $_->{name};
- my $value = $_->{value};
- if (exists($result{$recnum})) {
- $result{$recnum}->{$name} = $value;
- }
- }
- }
- my @return;
- if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
- if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
- #derivied class didn't override new method, so this optimization is safe
- if ( $cache ) {
- @return = map {
- new_or_cached( "FS::$table", { %{$_} }, $cache )
- } values(%result);
- } else {
- @return = map {
- new( "FS::$table", { %{$_} } )
- } values(%result);
- }
- } else {
- #okay, its been tested
- # warn "untested code (class FS::$table uses custom new method)";
- @return = map {
- eval 'FS::'. $table. '->new( { %{$_} } )';
- } values(%result);
- }
-
- # Check for encrypted fields and decrypt them.
- ## only in the local copy, not the cached object
- if ( $conf_encryption
- && eval 'defined(@FS::'. $table . '::encrypted_fields)' ) {
- foreach my $record (@return) {
- foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
- # Set it directly... This may cause a problem in the future...
- $record->setfield($field, $record->decrypt($record->getfield($field)));
- }
- }
- }
- } else {
- cluck "warning: FS::$table not loaded; returning FS::Record objects"
- unless $nowarn_classload;
- @return = map {
- FS::Record->new( $table, { %{$_} } );
- } values(%result);
- }
- return @return;
-}
-
-## makes this easier to read
-
-sub get_virtual_fields {
- my $table = shift;
- my $pkey = shift;
- my $record = shift;
- my $virtual_fields = shift;
-
- return
- ( map {
- my $op = '=';
- my $column = $_;
- if ( ref($record->{$_}) ) {
- $op = $record->{$_}{'op'} if $record->{$_}{'op'};
- if ( uc($op) eq 'ILIKE' ) {
- $op = 'LIKE';
- $record->{$_}{'value'} = lc($record->{$_}{'value'});
- $column = "LOWER($_)";
- }
- $record->{$_} = $record->{$_}{'value'};
- }
-
- # ... EXISTS ( SELECT name, value FROM part_virtual_field
- # JOIN virtual_field
- # ON part_virtual_field.vfieldpart = virtual_field.vfieldpart
- # WHERE recnum = svc_acct.svcnum
- # AND (name, value) = ('egad', 'brain') )
-
- my $value = $record->{$_};
-
- my $subq;
-
- $subq = ($value ? 'EXISTS ' : 'NOT EXISTS ') .
- "( SELECT part_virtual_field.name, virtual_field.value ".
- "FROM part_virtual_field JOIN virtual_field ".
- "ON part_virtual_field.vfieldpart = virtual_field.vfieldpart ".
- "WHERE virtual_field.recnum = ${table}.${pkey} ".
- "AND part_virtual_field.name = '${column}'".
- ($value ?
- " AND virtual_field.value ${op} '${value}'"
- : "") . ")";
- $subq;
-
- } @{ $virtual_fields } ) ;
-}
-
-sub get_real_fields {
- my $table = shift;
- my $record = shift;
- my $real_fields = shift;
-
- ## this huge map was previously inline, just broke it out to help read the qsearch method, should be optimized for readability
- return (
- map {
-
- my $op = '=';
- my $column = $_;
- my $type = dbdef->table($table)->column($column)->type;
- my $value = $record->{$column};
- $value = $value->{'value'} if ref($value);
- if ( ref($record->{$_}) ) {
- $op = $record->{$_}{'op'} if $record->{$_}{'op'};
- #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg';
- if ( uc($op) eq 'ILIKE' ) {
- $op = 'LIKE';
- $record->{$_}{'value'} = lc($record->{$_}{'value'});
- $column = "LOWER($_)";
- }
- $record->{$_} = $record->{$_}{'value'}
- }
-
- if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
- if ( $op eq '=' ) {
- if ( driver_name eq 'Pg' ) {
- if ( $type =~ /(int|numeric|real|float4|(big)?serial)/i ) {
- qq-( $column IS NULL )-;
- } else {
- qq-( $column IS NULL OR $column = '' )-;
- }
- } else {
- qq-( $column IS NULL OR $column = "" )-;
- }
- } elsif ( $op eq '!=' ) {
- if ( driver_name eq 'Pg' ) {
- if ( $type =~ /(int|numeric|real|float4|(big)?serial)/i ) {
- qq-( $column IS NOT NULL )-;
- } else {
- qq-( $column IS NOT NULL AND $column != '' )-;
- }
- } else {
- qq-( $column IS NOT NULL AND $column != "" )-;
- }
- } else {
- if ( driver_name eq 'Pg' ) {
- qq-( $column $op '' )-;
- } else {
- qq-( $column $op "" )-;
- }
- }
- #if this needs to be re-enabled, it needs to use a custom op like
- #"APPROX=" or something (better name?, not '=', to avoid affecting other
- # searches
- #} elsif ( $op eq 'APPROX=' && _is_fs_float( $type, $value ) ) {
- # ( "$column <= ?", "$column >= ?" );
- } else {
- "$column $op ?";
- }
- } @{ $real_fields } );
-}
-
-=item by_key PRIMARY_KEY_VALUE
-
-This is a class method that returns the record with the given primary key
-value. This method is only useful in FS::Record subclasses. For example:
-
- my $cust_main = FS::cust_main->by_key(1); # retrieve customer with custnum 1
-
-is equivalent to:
-
- my $cust_main = qsearchs('cust_main', { 'custnum' => 1 } );
-
-=cut
-
-sub by_key {
- my ($class, $pkey_value) = @_;
-
- my $table = $class->table
- or croak "No table for $class found";
-
- my $dbdef_table = dbdef->table($table)
- or die "No schema for table $table found - ".
- "do you need to create it or run dbdef-create?";
- my $pkey = $dbdef_table->primary_key
- or die "No primary key for table $table";
-
- return qsearchs($table, { $pkey => $pkey_value });
-}
-
-=item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY
-
-Experimental JOINed search method. Using this method, you can execute a
-single SELECT spanning multiple tables, and cache the results for subsequent
-method calls. Interface will almost definately change in an incompatible
-fashion.
-
-Arguments:
-
-=cut
-
-sub jsearch {
- my($table, $record, $select, $extra_sql, $ptable, $pkey ) = @_;
- my $cache = FS::SearchCache->new( $ptable, $pkey );
- my %saw;
- ( $cache,
- grep { !$saw{$_->getfield($pkey)}++ }
- qsearch($table, $record, $select, $extra_sql, $cache )
- );
-}
-
-=item qsearchs PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
-
-Same as qsearch, except that if more than one record matches, it B<carp>s but
-returns the first. If this happens, you either made a logic error in asking
-for a single item, or your data is corrupted.
-
-=cut
-
-sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
- my $table = $_[0];
- my(@result) = qsearch(@_);
- cluck "warning: Multiple records in scalar search ($table)"
- if scalar(@result) > 1;
- #should warn more vehemently if the search was on a primary key?
- scalar(@result) ? ($result[0]) : ();
-}
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item table
-
-Returns the table name.
-
-=cut
-
-sub table {
-# cluck "warning: FS::Record::table deprecated; supply one in subclass!";
- my $self = shift;
- $self -> {'Table'};
-}
-
-=item dbdef_table
-
-Returns the DBIx::DBSchema::Table object for the table.
-
-=cut
-
-sub dbdef_table {
- my($self)=@_;
- my($table)=$self->table;
- dbdef->table($table);
-}
-
-=item primary_key
-
-Returns the primary key for the table.
-
-=cut
-
-sub primary_key {
- my $self = shift;
- my $pkey = $self->dbdef_table->primary_key;
-}
-
-=item get, getfield COLUMN
-
-Returns the value of the column/field/key COLUMN.
-
-=cut
-
-sub get {
- my($self,$field) = @_;
- # to avoid "Use of unitialized value" errors
- if ( defined ( $self->{Hash}->{$field} ) ) {
- $self->{Hash}->{$field};
- } else {
- '';
- }
-}
-sub getfield {
- my $self = shift;
- $self->get(@_);
-}
-
-=item set, setfield COLUMN, VALUE
-
-Sets the value of the column/field/key COLUMN to VALUE. Returns VALUE.
-
-=cut
-
-sub set {
- my($self,$field,$value) = @_;
- $self->{'modified'} = 1;
- $self->{'Hash'}->{$field} = $value;
-}
-sub setfield {
- my $self = shift;
- $self->set(@_);
-}
-
-=item exists COLUMN
-
-Returns true if the column/field/key COLUMN exists.
-
-=cut
-
-sub exists {
- my($self,$field) = @_;
- exists($self->{Hash}->{$field});
-}
-
-=item AUTLOADED METHODS
-
-$record->column is a synonym for $record->get('column');
-
-$record->column('value') is a synonym for $record->set('column','value');
-
-=cut
-
-# readable/safe
-sub AUTOLOAD {
- my($self,$value)=@_;
- my($field)=$AUTOLOAD;
- $field =~ s/.*://;
- if ( defined($value) ) {
- confess "errant AUTOLOAD $field for $self (arg $value)"
- unless blessed($self) && $self->can('setfield');
- $self->setfield($field,$value);
- } else {
- confess "errant AUTOLOAD $field for $self (no args)"
- unless blessed($self) && $self->can('getfield');
- $self->getfield($field);
- }
-}
-
-# efficient
-#sub AUTOLOAD {
-# my $field = $AUTOLOAD;
-# $field =~ s/.*://;
-# if ( defined($_[1]) ) {
-# $_[0]->setfield($field, $_[1]);
-# } else {
-# $_[0]->getfield($field);
-# }
-#}
-
-=item hash
-
-Returns a list of the column/value pairs, usually for assigning to a new hash.
-
-To make a distinct duplicate of an FS::Record object, you can do:
-
- $new = new FS::Record ( $old->table, { $old->hash } );
-
-=cut
-
-sub hash {
- my($self) = @_;
- confess $self. ' -> hash: Hash attribute is undefined'
- unless defined($self->{'Hash'});
- %{ $self->{'Hash'} };
-}
-
-=item hashref
-
-Returns a reference to the column/value hash. This may be deprecated in the
-future; if there's a reason you can't just use the autoloaded or get/set
-methods, speak up.
-
-=cut
-
-sub hashref {
- my($self) = @_;
- $self->{'Hash'};
-}
-
-=item modified
-
-Returns true if any of this object's values have been modified with set (or via
-an autoloaded method). Doesn't yet recognize when you retreive a hashref and
-modify that.
-
-=cut
-
-sub modified {
- my $self = shift;
- $self->{'modified'};
-}
-
-=item select_for_update
-
-Selects this record with the SQL "FOR UPDATE" command. This can be useful as
-a mutex.
-
-=cut
-
-sub select_for_update {
- my $self = shift;
- my $primary_key = $self->primary_key;
- qsearchs( {
- 'select' => '*',
- 'table' => $self->table,
- 'hashref' => { $primary_key => $self->$primary_key() },
- 'extra_sql' => 'FOR UPDATE',
- } );
-}
-
-=item lock_table
-
-Locks this table with a database-driver specific lock method. This is used
-as a mutex in order to do a duplicate search.
-
-For PostgreSQL, does "LOCK TABLE tablename IN SHARE ROW EXCLUSIVE MODE".
-
-For MySQL, does a SELECT FOR UPDATE on the duplicate_lock table.
-
-Errors are fatal; no useful return value.
-
-Note: To use this method for new tables other than svc_acct and svc_phone,
-edit freeside-upgrade and add those tables to the duplicate_lock list.
-
-=cut
-
-sub lock_table {
- my $self = shift;
- my $table = $self->table;
-
- warn "$me locking $table table\n" if $DEBUG;
-
- if ( driver_name =~ /^Pg/i ) {
-
- dbh->do("LOCK TABLE $table IN SHARE ROW EXCLUSIVE MODE")
- or die dbh->errstr;
-
- } elsif ( driver_name =~ /^mysql/i ) {
-
- dbh->do("SELECT * FROM duplicate_lock
- WHERE lockname = '$table'
- FOR UPDATE"
- ) or die dbh->errstr;
-
- } else {
-
- die "unknown database ". driver_name. "; don't know how to lock table";
-
- }
-
- warn "$me acquired $table table lock\n" if $DEBUG;
-
-}
-
-=item insert
-
-Inserts this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my $self = shift;
- my $saved = {};
-
- warn "$self -> insert" if $DEBUG;
-
- my $error = $self->check;
- return $error if $error;
-
- #single-field unique keys are given a value if false
- #(like MySQL's AUTO_INCREMENT or Pg SERIAL)
- foreach ( $self->dbdef_table->unique_singles) {
- $self->unique($_) unless $self->getfield($_);
- }
-
- #and also the primary key, if the database isn't going to
- my $primary_key = $self->dbdef_table->primary_key;
- my $db_seq = 0;
- if ( $primary_key ) {
- my $col = $self->dbdef_table->column($primary_key);
-
- $db_seq =
- uc($col->type) =~ /^(BIG)?SERIAL\d?/
- || ( driver_name eq 'Pg'
- && defined($col->default)
- && $col->quoted_default =~ /^nextval\(/i
- )
- || ( driver_name eq 'mysql'
- && defined($col->local)
- && $col->local =~ /AUTO_INCREMENT/i
- );
- $self->unique($primary_key) unless $self->getfield($primary_key) || $db_seq;
- }
-
- my $table = $self->table;
-
- # Encrypt before the database
- if ( defined(eval '@FS::'. $table . '::encrypted_fields')
- && scalar( eval '@FS::'. $table . '::encrypted_fields')
- && $conf->exists('encryption')
- ) {
- foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
- $self->{'saved'} = $self->getfield($field);
- $self->setfield($field, $self->encrypt($self->getfield($field)));
- }
- }
-
- #false laziness w/delete
- my @real_fields =
- grep { defined($self->getfield($_)) && $self->getfield($_) ne "" }
- real_fields($table)
- ;
- my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields;
- #eslaf
-
- my $statement = "INSERT INTO $table ";
- if ( @real_fields ) {
- $statement .=
- "( ".
- join( ', ', @real_fields ).
- ") VALUES (".
- join( ', ', @values ).
- ")"
- ;
- } else {
- $statement .= 'DEFAULT VALUES';
- }
- warn "[debug]$me $statement\n" if $DEBUG > 1;
- my $sth = dbh->prepare($statement) or return dbh->errstr;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- $sth->execute or return $sth->errstr;
-
- # get inserted id from the database, if applicable & needed
- if ( $db_seq && ! $self->getfield($primary_key) ) {
- warn "[debug]$me retreiving sequence from database\n" if $DEBUG;
-
- my $insertid = '';
-
- if ( driver_name eq 'Pg' ) {
-
- #my $oid = $sth->{'pg_oid_status'};
- #my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?";
-
- my $default = $self->dbdef_table->column($primary_key)->quoted_default;
- unless ( $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i ) {
- dbh->rollback if $FS::UID::AutoCommit;
- return "can't parse $table.$primary_key default value".
- " for sequence name: $default";
- }
- my $sequence = $1;
-
- my $i_sql = "SELECT currval('$sequence')";
- my $i_sth = dbh->prepare($i_sql) or do {
- dbh->rollback if $FS::UID::AutoCommit;
- return dbh->errstr;
- };
- $i_sth->execute() or do { #$i_sth->execute($oid)
- dbh->rollback if $FS::UID::AutoCommit;
- return $i_sth->errstr;
- };
- $insertid = $i_sth->fetchrow_arrayref->[0];
-
- } elsif ( driver_name eq 'mysql' ) {
-
- $insertid = dbh->{'mysql_insertid'};
- # work around mysql_insertid being null some of the time, ala RT :/
- unless ( $insertid ) {
- warn "WARNING: DBD::mysql didn't return mysql_insertid; ".
- "using SELECT LAST_INSERT_ID();";
- my $i_sql = "SELECT LAST_INSERT_ID()";
- my $i_sth = dbh->prepare($i_sql) or do {
- dbh->rollback if $FS::UID::AutoCommit;
- return dbh->errstr;
- };
- $i_sth->execute or do {
- dbh->rollback if $FS::UID::AutoCommit;
- return $i_sth->errstr;
- };
- $insertid = $i_sth->fetchrow_arrayref->[0];
- }
-
- } else {
-
- dbh->rollback if $FS::UID::AutoCommit;
- return "don't know how to retreive inserted ids from ". driver_name.
- ", try using counterfiles (maybe run dbdef-create?)";
-
- }
-
- $self->setfield($primary_key, $insertid);
-
- }
-
- my @virtual_fields =
- grep defined($self->getfield($_)) && $self->getfield($_) ne "",
- $self->virtual_fields;
- if (@virtual_fields) {
- my %v_values = map { $_, $self->getfield($_) } @virtual_fields;
-
- my $vfieldpart = $self->vfieldpart_hashref;
-
- my $v_statement = "INSERT INTO virtual_field(recnum, vfieldpart, value) ".
- "VALUES (?, ?, ?)";
-
- my $v_sth = dbh->prepare($v_statement) or do {
- dbh->rollback if $FS::UID::AutoCommit;
- return dbh->errstr;
- };
-
- foreach (keys(%v_values)) {
- $v_sth->execute($self->getfield($primary_key),
- $vfieldpart->{$_},
- $v_values{$_})
- or do {
- dbh->rollback if $FS::UID::AutoCommit;
- return $v_sth->errstr;
- };
- }
- }
-
-
- my $h_sth;
- if ( defined dbdef->table('h_'. $table) ) {
- my $h_statement = $self->_h_statement('insert');
- warn "[debug]$me $h_statement\n" if $DEBUG > 2;
- $h_sth = dbh->prepare($h_statement) or do {
- dbh->rollback if $FS::UID::AutoCommit;
- return dbh->errstr;
- };
- } else {
- $h_sth = '';
- }
- $h_sth->execute or return $h_sth->errstr if $h_sth;
-
- dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
-
- # Now that it has been saved, reset the encrypted fields so that $new
- # can still be used.
- foreach my $field (keys %{$saved}) {
- $self->setfield($field, $saved->{$field});
- }
-
- '';
-}
-
-=item add
-
-Depriciated (use insert instead).
-
-=cut
-
-sub add {
- cluck "warning: FS::Record::add deprecated!";
- insert @_; #call method in this scope
-}
-
-=item delete
-
-Delete this record from the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub delete {
- my $self = shift;
-
- my $statement = "DELETE FROM ". $self->table. " WHERE ". join(' AND ',
- map {
- $self->getfield($_) eq ''
- #? "( $_ IS NULL OR $_ = \"\" )"
- ? ( driver_name eq 'Pg'
- ? "$_ IS NULL"
- : "( $_ IS NULL OR $_ = \"\" )"
- )
- : "$_ = ". _quote($self->getfield($_),$self->table,$_)
- } ( $self->dbdef_table->primary_key )
- ? ( $self->dbdef_table->primary_key)
- : real_fields($self->table)
- );
- warn "[debug]$me $statement\n" if $DEBUG > 1;
- my $sth = dbh->prepare($statement) or return dbh->errstr;
-
- my $h_sth;
- if ( defined dbdef->table('h_'. $self->table) ) {
- my $h_statement = $self->_h_statement('delete');
- warn "[debug]$me $h_statement\n" if $DEBUG > 2;
- $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
- } else {
- $h_sth = '';
- }
-
- my $primary_key = $self->dbdef_table->primary_key;
- my $v_sth;
- my @del_vfields;
- my $vfp = $self->vfieldpart_hashref;
- foreach($self->virtual_fields) {
- next if $self->getfield($_) eq '';
- unless(@del_vfields) {
- my $st = "DELETE FROM virtual_field WHERE recnum = ? AND vfieldpart = ?";
- $v_sth = dbh->prepare($st) or return dbh->errstr;
- }
- push @del_vfields, $_;
- }
-
- 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 $rc = $sth->execute or return $sth->errstr;
- #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
- $h_sth->execute or return $h_sth->errstr if $h_sth;
- $v_sth->execute($self->getfield($primary_key), $vfp->{$_})
- or return $v_sth->errstr
- foreach (@del_vfields);
-
- dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
-
- #no need to needlessly destoy the data either (causes problems actually)
- #undef $self; #no need to keep object!
-
- '';
-}
-
-=item del
-
-Depriciated (use delete instead).
-
-=cut
-
-sub del {
- cluck "warning: FS::Record::del deprecated!";
- &delete(@_); #call method in this scope
-}
-
-=item replace OLD_RECORD
-
-Replace 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);
-
- $old = $new->replace_old unless defined($old);
-
- warn "[debug]$me $new ->replace $old\n" if $DEBUG;
-
- if ( $new->can('replace_check') ) {
- my $error = $new->replace_check($old);
- return $error if $error;
- }
-
- return "Records not in same table!" unless $new->table eq $old->table;
-
- my $primary_key = $old->dbdef_table->primary_key;
- return "Can't change primary key $primary_key ".
- 'from '. $old->getfield($primary_key).
- ' to ' . $new->getfield($primary_key)
- if $primary_key
- && ( $old->getfield($primary_key) ne $new->getfield($primary_key) );
-
- my $error = $new->check;
- return $error if $error;
-
- # Encrypt for replace
- my $saved = {};
- if ( $conf->exists('encryption')
- && defined(eval '@FS::'. $new->table . '::encrypted_fields')
- && scalar( eval '@FS::'. $new->table . '::encrypted_fields')
- ) {
- foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
- $saved->{$field} = $new->getfield($field);
- $new->setfield($field, $new->encrypt($new->getfield($field)));
- }
- }
-
- #my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
- my %diff = map { ($new->getfield($_) ne $old->getfield($_))
- ? ($_, $new->getfield($_)) : () } $old->fields;
-
- unless (keys(%diff) || $no_update_diff ) {
- carp "[warning]$me $new -> replace $old: records identical"
- unless $nowarn_identical;
- return '';
- }
-
- my $statement = "UPDATE ". $old->table. " SET ". join(', ',
- map {
- "$_ = ". _quote($new->getfield($_),$old->table,$_)
- } real_fields($old->table)
- ). ' WHERE '.
- join(' AND ',
- map {
-
- if ( $old->getfield($_) eq '' ) {
-
- #false laziness w/qsearch
- if ( driver_name eq 'Pg' ) {
- my $type = $old->dbdef_table->column($_)->type;
- if ( $type =~ /(int|(big)?serial)/i ) {
- qq-( $_ IS NULL )-;
- } else {
- qq-( $_ IS NULL OR $_ = '' )-;
- }
- } else {
- qq-( $_ IS NULL OR $_ = "" )-;
- }
-
- } else {
- "$_ = ". _quote($old->getfield($_),$old->table,$_);
- }
-
- } ( $primary_key ? ( $primary_key ) : real_fields($old->table) )
- )
- ;
- warn "[debug]$me $statement\n" if $DEBUG > 1;
- my $sth = dbh->prepare($statement) or return dbh->errstr;
-
- my $h_old_sth;
- if ( defined dbdef->table('h_'. $old->table) ) {
- my $h_old_statement = $old->_h_statement('replace_old');
- warn "[debug]$me $h_old_statement\n" if $DEBUG > 2;
- $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr;
- } else {
- $h_old_sth = '';
- }
-
- my $h_new_sth;
- if ( defined dbdef->table('h_'. $new->table) ) {
- my $h_new_statement = $new->_h_statement('replace_new');
- warn "[debug]$me $h_new_statement\n" if $DEBUG > 2;
- $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
- } else {
- $h_new_sth = '';
- }
-
- # For virtual fields we have three cases with different SQL
- # statements: add, replace, delete
- my $v_add_sth;
- my $v_rep_sth;
- my $v_del_sth;
- my (@add_vfields, @rep_vfields, @del_vfields);
- my $vfp = $old->vfieldpart_hashref;
- foreach(grep { exists($diff{$_}) } $new->virtual_fields) {
- if($diff{$_} eq '') {
- # Delete
- unless(@del_vfields) {
- my $st = "DELETE FROM virtual_field WHERE recnum = ? ".
- "AND vfieldpart = ?";
- warn "[debug]$me $st\n" if $DEBUG > 2;
- $v_del_sth = dbh->prepare($st) or return dbh->errstr;
- }
- push @del_vfields, $_;
- } elsif($old->getfield($_) eq '') {
- # Add
- unless(@add_vfields) {
- my $st = "INSERT INTO virtual_field (value, recnum, vfieldpart) ".
- "VALUES (?, ?, ?)";
- warn "[debug]$me $st\n" if $DEBUG > 2;
- $v_add_sth = dbh->prepare($st) or return dbh->errstr;
- }
- push @add_vfields, $_;
- } else {
- # Replace
- unless(@rep_vfields) {
- my $st = "UPDATE virtual_field SET value = ? ".
- "WHERE recnum = ? AND vfieldpart = ?";
- warn "[debug]$me $st\n" if $DEBUG > 2;
- $v_rep_sth = dbh->prepare($st) or return dbh->errstr;
- }
- push @rep_vfields, $_;
- }
- }
-
- 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 $rc = $sth->execute or return $sth->errstr;
- #not portable #return "Record not found (or records identical)." if $rc eq "0E0";
- $h_old_sth->execute or return $h_old_sth->errstr if $h_old_sth;
- $h_new_sth->execute or return $h_new_sth->errstr if $h_new_sth;
-
- $v_del_sth->execute($old->getfield($primary_key),
- $vfp->{$_})
- or return $v_del_sth->errstr
- foreach(@del_vfields);
-
- $v_add_sth->execute($new->getfield($_),
- $old->getfield($primary_key),
- $vfp->{$_})
- or return $v_add_sth->errstr
- foreach(@add_vfields);
-
- $v_rep_sth->execute($new->getfield($_),
- $old->getfield($primary_key),
- $vfp->{$_})
- or return $v_rep_sth->errstr
- foreach(@rep_vfields);
-
- dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
-
- # Now that it has been saved, reset the encrypted fields so that $new
- # can still be used.
- foreach my $field (keys %{$saved}) {
- $new->setfield($field, $saved->{$field});
- }
-
- '';
-
-}
-
-sub replace_old {
- my( $self ) = shift;
- warn "[$me] replace called with no arguments; autoloading old record\n"
- if $DEBUG;
-
- my $primary_key = $self->dbdef_table->primary_key;
- if ( $primary_key ) {
- $self->by_key( $self->$primary_key() ) #this is what's returned
- or croak "can't find ". $self->table. ".$primary_key ".
- $self->$primary_key();
- } else {
- croak $self->table. " has no primary key; pass old record as argument";
- }
-
-}
-
-=item rep
-
-Depriciated (use replace instead).
-
-=cut
-
-sub rep {
- cluck "warning: FS::Record::rep deprecated!";
- replace @_; #call method in this scope
-}
-
-=item check
-
-Checks virtual fields (using check_blocks). Subclasses should still provide
-a check method to validate real fields, foreign keys, etc., and call this
-method via $self->SUPER::check.
-
-(FIXME: Should this method try to make sure that it I<is> being called from
-a subclass's check method, to keep the current semantics as far as possible?)
-
-=cut
-
-sub check {
- #confess "FS::Record::check not implemented; supply one in subclass!";
- my $self = shift;
-
- foreach my $field ($self->virtual_fields) {
- for ($self->getfield($field)) {
- # See notes on check_block in FS::part_virtual_field.
- eval $self->pvf($field)->check_block;
- if ( $@ ) {
- #this is bad, probably want to follow the stack backtrace up and see
- #wtf happened
- my $err = "Fatal error checking $field for $self";
- cluck "$err: $@";
- return "$err (see log for backtrace): $@";
-
- }
- $self->setfield($field, $_);
- }
- }
- '';
-}
-
-=item process_batch_import JOB OPTIONS_HASHREF PARAMS
-
-Processes a batch import as a queued JSRPC job
-
-JOB is an FS::queue entry.
-
-OPTIONS_HASHREF can have the following keys:
-
-=over 4
-
-=item table
-
-Table name (required).
-
-=item params
-
-Listref of field names for static fields. They will be given values from the
-PARAMS hashref and passed as a "params" hashref to batch_import.
-
-=item formats
-
-Formats hashref. Keys are field names, values are listrefs that define the
-format.
-
-Each listref value can be a column name or a code reference. Coderefs are run
-with the row object, data and a FS::Conf object as the three parameters.
-For example, this coderef does the same thing as using the "columnname" string:
-
- sub {
- my( $record, $data, $conf ) = @_;
- $record->columnname( $data );
- },
-
-Coderefs are run after all "column name" fields are assigned.
-
-=item format_types
-
-Optional format hashref of types. Keys are field names, values are "csv",
-"xls" or "fixedlength". Overrides automatic determination of file type
-from extension.
-
-=item format_headers
-
-Optional format hashref of header lines. Keys are field names, values are 0
-for no header, 1 to ignore the first line, or to higher numbers to ignore that
-number of lines.
-
-=item format_sep_chars
-
-Optional format hashref of CSV sep_chars. Keys are field names, values are the
-CSV separation character.
-
-=item format_fixedlenth_formats
-
-Optional format hashref of fixed length format defintiions. Keys are field
-names, values Parse::FixedLength listrefs of field definitions.
-
-=item default_csv
-
-Set true to default to CSV file type if the filename does not contain a
-recognizable ".csv" or ".xls" extension (and type is not pre-specified by
-format_types).
-
-=back
-
-PARAMS is a base64-encoded Storable string containing the POSTed data as
-a hash ref. It normally contains at least one field, "uploaded files",
-generated by /elements/file-upload.html and containing the list of uploaded
-files. Currently only supports a single file named "file".
-
-=cut
-
-use Storable qw(thaw);
-use Data::Dumper;
-use MIME::Base64;
-sub process_batch_import {
- my($job, $opt) = ( shift, shift );
-
- my $table = $opt->{table};
- my @pass_params = $opt->{params} ? @{ $opt->{params} } : ();
- my %formats = %{ $opt->{formats} };
-
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- my $files = $param->{'uploaded_files'}
- or die "No files provided.\n";
-
- my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
-
- my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
- my $file = $dir. $files{'file'};
-
- my %iopt = (
- #class-static
- table => $table,
- formats => \%formats,
- format_types => $opt->{format_types},
- format_headers => $opt->{format_headers},
- format_sep_chars => $opt->{format_sep_chars},
- format_fixedlength_formats => $opt->{format_fixedlength_formats},
- format_xml_formats => $opt->{format_xml_formats},
- format_row_callbacks => $opt->{format_row_callbacks},
- #per-import
- job => $job,
- file => $file,
- #type => $type,
- format => $param->{format},
- params => { map { $_ => $param->{$_} } @pass_params },
- #?
- default_csv => $opt->{default_csv},
- );
-
- if ( $opt->{'batch_namecol'} ) {
- $iopt{'batch_namevalue'} = $param->{ $opt->{'batch_namecol'} };
- $iopt{$_} = $opt->{$_} foreach qw( batch_keycol batch_table batch_namecol );
- }
-
- my $error = FS::Record::batch_import( \%iopt );
-
- unlink $file;
-
- die "$error\n" if $error;
-}
-
-=item batch_import PARAM_HASHREF
-
-Class method for batch imports. Available params:
-
-=over 4
-
-=item table
-
-=item format - usual way to specify import, with this format string selecting data from the formats and format_* info hashes
-
-=item formats
-
-=item format_types
-
-=item format_headers
-
-=item format_sep_chars
-
-=item format_fixedlength_formats
-
-=item format_row_callbacks
-
-=item fields - Alternate way to specify import, specifying import fields directly as a listref
-
-=item postinsert_callback
-
-=item params
-
-=item job
-
-FS::queue object, will be updated with progress
-
-=item file
-
-=item type
-
-csv, xls, fixedlength, xml
-
-=item empty_ok
-
-=back
-
-=cut
-
-sub batch_import {
- my $param = shift;
-
- warn "$me batch_import call with params: \n". Dumper($param)
- if $DEBUG;
-
- my $table = $param->{table};
-
- my $job = $param->{job};
- my $file = $param->{file};
- my $params = $param->{params} || {};
-
- my( $type, $header, $sep_char, $fixedlength_format,
- $xml_format, $row_callback, @fields );
- my $postinsert_callback = '';
- if ( $param->{'format'} ) {
-
- my $format = $param->{'format'};
- my $formats = $param->{formats};
- die "unknown format $format" unless exists $formats->{ $format };
-
- $type = $param->{'format_types'}
- ? $param->{'format_types'}{ $format }
- : $param->{type} || 'csv';
-
-
- $header = $param->{'format_headers'}
- ? $param->{'format_headers'}{ $param->{'format'} }
- : 0;
-
- $sep_char = $param->{'format_sep_chars'}
- ? $param->{'format_sep_chars'}{ $param->{'format'} }
- : ',';
-
- $fixedlength_format =
- $param->{'format_fixedlength_formats'}
- ? $param->{'format_fixedlength_formats'}{ $param->{'format'} }
- : '';
-
- $xml_format =
- $param->{'format_xml_formats'}
- ? $param->{'format_xml_formats'}{ $param->{'format'} }
- : '';
-
- $row_callback =
- $param->{'format_row_callbacks'}
- ? $param->{'format_row_callbacks'}{ $param->{'format'} }
- : '';
-
- @fields = @{ $formats->{ $format } };
-
- } elsif ( $param->{'fields'} ) {
-
- $type = ''; #infer from filename
- $header = 0;
- $sep_char = ',';
- $fixedlength_format = '';
- $row_callback = '';
- @fields = @{ $param->{'fields'} };
-
- $postinsert_callback = $param->{'postinsert_callback'}
- if $param->{'postinsert_callback'}
-
- } else {
- die "neither format nor fields specified";
- }
-
- #my $file = $param->{file};
-
- unless ( $type ) {
- if ( $file =~ /\.(\w+)$/i ) {
- $type = lc($1);
- } else {
- #or error out???
- warn "can't parse file type from filename $file; defaulting to CSV";
- $type = 'csv';
- }
- $type = 'csv'
- if $param->{'default_csv'} && $type ne 'xls';
- }
-
-
- my $row = 0;
- my $count;
- my $parser;
- my @buffer = ();
- if ( $type eq 'csv' || $type eq 'fixedlength' ) {
-
- if ( $type eq 'csv' ) {
-
- my %attr = ();
- $attr{sep_char} = $sep_char if $sep_char;
- $parser = new Text::CSV_XS \%attr;
-
- } elsif ( $type eq 'fixedlength' ) {
-
- eval "use Parse::FixedLength;";
- die $@ if $@;
- $parser = new Parse::FixedLength $fixedlength_format;
-
- }
- else {
- die "Unknown file type $type\n";
- }
-
- @buffer = split(/\r?\n/, slurp($file) );
- splice(@buffer, 0, ($header || 0) );
- $count = scalar(@buffer);
-
- } elsif ( $type eq 'xls' ) {
-
- eval "use Spreadsheet::ParseExcel;";
- die $@ if $@;
-
- eval "use DateTime::Format::Excel;";
- #for now, just let the error be thrown if it is used, since only CDR
- # formats bill_west and troop use it, not other excel-parsing things
- #die $@ if $@;
-
- my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($file);
-
- $parser = $excel->{Worksheet}[0]; #first sheet
-
- $count = $parser->{MaxRow} || $parser->{MinRow};
- $count++;
-
- $row = $header || 0;
- } elsif ( $type eq 'xml' ) {
- # FS::pay_batch
- eval "use XML::Simple;";
- die $@ if $@;
- my $xmlrow = $xml_format->{'xmlrow'};
- $parser = $xml_format->{'xmlkeys'};
- die 'no xmlkeys specified' unless ref $parser eq 'ARRAY';
- my $data = XML::Simple::XMLin(
- $file,
- 'SuppressEmpty' => '', #sets empty values to ''
- 'KeepRoot' => 1,
- );
- my $rows = $data;
- $rows = $rows->{$_} foreach @$xmlrow;
- $rows = [ $rows ] if ref($rows) ne 'ARRAY';
- $count = @buffer = @$rows;
- } else {
- die "Unknown file type $type\n";
- }
-
- #my $columns;
-
- 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 $params = $param->{params} || {};
- if ( $param->{'batch_namecol'} && $param->{'batch_namevalue'} ) {
- my $batch_col = $param->{'batch_keycol'};
-
- my $batch_class = 'FS::'. $param->{'batch_table'};
- my $batch = $batch_class->new({
- $param->{'batch_namecol'} => $param->{'batch_namevalue'}
- });
- my $error = $batch->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert batch record: $error";
- }
- #primary key via dbdef? (so the column names don't have to match)
- my $batch_value = $batch->get( $param->{'batch_keycol'} );
-
- $params->{ $batch_col } = $batch_value;
- }
-
- #my $job = $param->{job};
- my $line;
- my $imported = 0;
- my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
- while (1) {
-
- my @columns = ();
- if ( $type eq 'csv' ) {
-
- last unless scalar(@buffer);
- $line = shift(@buffer);
-
- next if $line =~ /^\s*$/; #skip empty lines
-
- $line = &{$row_callback}($line) if $row_callback;
-
- $parser->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $parser->error_input();
- };
- @columns = $parser->fields();
-
- } elsif ( $type eq 'fixedlength' ) {
-
- @columns = $parser->parse($line);
-
- } elsif ( $type eq 'xls' ) {
-
- last if $row > ($parser->{MaxRow} || $parser->{MinRow})
- || ! $parser->{Cells}[$row];
-
- my @row = @{ $parser->{Cells}[$row] };
- @columns = map $_->{Val}, @row;
-
- #my $z = 'A';
- #warn $z++. ": $_\n" for @columns;
-
- } elsif ( $type eq 'xml' ) {
- # $parser = [ 'Column0Key', 'Column1Key' ... ]
- last unless scalar(@buffer);
- my $row = shift @buffer;
- @columns = @{ $row }{ @$parser };
- } else {
- die "Unknown file type $type\n";
- }
-
- my @later = ();
- my %hash = %$params;
-
- foreach my $field ( @fields ) {
-
- my $value = shift @columns;
-
- if ( ref($field) eq 'CODE' ) {
- #&{$field}(\%hash, $value);
- push @later, $field, $value;
- } else {
- #??? $hash{$field} = $value if length($value);
- $hash{$field} = $value if defined($value) && length($value);
- }
-
- }
-
- #my $table = $param->{table};
- my $class = "FS::$table";
-
- my $record = $class->new( \%hash );
-
- my $param = {};
- while ( scalar(@later) ) {
- my $sub = shift @later;
- my $data = shift @later;
- eval {
- &{$sub}($record, $data, $conf, $param); # $record->&{$sub}($data, $conf)
- };
- if ( $@ ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert record". ( $line ? " for $line" : '' ). ": $@";
- }
- last if exists( $param->{skiprow} );
- }
- next if exists( $param->{skiprow} );
-
- my $error = $record->insert;
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert record". ( $line ? " for $line" : '' ). ": $error";
- }
-
- $row++;
- $imported++;
-
- if ( $postinsert_callback ) {
- my $error = &{$postinsert_callback}($record, $param);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "postinsert_callback error". ( $line ? " for $line" : '' ).
- ": $error";
- }
- }
-
- if ( $job && time - $min_sec > $last ) { #progress bar
- $job->update_statustext( int(100 * $imported / $count) );
- $last = time;
- }
-
- }
-
- unless ( $imported || $param->{empty_ok} ) {
- $dbh->rollback if $oldAutoCommit;
- return "Empty file!";
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
-
- ''; #no error
-
-}
-
-sub _h_statement {
- my( $self, $action, $time ) = @_;
-
- $time ||= time;
-
- my %nohistory = map { $_=>1 } $self->nohistory_fields;
-
- my @fields =
- grep { defined($self->get($_)) && $self->get($_) ne "" && ! $nohistory{$_} }
- real_fields($self->table);
- ;
-
- # If we're encrypting then don't store the payinfo in the history
- if ( $conf && $conf->exists('encryption') ) {
- @fields = grep { $_ ne 'payinfo' } @fields;
- }
-
- my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
-
- "INSERT INTO h_". $self->table. " ( ".
- join(', ', qw(history_date history_user history_action), @fields ).
- ") VALUES (".
- join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values).
- ")"
- ;
-}
-
-=item unique COLUMN
-
-B<Warning>: External use is B<deprecated>.
-
-Replaces COLUMN in record with a unique number, using counters in the
-filesystem. Used by the B<insert> method on single-field unique columns
-(see L<DBIx::DBSchema::Table>) and also as a fallback for primary keys
-that aren't SERIAL (Pg) or AUTO_INCREMENT (mysql).
-
-Returns the new value.
-
-=cut
-
-sub unique {
- my($self,$field) = @_;
- my($table)=$self->table;
-
- croak "Unique called on field $field, but it is ",
- $self->getfield($field),
- ", not null!"
- if $self->getfield($field);
-
- #warn "table $table is tainted" if is_tainted($table);
- #warn "field $field is tainted" if is_tainted($field);
-
- my($counter) = new File::CounterFile "$table.$field",0;
-# hack for web demo
-# getotaker() =~ /^([\w\-]{1,16})$/ or die "Illegal CGI REMOTE_USER!";
-# my($user)=$1;
-# my($counter) = new File::CounterFile "$user/$table.$field",0;
-# endhack
-
- my $index = $counter->inc;
- $index = $counter->inc while qsearchs($table, { $field=>$index } );
-
- $index =~ /^(\d*)$/;
- $index=$1;
-
- $self->setfield($field,$index);
-
-}
-
-=item ut_float COLUMN
-
-Check/untaint floating point numeric data: 1.1, 1, 1.1e10, 1e10. May not be
-null. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_float {
- my($self,$field)=@_ ;
- ($self->getfield($field) =~ /^\s*(\d+\.\d+)\s*$/ ||
- $self->getfield($field) =~ /^\s*(\d+)\s*$/ ||
- $self->getfield($field) =~ /^\s*(\d+\.\d+e\d+)\s*$/ ||
- $self->getfield($field) =~ /^\s*(\d+e\d+)\s*$/)
- or return "Illegal or empty (float) $field: ". $self->getfield($field);
- $self->setfield($field,$1);
- '';
-}
-=item ut_floatn COLUMN
-
-Check/untaint floating point numeric data: 1.1, 1, 1.1e10, 1e10. May be
-null. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-#false laziness w/ut_ipn
-sub ut_floatn {
- my( $self, $field ) = @_;
- if ( $self->getfield($field) =~ /^()$/ ) {
- $self->setfield($field,'');
- '';
- } else {
- $self->ut_float($field);
- }
-}
-
-=item ut_sfloat COLUMN
-
-Check/untaint signed floating point numeric data: 1.1, 1, 1.1e10, 1e10.
-May not be null. If there is an error, returns the error, otherwise returns
-false.
-
-=cut
-
-sub ut_sfloat {
- my($self,$field)=@_ ;
- ($self->getfield($field) =~ /^\s*(-?\d+\.\d+)\s*$/ ||
- $self->getfield($field) =~ /^\s*(-?\d+)\s*$/ ||
- $self->getfield($field) =~ /^\s*(-?\d+\.\d+[eE]-?\d+)\s*$/ ||
- $self->getfield($field) =~ /^\s*(-?\d+[eE]-?\d+)\s*$/)
- or return "Illegal or empty (float) $field: ". $self->getfield($field);
- $self->setfield($field,$1);
- '';
-}
-=item ut_sfloatn COLUMN
-
-Check/untaint signed floating point numeric data: 1.1, 1, 1.1e10, 1e10. May be
-null. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_sfloatn {
- my( $self, $field ) = @_;
- if ( $self->getfield($field) =~ /^()$/ ) {
- $self->setfield($field,'');
- '';
- } else {
- $self->ut_sfloat($field);
- }
-}
-
-=item ut_snumber COLUMN
-
-Check/untaint signed numeric data (whole numbers). If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub ut_snumber {
- my($self, $field) = @_;
- $self->getfield($field) =~ /^\s*(-?)\s*(\d+)\s*$/
- or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
- $self->setfield($field, "$1$2");
- '';
-}
-
-=item ut_snumbern COLUMN
-
-Check/untaint signed numeric data (whole numbers). If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub ut_snumbern {
- my($self, $field) = @_;
- $self->getfield($field) =~ /^\s*(-?)\s*(\d*)\s*$/
- or return "Illegal (numeric) $field: ". $self->getfield($field);
- if ($1) {
- return "Illegal (numeric) $field: ". $self->getfield($field)
- unless $2;
- }
- $self->setfield($field, "$1$2");
- '';
-}
-
-=item ut_number COLUMN
-
-Check/untaint simple numeric data (whole numbers). May not be null. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_number {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^\s*(\d+)\s*$/
- or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_numbern COLUMN
-
-Check/untaint simple numeric data (whole numbers). May be null. If there is
-an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_numbern {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^\s*(\d*)\s*$/
- or return "Illegal (numeric) $field: ". $self->getfield($field);
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_money COLUMN
-
-Check/untaint monetary numbers. May be negative. Set to 0 if null. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_money {
- my($self,$field)=@_;
- $self->setfield($field, 0) if $self->getfield($field) eq '';
- $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{2})?\s*$/
- or return "Illegal (money) $field: ". $self->getfield($field);
- #$self->setfield($field, "$1$2$3" || 0);
- $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0);
- '';
-}
-
-=item ut_moneyn COLUMN
-
-Check/untaint monetary numbers. May be negative. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_moneyn {
- my($self,$field)=@_;
- if ($self->getfield($field) eq '') {
- $self->setfield($field, '');
- return '';
- }
- $self->ut_money($field);
-}
-
-=item ut_text COLUMN
-
-Check/untaint text. Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ] < >
-May not be null. If there is an error, returns the error, otherwise returns
-false.
-
-=cut
-
-sub ut_text {
- my($self,$field)=@_;
- #warn "msgcat ". \&msgcat. "\n";
- #warn "notexist ". \&notexist. "\n";
- #warn "AUTOLOAD ". \&AUTOLOAD. "\n";
- $self->getfield($field)
- =~ /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>]+)$/
- or return gettext('illegal_or_empty_text'). " $field: ".
- $self->getfield($field);
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_textn COLUMN
-
-Check/untaint text. Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
-May be null. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_textn {
- my($self,$field)=@_;
- return $self->setfield($field, '') if $self->getfield($field) =~ /^$/;
- $self->ut_text($field);
-}
-
-=item ut_alpha COLUMN
-
-Check/untaint alphanumeric strings (no spaces). May not be null. If there is
-an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_alpha {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\w+)$/
- or return "Illegal or empty (alphanumeric) $field: ".
- $self->getfield($field);
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_alphan COLUMN
-
-Check/untaint alphanumeric strings (no spaces). May be null. If there is an
-error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_alphan {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\w*)$/
- or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
- $self->setfield($field,$1);
- '';
-}
-
-=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
-there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_alpha_lower {
- my($self,$field)=@_;
- $self->getfield($field) =~ /[[:upper:]]/
- and return "Uppercase characters are not permitted in $field";
- $self->ut_alpha($field);
-}
-
-=item ut_phonen COLUMN [ COUNTRY ]
-
-Check/untaint phone numbers. May be null. If there is an error, returns
-the error, otherwise returns false.
-
-Takes an optional two-letter ISO country code; without it or with unsupported
-countries, ut_phonen simply calls ut_alphan.
-
-=cut
-
-sub ut_phonen {
- my( $self, $field, $country ) = @_;
- return $self->ut_alphan($field) unless defined $country;
- my $phonen = $self->getfield($field);
- if ( $phonen eq '' ) {
- $self->setfield($field,'');
- } elsif ( $country eq 'US' || $country eq 'CA' ) {
- $phonen =~ s/\D//g;
- $phonen = $conf->config('cust_main-default_areacode').$phonen
- if length($phonen)==7 && $conf->config('cust_main-default_areacode');
- $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
- or return gettext('illegal_phone'). " $field: ". $self->getfield($field);
- $phonen = "$1-$2-$3";
- $phonen .= " x$4" if $4;
- $self->setfield($field,$phonen);
- } else {
- warn "warning: don't know how to check phone numbers for country $country";
- return $self->ut_textn($field);
- }
- '';
-}
-
-=item ut_hex COLUMN
-
-Check/untaint hexadecimal values.
-
-=cut
-
-sub ut_hex {
- my($self, $field) = @_;
- $self->getfield($field) =~ /^([\da-fA-F]+)$/
- or return "Illegal (hex) $field: ". $self->getfield($field);
- $self->setfield($field, uc($1));
- '';
-}
-
-=item ut_hexn COLUMN
-
-Check/untaint hexadecimal values. May be null.
-
-=cut
-
-sub ut_hexn {
- my($self, $field) = @_;
- $self->getfield($field) =~ /^([\da-fA-F]*)$/
- or return "Illegal (hex) $field: ". $self->getfield($field);
- $self->setfield($field, uc($1));
- '';
-}
-=item ut_ip COLUMN
-
-Check/untaint ip addresses. IPv4 only for now, though ::1 is auto-translated
-to 127.0.0.1.
-
-=cut
-
-sub ut_ip {
- my( $self, $field ) = @_;
- $self->setfield($field, '127.0.0.1') if $self->getfield($field) eq '::1';
- $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
- or return "Illegal (IP address) $field: ". $self->getfield($field);
- for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; }
- $self->setfield($field, "$1.$2.$3.$4");
- '';
-}
-
-=item ut_ipn COLUMN
-
-Check/untaint ip addresses. IPv4 only for now, though ::1 is auto-translated
-to 127.0.0.1. May be null.
-
-=cut
-
-sub ut_ipn {
- my( $self, $field ) = @_;
- if ( $self->getfield($field) =~ /^()$/ ) {
- $self->setfield($field,'');
- '';
- } else {
- $self->ut_ip($field);
- }
-}
-
-=item ut_coord COLUMN [ LOWER [ UPPER ] ]
-
-Check/untaint coordinates.
-Accepts the following forms:
-DDD.DDDDD
--DDD.DDDDD
-DDD MM.MMM
--DDD MM.MMM
-DDD MM SS
--DDD MM SS
-DDD MM MMM
--DDD MM MMM
-
-The "DDD MM SS" and "DDD MM MMM" are potentially ambiguous.
-The latter form (that is, the MMM are thousands of minutes) is
-assumed if the "MMM" is exactly three digits or two digits > 59.
-
-To be safe, just use the DDD.DDDDD form.
-
-If LOWER or UPPER are specified, then the coordinate is checked
-for lower and upper bounds, respectively.
-
-=cut
-
-sub ut_coord {
-
- my ($self, $field) = (shift, shift);
-
- my $lower = shift if scalar(@_);
- my $upper = shift if scalar(@_);
- my $coord = $self->getfield($field);
- my $neg = $coord =~ s/^(-)//;
-
- my ($d, $m, $s) = (0, 0, 0);
-
- if (
- (($d) = ($coord =~ /^(\s*\d{1,3}(?:\.\d+)?)\s*$/)) ||
- (($d, $m) = ($coord =~ /^(\s*\d{1,3})\s+(\d{1,2}(?:\.\d+))\s*$/)) ||
- (($d, $m, $s) = ($coord =~ /^(\s*\d{1,3})\s+(\d{1,2})\s+(\d{1,3})\s*$/))
- ) {
- $s = (((($s =~ /^\d{3}$/) or $s > 59) ? ($s / 1000) : ($s / 60)) / 60);
- $m = $m / 60;
- if ($m > 59) {
- return "Invalid (coordinate with minutes > 59) $field: "
- . $self->getfield($field);
- }
-
- $coord = ($neg ? -1 : 1) * sprintf('%.8f', $d + $m + $s);
-
- if (defined($lower) and ($coord < $lower)) {
- return "Invalid (coordinate < $lower) $field: "
- . $self->getfield($field);;
- }
-
- if (defined($upper) and ($coord > $upper)) {
- return "Invalid (coordinate > $upper) $field: "
- . $self->getfield($field);;
- }
-
- $self->setfield($field, $coord);
- return '';
- }
-
- return "Invalid (coordinate) $field: " . $self->getfield($field);
-
-}
-
-=item ut_coordn COLUMN [ LOWER [ UPPER ] ]
-
-Same as ut_coord, except optionally null.
-
-=cut
-
-sub ut_coordn {
-
- my ($self, $field) = (shift, shift);
-
- if ($self->getfield($field) =~ /^$/) {
- return '';
- } else {
- return $self->ut_coord($field, @_);
- }
-
-}
-
-
-=item ut_domain COLUMN
-
-Check/untaint host and domain names.
-
-=cut
-
-sub ut_domain {
- my( $self, $field ) = @_;
- #$self->getfield($field) =~/^(\w+\.)*\w+$/
- $self->getfield($field) =~/^(([\w\-]+\.)*\w+)$/
- or return "Illegal (domain) $field: ". $self->getfield($field);
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_name COLUMN
-
-Check/untaint proper names; allows alphanumerics, spaces and the following
-punctuation: , . - '
-
-May not be null.
-
-=cut
-
-sub ut_name {
- my( $self, $field ) = @_;
-# warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n";
- #$self->getfield($field) =~ /^([\w \,\.\-\']+)$/
- $self->getfield($field) =~ /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \,\.\-\']+)$/
- or return gettext('illegal_name'). " $field: ". $self->getfield($field);
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_zip COLUMN
-
-Check/untaint zip codes.
-
-=cut
-
-my @zip_reqd_countries = qw( AU CA US ); #CA, US implicit...
-
-sub ut_zip {
- my( $self, $field, $country ) = @_;
-
- if ( $country eq 'US' ) {
-
- $self->getfield($field) =~ /^\s*(\d{5}(\-\d{4})?)\s*$/
- or return gettext('illegal_zip'). " $field for country $country: ".
- $self->getfield($field);
- $self->setfield($field, $1);
-
- } elsif ( $country eq 'CA' ) {
-
- $self->getfield($field) =~ /^\s*([A-Z]\d[A-Z])\s*(\d[A-Z]\d)\s*$/i
- or return gettext('illegal_zip'). " $field for country $country: ".
- $self->getfield($field);
- $self->setfield($field, "$1 $2");
-
- } else {
-
- if ( $self->getfield($field) =~ /^\s*$/
- && ( !$country || ! grep { $_ eq $country } @zip_reqd_countries )
- )
- {
- $self->setfield($field,'');
- } else {
- $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
- or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
- $self->setfield($field,$1);
- }
-
- }
-
- '';
-}
-
-=item ut_country COLUMN
-
-Check/untaint country codes. Country names are changed to codes, if possible -
-see L<Locale::Country>.
-
-=cut
-
-sub ut_country {
- my( $self, $field ) = @_;
- unless ( $self->getfield($field) =~ /^(\w\w)$/ ) {
- if ( $self->getfield($field) =~ /^([\w \,\.\(\)\']+)$/
- && country2code($1) ) {
- $self->setfield($field,uc(country2code($1)));
- }
- }
- $self->getfield($field) =~ /^(\w\w)$/
- or return "Illegal (country) $field: ". $self->getfield($field);
- $self->setfield($field,uc($1));
- '';
-}
-
-=item ut_anything COLUMN
-
-Untaints arbitrary data. Be careful.
-
-=cut
-
-sub ut_anything {
- my( $self, $field ) = @_;
- $self->getfield($field) =~ /^(.*)$/s
- or return "Illegal $field: ". $self->getfield($field);
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_enum COLUMN CHOICES_ARRAYREF
-
-Check/untaint a column, supplying all possible choices, like the "enum" type.
-
-=cut
-
-sub ut_enum {
- my( $self, $field, $choices ) = @_;
- foreach my $choice ( @$choices ) {
- if ( $self->getfield($field) eq $choice ) {
- $self->setfield($field, $choice);
- return '';
- }
- }
- return "Illegal (enum) field $field: ". $self->getfield($field);
-}
-
-=item ut_enumn COLUMN CHOICES_ARRAYREF
-
-Like ut_enum, except the null value is also allowed.
-
-=cut
-
-sub ut_enumn {
- my( $self, $field, $choices ) = @_;
- $self->getfield($field)
- ? $self->ut_enum($field, $choices)
- : '';
-}
-
-
-=item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN
-
-Check/untaint a foreign column key. Call a regular ut_ method (like ut_number)
-on the column first.
-
-=cut
-
-sub ut_foreign_key {
- my( $self, $field, $table, $foreign ) = @_;
- return '' if $no_check_foreign;
- qsearchs($table, { $foreign => $self->getfield($field) })
- or return "Can't find ". $self->table. ".$field ". $self->getfield($field).
- " in $table.$foreign";
- '';
-}
-
-=item ut_foreign_keyn COLUMN FOREIGN_TABLE FOREIGN_COLUMN
-
-Like ut_foreign_key, except the null value is also allowed.
-
-=cut
-
-sub ut_foreign_keyn {
- my( $self, $field, $table, $foreign ) = @_;
- $self->getfield($field)
- ? $self->ut_foreign_key($field, $table, $foreign)
- : '';
-}
-
-=item ut_agentnum_acl COLUMN [ NULL_RIGHT | NULL_RIGHT_LISTREF ]
-
-Checks this column as an agentnum, taking into account the current users's
-ACLs. NULL_RIGHT or NULL_RIGHT_LISTREF, if specified, indicates the access
-right or rights allowing no agentnum.
-
-=cut
-
-sub ut_agentnum_acl {
- my( $self, $field ) = (shift, shift);
- my $null_acl = scalar(@_) ? shift : [];
- $null_acl = [ $null_acl ] unless ref($null_acl);
-
- my $error = $self->ut_foreign_keyn($field, 'agent', 'agentnum');
- return "Illegal agentnum: $error" if $error;
-
- my $curuser = $FS::CurrentUser::CurrentUser;
-
- if ( $self->$field() ) {
-
- return "Access denied"
- unless $curuser->agentnum($self->$field());
-
- } else {
-
- return "Access denied"
- unless grep $curuser->access_right($_), @$null_acl;
-
- }
-
- '';
-
-}
-
-=item virtual_fields [ TABLE ]
-
-Returns a list of virtual fields defined for the table. This should not
-be exported, and should only be called as an instance or class method.
-
-=cut
-
-sub virtual_fields {
- my $self = shift;
- my $table;
- $table = $self->table or confess "virtual_fields called on non-table";
-
- confess "Unknown table $table" unless dbdef->table($table);
-
- return () unless dbdef->table('part_virtual_field');
-
- unless ( $virtual_fields_cache{$table} ) {
- my $query = 'SELECT name from part_virtual_field ' .
- "WHERE dbtable = '$table'";
- my $dbh = dbh;
- my $result = $dbh->selectcol_arrayref($query);
- confess "Error executing virtual fields query: $query: ". $dbh->errstr
- if $dbh->err;
- $virtual_fields_cache{$table} = $result;
- }
-
- @{$virtual_fields_cache{$table}};
-
-}
-
-
-=item fields [ TABLE ]
-
-This is a wrapper for real_fields and virtual_fields. Code that called
-fields before should probably continue to call fields.
-
-=cut
-
-sub fields {
- my $something = shift;
- my $table;
- if($something->isa('FS::Record')) {
- $table = $something->table;
- } else {
- $table = $something;
- $something = "FS::$table";
- }
- return (real_fields($table), $something->virtual_fields());
-}
-
-=item pvf FIELD_NAME
-
-Returns the FS::part_virtual_field object corresponding to a field in the
-record (specified by FIELD_NAME).
-
-=cut
-
-sub pvf {
- my ($self, $name) = (shift, shift);
-
- if(grep /^$name$/, $self->virtual_fields) {
- return qsearchs('part_virtual_field', { dbtable => $self->table,
- name => $name } );
- }
- ''
-}
-
-=item vfieldpart_hashref TABLE
-
-Returns a hashref of virtual field names and vfieldparts applicable to the given
-TABLE.
-
-=cut
-
-sub vfieldpart_hashref {
- my $self = shift;
- my $table = $self->table;
-
- return {} unless dbdef->table('part_virtual_field');
-
- my $dbh = dbh;
- my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ".
- "dbtable = '$table'";
- my $sth = $dbh->prepare($statement);
- $sth->execute or croak "Execution of '$statement' failed: ".$dbh->errstr;
- return { map { $_->{name}, $_->{vfieldpart} }
- @{$sth->fetchall_arrayref({})} };
-
-}
-
-=item encrypt($value)
-
-Encrypts the credit card using a combination of PK to encrypt and uuencode to armour.
-
-Returns the encrypted string.
-
-You should generally not have to worry about calling this, as the system handles this for you.
-
-=cut
-
-sub encrypt {
- my ($self, $value) = @_;
- my $encrypted;
-
- if ($conf->exists('encryption')) {
- if ($self->is_encrypted($value)) {
- # Return the original value if it isn't plaintext.
- $encrypted = $value;
- } else {
- $self->loadRSA;
- if (ref($rsa_encrypt) =~ /::RSA/) { # We Can Encrypt
- # RSA doesn't like the empty string so let's pack it up
- # The database doesn't like the RSA data so uuencode it
- my $length = length($value)+1;
- $encrypted = pack("u*",$rsa_encrypt->encrypt(pack("Z$length",$value)));
- } else {
- die ("You can't encrypt w/o a valid RSA engine - Check your installation or disable encryption");
- }
- }
- }
- return $encrypted;
-}
-
-=item is_encrypted($value)
-
-Checks to see if the string is encrypted and returns true or false (1/0) to indicate it's status.
-
-=cut
-
-
-sub is_encrypted {
- my ($self, $value) = @_;
- # Possible Bug - Some work may be required here....
-
- if ($value =~ /^M/ && length($value) > 80) {
- return 1;
- } else {
- return 0;
- }
-}
-
-=item decrypt($value)
-
-Uses the private key to decrypt the string. Returns the decryoted string or undef on failure.
-
-You should generally not have to worry about calling this, as the system handles this for you.
-
-=cut
-
-sub decrypt {
- my ($self,$value) = @_;
- my $decrypted = $value; # Will return the original value if it isn't encrypted or can't be decrypted.
- if ($conf->exists('encryption') && $self->is_encrypted($value)) {
- $self->loadRSA;
- if (ref($rsa_decrypt) =~ /::RSA/) {
- my $encrypted = unpack ("u*", $value);
- $decrypted = unpack("Z*", eval{$rsa_decrypt->decrypt($encrypted)});
- if ($@) {warn "Decryption Failed"};
- }
- }
- return $decrypted;
-}
-
-sub loadRSA {
- my $self = shift;
- #Initialize the Module
- $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
-
- if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') {
- $rsa_module = $conf->config('encryptionmodule');
- }
-
- if (!$rsa_loaded) {
- eval ("require $rsa_module"); # No need to import the namespace
- $rsa_loaded++;
- }
- # Initialize Encryption
- if ($conf->exists('encryptionpublickey') && $conf->config('encryptionpublickey') ne '') {
- my $public_key = join("\n",$conf->config('encryptionpublickey'));
- $rsa_encrypt = $rsa_module->new_public_key($public_key);
- }
-
- # Intitalize Decryption
- if ($conf->exists('encryptionprivatekey') && $conf->config('encryptionprivatekey') ne '') {
- my $private_key = join("\n",$conf->config('encryptionprivatekey'));
- $rsa_decrypt = $rsa_module->new_private_key($private_key);
- }
-}
-
-=item h_search ACTION
-
-Given an ACTION, either "insert", or "delete", returns the appropriate history
-record corresponding to this record, if any.
-
-=cut
-
-sub h_search {
- my( $self, $action ) = @_;
-
- my $table = $self->table;
- $table =~ s/^h_//;
-
- my $primary_key = dbdef->table($table)->primary_key;
-
- qsearchs({
- 'table' => "h_$table",
- 'hashref' => { $primary_key => $self->$primary_key(),
- 'history_action' => $action,
- },
- });
-
-}
-
-=item h_date ACTION
-
-Given an ACTION, either "insert", or "delete", returns the timestamp of the
-appropriate history record corresponding to this record, if any.
-
-=cut
-
-sub h_date {
- my($self, $action) = @_;
- my $h = $self->h_search($action);
- $h ? $h->history_date : '';
-}
-
-=item scalar_sql SQL [ PLACEHOLDER, ... ]
-
-A class or object method. Executes the sql statement represented by SQL and
-returns a scalar representing the result: the first column of the first row.
-
-Dies on bogus SQL. Returns an empty string if no row is returned.
-
-Typically used for statments which return a single value such as "SELECT
-COUNT(*) FROM table WHERE something" OR "SELECT column FROM table WHERE key = ?"
-
-=cut
-
-sub scalar_sql {
- my($self, $sql) = (shift, shift);
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute(@_)
- or die "Unexpected error executing statement $sql: ". $sth->errstr;
- my $scalar = $sth->fetchrow_arrayref->[0];
- defined($scalar) ? $scalar : '';
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item real_fields [ TABLE ]
-
-Returns a list of the real columns in the specified table. Called only by
-fields() and other subroutines elsewhere in FS::Record.
-
-=cut
-
-sub real_fields {
- my $table = shift;
-
- my($table_obj) = dbdef->table($table);
- confess "Unknown table $table" unless $table_obj;
- $table_obj->columns;
-}
-
-=item _quote VALUE, TABLE, COLUMN
-
-This is an internal function used to construct SQL statements. It returns
-VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
-type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.
-
-=cut
-
-sub _quote {
- my($value, $table, $column) = @_;
- my $column_obj = dbdef->table($table)->column($column);
- my $column_type = $column_obj->type;
- my $nullable = $column_obj->null;
-
- warn " $table.$column: $value ($column_type".
- ( $nullable ? ' NULL' : ' NOT NULL' ).
- ")\n" if $DEBUG > 2;
-
- if ( $value eq '' && $nullable ) {
- 'NULL';
- } elsif ( $value eq '' && $column_type =~ /^(int|numeric)/ ) {
- cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
- "using 0 instead";
- 0;
- } elsif ( $value =~ /^\d+(\.\d+)?$/ &&
- ! $column_type =~ /(char|binary|text)$/i ) {
- $value;
- } elsif (( $column_type =~ /^bytea$/i || $column_type =~ /(blob|varbinary)/i )
- && driver_name eq 'Pg'
- )
- {
- no strict 'subs';
-# dbh->quote($value, { pg_type => PG_BYTEA() }); # doesn't work right
- # Pg binary string quoting: convert each character to 3-digit octal prefixed with \\,
- # single-quote the whole mess, and put an "E" in front.
- return ("E'" . join('', map { sprintf('\\\\%03o', ord($_)) } split(//, $value) ) . "'");
- } else {
- dbh->quote($value);
- }
-}
-
-=item hfields TABLE
-
-This is deprecated. Don't use it.
-
-It returns a hash-type list with the fields of this record's table set true.
-
-=cut
-
-sub hfields {
- carp "warning: hfields is deprecated";
- my($table)=@_;
- my(%hash);
- foreach (fields($table)) {
- $hash{$_}=1;
- }
- \%hash;
-}
-
-sub _dump {
- my($self)=@_;
- join("\n", map {
- "$_: ". $self->getfield($_). "|"
- } (fields($self->table)) );
-}
-
-sub DESTROY { return; }
-
-#sub DESTROY {
-# my $self = shift;
-# #use Carp qw(cluck);
-# #cluck "DESTROYING $self";
-# warn "DESTROYING $self";
-#}
-
-#sub is_tainted {
-# return ! eval { join('',@_), kill 0; 1; };
-# }
-
-=item str2time_sql [ DRIVER_NAME ]
-
-Returns a function to convert to unix time based on database type, such as
-"EXTRACT( EPOCH FROM" for Pg or "UNIX_TIMESTAMP(" for mysql. See
-the str2time_sql_closing method to return a closing string rather than just
-using a closing parenthesis as previously suggested.
-
-You can pass an optional driver name such as "Pg", "mysql" or
-$dbh->{Driver}->{Name} to return a function for that database instead of
-the current database.
-
-=cut
-
-sub str2time_sql {
- my $driver = shift || driver_name;
-
- return 'UNIX_TIMESTAMP(' if $driver =~ /^mysql/i;
- return 'EXTRACT( EPOCH FROM ' if $driver =~ /^Pg/i;
-
- warn "warning: unknown database type $driver; guessing how to convert ".
- "dates to UNIX timestamps";
- return 'EXTRACT(EPOCH FROM ';
-
-}
-
-=item str2time_sql_closing [ DRIVER_NAME ]
-
-Returns the closing suffix of a function to convert to unix time based on
-database type, such as ")::integer" for Pg or ")" for mysql.
-
-You can pass an optional driver name such as "Pg", "mysql" or
-$dbh->{Driver}->{Name} to return a function for that database instead of
-the current database.
-
-=cut
-
-sub str2time_sql_closing {
- my $driver = shift || driver_name;
-
- return ' )::INTEGER ' if $driver =~ /^Pg/i;
- return ' ) ';
-}
-
-=item regexp_sql [ DRIVER_NAME ]
-
-Returns the operator to do a regular expression comparison based on database
-type, such as '~' for Pg or 'REGEXP' for mysql.
-
-You can pass an optional driver name such as "Pg", "mysql" or
-$dbh->{Driver}->{Name} to return a function for that database instead of
-the current database.
-
-=cut
-
-sub regexp_sql {
- my $driver = shift || driver_name;
-
- return '~' if $driver =~ /^Pg/i;
- return 'REGEXP' if $driver =~ /^mysql/i;
-
- die "don't know how to use regular expressions in ". driver_name." databases";
-
-}
-
-=item not_regexp_sql [ DRIVER_NAME ]
-
-Returns the operator to do a regular expression negation based on database
-type, such as '!~' for Pg or 'NOT REGEXP' for mysql.
-
-You can pass an optional driver name such as "Pg", "mysql" or
-$dbh->{Driver}->{Name} to return a function for that database instead of
-the current database.
-
-=cut
-
-sub not_regexp_sql {
- my $driver = shift || driver_name;
-
- return '!~' if $driver =~ /^Pg/i;
- return 'NOT REGEXP' if $driver =~ /^mysql/i;
-
- die "don't know how to use regular expressions in ". driver_name." databases";
-
-}
-
-=back
-
-=head1 BUGS
-
-This module should probably be renamed, since much of the functionality is
-of general use. It is not completely unlike Adapter::DBI (see below).
-
-Exported qsearch and qsearchs should be deprecated in favor of method calls
-(against an FS::Record object like the old search and searchs that qsearch
-and qsearchs were on top of.)
-
-The whole fields / hfields mess should be removed.
-
-The various WHERE clauses should be subroutined.
-
-table string should be deprecated in favor of DBIx::DBSchema::Table.
-
-No doubt we could benefit from a Tied hash. Documenting how exists / defined
-true maps to the database (and WHERE clauses) would also help.
-
-The ut_ methods should ask the dbdef for a default length.
-
-ut_sqltype (like ut_varchar) should all be defined
-
-A fallback check method should be provided which uses the dbdef.
-
-The ut_money method assumes money has two decimal digits.
-
-The Pg money kludge in the new method only strips `$'.
-
-The ut_phonen method only checks US-style phone numbers.
-
-The _quote function should probably use ut_float instead of a regex.
-
-All the subroutines probably should be methods, here or elsewhere.
-
-Probably should borrow/use some dbdef methods where appropriate (like sub
-fields)
-
-As of 1.14, DBI fetchall_hashref( {} ) doesn't set fetchrow_hashref NAME_lc,
-or allow it to be set. Working around it is ugly any way around - DBI should
-be fixed. (only affects RDBMS which return uppercase column names)
-
-ut_zip should take an optional country like ut_phone.
-
-=head1 SEE ALSO
-
-L<DBIx::DBSchema>, L<FS::UID>, L<DBI>
-
-Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.
-
-http://poop.sf.net/
-
-=cut
-
-1;
-
diff --git a/FS/FS/Report.pm b/FS/FS/Report.pm
deleted file mode 100644
index 181fea2..0000000
--- a/FS/FS/Report.pm
+++ /dev/null
@@ -1,46 +0,0 @@
-package FS::Report;
-
-use strict;
-
-=head1 NAME
-
-FS::Report - Report data objects
-
-=head1 SYNOPSIS
-
- #see the more speicific report objects, currently only FS::Report::Table
-
-=head1 DESCRIPTION
-
-See the more specific report objects, currently only FS::Report::Table
-
-=head1 METHODS
-
-=over 4
-
-=item new [ OPTION => VALUE ... ]
-
-Constructor. Takes a list of options and their values.
-
-=cut
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = @_ ? ( ref($_[0]) ? shift : { @_ } ) : {};
- bless( $self, $class );
-}
-
-=back
-
-=head1 BUGS
-
-Documentation.
-
-=head1 SEE ALSO
-
-L<FS::Report::Table>, reports in the web interface.
-
-=cut
-
-1;
diff --git a/FS/FS/Report/FCC_477.pm b/FS/FS/Report/FCC_477.pm
deleted file mode 100644
index 518b9f0..0000000
--- a/FS/FS/Report/FCC_477.pm
+++ /dev/null
@@ -1,90 +0,0 @@
-package FS::Report::FCC_477;
-
-use strict;
-use vars qw( @ISA @upload @download @technology @part2aoption @part2boption );
-use FS::Report;
-
-@ISA = qw( FS::Report );
-
-=head1 NAME
-
-FS::Report::FCC_477 - Routines for FCC Form 477 reports
-
-=head1 SYNOPSIS
-
-=head1 BUGS
-
-Documentation.
-
-=head1 SEE ALSO
-
-=cut
-
-@upload = qw(
- <200kpbs
- 200-768kpbs
- 768kbps-1.5mbps
- 1.5-3mpbs
- 3-6mbps
- 6-10mbps
- 10-25mbps
- 25-100mbps
- >100bmps
-);
-
-@download = qw(
- 200-768kpbs
- 768kbps-1.5mbps
- 1.5-3mpbs
- 3-6mbps
- 6-10mbps
- 10-25mbps
- 25-100mbps
- >100bmps
-);
-
-@technology = (
- 'Asymetric xDSL',
- 'Symetric xDSL',
- 'Other Wireline',
- 'Cable Modem',
- 'Optical Carrier',
- 'Satellite',
- 'Terrestrial Fixed Wireless',
- 'Terrestrial Mobile Wireless',
- 'Electric Power Line',
- 'Other Technology',
-);
-
-@part2aoption = (
- 'LD carrier',
- 'owned loops',
- 'unswitched UNE loops',
- 'UNE-P',
- 'UNE-P replacement',
- 'FTTP',
- 'coax',
- 'wireless',
-);
-
-@part2boption = (
- 'nomadic',
- 'copper',
- 'FTTP',
- 'coax',
- 'wireless',
- 'other broadband',
-);
-
-sub parse_technology_option {
- my $cgi = shift;
- my @result = ();
- my $i = 0;
- for (my $i = 0; $i < scalar(@technology); $i++) {
- my $value = $cgi->param("part1_technology_option_$i"); #lame
- push @result, $value =~ /^\d+$/ ? $value : 0;
- }
- return (@result);
-}
-
-1;
diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm
deleted file mode 100644
index 9f636fa..0000000
--- a/FS/FS/Report/Table.pm
+++ /dev/null
@@ -1,27 +0,0 @@
-package FS::Report::Table;
-
-use strict;
-use vars qw( @ISA );
-use FS::Report;
-
-@ISA = qw( FS::Report );
-
-=head1 NAME
-
-FS::Report::Table - Tables of report data
-
-=head1 SYNOPSIS
-
-See the more specific report objects, currently only FS::Report::Table::Monthly
-
-=head1 BUGS
-
-Documentation.
-
-=head1 SEE ALSO
-
-L<FS::Report::Table::Monthly>, reports in the web interface.
-
-=cut
-
-1;
diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm
deleted file mode 100644
index 376ee5c..0000000
--- a/FS/FS/Report/Table/Monthly.pm
+++ /dev/null
@@ -1,590 +0,0 @@
-package FS::Report::Table::Monthly;
-
-use strict;
-use vars qw( @ISA $DEBUG );
-use Time::Local;
-use FS::UID qw( dbh );
-use FS::Report::Table;
-use FS::CurrentUser;
-
-@ISA = qw( FS::Report::Table );
-$DEBUG = 0; # turning this on will trace all SQL statements, VERY noisy
-
-=head1 NAME
-
-FS::Report::Table::Monthly - Tables of report data, indexed monthly
-
-=head1 SYNOPSIS
-
- use FS::Report::Table::Monthly;
-
- my $report = new FS::Report::Table::Monthly (
- 'items' => [ 'invoiced', 'netsales', 'credits', 'receipts', ],
- 'start_month' => 4,
- 'start_year' => 2000,
- 'end_month' => 4,
- 'end_year' => 2020,
- #opt
- 'agentnum' => 54
- 'params' => [ [ 'paramsfor', 'item_one' ], [ 'item', 'two' ] ], # ...
- 'remove_empty' => 1, #collapse empty rows, default 0
- 'item_labels' => [ ], #useful with remove_empty
- );
-
- my $data = $report->data;
-
-=head1 METHODS
-
-=over 4
-
-=item data
-
-Returns a hashref of data (!! describe)
-
-=cut
-
-sub data {
- my $self = shift;
-
- #use Data::Dumper;
- #warn Dumper($self);
-
- my $smonth = $self->{'start_month'};
- my $syear = $self->{'start_year'};
- my $emonth = $self->{'end_month'};
- my $eyear = $self->{'end_year'};
- my $agentnum = $self->{'agentnum'};
-
- my %data;
-
- while ( $syear < $eyear || ( $syear == $eyear && $smonth < $emonth+1 ) ) {
-
- push @{$data{label}}, "$smonth/$syear";
-
- my $speriod = timelocal(0,0,0,1,$smonth-1,$syear);
- push @{$data{speriod}}, $speriod;
- if ( ++$smonth == 13 ) { $syear++; $smonth=1; }
- my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear);
- push @{$data{eperiod}}, $eperiod;
-
- my $col = 0;
- my @row = ();
- foreach my $item ( @{$self->{'items'}} ) {
- my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: ();
- my $value = $self->$item($speriod, $eperiod, $agentnum, @param);
- #push @{$data{$item}}, $value;
- push @{$data{data}->[$col++]}, $value;
- }
-
- }
-
- #these need to get generalized, sheesh
- $data{'items'} = $self->{'items'};
- $data{'item_labels'} = $self->{'item_labels'} || $self->{'items'};
- $data{'colors'} = $self->{'colors'};
- $data{'links'} = $self->{'links'} || [];
-
- #use Data::Dumper;
- #warn Dumper(\%data);
-
- if ( $self->{'remove_empty'} ) {
-
- #warn "removing empty rows\n";
-
- my $col = 0;
- #these need to get generalized, sheesh
- my @newitems = ();
- my @newlabels = ();
- my @newdata = ();
- my @newcolors = ();
- my @newlinks = ();
- foreach my $item ( @{$self->{'items'}} ) {
-
- if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) {
- push @newitems, $data{'items'}->[$col];
- push @newlabels, $data{'item_labels'}->[$col];
- push @newdata, $data{'data'}->[$col];
- push @newcolors, $data{'colors'}->[$col];
- push @newlinks, $data{'links'}->[$col];
- }
-
- $col++;
- }
-
- $data{'items'} = \@newitems;
- $data{'item_labels'} = \@newlabels;
- $data{'data'} = \@newdata;
- $data{'colors'} = \@newcolors;
- $data{'links'} = \@newlinks;
-
- }
-
- #use Data::Dumper;
- #warn Dumper(\%data);
-
- \%data;
-
-}
-
-sub invoiced { #invoiced
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
-
- $self->scalar_sql("
- SELECT SUM(charged)
- FROM cust_bill
- LEFT JOIN cust_main USING ( custnum )
- WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
- );
-
-}
-
-sub netsales { #net sales
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
-
- $self->invoiced($speriod,$eperiod,$agentnum)
- - $self->netcredits($speriod,$eperiod,$agentnum);
-}
-
-#deferred revenue
-
-sub cashflow {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
-
- $self->payments($speriod, $eperiod, $agentnum)
- - $self->refunds( $speriod, $eperiod, $agentnum);
-}
-
-sub netcashflow {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
-
- $self->receipts($speriod, $eperiod, $agentnum)
- - $self->netrefunds( $speriod, $eperiod, $agentnum);
-}
-
-sub payments {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $self->scalar_sql("
- SELECT SUM(paid)
- FROM cust_pay
- LEFT JOIN cust_main USING ( custnum )
- WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
- );
-}
-
-sub credits {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $self->scalar_sql("
- SELECT SUM(amount)
- FROM cust_credit
- LEFT JOIN cust_main USING ( custnum )
- WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
- );
-}
-
-sub refunds {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $self->scalar_sql("
- SELECT SUM(refund)
- FROM cust_refund
- LEFT JOIN cust_main USING ( custnum )
- WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum)
- );
-}
-
-sub netcredits {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $self->scalar_sql("
- SELECT SUM(cust_credit_bill.amount)
- FROM cust_credit_bill
- LEFT JOIN cust_bill USING ( invnum )
- LEFT JOIN cust_main USING ( custnum )
- WHERE ". $self->in_time_period_and_agent( $speriod,
- $eperiod,
- $agentnum,
- 'cust_bill._date'
- )
- );
-}
-
-sub receipts { #net payments
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $self->scalar_sql("
- SELECT SUM(cust_bill_pay.amount)
- FROM cust_bill_pay
- LEFT JOIN cust_bill USING ( invnum )
- LEFT JOIN cust_main USING ( custnum )
- WHERE ". $self->in_time_period_and_agent( $speriod,
- $eperiod,
- $agentnum,
- 'cust_bill._date'
- )
- );
-}
-
-sub netrefunds {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $self->scalar_sql("
- SELECT SUM(cust_credit_refund.amount)
- FROM cust_credit_refund
- LEFT JOIN cust_credit USING ( crednum )
- LEFT JOIN cust_main USING ( custnum )
- WHERE ". $self->in_time_period_and_agent( $speriod,
- $eperiod,
- $agentnum,
- 'cust_credit._date'
- )
- );
-}
-
-#these should be auto-generated or $AUTOLOADed or something
-sub invoiced_12mo {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $speriod = $self->_subtract_11mo($speriod);
- $self->invoiced($speriod, $eperiod, $agentnum);
-}
-
-sub netsales_12mo {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $speriod = $self->_subtract_11mo($speriod);
- $self->netsales($speriod, $eperiod, $agentnum);
-}
-
-sub receipts_12mo {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $speriod = $self->_subtract_11mo($speriod);
- $self->receipts($speriod, $eperiod, $agentnum);
-}
-
-sub payments_12mo {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $speriod = $self->_subtract_11mo($speriod);
- $self->payments($speriod, $eperiod, $agentnum);
-}
-
-sub credits_12mo {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $speriod = $self->_subtract_11mo($speriod);
- $self->credits($speriod, $eperiod, $agentnum);
-}
-
-sub netcredits_12mo {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $speriod = $self->_subtract_11mo($speriod);
- $self->netcredits($speriod, $eperiod, $agentnum);
-}
-
-sub cashflow_12mo {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $speriod = $self->_subtract_11mo($speriod);
- $self->cashflow($speriod, $eperiod, $agentnum);
-}
-
-sub netcashflow_12mo {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $speriod = $self->_subtract_11mo($speriod);
- $self->cashflow($speriod, $eperiod, $agentnum);
-}
-
-sub refunds_12mo {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $speriod = $self->_subtract_11mo($speriod);
- $self->refunds($speriod, $eperiod, $agentnum);
-}
-
-sub netrefunds_12mo {
- my( $self, $speriod, $eperiod, $agentnum ) = @_;
- $speriod = $self->_subtract_11mo($speriod);
- $self->netrefunds($speriod, $eperiod, $agentnum);
-}
-
-
-#not being too bad with the false laziness
-use Time::Local qw(timelocal);
-sub _subtract_11mo {
- my($self, $time) = @_;
- my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
- $mon -= 11;
- if ( $mon < 0 ) { $mon+=12; $year--; }
- timelocal($sec,$min,$hour,$mday,$mon,$year);
-}
-
-sub cust_pkg_setup_cost {
- my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
- my $where = '';
- my $comparison = '';
- if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
- if ( $1 == 0 ) {
- $comparison = 'IS NULL';
- }
- else {
- $comparison = "= $1";
- }
- $where = "AND part_pkg.classnum $comparison";
- }
- $agentnum ||= $opt{'agentnum'};
-
- my $total_sql = " SELECT SUM(part_pkg.setup_cost) ";
- $total_sql .= " FROM cust_pkg
- LEFT JOIN cust_main USING ( custnum )
- LEFT JOIN part_pkg USING ( pkgpart )
- WHERE pkgnum != 0
- $where
- AND ".$self->in_time_period_and_agent(
- $speriod, $eperiod, $agentnum, 'cust_pkg.setup');
- return $self->scalar_sql($total_sql);
-}
-
-sub cust_pkg_recur_cost {
- my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
- my $where = '';
- my $comparison = '';
- if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
- if ( $1 == 0 ) {
- $comparison = 'IS NULL';
- }
- else {
- $comparison = "= $1";
- }
- $where = " AND part_pkg.classnum $comparison";
- }
- $agentnum ||= $opt{'agentnum'};
- # duplication of in_time_period_and_agent
- # because we do it a little differently here
- $where .= " AND cust_main.agentnum = $agentnum" if $agentnum;
- $where .= " AND ".
- $FS::CurrentUser::CurrentUser->agentnums_sql('table' => 'cust_main');
-
- my $total_sql = " SELECT SUM(part_pkg.recur_cost) ";
- $total_sql .= " FROM cust_pkg
- LEFT JOIN cust_main USING ( custnum )
- LEFT JOIN part_pkg USING ( pkgpart )
- WHERE pkgnum != 0
- $where
- AND cust_pkg.setup < $eperiod
- AND (cust_pkg.cancel > $speriod OR cust_pkg.cancel IS NULL)
- ";
- return $self->scalar_sql($total_sql);
-}
-
-sub cust_bill_pkg {
- my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
-
- my $where = '';
- my $comparison = '';
- if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
- if ( $1 == 0 ) {
- $comparison = "IS NULL";
- } else {
- $comparison = "= $1";
- }
-
- if ( $opt{'use_override'} ) {
- $where = "AND (
- part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
- override.classnum $comparison AND pkgpart_override IS NOT NULL
- )";
- } else {
- $where = "AND part_pkg.classnum $comparison";
- }
- }
-
- $agentnum ||= $opt{'agentnum'};
-
- my $total_sql =
- " SELECT COALESCE( SUM(cust_bill_pkg.setup + cust_bill_pkg.recur), 0 ) ";
-
- $total_sql .=
- " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
- if $opt{average_per_cust_pkg};
-
- $total_sql .=
- " FROM cust_bill_pkg
- LEFT JOIN cust_bill USING ( invnum )
- LEFT JOIN cust_main USING ( custnum )
- LEFT JOIN cust_pkg USING ( pkgnum )
- LEFT JOIN part_pkg USING ( pkgpart )
- LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
- WHERE pkgnum != 0
- $where
- AND ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
-
- if ($opt{use_usage} && $opt{use_usage} eq 'recurring') {
- my $total = $self->scalar_sql($total_sql);
- my $usage = cust_bill_pkg_detail(@_); #$speriod, $eperiod, $agentnum, %opt
- return $total-$usage;
- } elsif ($opt{use_usage} && $opt{use_usage} eq 'usage') {
- return cust_bill_pkg_detail(@_); #$speriod, $eperiod, $agentnum, %opt
- } else {
- return $self->scalar_sql($total_sql);
- }
-}
-
-sub cust_bill_pkg_detail {
- my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
-
- my @where = ( "cust_bill_pkg.pkgnum != 0" );
- my $comparison = '';
- if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
- if ( $1 == 0 ) {
- $comparison = "IS NULL";
- } else {
- $comparison = "= $1";
- }
-
- if ( $opt{'use_override'} ) {
- push @where, "(
- part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
- override.classnum $comparison AND pkgpart_override IS NOT NULL
- )";
- } else {
- push @where, "part_pkg.classnum $comparison";
- }
- }
-
- if ( $opt{'usageclass'} =~ /^(\d+)$/ ) {
- if ( $1 == 0 ) {
- $comparison = "IS NULL";
- } else {
- $comparison = "= $1";
- }
-
- push @where, "cust_bill_pkg_detail.classnum $comparison";
- }
-
- $agentnum ||= $opt{'agentnum'};
-
- my $where = join( ' AND ', @where );
-
- my $total_sql = " SELECT SUM(amount) ";
-
- $total_sql .=
- " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
- if $opt{average_per_cust_pkg};
-
- $total_sql .=
- " FROM cust_bill_pkg_detail
- LEFT JOIN cust_bill_pkg USING ( billpkgnum )
- LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum
- LEFT JOIN cust_main USING ( custnum )
- LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum
- LEFT JOIN part_pkg USING ( pkgpart )
- LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
- WHERE $where
- AND ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
-
- $self->scalar_sql($total_sql);
-
-}
-
-sub cust_bill_pkg_discount {
- my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_;
-
- #my $where = '';
- #my $comparison = '';
- #if ( $opt{'classnum'} =~ /^(\d+)$/ ) {
- # if ( $1 == 0 ) {
- # $comparison = "IS NULL";
- # } else {
- # $comparison = "= $1";
- # }
- #
- # if ( $opt{'use_override'} ) {
- # $where = "(
- # part_pkg.classnum $comparison AND pkgpart_override IS NULL OR
- # override.classnum $comparison AND pkgpart_override IS NOT NULL
- # )";
- # } else {
- # $where = "part_pkg.classnum $comparison";
- # }
- #}
-
- $agentnum ||= $opt{'agentnum'};
-
- my $total_sql =
- " SELECT COALESCE( SUM( cust_bill_pkg_discount.amount ), 0 ) ";
-
- #$total_sql .=
- # " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END "
- # if $opt{average_per_cust_pkg};
-
- $total_sql .=
- " FROM cust_bill_pkg_discount
- LEFT JOIN cust_bill_pkg USING ( billpkgnum )
- LEFT JOIN cust_bill USING ( invnum )
- LEFT JOIN cust_main USING ( custnum )
- WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum);
- # LEFT JOIN cust_pkg_discount USING ( pkgdiscountnum )
- # LEFT JOIN discount USING ( discountnum )
- # LEFT JOIN cust_pkg USING ( pkgnum )
- # LEFT JOIN part_pkg USING ( pkgpart )
- # LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart
-
- return $self->scalar_sql($total_sql);
-
-}
-
-sub setup_pkg { shift->pkg_field( @_, 'setup' ); }
-sub susp_pkg { shift->pkg_field( @_, 'susp' ); }
-sub cancel_pkg { shift->pkg_field( @_, 'cancel'); }
-
-sub pkg_field {
- my( $self, $speriod, $eperiod, $agentnum, $field ) = @_;
- $self->scalar_sql("
- SELECT COUNT(*) FROM cust_pkg
- LEFT JOIN cust_main USING ( custnum )
- WHERE ". $self->in_time_period_and_agent( $speriod,
- $eperiod,
- $agentnum,
- "cust_pkg.$field",
- )
- );
-
-}
-
-#this is going to be harder..
-#sub unsusp_pkg {
-# my( $self, $speriod, $eperiod, $agentnum ) = @_;
-# $self->scalar_sql("
-# SELECT COUNT(*) FROM h_cust_pkg
-# WHERE
-#
-#}
-
-sub in_time_period_and_agent {
- my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4);
- my $col = @_ ? shift() : '_date';
-
- my $sql = "$col >= $speriod AND $col < $eperiod";
-
- #agent selection
- $sql .= " AND cust_main.agentnum = $agentnum"
- if $agentnum;
-
- #agent virtualization
- $sql .= ' AND '.
- $FS::CurrentUser::CurrentUser->agentnums_sql( 'table'=>'cust_main' );
-
- $sql;
-}
-
-sub scalar_sql {
- my( $self, $sql ) = ( shift, shift );
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- warn "FS::Report::Table::Monthly\n$sql\n" if $DEBUG;
- $sth->execute
- or die "Unexpected error executing statement $sql: ". $sth->errstr;
- $sth->fetchrow_arrayref->[0] || 0;
-}
-
-=back
-
-=head1 BUGS
-
-Documentation.
-
-=head1 SEE ALSO
-
-=cut
-
-1;
-
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
deleted file mode 100644
index 7224341..0000000
--- a/FS/FS/Schema.pm
+++ /dev/null
@@ -1,3171 +0,0 @@
-package FS::Schema;
-
-use vars qw(@ISA @EXPORT_OK $DEBUG $setup_hack %dbdef_cache);
-use subs qw(reload_dbdef);
-use Exporter;
-use DBIx::DBSchema 0.33;
-use DBIx::DBSchema::Table;
-use DBIx::DBSchema::Column 0.06;
-use DBIx::DBSchema::Index;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw( dbdef dbdef_dist reload_dbdef );
-
-$DEBUG = 0;
-$me = '[FS::Schema]';
-
-=head1 NAME
-
-FS::Schema - Freeside database schema
-
-=head1 SYNOPSYS
-
- use FS::Schema qw(dbdef dbdef_dist reload_dbdef);
-
- $dbdef = reload_dbdef;
- $dbdef = reload_dbdef "/non/standard/filename";
- $dbdef = dbdef;
- $dbdef_dist = dbdef_dist;
-
-=head1 DESCRIPTION
-
-This class represents the database schema.
-
-=head1 METHODS
-
-=over 4
-
-=item reload_dbdef([FILENAME])
-
-Load a database definition (see L<DBIx::DBSchema>), optionally from a
-non-default filename. This command is executed at startup unless
-I<$FS::Schema::setup_hack> is true. Returns a DBIx::DBSchema object.
-
-=cut
-
-sub reload_dbdef {
- my $file = shift;
-
- unless ( exists $dbdef_cache{$file} ) {
- warn "[debug]$me loading dbdef for $file\n" if $DEBUG;
- $dbdef_cache{$file} = DBIx::DBSchema->load( $file )
- or die "can't load database schema from $file: $DBIx::DBSchema::errstr\n";
- } else {
- warn "[debug]$me re-using cached dbdef for $file\n" if $DEBUG;
- }
- $dbdef = $dbdef_cache{$file};
-}
-
-=item dbdef
-
-Returns the current database definition (represents the current database,
-assuming it is up-to-date). See L<DBIx::DBSchema>.
-
-=cut
-
-sub dbdef { $dbdef; }
-
-=item dbdef_dist [ DATASRC ]
-
-Returns the current canoical database definition as defined in this file.
-
-Optionally, pass a DBI data source to enable syntax specific to that database.
-Currently, this enables "TYPE=InnoDB" for MySQL databases.
-
-=cut
-
-sub dbdef_dist {
- my $datasrc = @_ ? shift : '';
-
- my $local_options = '';
- if ( $datasrc =~ /^dbi:mysql/i ) {
- $local_options = 'TYPE=InnoDB';
- }
-
- ###
- # create a dbdef object from the old data structure
- ###
-
- my $tables_hashref = tables_hashref();
-
- #turn it into objects
- my $dbdef = new DBIx::DBSchema map {
-
- my $tablename = $_;
- my $indexnum = 1;
-
- my @columns;
- while (@{$tables_hashref->{$tablename}{'columns'}}) {
- #my($name, $type, $null, $length, $default, $local) =
- my @coldef =
- splice @{$tables_hashref->{$tablename}{'columns'}}, 0, 6;
- 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>;
- }
-
- push @columns, new DBIx::DBSchema::Column ( \%hash );
- }
-
- #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'} };
-
- # 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({
- 'name' => $tablename. $indexnum++,
- 'unique' => 1,
- 'columns' => $_,
- });
- }
- @$unique;
- push @indices, map {
- DBIx::DBSchema::Index->new({
- 'name' => $tablename. $indexnum++,
- 'unique' => 0,
- 'columns' => $_,
- });
- }
- @index;
-
- DBIx::DBSchema::Table->new({
- 'name' => $tablename,
- 'primary_key' => $tables_hashref->{$tablename}{'primary_key'},
- 'columns' => \@columns,
- 'indices' => \@indices,
- 'local_options' => $local_options,
- });
-
- } keys %$tables_hashref;
-
- if ( $DEBUG ) {
- warn "[debug]$me initial dbdef_dist created ($dbdef) with tables:\n";
- warn "[debug]$me $_\n" foreach $dbdef->tables;
- }
-
- #add radius attributes to svc_acct
- #
- #my($svc_acct)=$dbdef->table('svc_acct');
- #
- #my($attribute);
- #foreach $attribute (@attributes) {
- # $svc_acct->addcolumn ( new DBIx::DBSchema::Column (
- # 'radius_'. $attribute,
- # 'varchar',
- # 'NULL',
- # $char_d,
- # ));
- #}
- #
- #foreach $attribute (@check_attributes) {
- # $svc_acct->addcolumn( new DBIx::DBSchema::Column (
- # 'rc_'. $attribute,
- # 'varchar',
- # 'NULL',
- # $char_d,
- # ));
- #}
-
- #create history tables (false laziness w/create-history-tables)
- foreach my $table (
- grep { ! /^clientapi_session/ }
- grep { ! /^h_/ }
- $dbdef->tables
- ) {
- my $tableobj = $dbdef->table($table)
- or die "unknown table $table";
-
- my %indices = $tableobj->indices;
-
- my %h_indices = map {
- ( "h_$_" =>
- DBIx::DBSchema::Index->new({
- 'name' => 'h_'. $indices{$_}->name,
- 'unique' => 0,
- 'columns' => [ @{$indices{$_}->columns} ],
- })
- );
- }
- keys %indices;
-
- $h_indices{"h_${table}_srckey"} = DBIx::DBSchema::Index->new({
- 'name' => "h_${table}_srckey",
- 'unique' => 0,
- 'columns' => [ 'history_action', #right?
- $tableobj->primary_key,
- ],
- });
-
- $h_indices{"h_${table}_srckey2"} = DBIx::DBSchema::Index->new({
- 'name' => "h_${table}_srckey2",
- 'unique' => 0,
- 'columns' => [ 'history_date',
- $tableobj->primary_key,
- ],
- });
-
- my $h_tableobj = DBIx::DBSchema::Table->new( {
- 'name' => "h_$table",
- 'primary_key' => 'historynum',
- 'indices' => \%h_indices,
- 'local_options' => $local_options,
- 'columns' => [
- DBIx::DBSchema::Column->new( {
- 'name' => 'historynum',
- 'type' => 'serial',
- 'null' => 'NOT NULL',
- 'length' => '',
- 'default' => '',
- 'local' => '',
- } ),
- DBIx::DBSchema::Column->new( {
- 'name' => 'history_date',
- 'type' => 'int',
- 'null' => 'NULL',
- 'length' => '',
- 'default' => '',
- 'local' => '',
- } ),
- DBIx::DBSchema::Column->new( {
- 'name' => 'history_user',
- 'type' => 'varchar',
- 'null' => 'NOT NULL',
- 'length' => '80',
- 'default' => '',
- 'local' => '',
- } ),
- DBIx::DBSchema::Column->new( {
- 'name' => 'history_action',
- 'type' => 'varchar',
- 'null' => 'NOT NULL',
- 'length' => '80',
- 'default' => '',
- 'local' => '',
- } ),
- map {
- my $column = $tableobj->column($_);
-
- #clone so as to not disturb the original
- $column = DBIx::DBSchema::Column->new( {
- map { $_ => $column->$_() }
- qw( name type null length default local )
- } );
-
- if ( $column->type =~ /^(\w*)SERIAL$/i ) {
- $column->type(uc($1).'INT');
- $column->null('NULL');
- }
- #$column->default('')
- # if $column->default =~ /^nextval\(/i;
- #( my $local = $column->local ) =~ s/AUTO_INCREMENT//i;
- #$column->local($local);
- $column;
- } $tableobj->columns
- ],
- } );
- $dbdef->addtable($h_tableobj);
- }
-
- if ( $datasrc =~ /^dbi:mysql/i ) {
-
- my $dup_lock_table = DBIx::DBSchema::Table->new( {
- 'name' => 'duplicate_lock',
- 'primary_key' => 'duplocknum',
- 'local_options' => $local_options,
- 'columns' => [
- DBIx::DBSchema::Column->new( {
- 'name' => 'duplocknum',
- 'type' => 'serial',
- 'null' => 'NOT NULL',
- 'length' => '',
- 'default' => '',
- 'local' => '',
- } ),
- DBIx::DBSchema::Column->new( {
- 'name' => 'lockname',
- 'type' => 'varchar',
- 'null' => 'NOT NULL',
- 'length' => '80',
- 'default' => '',
- 'local' => '',
- } ),
- ],
- 'indices' => { 'duplicate_lock1' =>
- DBIx::DBSchema::Index->new({
- 'name' => 'duplicate_lock1',
- 'unique' => 1,
- 'columns' => [ 'lockname' ],
- })
- },
- } );
-
- $dbdef->addtable($dup_lock_table);
-
- }
-
- $dbdef;
-
-}
-
-sub tables_hashref {
-
- my $char_d = 80; #default maxlength for text fields
-
- #my(@date_type) = ( 'timestamp', '', '' );
- my @date_type = ( 'int', 'NULL', '' );
- my @perl_type = ( 'text', 'NULL', '' );
- my @money_type = ( 'decimal', '', '10,2' );
- my @money_typen = ( 'decimal', 'NULL', '10,2' );
- my @taxrate_type = ( 'decimal', '', '14,8' ); # requires pg 8 for
- my @taxrate_typen = ( 'decimal', 'NULL', '14,8' ); # fs-upgrade to work
-
- my $username_len = 32; #usernamemax config file
-
- # name type nullability length default local
-
- return {
-
- 'agent' => {
- 'columns' => [
- 'agentnum', 'serial', '', '', '', '',
- 'agent', 'varchar', '', $char_d, '', '',
- 'typenum', 'int', '', '', '', '',
- 'ticketing_queueid', 'int', 'NULL', '', '', '',
- 'invoice_template', 'varchar', 'NULL', $char_d, '', '',
- 'agent_custnum', 'int', 'NULL', '', '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- 'username', 'varchar', 'NULL', $char_d, '', '',
- '_password', 'varchar', 'NULL', $char_d, '', '',
- 'freq', 'int', 'NULL', '', '', '', #deprecated (never used)
- 'prog', @perl_type, '', '', #deprecated (never used)
- ],
- 'primary_key' => 'agentnum',
- #'unique' => [ [ 'agent_custnum' ] ], #one agent per customer?
- #insert is giving it a value, tho..
- #'index' => [ ['typenum'], ['disabled'] ],
- 'unique' => [],
- 'index' => [ ['typenum'], ['disabled'], ['agent_custnum'] ],
- },
-
- 'agent_type' => {
- 'columns' => [
- 'typenum', 'serial', '', '', '', '',
- 'atype', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'typenum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'type_pkgs' => {
- 'columns' => [
- 'typepkgnum', 'serial', '', '', '', '',
- 'typenum', 'int', '', '', '', '',
- 'pkgpart', 'int', '', '', '', '',
- ],
- 'primary_key' => 'typepkgnum',
- 'unique' => [ ['typenum', 'pkgpart'] ],
- 'index' => [ ['typenum'] ],
- },
-
- 'cust_attachment' => {
- 'columns' => [
- 'attachnum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- '_date', @date_type, '', '',
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
- 'filename', 'varchar', '', 255, '', '',
- 'mime_type', 'varchar', '', $char_d, '', '',
- 'title', 'varchar', 'NULL', $char_d, '', '',
- 'body', 'blob', 'NULL', '', '', '',
- 'disabled', @date_type, '', '',
- ],
- 'primary_key' => 'attachnum',
- 'unique' => [],
- 'index' => [ ['custnum'], ['usernum'], ],
- },
-
- 'cust_bill' => {
- 'columns' => [
- #regular fields
- 'invnum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- '_date', @date_type, '', '',
- 'charged', @money_type, '', '',
- 'invoice_terms', 'varchar', 'NULL', $char_d, '', '',
-
- #customer balance info at invoice generation time
- 'previous_balance', @money_typen, '', '', #eventually not nullable
- 'billing_balance', @money_typen, '', '', #eventually not nullable
-
- #deprecated (unused by now, right?)
- 'printed', 'int', '', '', '', '',
-
- #specific use cases
- 'closed', 'char', 'NULL', 1, '', '', #not yet used much
- 'statementnum', 'int', 'NULL', '', '', '', #invoice aggregate statements
- 'agent_invid', 'int', 'NULL', '', '', '', #(varchar?) importing legacy
- ],
- 'primary_key' => 'invnum',
- 'unique' => [ [ 'custnum', 'agent_invid' ] ], #agentnum? huh
- 'index' => [ ['custnum'], ['_date'], ['statementnum'], ['agent_invid'] ],
- },
-
- 'cust_statement' => {
- 'columns' => [
- 'statementnum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- '_date', @date_type, '', '',
- ],
- 'primary_key' => 'statementnum',
- 'unique' => [],
- 'index' => [ ['custnum'], ['_date'], ],
- },
-
- 'cust_bill_event' => {
- 'columns' => [
- 'eventnum', 'serial', '', '', '', '',
- 'invnum', 'int', '', '', '', '',
- 'eventpart', 'int', '', '', '', '',
- '_date', @date_type, '', '',
- 'status', 'varchar', '', $char_d, '', '',
- 'statustext', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'eventnum',
- #no... there are retries now #'unique' => [ [ 'eventpart', 'invnum' ] ],
- 'unique' => [],
- 'index' => [ ['invnum'], ['status'], ['eventpart'],
- ['statustext'], ['_date'],
- ],
- },
-
- 'part_bill_event' => {
- 'columns' => [
- 'eventpart', 'serial', '', '', '', '',
- 'freq', 'varchar', 'NULL', $char_d, '', '',
- 'payby', 'char', '', 4, '', '',
- 'event', 'varchar', '', $char_d, '', '',
- 'eventcode', @perl_type, '', '',
- 'seconds', 'int', 'NULL', '', '', '',
- 'weight', 'int', '', '', '', '',
- 'plan', 'varchar', 'NULL', $char_d, '', '',
- 'plandata', 'text', 'NULL', '', '', '',
- 'reason', 'int', 'NULL', '', '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'eventpart',
- 'unique' => [],
- 'index' => [ ['payby'], ['disabled'], ],
- },
-
- 'part_event' => {
- 'columns' => [
- 'eventpart', 'serial', '', '', '', '',
- 'agentnum', 'int', 'NULL', '', '', '',
- 'event', 'varchar', '', $char_d, '', '',
- 'eventtable', 'varchar', '', $char_d, '', '',
- 'check_freq', 'varchar', 'NULL', $char_d, '', '',
- 'weight', 'int', '', '', '', '',
- 'action', 'varchar', '', $char_d, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'eventpart',
- 'unique' => [],
- 'index' => [ ['agentnum'], ['eventtable'], ['check_freq'], ['disabled'], ],
- },
-
- 'part_event_option' => {
- 'columns' => [
- 'optionnum', 'serial', '', '', '', '',
- 'eventpart', 'int', '', '', '', '',
- 'optionname', 'varchar', '', $char_d, '', '',
- 'optionvalue', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'optionnum',
- 'unique' => [],
- 'index' => [ [ 'eventpart' ], [ 'optionname' ] ],
- },
-
- 'part_event_condition' => {
- 'columns' => [
- 'eventconditionnum', 'serial', '', '', '', '',
- 'eventpart', 'int', '', '', '', '',
- 'conditionname', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'eventconditionnum',
- 'unique' => [],
- 'index' => [ [ 'eventpart' ], [ 'conditionname' ] ],
- },
-
- 'part_event_condition_option' => {
- 'columns' => [
- 'optionnum', 'serial', '', '', '', '',
- 'eventconditionnum', 'int', '', '', '', '',
- 'optionname', 'varchar', '', $char_d, '', '',
- 'optionvalue', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'optionnum',
- 'unique' => [],
- 'index' => [ [ 'eventconditionnum' ], [ 'optionname' ] ],
- },
-
- 'part_event_condition_option_option' => {
- 'columns' => [
- 'optionoptionnum', 'serial', '', '', '', '',
- 'optionnum', 'int', '', '', '', '',
- 'optionname', 'varchar', '', $char_d, '', '',
- 'optionvalue', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'optionoptionnum',
- 'unique' => [],
- 'index' => [ [ 'optionnum' ], [ 'optionname' ] ],
- },
-
- 'cust_event' => {
- 'columns' => [
- 'eventnum', 'serial', '', '', '', '',
- 'eventpart', 'int', '', '', '', '',
- 'tablenum', 'int', '', '', '', '',
- '_date', @date_type, '', '',
- 'status', 'varchar', '', $char_d, '', '',
- 'statustext', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'eventnum',
- #no... there are retries now #'unique' => [ [ 'eventpart', 'invnum' ] ],
- 'unique' => [],
- 'index' => [ ['eventpart'], ['tablenum'], ['status'],
- ['statustext'], ['_date'],
- ],
- },
-
- 'cust_bill_pkg' => {
- 'columns' => [
- 'billpkgnum', 'serial', '', '', '', '',
- 'invnum', 'int', '', '', '', '',
- 'pkgnum', 'int', '', '', '', '',
- 'pkgpart_override', 'int', 'NULL', '', '', '',
- 'setup', @money_type, '', '',
- 'recur', @money_type, '', '',
- 'sdate', @date_type, '', '',
- 'edate', @date_type, '', '',
- 'itemdesc', 'varchar', 'NULL', $char_d, '', '',
- 'itemcomment', 'varchar', 'NULL', $char_d, '', '',
- 'section', 'varchar', 'NULL', $char_d, '', '',
- 'freq', 'varchar', 'NULL', $char_d, '', '',
- 'quantity', 'int', 'NULL', '', '', '',
- 'unitsetup', @money_typen, '', '',
- 'unitrecur', @money_typen, '', '',
- 'hidden', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'billpkgnum',
- 'unique' => [],
- 'index' => [ ['invnum'], [ 'pkgnum' ], [ 'itemdesc' ], ],
- },
-
- 'cust_bill_pkg_detail' => {
- 'columns' => [
- 'detailnum', 'serial', '', '', '', '',
- 'billpkgnum', 'int', 'NULL', '', '', '', # should not be nullable
- 'pkgnum', 'int', 'NULL', '', '', '', # deprecated
- 'invnum', 'int', 'NULL', '', '', '', # deprecated
- 'amount', 'decimal', 'NULL', '10,4', '', '',
- 'format', 'char', 'NULL', 1, '', '',
- 'classnum', 'int', 'NULL', '', '', '',
- 'duration', 'int', 'NULL', '', 0, '',
- 'phonenum', 'varchar', 'NULL', 15, '', '',
- 'regionname', 'varchar', 'NULL', $char_d, '', '',
- 'detail', 'varchar', '', 255, '', '',
- ],
- 'primary_key' => 'detailnum',
- 'unique' => [],
- 'index' => [ [ 'billpkgnum' ], [ 'classnum' ], [ 'pkgnum', 'invnum' ] ],
- },
-
- 'cust_bill_pkg_display' => {
- 'columns' => [
- 'billpkgdisplaynum', 'serial', '', '', '', '',
- 'billpkgnum', 'int', '', '', '', '',
- 'section', 'varchar', 'NULL', $char_d, '', '',
- #'unitsetup', @money_typen, '', '', #override the linked real one?
- #'unitrecur', @money_typen, '', '', #this too?
- 'post_total', 'char', 'NULL', 1, '', '',
- 'type', 'char', 'NULL', 1, '', '',
- 'summary', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'billpkgdisplaynum',
- 'unique' => [],
- 'index' => [ ['billpkgnum'], ],
- },
-
- 'cust_bill_pkg_tax_location' => {
- 'columns' => [
- 'billpkgtaxlocationnum', 'serial', '', '', '', '',
- 'billpkgnum', 'int', '', '', '', '',
- 'taxnum', 'int', '', '', '', '',
- 'taxtype', 'varchar', '', $char_d, '', '',
- 'pkgnum', 'int', '', '', '', '',
- 'locationnum', 'int', '', '', '', '', #redundant?
- 'amount', @money_type, '', '',
- ],
- 'primary_key' => 'billpkgtaxlocationnum',
- 'unique' => [],
- 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'pkgnum' ], [ 'locationnum' ] ],
- },
-
- 'cust_bill_pkg_tax_rate_location' => {
- 'columns' => [
- 'billpkgtaxratelocationnum', 'serial', '', '', '', '',
- 'billpkgnum', 'int', '', '', '', '',
- 'taxnum', 'int', '', '', '', '',
- 'taxtype', 'varchar', '', $char_d, '', '',
- 'locationtaxid', 'varchar', 'NULL', $char_d, '', '',
- 'taxratelocationnum', 'int', '', '', '', '',
- 'amount', @money_type, '', '',
- ],
- 'primary_key' => 'billpkgtaxratelocationnum',
- 'unique' => [],
- 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'taxratelocationnum' ] ],
- },
-
- 'cust_credit' => {
- 'columns' => [
- 'crednum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- '_date', @date_type, '', '',
- 'amount', @money_type, '', '',
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
- 'reason', 'text', 'NULL', '', '', '',
- 'reasonnum', 'int', 'NULL', '', '', '',
- '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'], ['usernum'], ['eventnum'] ],
- },
-
- 'cust_credit_bill' => {
- 'columns' => [
- 'creditbillnum', 'serial', '', '', '', '',
- 'crednum', 'int', '', '', '', '',
- 'invnum', 'int', '', '', '', '',
- '_date', @date_type, '', '',
- 'amount', @money_type, '', '',
- 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances
- ],
- 'primary_key' => 'creditbillnum',
- 'unique' => [],
- 'index' => [ ['crednum'], ['invnum'] ],
- },
-
- 'cust_credit_bill_pkg' => {
- 'columns' => [
- 'creditbillpkgnum', 'serial', '', '', '', '',
- 'creditbillnum', 'int', '', '', '', '',
- 'billpkgnum', 'int', '', '', '', '',
- 'billpkgtaxlocationnum', 'int', 'NULL', '', '', '',
- 'billpkgtaxratelocationnum', 'int', 'NULL', '', '', '',
- 'amount', @money_type, '', '',
- 'setuprecur', 'varchar', '', $char_d, '', '',
- 'sdate', @date_type, '', '',
- 'edate', @date_type, '', '',
- ],
- 'primary_key' => 'creditbillpkgnum',
- 'unique' => [],
- 'index' => [ [ 'creditbillnum' ],
- [ 'billpkgnum' ],
- [ 'billpkgtaxlocationnum' ],
- [ 'billpkgtaxratelocationnum' ],
- ],
- },
-
- 'cust_main' => {
- 'columns' => [
- 'custnum', 'serial', '', '', '', '',
- 'agentnum', 'int', '', '', '', '',
- 'agent_custid', 'varchar', 'NULL', $char_d, '', '',
- 'classnum', 'int', 'NULL', '', '', '',
- 'custbatch', 'varchar', 'NULL', $char_d, '', '',
-# 'titlenum', 'int', 'NULL', '', '', '',
- 'last', 'varchar', '', $char_d, '', '',
-# 'middle', 'varchar', 'NULL', $char_d, '', '',
- 'first', 'varchar', '', $char_d, '', '',
- 'ss', 'varchar', 'NULL', 11, '', '',
- 'stateid', 'varchar', 'NULL', $char_d, '', '',
- 'stateid_state', 'varchar', 'NULL', $char_d, '', '',
- 'birthdate' ,@date_type, '', '',
- 'signupdate',@date_type, '', '',
- 'dundate', @date_type, '', '',
- 'company', 'varchar', 'NULL', $char_d, '', '',
- 'address1', 'varchar', '', $char_d, '', '',
- 'address2', 'varchar', 'NULL', $char_d, '', '',
- 'city', 'varchar', '', $char_d, '', '',
- 'county', 'varchar', 'NULL', $char_d, '', '',
- 'state', 'varchar', 'NULL', $char_d, '', '',
- 'zip', 'varchar', 'NULL', 10, '', '',
- 'country', 'char', '', 2, '', '',
- 'daytime', 'varchar', 'NULL', 20, '', '',
- 'night', 'varchar', 'NULL', 20, '', '',
- 'fax', 'varchar', 'NULL', 12, '', '',
- 'ship_last', 'varchar', 'NULL', $char_d, '', '',
-# 'ship_middle', 'varchar', 'NULL', $char_d, '', '',
- 'ship_first', 'varchar', 'NULL', $char_d, '', '',
- 'ship_company', 'varchar', 'NULL', $char_d, '', '',
- 'ship_address1', 'varchar', 'NULL', $char_d, '', '',
- 'ship_address2', 'varchar', 'NULL', $char_d, '', '',
- 'ship_city', 'varchar', 'NULL', $char_d, '', '',
- 'ship_county', 'varchar', 'NULL', $char_d, '', '',
- 'ship_state', 'varchar', 'NULL', $char_d, '', '',
- 'ship_zip', 'varchar', 'NULL', 10, '', '',
- 'ship_country', 'char', 'NULL', 2, '', '',
- 'ship_daytime', 'varchar', 'NULL', 20, '', '',
- 'ship_night', 'varchar', 'NULL', 20, '', '',
- 'ship_fax', 'varchar', 'NULL', 12, '', '',
- 'payby', 'char', '', 4, '', '',
- 'payinfo', 'varchar', 'NULL', 512, '', '',
- 'paycvv', 'varchar', 'NULL', 512, '', '',
- 'paymask', 'varchar', 'NULL', $char_d, '', '',
- #'paydate', @date_type, '', '',
- 'paydate', 'varchar', 'NULL', 10, '', '',
- 'paystart_month', 'int', 'NULL', '', '', '',
- 'paystart_year', 'int', 'NULL', '', '', '',
- 'payissue', 'varchar', 'NULL', 2, '', '',
- 'payname', 'varchar', 'NULL', $char_d, '', '',
- 'paystate', 'varchar', 'NULL', $char_d, '', '',
- 'paytype', 'varchar', 'NULL', $char_d, '', '',
- 'payip', 'varchar', 'NULL', 15, '', '',
- 'geocode', 'varchar', 'NULL', 20, '', '',
- 'censustract', 'varchar', 'NULL', 20, '', '', # 7 to save space?
- 'tax', 'char', 'NULL', 1, '', '',
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
- 'refnum', 'int', '', '', '', '',
- 'referral_custnum', 'int', 'NULL', '', '', '',
- 'comments', 'text', 'NULL', '', '', '',
- 'spool_cdr','char', 'NULL', 1, '', '',
- 'squelch_cdr','char', 'NULL', 1, '', '',
- 'cdr_termination_percentage', 'decimal', 'NULL', '', '', '',
- 'invoice_terms', 'varchar', 'NULL', $char_d, '', '',
- 'credit_limit', @money_typen, '', '',
- 'archived', 'char', 'NULL', 1, '', '',
- 'email_csv_cdr', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'custnum',
- 'unique' => [ [ 'agentnum', 'agent_custid' ] ],
- #'index' => [ ['last'], ['company'] ],
- 'index' => [
- [ 'agentnum' ], [ 'refnum' ], [ 'classnum' ], [ 'usernum' ],
- [ 'custbatch' ],
- [ 'referral_custnum' ],
- [ 'payby' ], [ 'paydate' ],
- [ 'archived' ],
- #billing
- [ 'last' ], [ 'company' ],
- [ 'county' ], [ 'state' ], [ 'country' ],
- [ 'zip' ],
- [ 'daytime' ], [ 'night' ], [ 'fax' ],
- #shipping
- [ 'ship_last' ], [ 'ship_company' ],
- [ 'ship_county' ], [ 'ship_state' ], [ 'ship_country' ],
- [ 'ship_zip' ],
- [ 'ship_daytime' ], [ 'ship_night' ], [ 'ship_fax' ],
- ],
- },
-
- 'cust_recon' => { # what purpose does this serve?
- 'columns' => [
- 'reconid', 'serial', '', '', '', '',
- 'recondate', @date_type, '', '',
- 'custnum', 'int' , '', '', '', '',
- 'agentnum', 'int', '', '', '', '',
- 'last', 'varchar', '', $char_d, '', '',
- 'first', 'varchar', '', $char_d, '', '',
- 'address1', 'varchar', '', $char_d, '', '',
- 'address2', 'varchar', 'NULL', $char_d, '', '',
- 'city', 'varchar', '', $char_d, '', '',
- 'state', 'varchar', 'NULL', $char_d, '', '',
- 'zip', 'varchar', 'NULL', 10, '', '',
- 'pkg', 'varchar', 'NULL', $char_d, '', '',
- 'adjourn', @date_type, '', '',
- 'status', 'varchar', 'NULL', 10, '', '',
- 'agent_custid', 'varchar', '', $char_d, '', '',
- 'agent_pkg', 'varchar', 'NULL', $char_d, '', '',
- 'agent_adjourn', @date_type, '', '',
- 'comments', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'reconid',
- 'unique' => [],
- 'index' => [],
- },
-
- #eventually for cust_main too
- 'contact' => {
- 'columns' => [
- 'contactnum', 'serial', '', '', '', '',
- 'prospectnum', 'int', 'NULL', '', '', '',
- 'custnum', 'int', 'NULL', '', '', '',
- 'locationnum', 'int', 'NULL', '', '', '', #not yet
-# 'titlenum', 'int', 'NULL', '', '', '', #eg Mr. Mrs. Dr. Rev.
- 'last', 'varchar', '', $char_d, '', '',
-# 'middle', 'varchar', 'NULL', $char_d, '', '',
- 'first', 'varchar', '', $char_d, '', '',
- 'title', 'varchar', 'NULL', $char_d, '', '', #eg Head Bottle Washer
- 'comment', 'varchar', 'NULL', $char_d, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'contactnum',
- 'unique' => [],
- 'index' => [ [ 'prospectnum' ], [ 'custnum' ], [ 'locationnum' ],
- [ 'last' ], [ 'first' ],
- ],
- },
-
- 'contact_phone' => {
- 'columns' => [
- 'contactphonenum', 'serial', '', '', '', '',
- 'contactnum', 'int', '', '', '', '',
- 'phonetypenum', 'int', '', '', '', '',
- 'countrycode', 'varchar', '', 3, '', '',
- 'phonenum', 'varchar', '', 14, '', '',
- 'extension', 'varchar', 'NULL', 7, '', '',
- #?#'comment', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'contactphonenum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'phone_type' => {
- 'columns' => [
- 'phonetypenum', 'serial', '', '', '', '',
- 'typename', 'varchar', '', $char_d, '', '',
- 'weight', 'int', '', '', '', '',
- ],
- 'primary_key' => 'phonetypenum',
- 'unique' => [ [ 'typename' ], ],
- 'index' => [],
- },
-
- 'contact_email' => {
- 'columns' => [
- 'contactemailnum', 'serial', '', '', '', '',
- 'contactnum', 'int', '', '', '', '',
- 'emailaddress', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'contactemailnum',
- 'unique' => [ [ 'emailaddress' ], ],
- 'index' => [],
- },
-
- 'prospect_main' => {
- 'columns' => [
- 'prospectnum', 'serial', '', '', '', '',
- 'agentnum', 'int', '', '', '', '',
- 'company', 'varchar', '', $char_d, '', '',
- #'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'prospectnum',
- 'unique' => [],
- 'index' => [ [ 'company' ], [ 'agentnum' ], ],
- },
-
- #eventually use for billing & ship from cust_main too
- #for now, just cust_pkg locations
- 'cust_location' => { #'location' now that its prospects too, but...
- 'columns' => [
- 'locationnum', 'serial', '', '', '', '',
- 'prospectnum', 'int', 'NULL', '', '', '',
- 'custnum', 'int', 'NULL', '', '', '',
- 'address1', 'varchar', '', $char_d, '', '',
- 'address2', 'varchar', 'NULL', $char_d, '', '',
- 'city', 'varchar', '', $char_d, '', '',
- 'county', 'varchar', 'NULL', $char_d, '', '',
- 'state', 'varchar', 'NULL', $char_d, '', '',
- 'zip', 'varchar', 'NULL', 10, '', '',
- 'country', 'char', '', 2, '', '',
- 'geocode', 'varchar', 'NULL', 20, '', '',
- 'location_type', 'varchar', 'NULL', 20, '', '',
- 'location_number', 'varchar', 'NULL', 20, '', '',
- 'location_kind', 'char', 'NULL', 1, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'locationnum',
- 'unique' => [],
- 'index' => [ [ 'prospectnum' ], [ 'custnum' ],
- [ 'county' ], [ 'state' ], [ 'country' ], [ 'zip' ],
- ],
- },
-
- 'cust_main_invoice' => {
- 'columns' => [
- 'destnum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- 'dest', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'destnum',
- 'unique' => [],
- 'index' => [ ['custnum'], ],
- },
-
- 'cust_main_note' => {
- 'columns' => [
- 'notenum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- 'classnum', 'int', 'NULL', '', '', '',
- '_date', @date_type, '', '',
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
- 'comments', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'notenum',
- 'unique' => [],
- 'index' => [ [ 'custnum' ], [ '_date' ], [ 'usernum' ], ],
- },
-
- 'cust_note_class' => {
- 'columns' => [
- 'classnum', 'serial', '', '', '', '',
- 'classname', 'varchar', '', $char_d, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'classnum',
- 'unique' => [],
- 'index' => [ ['disabled'] ],
- },
-
- 'cust_category' => {
- 'columns' => [
- 'categorynum', 'serial', '', '', '', '',
- 'categoryname', 'varchar', '', $char_d, '', '',
- 'weight', 'int', 'NULL', '', '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'categorynum',
- 'unique' => [],
- 'index' => [ ['disabled'] ],
- },
-
- 'cust_class' => {
- 'columns' => [
- 'classnum', 'serial', '', '', '', '',
- 'classname', 'varchar', '', $char_d, '', '',
- 'categorynum', 'int', 'NULL', '', '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'classnum',
- 'unique' => [],
- 'index' => [ ['disabled'] ],
- },
-
- 'cust_tag' => {
- 'columns' => [
- 'custtagnum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- 'tagnum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'custtagnum',
- 'unique' => [ [ 'custnum', 'tagnum' ] ],
- 'index' => [ [ 'custnum' ] ],
- },
-
- 'part_tag' => {
- 'columns' => [
- 'tagnum', 'serial', '', '', '', '',
- 'tagname', 'varchar', '', $char_d, '', '',
- 'tagdesc', 'varchar', 'NULL', $char_d, '', '',
- 'tagcolor', 'varchar', 'NULL', 6, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'tagnum',
- 'unique' => [], #[ [ 'tagname' ] ], #?
- 'index' => [ [ 'disabled' ] ],
- },
-
- 'cust_main_exemption' => {
- 'columns' => [
- 'exemptionnum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- 'taxname', 'varchar', '', $char_d, '', '',
- #start/end dates? for reporting?
- ],
- 'primary_key' => 'exemptionnum',
- 'unique' => [],
- 'index' => [ [ 'custnum' ] ],
- },
-
- 'cust_tax_adjustment' => {
- 'columns' => [
- 'adjustmentnum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- 'taxname', 'varchar', '', $char_d, '', '',
- 'amount', @money_type, '', '',
- 'comment', 'varchar', 'NULL', $char_d, '', '',
- 'billpkgnum', 'int', 'NULL', '', '', '',
- #more? no cust_bill_pkg_tax_location?
- ],
- 'primary_key' => 'adjustmentnum',
- 'unique' => [],
- 'index' => [ [ 'custnum' ], [ 'billpkgnum' ] ],
- },
-
- 'cust_main_county' => { #county+state+country are checked off the
- #cust_main_county for validation and to provide
- # a tax rate.
- 'columns' => [
- 'taxnum', 'serial', '', '', '', '',
- 'city', 'varchar', 'NULL', $char_d, '', '',
- 'county', 'varchar', 'NULL', $char_d, '', '',
- 'state', 'varchar', 'NULL', $char_d, '', '',
- 'country', 'char', '', 2, '', '',
- 'taxclass', 'varchar', 'NULL', $char_d, '', '',
- 'exempt_amount', @money_type, '', '',
- 'tax', 'real', '', '', '', '', #tax %
- 'taxname', 'varchar', 'NULL', $char_d, '', '',
- 'setuptax', 'char', 'NULL', 1, '', '', # Y = setup tax exempt
- 'recurtax', 'char', 'NULL', 1, '', '', # Y = recur tax exempt
- ],
- 'primary_key' => 'taxnum',
- 'unique' => [],
- # 'unique' => [ ['taxnum'], ['state', 'county'] ],
- 'index' => [ [ 'city' ], [ 'county' ], [ 'state' ], [ 'country' ],
- [ 'taxclass' ],
- ],
- },
-
- 'tax_rate' => {
- 'columns' => [
- 'taxnum', 'serial', '', '', '', '',
- 'geocode', 'varchar', 'NULL', $char_d, '', '',#cch provides 10 char
- 'data_vendor', 'varchar', 'NULL', $char_d, '', '',#auto update source
- 'location', 'varchar', 'NULL', $char_d, '', '',#provided by tax authority
- 'taxclassnum', 'int', '', '', '', '',
- 'effective_date', @date_type, '', '',
- 'tax', @taxrate_type, '', '', # tax %
- 'excessrate', @taxrate_typen, '', '', # second tax %
- 'taxbase', @money_typen, '', '', # amount at first tax rate
- 'taxmax', @money_typen, '', '', # maximum about at both rates
- 'usetax', @taxrate_typen, '', '', # tax % when non-local
- 'useexcessrate', @taxrate_typen, '', '', # second tax % when non-local
- 'unittype', 'int', 'NULL', '', '', '', # for fee
- 'fee', @taxrate_typen, '', '', # amount tax per unit
- 'excessfee', @taxrate_typen, '', '', # second amount tax per unit
- 'feebase', @taxrate_typen, '', '', # units taxed at first rate
- 'feemax', @taxrate_typen, '', '', # maximum number of unit taxed
- 'maxtype', 'int', 'NULL', '', '', '', # indicator of how thresholds accumulate
- 'taxname', 'varchar', 'NULL', $char_d, '', '', # may appear on invoice
- 'taxauth', 'int', 'NULL', '', '', '', # tax authority
- 'basetype', 'int', 'NULL', '', '', '', # indicator of basis for tax
- 'passtype', 'int', 'NULL', '', '', '', # indicator declaring how item should be shown
- 'passflag', 'char', 'NULL', 1, '', '', # Y = required to list as line item, N = Prohibited
- 'setuptax', 'char', 'NULL', 1, '', '', # Y = setup tax exempt
- 'recurtax', 'char', 'NULL', 1, '', '', # Y = recur tax exempt
- 'inoutcity', 'char', 'NULL', 1, '', '', # '', 'I', or 'O'
- 'inoutlocal', 'char', 'NULL', 1, '', '', # '', 'I', or 'O'
- 'manual', 'char', 'NULL', 1, '', '', # Y = manually edited
- 'disabled', 'char', 'NULL', 1, '', '', # Y = tax disabled
- ],
- 'primary_key' => 'taxnum',
- 'unique' => [],
- 'index' => [ ['taxclassnum'], ['data_vendor', 'geocode'] ],
- },
-
- 'tax_rate_location' => {
- 'columns' => [
- 'taxratelocationnum', 'serial', '', '', '', '',
- 'data_vendor', 'varchar', 'NULL', $char_d, '', '',
- 'geocode', 'varchar', '', 20, '', '',
- 'city', 'varchar', 'NULL', $char_d, '', '',
- 'county', 'varchar', 'NULL', $char_d, '', '',
- 'state', 'char', 'NULL', 2, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'taxratelocationnum',
- 'unique' => [],
- 'index' => [ [ 'data_vendor', 'geocode', 'disabled' ] ],
- },
-
- 'cust_tax_location' => {
- 'columns' => [
- 'custlocationnum', 'serial', '', '', '', '',
- 'data_vendor', 'varchar', 'NULL', $char_d, '', '', # update source
- 'city', 'varchar', 'NULL', $char_d, '', '',
- 'postalcity', 'varchar', 'NULL', $char_d, '', '',
- 'county', 'varchar', 'NULL', $char_d, '', '',
- 'zip', 'char', '', 5, '', '',
- 'state', 'char', '', 2, '', '',
- 'plus4hi', 'char', 'NULL', 4, '', '',
- 'plus4lo', 'char', 'NULL', 4, '', '',
- 'default_location','char', 'NULL', 1, '', '', # Y = default for zip
- 'cityflag', 'char', 'NULL', 1, '', '', # I(n)/O(out)/B(oth)/NULL
- 'geocode', 'varchar', '', 20, '', '',
- ],
- 'primary_key' => 'custlocationnum',
- 'unique' => [],
- 'index' => [ [ 'zip', 'plus4lo', 'plus4hi' ] ],
- },
-
- 'tax_class' => {
- 'columns' => [
- 'taxclassnum', 'serial', '', '', '', '',
- 'data_vendor', 'varchar', 'NULL', $char_d, '', '',
- 'taxclass', 'varchar', '', $char_d, '', '',
- 'description', 'varchar', '', 2*$char_d, '', '',
- ],
- 'primary_key' => 'taxclassnum',
- 'unique' => [ [ 'data_vendor', 'taxclass' ] ],
- 'index' => [],
- },
-
- 'cust_pay_pending' => {
- 'columns' => [
- 'paypendingnum','serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- 'paid', @money_type, '', '',
- '_date', @date_type, '', '',
- 'payby', 'char', '', 4, '', '', #CARD/BILL/COMP, should
- # be index into payby
- # table eventually
- 'payinfo', 'varchar', 'NULL', 512, '', '', #see cust_main above
- 'paymask', 'varchar', 'NULL', $char_d, '', '',
- 'paydate', 'varchar', 'NULL', 10, '', '',
- 'recurring_billing', 'varchar', 'NULL', $char_d, '', '',
- #'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes.
- 'payunique', 'varchar', 'NULL', $char_d, '', '', #separate paybatch "unique" functions from current usage
-
- 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances
- 'status', 'varchar', '', $char_d, '', '',
- 'session_id', 'varchar', 'NULL', $char_d, '', '', #only need 32
- 'statustext', 'text', 'NULL', '', '', '',
- 'gatewaynum', 'int', 'NULL', '', '', '',
- #'cust_balance', @money_type, '', '',
- 'paynum', 'int', 'NULL', '', '', '',
- 'jobnum', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'paypendingnum',
- 'unique' => [ [ 'payunique' ] ],
- 'index' => [ [ 'custnum' ], [ 'status' ], ],
- },
-
- 'cust_pay' => {
- 'columns' => [
- 'paynum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- '_date', @date_type, '', '',
- 'paid', @money_type, '', '',
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
- 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should be
- # index into payby table
- # eventually
- 'payinfo', 'varchar', 'NULL', 512, '', '', #see cust_main above
- 'paymask', 'varchar', 'NULL', $char_d, '', '',
- 'paydate', 'varchar', 'NULL', 10, '', '',
- 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes.
- 'payunique', 'varchar', 'NULL', $char_d, '', '', #separate paybatch "unique" functions from current usage
- 'closed', 'char', 'NULL', 1, '', '',
- 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances
- ],
- 'primary_key' => 'paynum',
- #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it# 'unique' => [ [ 'payunique' ] ],
- 'index' => [ [ 'custnum' ], [ 'paybatch' ], [ 'payby' ], [ '_date' ], [ 'usernum' ] ],
- },
-
- 'cust_pay_void' => {
- 'columns' => [
- 'paynum', 'int', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- 'paid', @money_type, '', '',
- '_date', @date_type, '', '',
- 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should be
- # index into payby table
- # eventually
- 'payinfo', 'varchar', 'NULL', 512, '', '', #see cust_main above
- 'paymask', 'varchar', 'NULL', $char_d, '', '',
- 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes.
- 'closed', 'char', 'NULL', 1, '', '',
- 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances
- 'void_date', @date_type, '', '',
- 'reason', 'varchar', 'NULL', $char_d, '', '',
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
- 'void_usernum', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'paynum',
- 'unique' => [],
- 'index' => [ [ 'custnum' ], [ 'usernum' ], [ 'void_usernum' ] ],
- },
-
- 'cust_bill_pay' => {
- 'columns' => [
- 'billpaynum', 'serial', '', '', '', '',
- 'invnum', 'int', '', '', '', '',
- 'paynum', 'int', '', '', '', '',
- 'amount', @money_type, '', '',
- '_date', @date_type, '', '',
- 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances
- ],
- 'primary_key' => 'billpaynum',
- 'unique' => [],
- 'index' => [ [ 'paynum' ], [ 'invnum' ] ],
- },
-
- 'cust_bill_pay_batch' => {
- 'columns' => [
- 'billpaynum', 'serial', '', '', '', '',
- 'invnum', 'int', '', '', '', '',
- 'paybatchnum', 'int', '', '', '', '',
- 'amount', @money_type, '', '',
- '_date', @date_type, '', '',
- ],
- 'primary_key' => 'billpaynum',
- 'unique' => [],
- 'index' => [ [ 'paybatchnum' ], [ 'invnum' ] ],
- },
-
- 'cust_bill_pay_pkg' => {
- 'columns' => [
- 'billpaypkgnum', 'serial', '', '', '', '',
- 'billpaynum', 'int', '', '', '', '',
- 'billpkgnum', 'int', '', '', '', '',
- 'billpkgtaxlocationnum', 'int', 'NULL', '', '', '',
- 'billpkgtaxratelocationnum', 'int', 'NULL', '', '', '',
- 'amount', @money_type, '', '',
- 'setuprecur', 'varchar', '', $char_d, '', '',
- 'sdate', @date_type, '', '',
- 'edate', @date_type, '', '',
- ],
- 'primary_key' => 'billpaypkgnum',
- 'unique' => [],
- 'index' => [ [ 'billpaynum' ], [ 'billpkgnum' ], ],
- },
-
- 'pay_batch' => { #batches of payments to an external processor
- 'columns' => [
- 'batchnum', 'serial', '', '', '', '',
- 'payby', 'char', '', 4, '', '', # CARD/CHEK
- 'status', 'char', 'NULL', 1, '', '',
- 'download', @date_type, '', '',
- 'upload', @date_type, '', '',
- ],
- 'primary_key' => 'batchnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'cust_pay_batch' => { #what's this used for again? list of customers
- #in current CARD batch? (necessarily CARD?)
- 'columns' => [
- 'paybatchnum', 'serial', '', '', '', '',
- 'batchnum', 'int', '', '', '', '',
- 'invnum', 'int', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- 'last', 'varchar', '', $char_d, '', '',
- 'first', 'varchar', '', $char_d, '', '',
- 'address1', 'varchar', '', $char_d, '', '',
- 'address2', 'varchar', 'NULL', $char_d, '', '',
- 'city', 'varchar', '', $char_d, '', '',
- 'state', 'varchar', 'NULL', $char_d, '', '',
- 'zip', 'varchar', 'NULL', 10, '', '',
- 'country', 'char', '', 2, '', '',
- # 'trancode', 'int', '', '', '', ''
- 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should be
- 'payinfo', 'varchar', '', 512, '', '',
- #'exp', @date_type, '', ''
- 'exp', 'varchar', 'NULL', 11, '', '',
- 'payname', 'varchar', 'NULL', $char_d, '', '',
- 'amount', @money_type, '', '',
- 'status', 'varchar', 'NULL', $char_d, '', '',
- ],
- 'primary_key' => 'paybatchnum',
- 'unique' => [],
- 'index' => [ ['batchnum'], ['invnum'], ['custnum'] ],
- },
-
- 'cust_pkg' => {
- 'columns' => [
- 'pkgnum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- 'pkgpart', 'int', '', '', '', '',
- 'pkgbatch', 'varchar', 'NULL', $char_d, '', '',
- 'locationnum', 'int', 'NULL', '', '', '',
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
- 'start_date', @date_type, '', '',
- 'setup', @date_type, '', '',
- 'bill', @date_type, '', '',
- 'last_bill', @date_type, '', '',
- 'susp', @date_type, '', '',
- 'adjourn', @date_type, '', '',
- 'cancel', @date_type, '', '',
- 'expire', @date_type, '', '',
- 'contract_end', @date_type, '', '',
- 'change_date', @date_type, '', '',
- 'change_pkgnum', 'int', 'NULL', '', '', '',
- 'change_pkgpart', 'int', 'NULL', '', '', '',
- 'change_locationnum', 'int', 'NULL', '', '', '',
- 'manual_flag', 'char', 'NULL', 1, '', '',
- 'no_auto', 'char', 'NULL', 1, '', '',
- 'quantity', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'pkgnum',
- 'unique' => [],
- 'index' => [ ['custnum'], ['pkgpart'], [ 'pkgbatch' ], [ 'locationnum' ],
- [ 'usernum' ],
- [ 'start_date' ], ['setup'], ['last_bill'], ['bill'],
- ['susp'], ['adjourn'], ['expire'], ['cancel'],
- ['change_date'],
- ],
- },
-
- 'cust_pkg_option' => {
- 'columns' => [
- 'optionnum', 'serial', '', '', '', '',
- 'pkgnum', 'int', '', '', '', '',
- 'optionname', 'varchar', '', $char_d, '', '',
- 'optionvalue', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'optionnum',
- 'unique' => [],
- 'index' => [ [ 'pkgnum' ], [ 'optionname' ] ],
- },
-
- 'cust_pkg_detail' => {
- 'columns' => [
- 'pkgdetailnum', 'serial', '', '', '', '',
- 'pkgnum', 'int', '', '', '', '',
- 'detail', 'varchar', '', $char_d, '', '',
- 'detailtype', 'char', '', 1, '', '', # "I"nvoice or "C"omment
- 'weight', 'int', '', '', '', '',
- ],
- 'primary_key' => 'pkgdetailnum',
- 'unique' => [],
- 'index' => [ [ 'pkgnum', 'detailtype' ] ],
- },
-
- 'cust_pkg_reason' => {
- 'columns' => [
- 'num', 'serial', '', '', '', '',
- 'pkgnum', 'int', '', '', '', '',
- 'reasonnum','int', '', '', '', '',
- 'action', 'char', 'NULL', 1, '', '', #should not be nullable
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
- 'date', @date_type, '', '',
- ],
- 'primary_key' => 'num',
- 'unique' => [],
- 'index' => [ [ 'pkgnum' ], [ 'reasonnum' ], ['action'], [ 'usernum' ], ],
- },
-
- 'cust_pkg_discount' => {
- 'columns' => [
- 'pkgdiscountnum', 'serial', '', '', '', '',
- 'pkgnum', 'int', '', '', '', '',
- 'discountnum', 'int', '', '', '', '',
- 'months_used', 'decimal', 'NULL', '', '', '',
- 'end_date', @date_type, '', '',
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'pkgdiscountnum',
- 'unique' => [],
- 'index' => [ [ 'pkgnum' ], [ 'discountnum' ], [ 'usernum' ], ],
- },
-
- 'cust_bill_pkg_discount' => {
- 'columns' => [
- 'billpkgdiscountnum', 'serial', '', '', '', '',
- 'billpkgnum', 'int', '', '', '', '',
- 'pkgdiscountnum', 'int', '', '', '', '',
- 'amount', @money_type, '', '',
- 'months', 'decimal', 'NULL', '', '', '',
- ],
- 'primary_key' => 'billpkgdiscountnum',
- 'unique' => [],
- 'index' => [ [ 'billpkgnum' ], [ 'pkgdiscountnum' ] ],
- },
-
- 'discount' => {
- 'columns' => [
- 'discountnum', 'serial', '', '', '', '',
- #'agentnum', 'int', 'NULL', '', '', '',
- 'name', 'varchar', 'NULL', $char_d, '', '',
- 'amount', @money_type, '', '',
- 'percent', 'decimal', '', '', '', '',
- 'months', 'decimal', 'NULL', '', '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'discountnum',
- 'unique' => [],
- 'index' => [], # [ 'agentnum' ], ],
- },
-
- 'cust_refund' => {
- 'columns' => [
- 'refundnum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- '_date', @date_type, '', '',
- 'refund', @money_type, '', '',
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
- 'reason', 'varchar', '', $char_d, '', '',
- 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should
- # be index into payby
- # table eventually
- 'payinfo', 'varchar', 'NULL', 512, '', '', #see cust_main above
- 'paymask', 'varchar', 'NULL', $char_d, '', '',
- 'paybatch', 'varchar', 'NULL', $char_d, '', '',
- 'closed', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'refundnum',
- 'unique' => [],
- 'index' => [ ['custnum'], ['_date'], [ 'usernum' ], ],
- },
-
- 'cust_credit_refund' => {
- 'columns' => [
- 'creditrefundnum', 'serial', '', '', '', '',
- 'crednum', 'int', '', '', '', '',
- 'refundnum', 'int', '', '', '', '',
- 'amount', @money_type, '', '',
- '_date', @date_type, '', '',
- ],
- 'primary_key' => 'creditrefundnum',
- 'unique' => [],
- 'index' => [ ['crednum'], ['refundnum'] ],
- },
-
-
- 'cust_svc' => {
- 'columns' => [
- 'svcnum', 'serial', '', '', '', '',
- 'pkgnum', 'int', 'NULL', '', '', '',
- 'svcpart', 'int', '', '', '', '',
- 'overlimit', @date_type, '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [],
- 'index' => [ ['svcnum'], ['pkgnum'], ['svcpart'] ],
- },
-
- 'cust_svc_option' => {
- 'columns' => [
- 'optionnum', 'serial', '', '', '', '',
- 'svcnum', 'int', '', '', '', '',
- 'optionname', 'varchar', '', $char_d, '', '',
- 'optionvalue', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'optionnum',
- 'unique' => [],
- 'index' => [ [ 'svcnum' ], [ 'optionname' ] ],
- },
-
- 'part_pkg' => {
- 'columns' => [
- 'pkgpart', 'serial', '', '', '', '',
- 'pkg', 'varchar', '', $char_d, '', '',
- 'comment', 'varchar', '', $char_d, '', '',
- 'promo_code', 'varchar', 'NULL', $char_d, '', '',
- 'setup', @perl_type, '', '',
- 'freq', 'varchar', '', $char_d, '', '', #billing frequency
- 'recur', @perl_type, '', '',
- 'setuptax', 'char', 'NULL', 1, '', '',
- 'recurtax', 'char', 'NULL', 1, '', '',
- 'plan', 'varchar', 'NULL', $char_d, '', '',
- 'plandata', 'text', 'NULL', '', '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- 'custom', 'char', 'NULL', 1, '', '',
- 'taxclass', 'varchar', 'NULL', $char_d, '', '',
- 'classnum', 'int', 'NULL', '', '', '',
- 'addon_classnum','int', 'NULL', '', '', '',
- 'taxproductnum', 'int', 'NULL', '', '', '',
- 'setup_cost', @money_typen, '', '',
- 'recur_cost', @money_typen, '', '',
- 'pay_weight', 'real', 'NULL', '', '', '',
- 'credit_weight', 'real', 'NULL', '', '', '',
- 'agentnum', 'int', 'NULL', '', '', '',
- 'fcc_ds0s', 'int', 'NULL', '', '', '',
- 'no_auto', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'pkgpart',
- 'unique' => [],
- 'index' => [ [ 'promo_code' ], [ 'disabled' ], [ 'classnum' ],
- [ 'agentnum' ],
- ],
- },
-
- 'part_pkg_link' => {
- 'columns' => [
- 'pkglinknum', 'serial', '', '', '', '',
- 'src_pkgpart', 'int', '', '', '', '',
- 'dst_pkgpart', 'int', '', '', '', '',
- 'link_type', 'varchar', '', $char_d, '', '',
- 'hidden', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'pkglinknum',
- 'unique' => [ [ 'src_pkgpart', 'dst_pkgpart', 'link_type', 'hidden' ] ],
- 'index' => [ [ 'src_pkgpart' ] ],
- },
- # XXX somewhat borked unique: we don't really want a hidden and unhidden
- # it turns out we'd prefer to use svc, bill, and invisibill (or something)
-
- 'part_pkg_discount' => {
- 'columns' => [
- 'pkgdiscountnum', 'serial', '', '', '', '',
- 'pkgpart', 'int', '', '', '', '',
- 'discountnum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'pkgdiscountnum',
- 'unique' => [ [ 'pkgpart', 'discountnum' ] ],
- 'index' => [],
- },
-
- 'part_pkg_taxclass' => {
- 'columns' => [
- 'taxclassnum', 'serial', '', '', '', '',
- 'taxclass', 'varchar', '', $char_d, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'taxclassnum',
- 'unique' => [ [ 'taxclass' ] ],
- 'index' => [ [ 'disabled' ] ],
- },
-
- 'part_pkg_taxproduct' => {
- 'columns' => [
- 'taxproductnum', 'serial', '', '', '', '',
- 'data_vendor', 'varchar', 'NULL', $char_d, '', '',
- 'taxproduct', 'varchar', '', $char_d, '', '',
- 'description', 'varchar', '', 3*$char_d, '', '',
- ],
- 'primary_key' => 'taxproductnum',
- 'unique' => [ [ 'data_vendor', 'taxproduct' ] ],
- 'index' => [],
- },
-
- 'part_pkg_taxrate' => {
- 'columns' => [
- 'pkgtaxratenum', 'serial', '', '', '', '',
- 'data_vendor', 'varchar', 'NULL', $char_d, '', '', # update source
- 'geocode', 'varchar', 'NULL', $char_d, '', '', # cch provides 10
- 'taxproductnum', 'int', '', '', '', '',
- 'city', 'varchar', 'NULL', $char_d, '', '', # tax_location?
- 'county', 'varchar', 'NULL', $char_d, '', '',
- 'state', 'varchar', 'NULL', $char_d, '', '',
- 'local', 'varchar', 'NULL', $char_d, '', '',
- 'country', 'char', 'NULL', 2, '', '',
- 'taxclassnumtaxed', 'int', 'NULL', '', '', '',
- 'taxcattaxed', 'varchar', 'NULL', $char_d, '', '',
- 'taxclassnum', 'int', 'NULL', '', '', '',
- 'effdate', @date_type, '', '',
- 'taxable', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'pkgtaxratenum',
- 'unique' => [],
- 'index' => [ [ 'data_vendor', 'geocode', 'taxproductnum' ] ],
- },
-
- 'part_pkg_taxoverride' => {
- 'columns' => [
- 'taxoverridenum', 'serial', '', '', '', '',
- 'pkgpart', 'int', '', '', '', '',
- 'taxclassnum', 'int', '', '', '', '',
- 'usage_class', 'varchar', 'NULL', $char_d, '', '',
- ],
- 'primary_key' => 'taxoverridenum',
- 'unique' => [],
- 'index' => [ [ 'pkgpart' ], [ 'taxclassnum' ] ],
- },
-
-# 'part_title' => {
-# 'columns' => [
-# 'titlenum', 'int', '', '',
-# 'title', 'varchar', '', $char_d,
-# ],
-# 'primary_key' => 'titlenum',
-# 'unique' => [ [] ],
-# 'index' => [ [] ],
-# },
-
- 'pkg_svc' => {
- 'columns' => [
- 'pkgsvcnum', 'serial', '', '', '', '',
- 'pkgpart', 'int', '', '', '', '',
- 'svcpart', 'int', '', '', '', '',
- 'quantity', 'int', '', '', '', '',
- 'primary_svc','char', 'NULL', 1, '', '',
- 'hidden', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'pkgsvcnum',
- 'unique' => [ ['pkgpart', 'svcpart'] ],
- 'index' => [ ['pkgpart'], ['quantity'] ],
- },
-
- 'part_referral' => {
- 'columns' => [
- 'refnum', 'serial', '', '', '', '',
- 'referral', 'varchar', '', $char_d, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- 'agentnum', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'refnum',
- 'unique' => [],
- 'index' => [ ['disabled'], ['agentnum'], ],
- },
-
- 'part_svc' => {
- 'columns' => [
- 'svcpart', 'serial', '', '', '', '',
- 'svc', 'varchar', '', $char_d, '', '',
- 'svcdb', 'varchar', '', $char_d, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'svcpart',
- 'unique' => [],
- 'index' => [ [ 'disabled' ] ],
- },
-
- 'part_svc_column' => {
- 'columns' => [
- 'columnnum', 'serial', '', '', '', '',
- 'svcpart', 'int', '', '', '', '',
- 'columnname', 'varchar', '', 64, '', '',
- 'columnlabel', 'varchar', 'NULL', $char_d, '', '',
- 'columnvalue', 'varchar', 'NULL', $char_d, '', '',
- 'columnflag', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'columnnum',
- 'unique' => [ [ 'svcpart', 'columnname' ] ],
- 'index' => [ [ 'svcpart' ] ],
- },
-
- #(this should be renamed to part_pop)
- 'svc_acct_pop' => {
- 'columns' => [
- 'popnum', 'serial', '', '', '', '',
- 'city', 'varchar', '', $char_d, '', '',
- 'state', 'varchar', '', $char_d, '', '',
- 'ac', 'char', '', 3, '', '',
- 'exch', 'char', '', 3, '', '',
- 'loc', 'char', 'NULL', 4, '', '', #NULL for legacy purposes
- ],
- 'primary_key' => 'popnum',
- 'unique' => [],
- 'index' => [ [ 'state' ] ],
- },
-
- 'part_pop_local' => {
- 'columns' => [
- 'localnum', 'serial', '', '', '', '',
- 'popnum', 'int', '', '', '', '',
- 'city', 'varchar', 'NULL', $char_d, '', '',
- 'state', 'char', 'NULL', 2, '', '',
- 'npa', 'char', '', 3, '', '',
- 'nxx', 'char', '', 3, '', '',
- ],
- 'primary_key' => 'localnum',
- 'unique' => [],
- 'index' => [ [ 'npa', 'nxx' ], [ 'popnum' ] ],
- },
-
- 'qual' => {
- 'columns' => [
- 'qualnum', 'serial', '', '', '', '',
- 'custnum', 'int', 'NULL', '', '', '',
- 'prospectnum', 'int', 'NULL', '', '', '',
- 'locationnum', 'int', 'NULL', '', '', '',
- 'phonenum', 'varchar', 'NULL', 24, '', '',
- 'exportnum', 'int', 'NULL', '', '', '',
- 'vendor_qual_id', 'varchar', 'NULL', $char_d, '', '',
- 'status', 'char', '', 1, '', '',
- ],
- 'primary_key' => 'qualnum',
- 'unique' => [],
- 'index' => [ [ 'locationnum' ], ['custnum'], ['prospectnum'],
- ['phonenum'], ['vendor_qual_id'] ],
- },
-
- 'qual_option' => {
- 'columns' => [
- 'optionnum', 'serial', '', '', '', '',
- 'qualnum', 'int', '', '', '', '',
- 'optionname', 'varchar', '', $char_d, '', '',
- 'optionvalue', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'optionnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'svc_acct' => {
- 'columns' => [
- 'svcnum', 'int', '', '', '', '',
- 'username', 'varchar', '', $username_len, '', '',
- '_password', 'varchar', 'NULL', 512, '', '',
- '_password_encoding', 'varchar', 'NULL', $char_d, '', '',
- 'sec_phrase', 'varchar', 'NULL', $char_d, '', '',
- 'popnum', 'int', 'NULL', '', '', '',
- 'uid', 'int', 'NULL', '', '', '',
- 'gid', 'int', 'NULL', '', '', '',
- 'finger', 'varchar', 'NULL', $char_d, '', '',
- 'dir', 'varchar', 'NULL', $char_d, '', '',
- 'shell', 'varchar', 'NULL', $char_d, '', '',
- 'quota', 'varchar', 'NULL', $char_d, '', '',
- 'slipip', 'varchar', 'NULL', 15, '', '', #four TINYINTs, bah.
- 'seconds', 'int', 'NULL', '', '', '', #uhhhh
- 'seconds_threshold', 'int', 'NULL', '', '', '',
- 'upbytes', 'bigint', 'NULL', '', '', '',
- 'upbytes_threshold', 'bigint', 'NULL', '', '', '',
- 'downbytes', 'bigint', 'NULL', '', '', '',
- 'downbytes_threshold', 'bigint', 'NULL', '', '', '',
- 'totalbytes','bigint', 'NULL', '', '', '',
- 'totalbytes_threshold', 'bigint', 'NULL', '', '', '',
- 'domsvc', 'int', '', '', '', '',
- 'pbxsvc', 'int', 'NULL', '', '', '',
- 'last_login', @date_type, '', '',
- 'last_logout', @date_type, '', '',
- #cardfortress field(s)
- 'cf_privatekey', 'text', 'NULL', '', '', '',
- #communigate pro fields (quota = MaxAccountSize)
- 'cgp_aliases', 'varchar', 'NULL', 255, '', '',
- #settings
- 'cgp_type', 'varchar', 'NULL', $char_d, '', '', #AccountType
- '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, 'Y','', #PasswordRecovery
- 'cgp_rulesallowed','varchar', 'NULL', $char_d, '', '', #RulesAllowed
- 'cgp_rpopallowed', 'char', 'NULL', 1, '', '', #RPOPAllowed
- 'cgp_mailtoall', 'char', 'NULL', 1, '', '', #MailToAll
- 'cgp_addmailtrailer', 'char', 'NULL', 1, '', '', #AddMailTrailer
- 'cgp_archiveafter', 'int', 'NULL', '', '', '', #ArchiveMessagesAfter
- #XXX mailing lists
- #preferences
- 'cgp_deletemode', 'varchar', 'NULL', $char_d, '', '',#DeleteMode
- 'cgp_emptytrash', 'varchar', 'NULL', $char_d, '', '',#EmptyTrash
- 'cgp_language', 'varchar', 'NULL', $char_d, '', '',#Language
- 'cgp_timezone', 'varchar', 'NULL', $char_d, '', '',#TimeZone
- 'cgp_skinname', 'varchar', 'NULL', $char_d, '', '',#SkinName
- 'cgp_prontoskinname', 'varchar', 'NULL', $char_d, '', '',#ProntoSkinName
- 'cgp_sendmdnmode', 'varchar', 'NULL', $char_d, '', '',#SendMDNMode
- #mail
- #XXX RPOP settings
- ],
- 'primary_key' => 'svcnum',
- #'unique' => [ [ 'username', 'domsvc' ] ],
- 'unique' => [],
- 'index' => [ ['username'], ['domsvc'], ['pbxsvc'] ],
- },
-
- 'acct_rt_transaction' => {
- 'columns' => [
- 'svcrtid', 'int', '', '', '', '',
- 'svcnum', 'int', '', '', '', '',
- 'transaction_id', 'int', '', '', '', '',
- '_date', @date_type, '', '',
- 'seconds', 'int', '', '', '', '', #uhhhh
- 'support', 'int', '', '', '', '',
- ],
- 'primary_key' => 'svcrtid',
- 'unique' => [],
- 'index' => [ ['svcnum', 'transaction_id'] ],
- },
-
- #'svc_charge' => {
- # 'columns' => [
- # 'svcnum', 'int', '', '',
- # 'amount', @money_type,
- # ],
- # 'primary_key' => 'svcnum',
- # 'unique' => [ [] ],
- # 'index' => [ [] ],
- #},
-
- 'svc_domain' => {
- 'columns' => [
- 'svcnum', 'int', '', '', '', '',
- 'domain', 'varchar', '', $char_d, '', '',
- 'suffix', 'varchar', 'NULL', $char_d, '', '',
- 'catchall', 'int', 'NULL', '', '', '',
- 'parent_svcnum', 'int', 'NULL', '', '', '',
- 'registrarnum', 'int', 'NULL', '', '', '',
- 'registrarkey', 'varchar', 'NULL', 512, '', '',
- 'setup_date', @date_type, '', '',
- 'renewal_interval', 'int', 'NULL', '', '', '',
- 'expiration_date', @date_type, '', '',
- #communigate pro fields (quota = MaxAccountSize)
- 'max_accounts', 'int', 'NULL', '', '', '',
- 'trailer', 'text', 'NULL', '', '', '',
- 'cgp_aliases', 'varchar', 'NULL', 255, '', '',
- 'cgp_accessmodes','varchar','NULL', 255, '', '', #DomainAccessModes
- 'cgp_certificatetype','varchar','NULL', $char_d, '', '',
- #settings
- 'acct_def_password_selfchange', 'char', 'NULL', 1, '', '',
- 'acct_def_password_recover', 'char', 'NULL', 1, 'Y', '',
- '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_rulesallowed', 'varchar', 'NULL', $char_d, '', '',
- 'acct_def_cgp_rpopallowed', 'char', 'NULL', 1, '', '',
- 'acct_def_cgp_mailtoall', 'char', 'NULL', 1, '', '',
- 'acct_def_cgp_addmailtrailer', 'char', 'NULL', 1, '', '',
- 'acct_def_cgp_archiveafter', 'int', 'NULL', '', '', '',
- #preferences
- 'acct_def_cgp_deletemode', 'varchar', 'NULL', $char_d, '', '',
- 'acct_def_cgp_emptytrash', 'varchar', 'NULL', $char_d, '', '',
- 'acct_def_cgp_language', 'varchar', 'NULL', $char_d, '', '',
- 'acct_def_cgp_timezone', 'varchar', 'NULL', $char_d, '', '',
- 'acct_def_cgp_skinname', 'varchar', 'NULL', $char_d, '', '',
- 'acct_def_cgp_prontoskinname', 'varchar', 'NULL', $char_d, '', '',
- 'acct_def_cgp_sendmdnmode', 'varchar', 'NULL', $char_d, '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [ ],
- 'index' => [ ['domain'] ],
- },
-
- 'svc_dsl' => {
- 'columns' => [
- 'svcnum', 'int', '', '', '', '',
- 'pushed', 'int', 'NULL', '', '', '',
- 'desired_due_date', 'int', 'NULL', '', '', '',
- 'due_date', 'int', 'NULL', '', '', '',
- 'vendor_order_id', 'varchar', 'NULL', $char_d, '', '',
- 'vendor_qual_id', 'varchar', 'NULL', $char_d, '', '',
- 'vendor_order_type', 'varchar', 'NULL', $char_d, '', '',
- 'vendor_order_status', 'varchar', 'NULL', $char_d, '', '',
- 'first', 'varchar', 'NULL', $char_d, '', '',
- 'last', 'varchar', 'NULL', $char_d, '', '',
- 'company', 'varchar', 'NULL', $char_d, '', '',
- 'phonenum', 'varchar', 'NULL', 24, '', '',
- 'loop_type', 'char', 'NULL', 1, '', '',
- 'local_voice_provider', 'varchar', 'NULL', $char_d, '', '',
- 'circuitnum', 'varchar', 'NULL', $char_d, '', '',
- 'rate_band', 'varchar', 'NULL', $char_d, '', '',
- 'isp_chg', 'char', 'NULL', 1, '', '',
- 'isp_prev', 'varchar', 'NULL', $char_d, '', '',
- 'username', 'varchar', 'NULL', $char_d, '', '',
- 'password', 'varchar', 'NULL', $char_d, '', '',
- 'staticips', 'text', 'NULL', '', '', '',
- 'monitored', 'char', 'NULL', 1, '', '',
- 'last_pull', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [ ],
- 'index' => [ ['phonenum'], ['vendor_order_id'] ],
- },
-
- 'dsl_note' => {
- 'columns' => [
- 'notenum', 'serial', '', '', '', '',
- 'svcnum', 'int', '', '', '', '',
- 'author', 'varchar', 'NULL', $char_d, '', '',
- 'priority', 'char', 'NULL', 1, '', '',
- '_date', 'int', 'NULL', '', '', '',
- 'note', 'text', '', '', '', '',
- ],
- 'primary_key' => 'notenum',
- 'unique' => [ ],
- 'index' => [ ['svcnum'] ],
- },
-
- 'domain_record' => {
- 'columns' => [
- 'recnum', 'serial', '', '', '', '',
- 'svcnum', 'int', '', '', '', '',
- 'reczone', 'varchar', '', 255, '', '',
- 'recaf', 'char', '', 2, '', '',
- 'rectype', 'varchar', '', 5, '', '',
- 'recdata', 'varchar', '', 255, '', '',
- 'ttl', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'recnum',
- 'unique' => [],
- 'index' => [ ['svcnum'] ],
- },
-
- 'registrar' => {
- 'columns' => [
- 'registrarnum', 'serial', '', '', '', '',
- 'registrarname', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'registrarnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'cgp_rule' => {
- 'columns' => [
- 'rulenum', 'serial', '', '', '', '',
- 'name', 'varchar', '', $char_d, '', '',
- 'comment', 'varchar', 'NULL', $char_d, '', '',
- 'svcnum', 'int', '', '', '', '',
- 'priority', 'int', '', '', '', '',
- ],
- 'primary_key' => 'rulenum',
- 'unique' => [ [ 'svcnum', 'name' ] ],
- 'index' => [ [ 'svcnum' ] ],
- },
-
- 'cgp_rule_condition' => {
- 'columns' => [
- 'ruleconditionnum', 'serial', '', '', '', '',
- 'conditionname', 'varchar', '', $char_d, '', '',
- 'op', 'varchar', 'NULL', $char_d, '', '',
- 'params', 'varchar', 'NULL', 255, '', '',
- 'rulenum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'ruleconditionnum',
- 'unique' => [],
- 'index' => [ [ 'rulenum' ] ],
- },
-
- 'cgp_rule_action' => {
- 'columns' => [
- 'ruleactionnum', 'serial', '', '', '', '',
- 'action', 'varchar', '', $char_d, '', '',
- 'params', 'varchar', 'NULL', 255, '', '',
- 'rulenum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'ruleactionnum',
- 'unique' => [],
- 'index' => [ [ 'rulenum' ] ],
- },
-
- 'svc_forward' => {
- 'columns' => [
- 'svcnum', 'int', '', '', '', '',
- 'srcsvc', 'int', 'NULL', '', '', '',
- 'src', 'varchar', 'NULL', 255, '', '',
- 'dstsvc', 'int', 'NULL', '', '', '',
- 'dst', 'varchar', 'NULL', 255, '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [],
- 'index' => [ ['srcsvc'], ['dstsvc'] ],
- },
-
- 'svc_www' => {
- 'columns' => [
- 'svcnum', 'int', '', '', '', '',
- 'recnum', 'int', '', '', '', '',
- 'usersvc', 'int', 'NULL', '', '', '',
- 'config', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [],
- 'index' => [],
- },
-
- #'svc_wo' => {
- # 'columns' => [
- # 'svcnum', 'int', '', '',
- # 'svcnum', 'int', '', '',
- # 'svcnum', 'int', '', '',
- # 'worker', 'varchar', '', $char_d,
- # '_date', @date_type,
- # ],
- # 'primary_key' => 'svcnum',
- # 'unique' => [ [] ],
- # 'index' => [ [] ],
- #},
-
- 'prepay_credit' => {
- 'columns' => [
- 'prepaynum', 'serial', '', '', '', '',
- 'identifier', 'varchar', '', $char_d, '', '',
- 'amount', @money_type, '', '',
- 'seconds', 'int', 'NULL', '', '', '',
- 'upbytes', 'bigint', 'NULL', '', '', '',
- 'downbytes', 'bigint', 'NULL', '', '', '',
- 'totalbytes', 'bigint', 'NULL', '', '', '',
- 'agentnum', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'prepaynum',
- 'unique' => [ ['identifier'] ],
- 'index' => [],
- },
-
- 'port' => {
- 'columns' => [
- 'portnum', 'serial', '', '', '', '',
- 'ip', 'varchar', 'NULL', 15, '', '',
- 'nasport', 'int', 'NULL', '', '', '',
- 'nasnum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'portnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'nas' => {
- 'columns' => [
- 'nasnum', 'serial', '', '', '', '',
- 'nas', 'varchar', '', $char_d, '', '',
- 'nasip', 'varchar', '', 15, '', '',
- 'nasfqdn', 'varchar', '', $char_d, '', '',
- 'last', 'int', '', '', '', '',
- ],
- 'primary_key' => 'nasnum',
- 'unique' => [ [ 'nas' ], [ 'nasip' ] ],
- 'index' => [ [ 'last' ] ],
- },
-
-# 'session' => {
-# 'columns' => [
-# 'sessionnum', 'serial', '', '', '', '',
-# 'portnum', 'int', '', '', '', '',
-# 'svcnum', 'int', '', '', '', '',
-# 'login', @date_type, '', '',
-# 'logout', @date_type, '', '',
-# ],
-# 'primary_key' => 'sessionnum',
-# 'unique' => [],
-# 'index' => [ [ 'portnum' ] ],
-# },
-
- 'queue' => {
- 'columns' => [
- 'jobnum', 'serial', '', '', '', '',
- 'job', 'varchar', '', 512, '', '',
- '_date', 'int', '', '', '', '',
- 'status', 'varchar', '', $char_d, '', '',
- 'statustext', 'text', 'NULL', '', '', '',
- 'svcnum', 'int', 'NULL', '', '', '',
- 'custnum', 'int', 'NULL', '', '', '',
- 'secure', 'char', 'NULL', 1, '', '',
- 'priority', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'jobnum',
- 'unique' => [],
- 'index' => [ [ 'secure' ], [ 'priority' ],
- [ 'job' ], [ 'svcnum' ], [ 'custnum' ], [ 'status' ],
- ],
- },
-
- 'queue_arg' => {
- 'columns' => [
- 'argnum', 'serial', '', '', '', '',
- 'jobnum', 'int', '', '', '', '',
- 'frozen', 'char', 'NULL', 1, '', '',
- 'arg', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'argnum',
- 'unique' => [],
- 'index' => [ [ 'jobnum' ] ],
- },
-
- 'queue_depend' => {
- 'columns' => [
- 'dependnum', 'serial', '', '', '', '',
- 'jobnum', 'int', '', '', '', '',
- 'depend_jobnum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'dependnum',
- 'unique' => [],
- 'index' => [ [ 'jobnum' ], [ 'depend_jobnum' ] ],
- },
-
- 'export_svc' => {
- 'columns' => [
- 'exportsvcnum' => 'serial', '', '', '', '',
- 'exportnum' => 'int', '', '', '', '',
- 'svcpart' => 'int', '', '', '', '',
- ],
- 'primary_key' => 'exportsvcnum',
- 'unique' => [ [ 'exportnum', 'svcpart' ] ],
- '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', '', '', '', '',
- 'exportname', 'varchar', 'NULL', $char_d, '', '',
- 'machine', 'varchar', '', $char_d, '', '',
- 'exporttype', 'varchar', '', $char_d, '', '',
- 'nodomain', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'exportnum',
- 'unique' => [],
- 'index' => [ [ 'machine' ], [ 'exporttype' ] ],
- },
-
- 'part_export_option' => {
- 'columns' => [
- 'optionnum', 'serial', '', '', '', '',
- 'exportnum', 'int', '', '', '', '',
- 'optionname', 'varchar', '', $char_d, '', '',
- 'optionvalue', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'optionnum',
- 'unique' => [],
- 'index' => [ [ 'exportnum' ], [ 'optionname' ] ],
- },
-
- 'radius_usergroup' => {
- 'columns' => [
- 'usergroupnum', 'serial', '', '', '', '',
- 'svcnum', 'int', '', '', '', '',
- 'groupname', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'usergroupnum',
- 'unique' => [],
- 'index' => [ [ 'svcnum' ], [ 'groupname' ] ],
- },
-
- 'msgcat' => {
- 'columns' => [
- 'msgnum', 'serial', '', '', '', '',
- 'msgcode', 'varchar', '', $char_d, '', '',
- 'locale', 'varchar', '', 16, '', '',
- 'msg', 'text', '', '', '', '',
- ],
- 'primary_key' => 'msgnum',
- 'unique' => [ [ 'msgcode', 'locale' ] ],
- 'index' => [],
- },
-
- 'cust_tax_exempt' => {
- 'columns' => [
- 'exemptnum', 'serial', '', '', '', '',
- 'custnum', 'int', '', '', '', '',
- 'taxnum', 'int', '', '', '', '',
- 'year', 'int', '', '', '', '',
- 'month', 'int', '', '', '', '',
- 'amount', @money_type, '', '',
- ],
- 'primary_key' => 'exemptnum',
- 'unique' => [ [ 'custnum', 'taxnum', 'year', 'month' ] ],
- 'index' => [],
- },
-
- 'cust_tax_exempt_pkg' => {
- 'columns' => [
- 'exemptpkgnum', 'serial', '', '', '', '',
- #'custnum', 'int', '', '', '', ''
- 'billpkgnum', 'int', '', '', '', '',
- 'taxnum', 'int', '', '', '', '',
- 'year', 'int', '', '', '', '',
- 'month', 'int', '', '', '', '',
- 'creditbillpkgnum', 'int', 'NULL', '', '', '',
- 'amount', @money_type, '', '',
- ],
- 'primary_key' => 'exemptpkgnum',
- 'unique' => [],
- 'index' => [ [ 'taxnum', 'year', 'month' ],
- [ 'billpkgnum' ],
- [ 'taxnum' ],
- [ 'creditbillpkgnum' ],
- ],
- },
-
- 'router' => {
- 'columns' => [
- 'routernum', 'serial', '', '', '', '',
- 'routername', 'varchar', '', $char_d, '', '',
- 'svcnum', 'int', 'NULL', '', '', '',
- 'agentnum', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'routernum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'part_svc_router' => {
- 'columns' => [
- 'svcrouternum', 'serial', '', '', '', '',
- 'svcpart', 'int', '', '', '', '',
- 'routernum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'svcrouternum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'addr_block' => {
- 'columns' => [
- 'blocknum', 'serial', '', '', '', '',
- 'routernum', 'int', '', '', '', '',
- 'ip_gateway', 'varchar', '', 15, '', '',
- 'ip_netmask', 'int', '', '', '', '',
- 'agentnum', 'int', 'NULL', '', '', '',
- 'manual_flag', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'blocknum',
- 'unique' => [ [ 'blocknum', 'routernum' ] ],
- 'index' => [],
- },
-
- 'svc_broadband' => {
- 'columns' => [
- 'svcnum', 'int', '', '', '', '',
- 'description', 'varchar', 'NULL', $char_d, '', '',
- 'blocknum', 'int', 'NULL', '', '', '',
- 'speed_up', 'int', '', '', '', '',
- 'speed_down', 'int', '', '', '', '',
- 'ip_addr', 'varchar', 'NULL', 15, '', '',
- 'mac_addr', 'varchar', 'NULL', 12, '', '',
- 'authkey', 'varchar', 'NULL', 32, '', '',
- 'latitude', 'decimal', 'NULL', '', '', '',
- 'longitude', 'decimal', 'NULL', '', '', '',
- 'altitude', 'decimal', 'NULL', '', '', '',
- 'vlan_profile', 'varchar', 'NULL', $char_d, '', '',
- 'performance_profile', 'varchar', 'NULL', $char_d, '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [ [ 'mac_addr' ] ],
- 'index' => [],
- },
-
- 'part_virtual_field' => {
- 'columns' => [
- 'vfieldpart', 'serial', '', '', '', '',
- 'dbtable', 'varchar', '', 32, '', '',
- 'name', 'varchar', '', 32, '', '',
- 'check_block', 'text', 'NULL', '', '', '',
- 'length', 'int', 'NULL', '', '', '',
- 'list_source', 'text', 'NULL', '', '', '',
- 'label', 'varchar', 'NULL', 80, '', '',
- ],
- 'primary_key' => 'vfieldpart',
- 'unique' => [],
- 'index' => [],
- },
-
- 'virtual_field' => {
- 'columns' => [
- 'vfieldnum', 'serial', '', '', '', '',
- 'recnum', 'int', '', '', '', '',
- 'vfieldpart', 'int', '', '', '', '',
- 'value', 'varchar', '', 128, '', '',
- ],
- 'primary_key' => 'vfieldnum',
- 'unique' => [ [ 'vfieldpart', 'recnum' ] ],
- 'index' => [],
- },
-
- 'acct_snarf' => {
- 'columns' => [
- 'snarfnum', 'serial', '', '', '', '',
- 'snarfname', 'varchar', 'NULL', $char_d, '', '',
- 'svcnum', 'int', '', '', '', '',
- 'machine', 'varchar', '', 255, '', '',
- 'protocol', 'varchar', '', $char_d, '', '',
- 'username', 'varchar', '', $char_d, '', '',
- '_password', 'varchar', '', $char_d, '', '',
- 'check_freq', 'int', 'NULL', '', '', '',
- 'leavemail', 'char', 'NULL', 1, '', '',
- 'apop', 'char', 'NULL', 1, '', '',
- 'tls', 'char', 'NULL', 1, '', '',
- 'mailbox', 'varchar', 'NULL', $char_d, '', '',
- ],
- 'primary_key' => 'snarfnum',
- 'unique' => [],
- 'index' => [ [ 'svcnum' ] ],
- },
-
- 'svc_external' => {
- 'columns' => [
- 'svcnum', 'int', '', '', '', '',
- 'id', 'int', 'NULL', '', '', '',
- 'title', 'varchar', 'NULL', $char_d, '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'cust_pay_refund' => {
- 'columns' => [
- 'payrefundnum', 'serial', '', '', '', '',
- 'paynum', 'int', '', '', '', '',
- 'refundnum', 'int', '', '', '', '',
- '_date', @date_type, '', '',
- 'amount', @money_type, '', '',
- ],
- 'primary_key' => 'payrefundnum',
- 'unique' => [],
- 'index' => [ ['paynum'], ['refundnum'] ],
- },
-
- 'part_pkg_option' => {
- 'columns' => [
- 'optionnum', 'serial', '', '', '', '',
- 'pkgpart', 'int', '', '', '', '',
- 'optionname', 'varchar', '', $char_d, '', '',
- 'optionvalue', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'optionnum',
- 'unique' => [],
- 'index' => [ [ 'pkgpart' ], [ 'optionname' ] ],
- },
-
- 'part_pkg_vendor' => {
- 'columns' => [
- 'num', 'serial', '', '', '', '',
- 'pkgpart', 'int', '', '', '', '',
- 'exportnum', 'int', '', '', '', '',
- 'vendor_pkg_id', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'num',
- 'unique' => [ [ 'pkgpart', 'exportnum' ] ],
- 'index' => [ [ 'pkgpart' ] ],
- },
-
- 'part_pkg_report_option' => {
- 'columns' => [
- 'num', 'serial', '', '', '', '',
- 'name', 'varchar', '', $char_d, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'num',
- 'unique' => [ [ 'name' ] ],
- 'index' => [ [ 'disabled' ] ],
- },
-
- 'rate' => {
- 'columns' => [
- 'ratenum', 'serial', '', '', '', '',
- 'ratename', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'ratenum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'rate_detail' => {
- 'columns' => [
- 'ratedetailnum', 'serial', '', '', '', '',
- 'ratenum', 'int', '', '', '', '',
- 'orig_regionnum', 'int', 'NULL', '', '', '',
- 'dest_regionnum', 'int', '', '', '', '',
- 'min_included', 'int', '', '', '', '',
- 'conn_charge', 'decimal', '', '10,4', '0', '',
- 'conn_sec', 'int', '', '', '0', '',
- 'min_charge', 'decimal', '', '10,5', '', '', #@money_type, '', '',
- 'sec_granularity', 'int', '', '', '', '',
- 'ratetimenum', 'int', 'NULL', '', '', '',
- 'classnum', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'ratedetailnum',
- 'unique' => [ [ 'ratenum', 'orig_regionnum', 'dest_regionnum' ] ],
- 'index' => [ [ 'ratenum', 'dest_regionnum' ] ],
- },
-
- 'rate_region' => {
- 'columns' => [
- 'regionnum', 'serial', '', '', '', '',
- 'regionname', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'regionnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'rate_prefix' => {
- 'columns' => [
- 'prefixnum', 'serial', '', '', '', '',
- 'regionnum', 'int', '', '', '', '',
- 'countrycode', 'varchar', '', 3, '', '',
- 'npa', 'varchar', 'NULL', 10, '', '', #actually the whole prefix
- 'nxx', 'varchar', 'NULL', 3, '', '', #actually not used
- ],
- 'primary_key' => 'prefixnum',
- 'unique' => [],
- 'index' => [ [ 'countrycode' ], [ 'npa' ], [ 'regionnum' ] ],
- },
-
- 'rate_time' => {
- 'columns' => [
- 'ratetimenum', 'serial', '', '', '', '',
- 'ratetimename', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'ratetimenum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'rate_time_interval' => {
- 'columns' => [
- 'intervalnum', 'serial', '', '', '', '',
- 'stime', 'int', '', '', '', '',
- 'etime', 'int', '', '', '', '',
- 'ratetimenum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'intervalnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'usage_class' => {
- 'columns' => [
- 'classnum', 'serial', '', '', '', '',
- 'weight', 'int', 'NULL', '', '', '',
- 'classname', 'varchar', '', $char_d, '', '',
- 'format', 'varchar', 'NULL', $char_d, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'classnum',
- 'unique' => [],
- 'index' => [ ['disabled'] ],
- },
-
- 'reg_code' => {
- 'columns' => [
- 'codenum', 'serial', '', '', '', '',
- 'code', 'varchar', '', $char_d, '', '',
- 'agentnum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'codenum',
- 'unique' => [ [ 'agentnum', 'code' ] ],
- 'index' => [ [ 'agentnum' ] ],
- },
-
- 'reg_code_pkg' => {
- 'columns' => [
- 'codepkgnum', 'serial', '', '', '', '',
- 'codenum', 'int', '', '', '', '',
- 'pkgpart', 'int', '', '', '', '',
- ],
- 'primary_key' => 'codepkgnum',
- 'unique' => [ [ 'codenum', 'pkgpart' ] ],
- 'index' => [ [ 'codenum' ] ],
- },
-
- 'clientapi_session' => {
- 'columns' => [
- 'sessionnum', 'serial', '', '', '', '',
- 'sessionid', 'varchar', '', $char_d, '', '',
- 'namespace', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'sessionnum',
- 'unique' => [ [ 'sessionid', 'namespace' ] ],
- 'index' => [],
- },
-
- 'clientapi_session_field' => {
- 'columns' => [
- 'fieldnum', 'serial', '', '', '', '',
- 'sessionnum', 'int', '', '', '', '',
- 'fieldname', 'varchar', '', $char_d, '', '',
- 'fieldvalue', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'fieldnum',
- 'unique' => [ [ 'sessionnum', 'fieldname' ] ],
- 'index' => [],
- },
-
- 'payment_gateway' => {
- 'columns' => [
- 'gatewaynum', 'serial', '', '', '', '',
- 'gateway_namespace','varchar', 'NULL', $char_d, '', '',
- 'gateway_module', 'varchar', '', $char_d, '', '',
- 'gateway_username', 'varchar', 'NULL', $char_d, '', '',
- 'gateway_password', 'varchar', 'NULL', $char_d, '', '',
- 'gateway_action', 'varchar', 'NULL', $char_d, '', '',
- 'gateway_callback_url', 'varchar', 'NULL', $char_d, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'gatewaynum',
- 'unique' => [],
- 'index' => [ [ 'disabled' ] ],
- },
-
- 'payment_gateway_option' => {
- 'columns' => [
- 'optionnum', 'serial', '', '', '', '',
- 'gatewaynum', 'int', '', '', '', '',
- 'optionname', 'varchar', '', $char_d, '', '',
- 'optionvalue', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'optionnum',
- 'unique' => [],
- 'index' => [ [ 'gatewaynum' ], [ 'optionname' ] ],
- },
-
- 'agent_payment_gateway' => {
- 'columns' => [
- 'agentgatewaynum', 'serial', '', '', '', '',
- 'agentnum', 'int', '', '', '', '',
- 'gatewaynum', 'int', '', '', '', '',
- 'cardtype', 'varchar', 'NULL', $char_d, '', '',
- 'taxclass', 'varchar', 'NULL', $char_d, '', '',
- ],
- 'primary_key' => 'agentgatewaynum',
- 'unique' => [],
- 'index' => [ [ 'agentnum', 'cardtype' ], ],
- },
-
- 'banned_pay' => {
- 'columns' => [
- 'bannum', 'serial', '', '', '', '',
- 'payby', 'char', '', 4, '', '',
- 'payinfo', 'varchar', '', 128, '', '', #say, a 512-big digest _hex encoded
- #'paymask', 'varchar', 'NULL', $char_d, '', ''
- '_date', @date_type, '', '',
- 'otaker', 'varchar', 'NULL', 32, '', '',
- 'usernum', 'int', 'NULL', '', '', '',
- 'reason', 'varchar', 'NULL', $char_d, '', '',
- ],
- 'primary_key' => 'bannum',
- 'unique' => [ [ 'payby', 'payinfo' ] ],
- 'index' => [ [ 'usernum' ] ],
- },
-
- 'pkg_category' => {
- 'columns' => [
- 'categorynum', 'serial', '', '', '', '',
- 'categoryname', 'varchar', '', $char_d, '', '',
- 'weight', 'int', 'NULL', '', '', '',
- 'condense', 'char', 'NULL', 1, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'categorynum',
- 'unique' => [],
- 'index' => [ ['disabled'] ],
- },
-
- 'pkg_class' => {
- 'columns' => [
- 'classnum', 'serial', '', '', '', '',
- 'classname', 'varchar', '', $char_d, '', '',
- 'categorynum', 'int', 'NULL', '', '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'classnum',
- 'unique' => [],
- 'index' => [ ['disabled'] ],
- },
-
- 'cdr' => {
- 'columns' => [
- # qw( name type null length default local );
-
- ###
- #asterisk fields
- ###
-
- 'acctid', 'bigserial', '', '', '', '',
- #'calldate', 'TIMESTAMP with time zone', '', '', \'now()', '',
- 'calldate', 'timestamp', '', '', \'now()', '',
- 'clid', 'varchar', '', $char_d, \"''", '',
- 'src', 'varchar', '', $char_d, \"''", '',
- 'dst', 'varchar', '', $char_d, \"''", '',
- 'dcontext', 'varchar', '', $char_d, \"''", '',
- 'channel', 'varchar', '', $char_d, \"''", '',
- 'dstchannel', 'varchar', '', $char_d, \"''", '',
- 'lastapp', 'varchar', '', $char_d, \"''", '',
- 'lastdata', 'varchar', '', $char_d, \"''", '',
-
- #these don't seem to be logged by most of the SQL cdr_* modules
- #except tds under sql-illegal names, so;
- # ... don't rely on them for rating?
- # and, what they hey, i went ahead and changed the names and data types
- # to freeside-style dates...
- #'start', 'timestamp', 'NULL', '', '', '',
- #'answer', 'timestamp', 'NULL', '', '', '',
- #'end', 'timestamp', 'NULL', '', '', '',
- 'startdate', @date_type, '', '',
- 'answerdate', @date_type, '', '',
- 'enddate', @date_type, '', '',
- #
-
- 'duration', 'int', '', '', 0, '',
- 'billsec', 'int', '', '', 0, '',
- 'disposition', 'varchar', '', 45, \"''", '',
- 'amaflags', 'int', '', '', 0, '',
- 'accountcode', 'varchar', '', 20, \"''", '',
- 'uniqueid', 'varchar', '', 32, \"''", '',
- 'userfield', 'varchar', '', 255, \"''", '',
-
- 'max_callers', 'int', 'NULL', '', '', '',
-
- ###
- # fields for unitel/RSLCOM/convergent that don't map well to asterisk
- # defaults
- # though these are now used elsewhere:
- # charged_party, upstream_price, rated_price, carrierid
- ###
-
- #cdr_type: Usage = 1, S&E = 7, OC&C = 8
- 'cdrtypenum', 'int', 'NULL', '', '', '',
-
- 'charged_party', 'varchar', 'NULL', $char_d, '', '',
-
- 'upstream_currency', 'char', 'NULL', 3, '', '',
- 'upstream_price', 'decimal', 'NULL', '10,2', '', '',
- 'upstream_rateplanid', 'int', 'NULL', '', '', '', #?
-
- # how it was rated internally...
- 'ratedetailnum', 'int', 'NULL', '', '', '',
- 'rated_price', 'decimal', 'NULL', '10,4', '', '',
-
- 'distance', 'decimal', 'NULL', '', '', '',
- 'islocal', 'int', 'NULL', '', '', '', # '', '', 0, '' instead?
-
- #cdr_calltype: the big list in appendix 2
- 'calltypenum', 'int', 'NULL', '', '', '',
-
- 'description', 'varchar', 'NULL', $char_d, '', '',
- 'quantity', 'int', 'NULL', '', '', '',
-
- #cdr_carrier: Telstra =1, Optus = 2, RSL COM = 3
- 'carrierid', 'int', 'NULL', '', '', '',
-
- 'upstream_rateid', 'int', 'NULL', '', '', '',
-
- ###
- #and now for our own fields
- ###
-
- # a svcnum... right..?
- 'svcnum', 'int', 'NULL', '', '', '',
-
- #NULL, done (or something)
- 'freesidestatus', 'varchar', 'NULL', 32, '', '',
-
- #NULL, done (or something)
- 'freesiderewritestatus', 'varchar', 'NULL', 32, '', '',
-
- #an indexed place to put big numbers
- 'cdrid', 'bigint', 'NULL', '', '', '',
-
- #old
- 'cdrbatch', 'varchar', 'NULL', 255, '', '',
- #new
- 'cdrbatchnum', 'int', 'NULL', '', '', '',
-
- ],
- 'primary_key' => 'acctid',
- 'unique' => [],
- 'index' => [ [ 'calldate' ],
- [ 'src' ], [ 'dst' ], [ 'dcontext' ], [ 'charged_party' ],
- [ 'accountcode' ], [ 'carrierid' ], [ 'cdrid' ],
- [ 'freesidestatus' ], [ 'freesiderewritestatus' ],
- [ 'cdrbatch' ], [ 'cdrbatchnum' ],
- ],
- },
-
- 'cdr_batch' => {
- 'columns' => [
- 'cdrbatchnum', 'serial', '', '', '', '',
- 'cdrbatch', 'varchar', 'NULL', 255, '', '',
- '_date', @date_type, '', '',
- ],
- 'primary_key' => 'cdrbatchnum',
- 'unique' => [ [ 'cdrbatch' ] ],
- 'index' => [],
- },
-
- 'cdr_termination' => {
- 'columns' => [
- 'cdrtermnum', 'bigserial', '', '', '', '',
- 'acctid', 'bigint', '', '', '', '',
- 'termpart', 'int', '', '', '', '',#future use see below
- 'rated_price', 'decimal', 'NULL', '10,4', '', '',
- 'status', 'varchar', 'NULL', 32, '', '',
- 'svcnum', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'cdrtermnum',
- 'unique' => [ [ 'acctid', 'termpart' ] ],
- 'index' => [ [ 'acctid' ], [ 'status' ], ],
- },
-
- #to handle multiple termination/settlement passes...
- # 'part_termination' => {
- # 'columns' => [
- # 'termpart', 'int', '', '', '', '',
- # 'termname', 'varchar', '', $char_d, '', '',
- # 'cdr_column', 'varchar', '', $char_d, '', '', #maybe set it here instead of in the price plan?
- # ],
- # 'primary_key' => 'termpart',
- # 'unique' => [],
- # 'index' => [],
- # },
-
- #the remaining cdr_ tables are not really used
- 'cdr_calltype' => {
- 'columns' => [
- 'calltypenum', 'serial', '', '', '', '',
- 'calltypename', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'calltypenum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'cdr_type' => {
- 'columns' => [
- 'cdrtypenum' => 'serial', '', '', '', '',
- 'cdrtypename' => 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'cdrtypenum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'cdr_carrier' => {
- 'columns' => [
- 'carrierid' => 'serial', '', '', '', '',
- 'carriername' => 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'carrierid',
- 'unique' => [],
- 'index' => [],
- },
-
- #'cdr_file' => {
- # 'columns' => [
- # 'filenum', 'serial', '', '', '', '',
- # 'filename', 'varchar', '', '', '', '',
- # 'status', 'varchar', 'NULL', '', '', '',
- # ],
- # 'primary_key' => 'filenum',
- # 'unique' => [ [ 'filename' ], ], #just change the index if we need to
- # # agent-virtualize or have a customer
- # # with dup-filename needs or something
- # # (only used by cdr.http_and_import for
- # # chrissakes)
- # 'index' => [],
- #},
-
- 'inventory_item' => {
- 'columns' => [
- 'itemnum', 'serial', '', '', '', '',
- 'classnum', 'int', '', '', '', '',
- 'agentnum', 'int', 'NULL', '', '', '',
- 'item', 'varchar', '', $char_d, '', '',
- 'svcnum', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'itemnum',
- 'unique' => [ [ 'classnum', 'item' ] ],
- 'index' => [ [ 'classnum' ], [ 'agentnum' ], [ 'svcnum' ] ],
- },
-
- 'inventory_class' => {
- 'columns' => [
- 'classnum', 'serial', '', '', '', '',
- 'classname', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'classnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'access_user' => {
- 'columns' => [
- 'usernum', 'serial', '', '', '', '',
- 'username', 'varchar', '', $char_d, '', '',
- '_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' => [ [ 'user_custnum' ] ],
- },
-
- 'access_user_pref' => {
- 'columns' => [
- 'prefnum', 'serial', '', '', '', '',
- 'usernum', 'int', '', '', '', '',
- 'prefname', 'varchar', '', $char_d, '', '',
- 'prefvalue', 'text', 'NULL', '', '', '',
- 'expiration', @date_type, '', '',
- ],
- 'primary_key' => 'prefnum',
- 'unique' => [],
- 'index' => [ [ 'usernum' ] ],
- },
-
- 'access_group' => {
- 'columns' => [
- 'groupnum', 'serial', '', '', '', '',
- 'groupname', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'groupnum',
- 'unique' => [ [ 'groupname' ] ],
- 'index' => [],
- },
-
- 'access_usergroup' => {
- 'columns' => [
- 'usergroupnum', 'serial', '', '', '', '',
- 'usernum', 'int', '', '', '', '',
- 'groupnum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'usergroupnum',
- 'unique' => [ [ 'usernum', 'groupnum' ] ],
- 'index' => [ [ 'usernum' ] ],
- },
-
- 'access_groupagent' => {
- 'columns' => [
- 'groupagentnum', 'serial', '', '', '', '',
- 'groupnum', 'int', '', '', '', '',
- 'agentnum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'groupagentnum',
- 'unique' => [ [ 'groupnum', 'agentnum' ] ],
- 'index' => [ [ 'groupnum' ] ],
- },
-
- 'access_right' => {
- 'columns' => [
- 'rightnum', 'serial', '', '', '', '',
- 'righttype', 'varchar', '', $char_d, '', '',
- 'rightobjnum', 'int', '', '', '', '',
- 'rightname', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'rightnum',
- 'unique' => [ [ 'righttype', 'rightobjnum', 'rightname' ] ],
- 'index' => [],
- },
-
- 'svc_phone' => {
- 'columns' => [
- 'svcnum', 'int', '', '', '', '',
- 'countrycode', 'varchar', '', 3, '', '',
- 'phonenum', 'varchar', '', 15, '', '', #12 ?
- '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', '', '', '',
- 'lnp_status', 'varchar', 'NULL', $char_d, '', '',
- 'portable', 'char', 'NULL', 1, '', '',
- 'lrn', 'char', 'NULL', 10, '', '',
- 'lnp_desired_due_date', 'int', 'NULL', '', '', '',
- 'lnp_due_date', 'int', 'NULL', '', '', '',
- 'lnp_other_provider', 'varchar', 'NULL', $char_d, '', '',
- 'lnp_other_provider_account', 'varchar', 'NULL', $char_d, '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [],
- 'index' => [ ['countrycode', 'phonenum'], ['pbxsvc'], ['domsvc'],
- ['locationnum'],
- ],
- },
-
- 'phone_device' => {
- 'columns' => [
- 'devicenum', 'serial', '', '', '', '',
- 'devicepart', 'int', '', '', '', '',
- 'svcnum', 'int', '', '', '', '',
- 'mac_addr', 'varchar', 'NULL', 12, '', '',
- ],
- 'primary_key' => 'devicenum',
- 'unique' => [ [ 'mac_addr' ], ],
- 'index' => [ [ 'devicepart' ], [ 'svcnum' ], ],
- },
-
- 'part_device' => {
- 'columns' => [
- 'devicepart', 'serial', '', '', '', '',
- 'devicename', 'varchar', '', $char_d, '', '',
- #'classnum', #tie to an inventory class?
- ],
- 'primary_key' => 'devicepart',
- 'unique' => [ [ 'devicename' ] ], #?
- 'index' => [],
- },
-
- 'phone_avail' => {
- 'columns' => [
- 'availnum', 'serial', '', '', '', '',
- 'exportnum', 'int', '', '', '', '',
- 'countrycode', 'varchar', '', 3, '', '',
- 'state', 'char', 'NULL', 2, '', '',
- 'npa', 'char', '', 3, '', '',
- 'nxx', 'char', 'NULL', 3, '', '',
- 'station', 'char', 'NULL', 4, '', '',
- 'name', 'varchar', 'NULL', $char_d, '', '',
- 'svcnum', 'int', 'NULL', '', '', '',
- 'availbatch', 'varchar', 'NULL', $char_d, '', '',
- ],
- 'primary_key' => 'availnum',
- 'unique' => [],
- 'index' => [ [ 'exportnum', 'countrycode', 'state' ], #npa search
- [ 'exportnum', 'countrycode', 'npa' ], #nxx search
- [ 'exportnum', 'countrycode', 'npa', 'nxx' ],#station search
- [ 'exportnum', 'countrycode', 'npa', 'nxx', 'station' ], # #
- [ 'svcnum' ],
- [ 'availbatch' ],
- ],
- },
-
- 'reason_type' => {
- 'columns' => [
- 'typenum', 'serial', '', '', '', '',
- 'class', 'char', '', 1, '', '',
- 'type', 'varchar', '', $char_d, '', '',
- ],
- 'primary_key' => 'typenum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'reason' => {
- 'columns' => [
- 'reasonnum', 'serial', '', '', '', '',
- 'reason_type', 'int', '', '', '', '',
- 'reason', 'text', '', '', '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- ],
- 'primary_key' => 'reasonnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'conf' => {
- 'columns' => [
- 'confnum', 'serial', '', '', '', '',
- 'agentnum', 'int', 'NULL', '', '', '',
- 'name', 'varchar', '', $char_d, '', '',
- 'value', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'confnum',
- 'unique' => [ [ 'agentnum', 'name' ]],
- 'index' => [],
- },
-
- 'pkg_referral' => {
- 'columns' => [
- 'pkgrefnum', 'serial', '', '', '', '',
- 'pkgnum', 'int', '', '', '', '',
- 'refnum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'pkgrefnum',
- 'unique' => [ [ 'pkgnum', 'refnum' ] ],
- 'index' => [ [ 'pkgnum' ], [ 'refnum' ] ],
- },
-
- 'svc_pbx' => {
- 'columns' => [
- 'svcnum', 'int', '', '', '', '',
- 'id', 'int', 'NULL', '', '', '',
- 'title', 'varchar', 'NULL', $char_d, '', '',
- 'max_extensions', 'int', 'NULL', '', '', '',
- 'max_simultaneous', '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', '', '', '',
- 'contactemailnum', 'int', 'NULL', '', '', '',
- 'email', 'varchar', 'NULL', 255, '', '',
- ],
- 'primary_key' => 'membernum',
- 'unique' => [],
- 'index' => [['listnum'],['svcnum'],['contactemailnum'],['email']],
- },
-
- 'bill_batch' => {
- 'columns' => [
- 'batchnum', 'serial', '', '', '', '',
- 'status', 'char', 'NULL','1', '', '',
- 'pdf', 'blob', 'NULL', '', '', '',
- ],
- 'primary_key' => 'batchnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'cust_bill_batch' => {
- 'columns' => [
- 'billbatchnum', 'serial', '', '', '', '',
- 'batchnum', 'int', '', '', '', '',
- 'invnum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'billbatchnum',
- 'unique' => [],
- 'index' => [ [ 'batchnum' ], [ 'invnum' ] ],
- },
-
- 'cust_bill_batch_option' => {
- 'columns' => [
- 'optionnum', 'serial', '', '', '', '',
- 'billbatchnum', 'int', '', '', '', '',
- 'optionname', 'varchar', '', $char_d, '', '',
- 'optionvalue', 'text', 'NULL', '', '', '',
- ],
- 'primary_key' => 'optionnum',
- 'unique' => [],
- 'index' => [ [ 'billbatchnum' ], [ 'optionname' ] ],
- },
-
- 'msg_template' => {
- 'columns' => [
- 'msgnum', 'serial', '', '', '', '',
- 'msgname', 'varchar', '', $char_d, '', '',
- 'agentnum', 'int', 'NULL', '', '', '',
- 'subject', 'varchar', 'NULL', 512, '', '',
- 'mime_type', 'varchar', '', $char_d, '', '',
- 'body', 'blob', 'NULL', '', '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- 'from_addr', 'varchar', 'NULL', 255, '', '',
- 'bcc_addr', 'varchar', 'NULL', 255, '', '',
- ],
- 'primary_key' => 'msgnum',
- 'unique' => [ ['msgname', 'mime_type'] ],
- 'index' => [ ['agentnum'], ]
- },
-
- 'svc_cert' => {
- 'columns' => [
- 'svcnum', 'int', '', '', '', '',
- 'recnum', 'int', 'NULL', '', '', '',
- 'privatekey', 'text', 'NULL', '', '', '',
- 'csr', 'text', 'NULL', '', '', '',
- 'certificate', 'text', 'NULL', '', '', '',
- 'cacert', 'text', 'NULL', '', '', '',
- 'common_name', 'varchar', 'NULL', $char_d, '', '',
- 'organization', 'varchar', 'NULL', $char_d, '', '',
- 'organization_unit', 'varchar', 'NULL', $char_d, '', '',
- 'city', 'varchar', 'NULL', $char_d, '', '',
- 'state', 'varchar', 'NULL', $char_d, '', '',
- 'country', 'char', 'NULL', 2, '', '',
- 'cert_contact', 'varchar', 'NULL', $char_d, '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [],
- 'index' => [], #recnum
- },
-
- 'nms_device' => {
- 'columns' => [
- 'nms_devicenum', 'serial', '', '', '', '',
- #'agentnum', 'int', 'NULL', '', '', '',
- 'devicename', 'varchar', '', $char_d, '', '',
- 'ip', 'varchar', '', 15, '', '',
- 'protocol', 'varchar', '', $char_d, '', '',
-# 'last', 'int', '', '', '', '',
- ],
- 'primary_key' => 'nms_devicenum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'nms_deviceport' => {
- 'columns' => [
- 'portnum', 'serial', '', '', '', '',
- 'nms_devicenum', 'int', '', '', '', '',
- 'deviceport', 'int', '', '', '', '',
- #'ip', 'varchar', 'NULL', 15, '', '',
- 'svcnum', 'int', 'NULL', '', '', '',
- ],
- 'primary_key' => 'portnum',
- 'unique' => [ [ 'nms_devicenum', 'deviceport' ] ],
- 'index' => [ [ 'svcnum' ] ],
- },
-
- 'svc_port' => {
- 'columns' => [
- 'svcnum', 'int', '', '', '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [],
- 'index' => [], #recnum
- },
-
-
- # name type nullability length default local
-
- #'new_table' => {
- # 'columns' => [
- # 'num', 'serial', '', '', '', '',
- # ],
- # 'primary_key' => 'num',
- # 'unique' => [],
- # 'index' => [],
- #},
-
- };
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<DBIx::DBSchema>
-
-=cut
-
-1;
-
diff --git a/FS/FS/SearchCache.pm b/FS/FS/SearchCache.pm
deleted file mode 100644
index 4218acf..0000000
--- a/FS/FS/SearchCache.pm
+++ /dev/null
@@ -1,96 +0,0 @@
-package FS::SearchCache;
-
-use strict;
-use vars qw($DEBUG);
-#use Carp qw(carp cluck croak confess);
-
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::SearchCache - cache
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-=cut
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my( $table, $key ) = @_;
- warn "table $table\n" if $DEBUG > 1;
- warn "key $key\n" if $DEBUG > 1;
- my $self = { 'table' => $table,
- 'key' => $key,
- 'cache' => {},
- 'subcache' => {},
- };
- bless ($self, $class);
-
- $self;
-}
-
-=item table
-
-=cut
-
-sub table { my $self = shift; $self->{table}; }
-
-=item key
-
-=cut
-
-sub key { my $self = shift; $self->{key}; }
-
-=item cache
-
-=cut
-
-sub cache { my $self = shift; $self->{cache}; }
-
-=item subcache
-
-=cut
-
-sub subcache {
- my $self = shift;
- my $col = shift;
- my $table = shift;
- my $keyval = shift;
- if ( exists $self->{subcache}->{$col}->{$keyval} ) {
- warn "returning existing subcache for $keyval ($col)".
- "$self->{subcache}->{$col}->{$keyval}\n" if $DEBUG;
- return $self->{subcache}->{$col}->{$keyval};
- } else {
- #my $tablekey = @_ ? shift : $col;
- my $tablekey = $col;
- my $subcache = ref($self)->new( $table, $tablekey );
- $self->{subcache}->{$col}->{$keyval} = $subcache;
- warn "creating new subcache $table $tablekey: $subcache\n" if $DEBUG;
- $subcache;
- }
-}
-
-=back
-
-=head1 BUGS
-
-Dismal documentation.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>
-
-=cut
-
-1;
-
-
diff --git a/FS/FS/Setup.pm b/FS/FS/Setup.pm
deleted file mode 100644
index 29ca9a8..0000000
--- a/FS/FS/Setup.pm
+++ /dev/null
@@ -1,552 +0,0 @@
-package FS::Setup;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK );
-use Exporter;
-#use Tie::DxHash;
-use Tie::IxHash;
-use FS::UID qw( dbh driver_name );
-use FS::Record;
-
-use FS::svc_domain;
-$FS::svc_domain::whois_hack = 1;
-$FS::svc_domain::whois_hack = 1;
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( create_initial_data );
-
-=head1 NAME
-
-FS::Setup - Database setup
-
-=head1 SYNOPSIS
-
- use FS::Setup;
-
-=head1 DESCRIPTION
-
-Currently this module simply provides a place to store common subroutines for
-database setup.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item
-
-=cut
-
-sub create_initial_data {
- my %opt = @_;
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- $FS::UID::AutoCommit = 0;
-
- populate_locales();
-
- populate_duplock();
-
- #initial_data data
- populate_initial_data(%opt);
-
- populate_access();
-
- populate_msgcat();
-
- if ( $oldAutoCommit ) {
- dbh->commit or die dbh->errstr;
- }
-
-}
-
-sub populate_locales {
-
- use Locale::Country;
- use FS::cust_main_county;
-
- #cust_main_county
- foreach my $country ( sort map uc($_), all_country_codes ) {
- _add_country($country);
- }
-
-}
-
-sub populate_addl_locales {
-
- my %addl = (
- 'US' => {
- 'FM' => 'Federated States of Micronesia',
- 'MH' => 'Marshall Islands',
- 'PW' => 'Palau',
- 'AA' => "Armed Forces Americas (except Canada)",
- 'AE' => "Armed Forces Europe / Canada / Middle East / Africa",
- 'AP' => "Armed Forces Pacific",
- },
- );
-
- foreach my $country ( keys %addl ) {
- foreach my $state ( keys %{ $addl{$country} } ) {
- # $longname = $addl{$country}{$state};
- _add_locale( 'country'=>$country, 'state'=>$state);
- }
- }
-
-}
-
-sub _add_country {
-
- use Locale::SubCountry;
-
- my( $country ) = shift;
-
- my $subcountry = eval { new Locale::SubCountry($country) };
- my @states = $subcountry ? $subcountry->all_codes : undef;
-
- if ( !scalar(@states) || ( scalar(@states)==1 && !defined($states[0]) ) ) {
-
- _add_locale( 'country'=>$country );
-
- } else {
-
- if ( $states[0] =~ /^(\d+|\w)$/ ) {
- @states = map $subcountry->full_name($_), @states
- }
-
- foreach my $state ( @states ) {
- _add_locale( 'country'=>$country, 'state'=>$state);
- }
-
- }
-
-}
-
-sub _add_locale {
- my $cust_main_county = new FS::cust_main_county( { 'tax'=>0, @_ });
- my $error = $cust_main_county->insert;
- die $error if $error;
-}
-
-sub populate_duplock {
-
- return unless driver_name =~ /^mysql/i;
-
- my $sth = dbh->prepare(
- "INSERT INTO duplicate_lock ( lockname ) VALUES ( 'svc_acct' )"
- ) or die dbh->errstr;
-
- $sth->execute or die $sth->errstr;
-
-}
-
-sub populate_initial_data {
- my %opt = @_;
-
- my $data = initial_data(%opt);
-
- foreach my $table ( keys %$data ) {
-
- #warn "popuilating $table\n";
-
- my $class = "FS::$table";
- eval "use $class;";
- die $@ if $@;
-
- $class->_populate_initial_data(%opt)
- if $class->can('_populate_initial_data');
-
- my @records = @{ $data->{$table} };
-
- foreach my $record ( @records ) {
-
- my $args = delete($record->{'_insert_args'}) || [];
- my $object = $class->new( $record );
- my $error = $object->insert( @$args );
- die "error inserting record into $table: $error\n"
- if $error;
-
- #my $pkey = $object->primary_key;
- #my $pkeyvalue = $object->$pkey();
- #warn " inserted $pkeyvalue\n";
-
- }
-
- }
-
-}
-
-sub initial_data {
- my %opt = @_;
-
- #tie my %hash, 'Tie::DxHash',
- tie my %hash, 'Tie::IxHash',
-
- #bootstrap user
- 'access_user' => [
- { 'username' => 'fs_bootstrap',
- '_password' => 'changeme', #will trigger warning if you try to enable
- 'last' => 'User',
- 'first' => 'Bootstrap',
- 'disabled' => 'Y',
- },
- ],
-
- #superuser group
- 'access_group' => [
- { 'groupname' => 'Superuser' },
- ],
-
- #reason types
- 'reason_type' => [],
-
-#XXX need default new-style billing events
-# #billing events
-# 'part_bill_event' => [
-# { 'payby' => 'CARD',
-# 'event' => 'Batch card',
-# 'seconds' => 0,
-# 'eventcode' => '$cust_bill->batch_card(%options);',
-# 'weight' => 40,
-# 'plan' => 'batch-card',
-# },
-# { 'payby' => 'BILL',
-# 'event' => 'Send invoice',
-# 'seconds' => 0,
-# 'eventcode' => '$cust_bill->send();',
-# 'weight' => 50,
-# 'plan' => 'send',
-# },
-# { 'payby' => 'DCRD',
-# 'event' => 'Send invoice',
-# 'seconds' => 0,
-# 'eventcode' => '$cust_bill->send();',
-# 'weight' => 50,
-# 'plan' => 'send',
-# },
-# { 'payby' => 'DCHK',
-# 'event' => 'Send invoice',
-# 'seconds' => 0,
-# 'eventcode' => '$cust_bill->send();',
-# 'weight' => 50,
-# 'plan' => 'send',
-# },
-# { 'payby' => 'DCLN',
-# 'event' => 'Suspend',
-# 'seconds' => 0,
-# 'eventcode' => '$cust_bill->suspend();',
-# 'weight' => 40,
-# 'plan' => 'suspend',
-# },
-# #{ 'payby' => 'DCLN',
-# # 'event' => 'Retriable',
-# # 'seconds' => 0,
-# # 'eventcode' => '$cust_bill_event->retriable();',
-# # 'weight' => 60,
-# # 'plan' => 'retriable',
-# #},
-# ],
-
- #you must create a service definition. An example of a service definition
- #would be a dial-up account or a domain. First, it is necessary to create a
- #domain definition. Click on View/Edit service definitions and Add a new
- #service definition with Table svc_domain (and no modifiers).
- 'part_svc' => [
- { 'svc' => 'Domain',
- 'svcdb' => 'svc_domain',
- }
- ],
-
- #Now that you have created your first service, you must create a package
- #including this service which you can sell to customers. Zero, one, or many
- #services are bundled into a package. Click on View/Edit package
- #definitions and Add a new package definition which includes quantity 1 of
- #the svc_domain service you created above.
- 'part_pkg' => [
- { 'pkg' => 'System Domain',
- 'comment' => '(NOT FOR CUSTOMERS)',
- 'freq' => '0',
- 'plan' => 'flat',
- '_insert_args' => [
- 'pkg_svc' => { 1 => 1 }, # XXX
- 'primary_svc' => 1, #XXX
- 'options' => {
- 'setup_fee' => '0',
- 'recur_fee' => '0',
- },
- ],
- },
- ],
-
- #After you create your first package, then you must define who is able to
- #sell that package by creating an agent type. An example of an agent type
- #would be an internal sales representitive which sells regular and
- #promotional packages, as opposed to an external sales representitive
- #which would only sell regular packages of services. Click on View/Edit
- #agent types and Add a new agent type.
- 'agent_type' => [
- { 'atype' => 'Internal' },
- ],
-
- #Allow this agent type to sell the package you created above.
- 'type_pkgs' => [
- { 'typenum' => 1, #XXX
- 'pkgpart' => 1, #XXX
- },
- ],
-
- #After creating a new agent type, you must create an agent. Click on
- #View/Edit agents and Add a new agent.
- 'agent' => [
- { 'agent' => 'Internal',
- 'typenum' => 1, # XXX
- },
- ],
-
- #Set up at least one Advertising source. Advertising sources will help you
- #keep track of how effective your advertising is, tracking where customers
- #heard of your service offerings. You must create at least one advertising
- #source. If you do not wish to use the referral functionality, simply
- #create a single advertising source only. Click on View/Edit advertising
- #sources and Add a new advertising source.
- 'part_referral' => [
- { 'referral' => 'Internal', },
- ],
-
- #Click on New Customer and create a new customer for your system accounts
- #with billing type Complimentary. Leave the First package dropdown set to
- #(none).
- 'cust_main' => [
- { 'agentnum' => 1, #XXX
- 'refnum' => 1, #XXX
- 'first' => 'System',
- 'last' => 'Accounts',
- 'address1' => '1234 System Lane',
- 'city' => 'Systemtown',
- 'state' => 'CA',
- 'zip' => '54321',
- 'country' => 'US',
- 'payby' => 'COMP',
- 'payinfo' => 'system', #or something
- 'paydate' => '1/2037',
- },
- ],
-
- #From the Customer View screen of the newly created customer, order the
- #package you defined above.
- 'cust_pkg' => [
- { 'custnum' => 1, #XXX
- 'pkgpart' => 1, #XXX
- },
- ],
-
- #From the Package View screen of the newly created package, choose
- #(Provision) to add the customer's service for this new package.
- #Add your own domain.
- 'svc_domain' => [
- { 'domain' => $opt{'domain'},
- 'pkgnum' => 1, #XXX
- 'svcpart' => 1, #XXX
- 'action' => 'N', #pseudo-field
- },
- ],
-
- #Go back to View/Edit service definitions on the main menu, and Add a new
- #service definition with Table svc_acct. Select your domain in the domsvc
- #Modifier. Set Fixed to define a service locked-in to this domain, or
- #Default to define a service which may select from among this domain and
- #the customer's domains.
-
- #not yet....
-
- #usage classes
- 'usage_class' => [],
-
- #phone types
- 'phone_type' => [],
-
- ;
-
- \%hash;
-
-}
-
-sub populate_access {
-
- use FS::AccessRight;
- use FS::access_right;
-
- foreach my $rightname ( FS::AccessRight->default_superuser_rights ) {
- my $access_right = new FS::access_right {
- 'righttype' => 'FS::access_group',
- 'rightobjnum' => 1, #$supergroup->groupnum,
- 'rightname' => $rightname,
- };
- my $ar_error = $access_right->insert;
- die $ar_error if $ar_error;
- }
-
- #foreach my $agent ( qsearch('agent', {} ) ) {
- my $access_groupagent = new FS::access_groupagent {
- 'groupnum' => 1, #$supergroup->groupnum,
- 'agentnum' => 1, #$agent->agentnum,
- };
- my $aga_error = $access_groupagent->insert;
- die $aga_error if $aga_error;
- #}
-
-}
-
-sub populate_msgcat {
-
- use FS::Record qw(qsearch);
- use FS::msgcat;
-
- foreach my $del_msgcat ( qsearch('msgcat', {}) ) {
- my $error = $del_msgcat->delete;
- die $error if $error;
- }
-
- my %messages = msgcat_messages();
-
- foreach my $msgcode ( keys %messages ) {
- foreach my $locale ( keys %{$messages{$msgcode}} ) {
- my $msgcat = new FS::msgcat( {
- 'msgcode' => $msgcode,
- 'locale' => $locale,
- 'msg' => $messages{$msgcode}{$locale},
- });
- my $error = $msgcat->insert;
- die $error if $error;
- }
- }
-
-}
-
-sub msgcat_messages {
-
- # 'msgcode' => {
- # 'en_US' => 'Message',
- # },
-
- (
-
- 'passwords_dont_match' => {
- 'en_US' => "Passwords don't match",
- },
-
- 'invalid_card' => {
- 'en_US' => 'Invalid credit card number',
- },
-
- 'unknown_card_type' => {
- 'en_US' => 'Unknown card type',
- },
-
- 'not_a' => {
- 'en_US' => 'Not a ',
- },
-
- 'empty_password' => {
- 'en_US' => 'Empty password',
- },
-
- 'no_access_number_selected' => {
- 'en_US' => 'No access number selected',
- },
-
- 'illegal_text' => {
- 'en_US' => 'Illegal (text)',
- #'en_US' => 'Only letters, numbers, spaces, and the following punctuation symbols are permitted: ! @ # $ % & ( ) - + ; : \' " , . ? / in field',
- },
-
- 'illegal_or_empty_text' => {
- 'en_US' => 'Illegal or empty (text)',
- #'en_US' => 'Only letters, numbers, spaces, and the following punctuation symbols are permitted: ! @ # $ % & ( ) - + ; : \' " , . ? / in required field',
- },
-
- 'illegal_username' => {
- 'en_US' => 'Illegal username',
- },
-
- 'illegal_password' => {
- 'en_US' => 'Illegal password (',
- },
-
- 'illegal_password_characters' => {
- 'en_US' => ' characters)',
- },
-
- 'username_in_use' => {
- 'en_US' => 'Username in use',
- },
-
- 'phonenum_in_use' => {
- 'en_US' => 'Phone number in use',
- },
-
- 'illegal_email_invoice_address' => {
- 'en_US' => 'Illegal email invoice address',
- },
-
- 'illegal_name' => {
- 'en_US' => 'Illegal (name)',
- #'en_US' => 'Only letters, numbers, spaces and the following punctuation symbols are permitted: , . - \' in field',
- },
-
- 'illegal_phone' => {
- 'en_US' => 'Illegal (phone)',
- #'en_US' => '',
- },
-
- 'illegal_zip' => {
- 'en_US' => 'Illegal (zip)',
- #'en_US' => '',
- },
-
- 'expired_card' => {
- 'en_US' => 'Expired card',
- },
-
- 'daytime' => {
- 'en_US' => 'Day Phone',
- },
-
- 'night' => {
- 'en_US' => 'Night Phone',
- },
-
- 'svc_external-id' => {
- 'en_US' => 'External ID',
- },
-
- 'svc_external-title' => {
- 'en_US' => 'Title',
- },
-
- 'stateid' => {
- 'en_US' => 'Driver\'s License',
- },
-
- 'stateid_state' => {
- 'en_US' => 'Driver\'s License State',
- },
-
- 'invalid_domain' => {
- 'en_US' => 'Invalid domain',
- },
-
- );
-}
-
-=back
-
-=head1 BUGS
-
-Sure.
-
-=head1 SEE ALSO
-
-=cut
-
-1;
-
diff --git a/FS/FS/TicketSystem.pm b/FS/FS/TicketSystem.pm
deleted file mode 100644
index d53d2f6..0000000
--- a/FS/FS/TicketSystem.pm
+++ /dev/null
@@ -1,52 +0,0 @@
-package FS::TicketSystem;
-
-use strict;
-use vars qw( $conf $system $AUTOLOAD );
-use FS::Conf;
-use FS::UID qw( dbh driver_name );
-
-FS::UID->install_callback( sub {
- $conf = new FS::Conf;
- $system = $conf->config('ticket_system');
-} );
-
-sub AUTOLOAD {
- my $self = shift;
-
- my($sub)=$AUTOLOAD;
- $sub =~ s/.*://;
-
- my $conf = new FS::Conf;
- die "FS::TicketSystem::$AUTOLOAD called, but no ticket system configured\n"
- unless $system;
-
- eval "use FS::TicketSystem::$system;";
- die $@ if $@;
-
- $self .= "::$system";
- $self->$sub(@_);
-}
-
-sub _upgrade_data {
- return if $system ne 'RT_Internal';
-
- my ($class, %opts) = @_;
- my ($t, $exec, @fields) = map { driver_name =~ /^mysql/i ? $_ : lc($_) }
- (qw( ScripConditions ExecModule
- Name Description ExecModule ApplicableTransTypes
- Creator Created LastUpdatedBy LastUpdated));
- my $count_sql = "SELECT COUNT(*) FROM $t WHERE $exec = 'CustomFieldChange'";
- my $sth = dbh->prepare($count_sql) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
- my $total = $sth->fetchrow_arrayref->[0];
- return if $total > 0;
-
- my $insert_sql = "INSERT INTO $t (".join(',',@fields).") VALUES (".
- "'On Custom Field Change', 'When a custom field is changed to some value',
- 'CustomFieldChange', 'Any', 1, CURRENT_DATE, 1, CURRENT_DATE )";
- $sth = dbh->prepare($insert_sql) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
- return;
-}
-
-1;
diff --git a/FS/FS/TicketSystem/RT_External.pm b/FS/FS/TicketSystem/RT_External.pm
deleted file mode 100644
index 2995b88..0000000
--- a/FS/FS/TicketSystem/RT_External.pm
+++ /dev/null
@@ -1,401 +0,0 @@
-package FS::TicketSystem::RT_External;
-
-use strict;
-use vars qw( $DEBUG $me $conf $dbh $default_queueid $external_url
- $priority_reverse
- $priority_field $priority_field_queue $field
- );
-use URI::Escape;
-use FS::UID qw(dbh);
-use FS::Record qw(qsearchs);
-use FS::cust_main;
-use Carp qw(cluck);
-
-$me = '[FS::TicketSystem::RT_External]';
-$DEBUG = 0;
-
-FS::UID->install_callback( sub {
- $conf = new FS::Conf;
- $default_queueid = $conf->config('ticket_system-default_queueid');
- $priority_reverse = $conf->exists('ticket_system-priority_reverse');
- $priority_field =
- $conf->config('ticket_system-custom_priority_field');
- if ( $priority_field ) {
- $priority_field_queue =
- $conf->config('ticket_system-custom_priority_field_queue');
-
- $field = $priority_field_queue
- ? $priority_field_queue. '.%7B'. $priority_field. '%7D'
- : $priority_field;
- } else {
- $priority_field_queue = '';
- $field = '';
- }
-
- $external_url = '';
- $dbh = dbh;
- if ($conf->config('ticket_system') eq 'RT_External') {
- my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
- $dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 })
- or die "RT_External DBI->connect error: $DBI::errstr\n";
-
- $external_url = $conf->config('ticket_system-rt_external_url');
- }
-
- #kludge... should *use* the id... but good enough for now
- if ( $priority_field_queue =~ /^(\d+)$/ ) {
- my $id = $1;
- my $sql = 'SELECT Name FROM Queues WHERE Id = ?';
- my $sth = $dbh->prepare($sql) or die $dbh->errstr. " preparing $sql";
- $sth->execute($id) or die $sth->errstr. " executing $sql";
-
- $priority_field_queue = $sth->fetchrow_arrayref->[0];
-
- }
-
-} );
-
-sub num_customer_tickets {
- my( $self, $custnum, $priority ) = @_;
-
- my( $from_sql, @param) = $self->_from_customer( $custnum, $priority );
-
- my $sql = "SELECT COUNT(*) $from_sql";
- warn "$me $sql (@param)" if $DEBUG;
- my $sth = $dbh->prepare($sql) or die $dbh->errstr. " preparing $sql";
- $sth->execute(@param) or die $sth->errstr. " executing $sql";
-
- $sth->fetchrow_arrayref->[0];
-
-}
-
-sub customer_tickets {
- my( $self, $custnum, $limit, $priority ) = @_;
- $limit ||= 0;
-
- my( $from_sql, @param) = $self->_from_customer( $custnum, $priority );
- my $sql = "
- SELECT Tickets.*,
- Queues.Name AS Queue,
- Users.Name AS Owner,
- position(Tickets.Status in 'newopenstalledresolvedrejecteddeleted')
- AS svalue
- ". ( length($priority) ? ", ObjectCustomFieldValues.Content" : '' )."
- $from_sql
- ORDER BY svalue,
- Priority ". ( $priority_reverse ? 'ASC' : 'DESC' ). ",
- id DESC
- LIMIT $limit
- ";
- warn "$me $sql (@param)" if $DEBUG;
- my $sth = $dbh->prepare($sql) or die $dbh->errstr. "preparing $sql";
- $sth->execute(@param) or die $sth->errstr. "executing $sql";
-
- #munge column names??? #httemplate/view/cust_main/tickets.html has column
- #names that might not make sense now...
- $sth->fetchall_arrayref({});
-
-}
-
-sub comments_on_tickets {
- my ($self, $custnum, $limit, $time ) = @_;
- $limit ||= 0;
-
- my( $from_sql, @param) = $self->_from_customer( $custnum );
- my $sql = qq{
- SELECT transactions.*, Attachments.content, Tickets.subject
- FROM transactions
- JOIN Attachments ON( Attachments.transactionid = transactions.id )
- JOIN Tickets ON ( Tickets.id = transactions.objectid )
- JOIN Links ON ( Tickets.id = Links.LocalBase
- AND Links.Base LIKE '%/ticket/' || Tickets.id )
-
-
- WHERE ( Status = 'new' OR Status = 'open' OR Status = 'stalled' )
- AND Target = 'freeside://freeside/cust_main/$custnum'
- AND transactions.type = 'Comment'
- AND transactions.created >= (SELECT TIMESTAMP WITH TIME ZONE 'epoch' + $time * INTERVAL '1 second')
- LIMIT $limit
- };
- cluck $sql if $DEBUG > 0;
- #AND created >
- $dbh->selectall_arrayref( $sql, { Slice => {} } ) or die $dbh->errstr . " $sql";
-}
-
-sub _from_customer {
- my( $self, $custnum, $priority ) = @_;
-
- my @param = ();
- my $join = '';
- my $where = '';
- if ( defined($priority) ) {
-
- my $queue_sql = " ObjectCustomFields.ObjectId = ( SELECT id FROM Queues
- WHERE Queues.Name = ? )
- OR ( ? = '' AND ObjectCustomFields.ObjectId = 0 )";
-
- my $customfield_sql =
- "customfield = (
- SELECT CustomFields.Id FROM CustomFields
- JOIN ObjectCustomFields
- ON ( CustomFields.id = ObjectCustomFields.CustomField )
- WHERE LookupType = 'RT::Queue-RT::Ticket'
- AND Name = ?
- AND ( $queue_sql )
- )";
-
- push @param, $priority_field,
- $priority_field_queue,
- $priority_field_queue;
-
- if ( length($priority) ) {
- #$where = "
- # and ? = ( select content from TicketCustomFieldValues
- # where ticket = tickets.id
- # and customfield = ( select id from customfields
- # where name = ?
- # and ( $queue_sql )
- # )
- # )
- #";
- unshift @param, $priority;
-
- $join = "JOIN ObjectCustomFieldValues
- ON ( Tickets.id = ObjectCustomFieldValues.ObjectId )";
-
- $where = " AND Content = ?
- AND ObjectCustomFieldValues.Disabled != 1
- AND ObjectType = 'RT::Ticket'
- AND $customfield_sql";
-
- } else {
-
- $where =
- "AND 0 = ( SELECT COUNT(*) FROM ObjectCustomFieldValues
- WHERE ObjectId = Tickets.id
- AND ObjectType = 'RT::Ticket'
- AND $customfield_sql
- )
- ";
- }
-
- }
-
- my $sql = "
- FROM Tickets
- JOIN Queues ON ( Tickets.Queue = Queues.id )
- JOIN Users ON ( Tickets.Owner = Users.id )
- JOIN Links ON ( Tickets.id = Links.LocalBase
- AND Links.Base LIKE '%/ticket/' || Tickets.id )
- $join
-
- WHERE ( ". join(' OR ', map "Status = '$_'", $self->statuses ). " )
- AND Target = 'freeside://freeside/cust_main/$custnum'
- $where
- ";
-
- ( $sql, @param );
-
-}
-
-sub statuses {
- #my $self = shift;
- my @statuses = grep { ! /^\s*$/ } $conf->config('cust_main-ticket_statuses');
- @statuses = (qw( new open stalled )) unless scalar(@statuses);
- @statuses;
-}
-
-sub href_customer_tickets {
- my( $self, $custnum ) = ( shift, shift );
- my( $priority, @statuses);
- if ( ref($_[0]) ) {
- my $opt = shift;
- $priority = $opt->{'priority'};
- @statuses = $opt->{'statuses'} ? @{$opt->{'statuses'}} : $self->statuses;
- } else {
- $priority = shift;
- @statuses = $self->statuses;
- }
-
- #my $href = $self->baseurl;
-
- #i snarfed this from an RT bookmarked search, then unescaped (some of) it with
- #perl -npe 's/%([0-9A-F]{2})/pack('C', hex($1))/eg;'
-
- #$href .=
- my $href =
- "Search/Results.html?Order=ASC&".
- "Query= MemberOf = 'freeside://freeside/cust_main/$custnum' ".
- #" AND ( Status = 'open' OR Status = 'new' OR Status = 'stalled' )"
- " AND ( ". join(' OR ', map "Status = '$_'", @statuses ). " ) "
- ;
-
- if ( defined($priority) && $field && $priority_field_queue ) {
- $href .= " AND Queue = '$priority_field_queue' ";
- }
- if ( defined($priority) && $field ) {
- $href .= " AND 'CF.$field' ";
- if ( $priority ) {
- $href .= "= '$priority' ";
- } else {
- $href .= "IS 'NULL' "; #this is "RTQL", not SQL
- }
- }
-
- #$href =
- uri_escape($href);
- #eventually should unescape all of it...
-
- $href .= '&Rows=100'.
- '&OrderBy=id&Page=1'.
- '&Format=%27%20%20%20%3Cb%3E%3Ca%20href%3D%22'.
- $self->baseurl.
- 'Ticket%2FDisplay.html%3Fid%3D__id__%22%3E__id__%3C%2Fa%3E%3C%2Fb%3E%2FTITLE%3A%23%27%2C%20%0A%27%3Cb%3E%3Ca%20href%3D%22'.
- $self->baseurl.
- 'Ticket%2FDisplay.html%3Fid%3D__id__%22%3E__Subject__%3C%2Fa%3E%3C%2Fb%3E%2FTITLE%3ASubject%27%2C%20%0A%27__Status__%27%2C%20';
-
- if ( defined($priority) && $field ) {
- $href .= '%0A%27__CustomField.'. $field. '__%2FTITLE%3ASeverity%27%2C%20';
- }
-
- $href .= '%0A%27__QueueName__%27%2C%20%0A%27__OwnerName__%27%2C%20%0A%27__Priority__%27%2C%20%0A%27__NEWLINE__%27%2C%20%0A%27%27%2C%20%0A%27%3Csmall%3E__Requestors__%3C%2Fsmall%3E%27%2C%20%0A%27%3Csmall%3E__CreatedRelative__%3C%2Fsmall%3E%27%2C';
-
- if ( defined($priority) && $field ) {
- $href .= '%20%0A%27__-__%27%2C';
- }
-
- $href .= '%20%0A%27%3Csmall%3E__ToldRelative__%3C%2Fsmall%3E%27%2C%20%0A%27%3Csmall%3E__LastUpdatedRelative__%3C%2Fsmall%3E%27%2C%20%0A%27%3Csmall%3E__TimeLeft__%3C%2Fsmall%3E%27';
-
- #$href =
- #uri_escape($href);
-
- $self->baseurl. $href;
-
-}
-
-sub href_params_new_ticket {
- my( $self, $custnum_or_cust_main, $requestors ) = @_;
-
- my( $custnum, $cust_main );
- if ( ref($custnum_or_cust_main) ) {
- $cust_main = $custnum_or_cust_main;
- $custnum = $cust_main->custnum;
- } else {
- $custnum = $custnum_or_cust_main;
- $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } );
- }
-
- 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 {
- my($self, $ticketnum) = @_;
- $self->baseurl. 'Ticket/Display.html?id='.$ticketnum;
-}
-
-sub queues {
- my($self) = @_;
-
- my $sql = "SELECT id, Name FROM Queues WHERE Disabled = 0";
- my $sth = $dbh->prepare($sql) or die $dbh->errstr. " preparing $sql";
- $sth->execute() or die $sth->errstr. " executing $sql";
-
- map { $_->[0] => $_->[1] } @{ $sth->fetchall_arrayref([]) };
-
-}
-
-sub queue {
- my($self, $queueid) = @_;
-
- return '' unless $queueid;
-
- my $sql = "SELECT Name FROM Queues WHERE id = ?";
- my $sth = $dbh->prepare($sql) or die $dbh->errstr. " preparing $sql";
- $sth->execute($queueid) or die $sth->errstr. " executing $sql";
-
- my $rows = $sth->fetchrow_arrayref;
- $rows ? $rows->[0] : '';
-
-}
-
-sub baseurl {
- #my $self = shift;
- $external_url. '/';
-}
-
-sub _retrieve_single_value {
- my( $self, $sql ) = @_;
-
- warn "$me $sql" if $DEBUG;
- my $sth = $dbh->prepare($sql) or die $dbh->errstr. "preparing $sql";
- $sth->execute or die $sth->errstr. "executing $sql";
-
- my $arrayref = $sth->fetchrow_arrayref;
- $arrayref ? $arrayref->[0] : $arrayref;
-}
-
-sub transaction_creator {
- my( $self, $transaction_id ) = @_;
-
- my $sql = "SELECT Name FROM Transactions JOIN Users ON ".
- "Transactions.Creator=Users.id WHERE Transactions.id = ".
- $transaction_id;
-
- $self->_retrieve_single_value($sql);
-}
-
-sub transaction_ticketid {
- my( $self, $transaction_id ) = @_;
-
- my $sql = "SELECT ObjectId FROM Transactions WHERE Transactions.id = ".
- $transaction_id;
-
- $self->_retrieve_single_value($sql);
-}
-
-sub transaction_subject {
- my( $self, $transaction_id ) = @_;
-
- my $sql = "SELECT Subject FROM Transactions JOIN Tickets ON ObjectId=".
- "Tickets.id WHERE Transactions.id = ". $transaction_id;
-
- $self->_retrieve_single_value($sql);
-}
-
-sub transaction_status {
- my( $self, $transaction_id ) = @_;
-
- my $sql = "SELECT Status FROM Transactions JOIN Tickets ON ObjectId=".
- "Tickets.id WHERE Transactions.id = ". $transaction_id;
-
- $self->_retrieve_single_value($sql);
-}
-
-sub access_right {
- warn "WARNING: no access rights available w/ external RT";
- 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
deleted file mode 100644
index befafb8..0000000
--- a/FS/FS/TicketSystem/RT_Internal.pm
+++ /dev/null
@@ -1,402 +0,0 @@
-package FS::TicketSystem::RT_Internal;
-
-use strict;
-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;
-
-@ISA = qw( FS::TicketSystem::RT_Libs );
-
-$DEBUG = 0;
-$me = '[FS::TicketSystem::RT_Internal]';
-
-sub sql_num_customer_tickets {
- "( select count(*) from Tickets
- join Links on ( Tickets.id = Links.LocalBase )
- where ( Status = 'new' or Status = 'open' or Status = 'stalled' )
- and Target = 'freeside://freeside/cust_main/' || custnum
- )";
-}
-
-sub baseurl {
- #my $self = shift;
- if ( $RT::URI::freeside::URL ) {
- $RT::URI::freeside::URL. '/rt/';
- } else {
- 'http://you_need_to_set_RT_URI_freeside_URL_in_SiteConfig.pm/';
- }
-}
-
-#mapping/genericize??
-#ShowConfigTab ModifySelf
-sub access_right {
- my( $self, $session, $right ) = @_;
-
- #return '' unless $conf->config('ticket_system');
- return '' unless FS::Conf->new->config('ticket_system');
-
- $session = $self->session($session);
-
- #warn "$me access_right: CurrentUser ". $session->{'CurrentUser'}. ":\n".
- # ( $DEBUG>1 ? Dumper($session->{'CurrentUser'}) : '' )
- # if $DEBUG > 1;
-
- $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;
-}
-
-=item get_ticket SESSION_HASHREF, OPTION => VALUE ...
-
-Class method. Retrieves a ticket. If there is an error, returns the scalar
-error. Otherwise, currently returns a slightly tricky data structure containing
-a list of the linked customers and each transaction's content, description, and
-create time.
-
-Accepts the following options:
-
-=over 4
-
-=item ticket_id
-
-The ticket id
-
-=back
-
-=cut
-
-sub get_ticket {
- my($self, $session, %param) = @_;
-
- $session = $self->session($session);
-
- my $Ticket = RT::Ticket->new($session->{'CurrentUser'});
- my $ticketid = $Ticket->Load( $param{'ticket_id'} );
- return 'Could not load ticket' unless $ticketid;
-
- my @custs = ();
- foreach my $link ( @{ $Ticket->Customers->ItemsArrayRef } ) {
- my $cust = $link->Target;
- push @custs, $1 if $cust =~ /\/(\d+)$/;
- }
-
- my @txns = ();
- my $transactions = $Ticket->Transactions;
- while ( my $transaction = $transactions->Next ) {
- my $t = { created => $transaction->Created,
- content => $transaction->Content,
- description => $transaction->Description,
- type => $transaction->Type,
- };
- push @txns, $t;
- }
-
- { txns => [ @txns ],
- custs => [ @custs ],
- };
-}
-
-
-=item correspond_ticket SESSION_HASHREF, OPTION => VALUE ...
-
-Class method. Correspond on a ticket. If there is an error, returns the scalar
-error. Otherwise, returns the transaction id, error message, and
-RT::Transaction object.
-
-Accepts the following options:
-
-=over 4
-
-=item ticket_id
-
-The ticket id
-
-=item content
-
-Correspondence content
-
-=back
-
-=cut
-
-sub correspond_ticket {
- my($self, $session, %param) = @_;
-
- $session = $self->session($session);
-
- my $Ticket = RT::Ticket->new($session->{'CurrentUser'});
- my $ticketid = $Ticket->Load( $param{'ticket_id'} );
- return 'Could not load ticket' unless $ticketid;
- return 'No content' unless $param{'content'};
-
- $Ticket->Correspond( Content => $param{'content'} );
-}
-
-#shameless false laziness w/RT::Interface::Web::AttemptExternalAuth
-# to get logged into RT from afar
-sub _web_external_auth {
- my( $self, $session ) = @_;
-
- my $user = $FS::CurrentUser::CurrentUser->username;
-
- eval 'use RT::CurrentUser;';
- die $@ if $@;
-
- $session ||= {};
- $session->{'CurrentUser'} = RT::CurrentUser->new();
-
- warn "$me _web_external_auth loading RT user for $user\n"
- if $DEBUG > 1;
-
- $session->{'CurrentUser'}->Load($user);
-
- if ( ! $session->{'CurrentUser'}->Id() ) {
-
- # Create users on-the-fly
-
- warn "can't load RT user for $user; auto-creating\n"
- if $DEBUG;
-
- my $UserObj = RT::User->new( RT::CurrentUser->new('RT_System') );
-
- my ( $val, $msg ) = $UserObj->Create(
- %{ ref($RT::AutoCreate) ? $RT::AutoCreate : {} },
- Name => $user,
- Gecos => $user,
- );
-
- if ($val) {
-
- # now get user specific information, to better create our user.
- my $new_user_info
- = RT::Interface::Web::WebExternalAutoInfo($user);
-
- # set the attributes that have been defined.
- # FIXME: this is a horrible kludge. I'm sure there's something cleaner
- foreach my $attribute (
- 'Name', 'Comments',
- 'Signature', 'EmailAddress',
- 'PagerEmailAddress', 'FreeformContactInfo',
- 'Organization', 'Disabled',
- 'Privileged', 'RealName',
- 'NickName', 'Lang',
- 'EmailEncoding', 'WebEncoding',
- 'ExternalContactInfoId', 'ContactInfoSystem',
- 'ExternalAuthId', 'Gecos',
- 'HomePhone', 'WorkPhone',
- 'MobilePhone', 'PagerPhone',
- 'Address1', 'Address2',
- 'City', 'State',
- 'Zip', 'Country'
- )
- {
- #uhh, wrong root
- #$m->comp( '/Elements/Callback', %ARGS,
- # _CallbackName => 'NewUser' );
-
- my $method = "Set$attribute";
- $UserObj->$method( $new_user_info->{$attribute} )
- if ( defined $new_user_info->{$attribute} );
- }
- $session->{'CurrentUser'}->Load($user);
- }
- else {
-
- # we failed to successfully create the user. abort abort abort.
- delete $session->{'CurrentUser'};
-
- die "can't auto-create RT user"; #an error message would be nice :/
- #$m->abort() unless $RT::WebFallbackToInternalAuth;
- #$m->comp( '/Elements/Login', %ARGS,
- # Error => loc( 'Cannot create user: [_1]', $msg ) );
- }
- }
-
- unless ( $session->{'CurrentUser'}->Id() ) {
- delete $session->{'CurrentUser'};
-
- die "can't auto-create RT user";
- #$user = $orig_user;
- #
- #if ($RT::WebExternalOnly) {
- # $m->comp( '/Elements/Login', %ARGS,
- # Error => loc('You are not an authorized user') );
- # $m->abort();
- #}
- }
-
- $session;
-
-}
-
-1;
-
diff --git a/FS/FS/TicketSystem/RT_Libs.pm b/FS/FS/TicketSystem/RT_Libs.pm
deleted file mode 100644
index aebe8c5..0000000
--- a/FS/FS/TicketSystem/RT_Libs.pm
+++ /dev/null
@@ -1,10 +0,0 @@
-package FS::TicketSystem::RT_Libs;
-
-use strict;
-use vars qw( @ISA );
-use FS::TicketSystem::RT_External;
-
-@ISA = qw( FS::TicketSystem::RT_External );
-
-1;
-
diff --git a/FS/FS/Tron.pm b/FS/FS/Tron.pm
deleted file mode 100644
index 78af0fe..0000000
--- a/FS/FS/Tron.pm
+++ /dev/null
@@ -1,123 +0,0 @@
-package FS::Tron;
-# a program to monitor outside systems
-
-use strict;
-use warnings;
-use base 'Exporter';
-use Net::SSH qw( sshopen2 ); #sshopen3 );
-use FS::Record qw( qsearchs );
-use FS::svc_external;
-use FS::cust_svc_option;
-
-our @EXPORT_OK = qw( tron_ping tron_scan tron_lint);
-
-our %desired = (
- #less lenient, we need to make sure we upgrade deb 4 & pg 7.4
- 'freeside_version' => qr/^1\.(7\.3|9\.0)/,
- 'debian_version' => qr/^5/, #qr/^5.0.[2-9]$/ #qr/^4/,
- 'apache_mpm' => qw/^(Prefork|$)/,
- 'pg_version' => qr/^8\.[1-9]/,
- 'apache_version' => qr/^2/,
-
- #payment gateway survey
-# 'payment_gateway' => qw/^authorizenet$/,
-
- #stuff to add/replace later
- #'apache_mpm' => qw/^Prefork/,
- #'pg_version' => qr/^8\.[3-9]/,
-);
-
-sub _cust_svc_external {
- my $cust_svc_or_svcnum = shift;
-
- my ( $cust_svc, $svc_external );
- if ( ref($cust_svc_or_svcnum) ) {
- $cust_svc = $cust_svc_or_svcnum;
- $svc_external = $cust_svc->svc_x;
- } else {
- $svc_external = qsearchs('svc_external', { svcnum=>$cust_svc_or_svcnum } );
- $cust_svc = $svc_external->cust_svc;
- }
-
- ( $cust_svc, $svc_external );
-
-}
-
-sub tron_ping {
- my( $cust_svc, $svc_external ) = _cust_svc_external(shift);
-
- my %hash = ();
- my $machine = $svc_external->title; # or better as a cust_svc_option??
- sshopen2($machine, *READER, *WRITER, '/bin/echo pong');
- my $pong = scalar(<READER>);
- close READER;
- close WRITER;
-
- $pong =~ /pong/;
-}
-
-sub tron_scan {
- my( $cust_svc, $svc_external ) = _cust_svc_external(shift);
-
- #don't scan again if things are okay
- my $bad = 0;
- foreach my $option ( keys %desired ) {
- my $current = $cust_svc->option($option);
- $bad++ unless $current =~ $desired{$option};
- }
- return '' unless $bad;
-
- #do the scan
- my %hash = ();
- my $machine = $svc_external->title; # or better as a cust_svc_option??
- #sshopen2($machine, *READER, *WRITER, '/usr/local/bin/freeside-yori all');
- #fix freeside users' patch if necessary, since packages put this in /usr/bin
- sshopen2($machine, *READER, *WRITER, 'freeside-yori all');
- while (<READER>) {
- chomp;
- my($option, $value) = split(/: ?/);
- next unless defined($option) && exists($desired{$option});
- $hash{$option} = $value;
- }
- close READER;
- close WRITER;
-
- unless ( keys %hash ) {
- return "error scanning $machine\n";
- }
-
- # store the results
- foreach my $option ( keys %hash ) {
- my %opthash = ( 'optionname' => $option,
- 'svcnum' => $cust_svc->svcnum,
- );
- my $cust_svc_option = qsearchs('cust_svc_option', \%opthash )
- || new FS::cust_svc_option \%opthash;
- next if $cust_svc_option->optionvalue eq $hash{$option};
- $cust_svc_option->optionvalue( $hash{$option} );
- my $error = $cust_svc_option->optionnum
- ? $cust_svc_option->replace
- : $cust_svc_option->insert;
- return $error if $error;
- }
-
- '';
-
-}
-
-sub tron_lint {
- my $cust_svc = shift;
-
- my @lint;
- foreach my $option ( keys %desired ) {
- my $current = $cust_svc->option($option);
- push @lint, "$option is $current" unless $current =~ $desired{$option};
- }
-
- push @lint, 'unchecked' unless scalar($cust_svc->options);
-
- @lint;
-
-}
-
-1;
diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm
deleted file mode 100644
index 2d00d2c..0000000
--- a/FS/FS/UI/Web.pm
+++ /dev/null
@@ -1,644 +0,0 @@
-package FS::UI::Web;
-
-use strict;
-use vars qw($DEBUG @ISA @EXPORT_OK $me);
-use Exporter;
-use FS::Conf;
-use FS::Misc::DateTime qw( parse_datetime );
-use FS::Record qw(dbdef);
-use FS::cust_main; # are sql_balance and sql_date_balance in the right module?
-
-#use vars qw(@ISA);
-#use FS::UI
-#@ISA = qw( FS::UI );
-@ISA = qw( Exporter );
-
-@EXPORT_OK = qw( svc_url );
-
-$DEBUG = 0;
-$me = '[FS::UID::Web]';
-
-###
-# date parsing
-###
-
-use Date::Parse;
-sub parse_beginning_ending {
- my($cgi, $prefix) = @_;
- $prefix .= '_' if $prefix;
-
- my $beginning = 0;
- if ( $cgi->param($prefix.'begin') =~ /^(\d+)$/ ) {
- $beginning = $1;
- } elsif ( $cgi->param($prefix.'beginning') =~ /^([ 0-9\-\/]{1,64})$/ ) {
- $beginning = parse_datetime($1) || 0;
- }
-
- my $ending = 4294967295; #2^32-1
- if ( $cgi->param($prefix.'end') =~ /^(\d+)$/ ) {
- $ending = $1 - 1;
- } elsif ( $cgi->param($prefix.'ending') =~ /^([ 0-9\-\/]{1,64})$/ ) {
- #probably need an option to turn off the + 86399
- $ending = parse_datetime($1) + 86399;
- }
-
- ( $beginning, $ending );
-}
-
-=item svc_url
-
-Returns a service URL, first checking to see if there is a service-specific
-page to link to, otherwise to a generic service handling page. Options are
-passed as a list of name-value pairs, and include:
-
-=over 4
-
-=item * m - Mason request object ($m)
-
-=item * action - The action for which to construct "edit", "view", or "search"
-
-=item ** part_svc - Service definition (see L<FS::part_svc>)
-
-=item ** svcdb - Service table
-
-=item *** query - Query string
-
-=item *** svc - FS::cust_svc or FS::svc_* object
-
-=item ahref - Optional flag, if set true returns <A HREF="$url"> instead of just the URL.
-
-=back
-
-* Required fields
-
-** part_svc OR svcdb is required
-
-*** query OR svc is required
-
-=cut
-
- # ##
- # #required
- # ##
- # 'm' => $m, #mason request object
- # 'action' => 'edit', #or 'view'
- #
- # 'part_svc' => $part_svc, #usual
- # #OR
- # 'svcdb' => 'svc_table',
- #
- # 'query' => #optional query string
- # # (pass a blank string if you want a "raw" URL to add your
- # # own svcnum to)
- # #OR
- # 'svc' => $svc_x, #or $cust_svc, it just needs a svcnum
- #
- # ##
- # #optional
- # ##
- # 'ahref' => 1, # if set true, returns <A HREF="$url">
-
-use FS::CGI qw(rooturl);
-sub svc_url {
- my %opt = @_;
-
- #? return '' unless ref($opt{part_svc});
-
- my $svcdb = $opt{svcdb} || $opt{part_svc}->svcdb;
- my $query = exists($opt{query}) ? $opt{query} : $opt{svc}->svcnum;
- my $url;
- warn "$me [svc_url] checking for /$opt{action}/$svcdb.cgi component"
- if $DEBUG;
- if ( $opt{m}->interp->comp_exists("/$opt{action}/$svcdb.cgi") ) {
- $url = "$svcdb.cgi?";
- } else {
-
- my $generic = $opt{action} eq 'search' ? 'cust_svc' : 'svc_Common';
-
- $url = "$generic.html?svcdb=$svcdb;";
- $url .= 'svcnum=' if $query =~ /^\d+(;|$)/ or $query eq '';
- }
-
- import FS::CGI 'rooturl'; #WTF! why is this necessary
- my $return = rooturl(). "$opt{action}/$url$query";
-
- $return = qq!<A HREF="$return">! if $opt{ahref};
-
- $return;
-}
-
-sub svc_link {
- my($m, $part_svc, $cust_svc) = @_ or return '';
- svc_X_link( $part_svc->svc, @_ );
-}
-
-sub svc_label_link {
- my($m, $part_svc, $cust_svc) = @_ or return '';
- svc_X_link( ($cust_svc->label)[1], @_ );
-}
-
-sub svc_X_link {
- my ($x, $m, $part_svc, $cust_svc) = @_ or return '';
-
- return $x
- unless $FS::CurrentUser::CurrentUser->access_right('View customer services');
-
- my $ahref = svc_url(
- 'ahref' => 1,
- 'm' => $m,
- 'action' => 'view',
- 'part_svc' => $part_svc,
- 'svc' => $cust_svc,
- );
-
- "$ahref$x</A>";
-}
-
-#this probably needs an ACL too...
-sub svc_export_links {
- my ($m, $part_svc, $cust_svc) = @_ or return '';
-
- my $ahref = $cust_svc->export_links;
-
- join('', @$ahref);
-}
-
-sub parse_lt_gt {
- my($cgi, $field) = @_;
-
- my @search = ();
-
- my %op = (
- 'lt' => '<',
- 'gt' => '>',
- );
-
- foreach my $op (keys %op) {
-
- warn "checking for ${field}_$op field\n"
- if $DEBUG;
-
- if ( $cgi->param($field."_$op") =~ /^\s*\$?\s*(-?[\d\,\s]+(\.\d\d)?)\s*$/ ) {
-
- my $num = $1;
- $num =~ s/[\,\s]+//g;
- my $search = "$field $op{$op} $num";
- push @search, $search;
-
- warn "found ${field}_$op field; adding search element $search\n"
- if $DEBUG;
- }
-
- }
-
- @search;
-
-}
-
-###
-# cust_main report subroutines
-###
-
-
-=item cust_header [ CUST_FIELDS_VALUE ]
-
-Returns an array of customer information headers according to the supplied
-customer fields value, or if no value is supplied, the B<cust-fields>
-configuration value.
-
-=cut
-
-use vars qw( @cust_fields @cust_colors @cust_styles @cust_aligns );
-
-sub cust_header {
-
- warn "FS::UI:Web::cust_header called"
- if $DEBUG;
-
- my $conf = new FS::Conf;
-
- my %header2method = (
- 'Customer' => 'name',
- 'Cust. Status' => 'ucfirst_cust_status',
- 'Cust#' => 'custnum',
- 'Name' => 'contact',
- 'Company' => 'company',
- '(bill) Customer' => 'name',
- '(service) Customer' => 'ship_name',
- '(bill) Name' => 'contact',
- '(service) Name' => 'ship_contact',
- '(bill) Company' => 'company',
- '(service) Company' => 'ship_company',
- 'Address 1' => 'address1',
- 'Address 2' => 'address2',
- 'City' => 'city',
- 'State' => 'state',
- 'Zip' => 'zip',
- 'Country' => 'country_full',
- 'Day phone' => 'daytime', # XXX should use msgcat, but how?
- 'Night phone' => 'night', # XXX should use msgcat, but how?
- 'Fax number' => 'fax',
- '(bill) Address 1' => 'address1',
- '(bill) Address 2' => 'address2',
- '(bill) City' => 'city',
- '(bill) State' => 'state',
- '(bill) Zip' => 'zip',
- '(bill) Country' => 'country_full',
- '(bill) Day phone' => 'daytime', # XXX should use msgcat, but how?
- '(bill) Night phone' => 'night', # XXX should use msgcat, but how?
- '(bill) Fax number' => 'fax',
- '(service) Address 1' => 'ship_address1',
- '(service) Address 2' => 'ship_address2',
- '(service) City' => 'ship_city',
- '(service) State' => 'ship_state',
- '(service) Zip' => 'ship_zip',
- '(service) Country' => 'ship_country_full',
- '(service) Day phone' => 'ship_daytime', # XXX should use msgcat, how?
- '(service) Night phone' => 'ship_night', # XXX should use msgcat, how?
- '(service) Fax number' => 'ship_fax',
- 'Invoicing email(s)' => 'invoicing_list_emailonly_scalar',
- 'Payment Type' => 'payby',
- 'Current Balance' => 'current_balance',
- );
- $header2method{'Cust#'} = 'display_custnum'
- if $conf->exists('cust_main-default_agent_custid');
-
- my %header2colormethod = (
- 'Cust. Status' => 'cust_statuscolor',
- );
- my %header2style = (
- 'Cust. Status' => 'b',
- );
- my %header2align = (
- 'Cust. Status' => 'c',
- 'Cust#' => 'r',
- );
-
- my $cust_fields;
- my @cust_header;
- if ( @_ && $_[0] ) {
-
- warn " using supplied cust-fields override".
- " (ignoring cust-fields config file)"
- if $DEBUG;
- $cust_fields = shift;
-
- } else {
-
- if ( $conf->exists('cust-fields')
- && $conf->config('cust-fields') =~ /^([\w\. \|\#\(\)]+):?/
- )
- {
- warn " found cust-fields configuration value"
- if $DEBUG;
- $cust_fields = $1;
- } else {
- warn " no cust-fields configuration value found; using default 'Cust. Status | Customer'"
- if $DEBUG;
- $cust_fields = 'Cust. Status | Customer';
- }
-
- }
-
- @cust_header = split(/ \| /, $cust_fields);
- @cust_fields = map { $header2method{$_} || $_ } @cust_header;
- @cust_colors = map { exists $header2colormethod{$_}
- ? $header2colormethod{$_}
- : ''
- }
- @cust_header;
- @cust_styles = map { exists $header2style{$_} ? $header2style{$_} : '' }
- @cust_header;
- @cust_aligns = map { exists $header2align{$_} ? $header2align{$_} : 'l' }
- @cust_header;
-
- #my $svc_x = shift;
- @cust_header;
-}
-
-=item cust_sql_fields [ CUST_FIELDS_VALUE ]
-
-Returns a list of fields for the SELECT portion of an SQL query.
-
-As with L<the cust_header subroutine|/cust_header>, the fields returned are
-defined by the supplied customer fields setting, or if no customer fields
-setting is supplied, the <B>cust-fields</B> configuration value.
-
-=cut
-
-sub cust_sql_fields {
-
- my @fields = qw( last first company );
- push @fields, map "ship_$_", @fields;
- push @fields, 'country';
-
- cust_header(@_);
- #inefficientish, but tiny lists and only run once per page
-
- my @add_fields = qw( address1 address2 city state zip daytime night fax );
- push @fields,
- grep { my $field = $_; grep { $_ eq $field } @cust_fields }
- ( @add_fields, ( map "ship_$_", @add_fields ), 'payby' );
-
- push @fields, 'agent_custid';
-
- my @extra_fields = ();
- if (grep { $_ eq 'current_balance' } @cust_fields) {
- push @extra_fields, FS::cust_main->balance_sql . " AS current_balance";
- }
-
- map("cust_main.$_", @fields), @extra_fields;
-}
-
-=item cust_fields OBJECT [ CUST_FIELDS_VALUE ]
-
-Given an object that contains fields from cust_main (say, from a
-JOINed search. See httemplate/search/svc_* for examples), returns an array
-of customer information, or "(unlinked)" if this service is not linked to a
-customer.
-
-As with L<the cust_header subroutine|/cust_header>, the fields returned are
-defined by the supplied customer fields setting, or if no customer fields
-setting is supplied, the <B>cust-fields</B> configuration value.
-
-=cut
-
-
-sub cust_fields {
- my $record = shift;
- warn "FS::UI::Web::cust_fields called for $record ".
- "(cust_fields: @cust_fields)"
- if $DEBUG > 1;
-
- #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields
- # #override incase we were passed as a sub
-
- my $seen_unlinked = 0;
-
- map {
- if ( $record->custnum ) {
- warn " $record -> $_" if $DEBUG > 1;
- $record->$_(@_);
- } else {
- warn " ($record unlinked)" if $DEBUG > 1;
- $seen_unlinked++ ? '' : '(unlinked)';
- }
- } @cust_fields;
-}
-
-=item cust_fields_subs
-
-Returns an array of subroutine references for returning customer field values.
-This is similar to cust_fields, but returns each field's sub as a distinct
-element.
-
-=cut
-
-sub cust_fields_subs {
- my $unlinked_warn = 0;
- return map {
- my $f = $_;
- if( $unlinked_warn++ ) {
- sub {
- my $record = shift;
- if( $record->custnum ) {
- $record->$f(@_);
- }
- else {
- '(unlinked)'
- };
- }
- }
- else {
- sub {
- my $record = shift;
- $record->$f(@_) if $record->custnum;
- }
- }
- } @cust_fields;
-}
-
-=item cust_colors
-
-Returns an array of subroutine references (or empty strings) for returning
-customer information colors.
-
-As with L<the cust_header subroutine|/cust_header>, the fields returned are
-defined by the supplied customer fields setting, or if no customer fields
-setting is supplied, the <B>cust-fields</B> configuration value.
-
-=cut
-
-sub cust_colors {
- map {
- my $method = $_;
- if ( $method ) {
- sub { shift->$method(@_) };
- } else {
- '';
- }
- } @cust_colors;
-}
-
-=item cust_styles
-
-Returns an array of customer information styles.
-
-As with L<the cust_header subroutine|/cust_header>, the fields returned are
-defined by the supplied customer fields setting, or if no customer fields
-setting is supplied, the <B>cust-fields</B> configuration value.
-
-=cut
-
-sub cust_styles {
- map {
- if ( $_ ) {
- $_;
- } else {
- '';
- }
- } @cust_styles;
-}
-
-=item cust_aligns
-
-Returns an array or scalar (depending on context) of customer information
-alignments.
-
-As with L<the cust_header subroutine|/cust_header>, the fields returned are
-defined by the supplied customer fields setting, or if no customer fields
-setting is supplied, the <B>cust-fields</B> configuration value.
-
-=cut
-
-sub cust_aligns {
- if ( wantarray ) {
- @cust_aligns;
- } else {
- join('', @cust_aligns);
- }
-}
-
-###
-# begin JSRPC code...
-###
-
-package FS::UI::Web::JSRPC;
-
-use strict;
-use vars qw($DEBUG);
-use Carp;
-use Storable qw(nfreeze);
-use MIME::Base64;
-use JSON;
-use FS::UID qw(getotaker);
-use FS::Record qw(qsearchs);
-use FS::queue;
-use FS::CGI qw(rooturl);
-
-$DEBUG = 0;
-
-sub new {
- my $class = shift;
- my $self = {
- env => {},
- job => shift,
- cgi => shift,
- };
-
- bless $self, $class;
-
- croak "CGI object required as second argument" unless $self->{'cgi'};
-
- return $self;
-}
-
-sub process {
-
- my $self = shift;
-
- my $cgi = $self->{'cgi'};
-
- # XXX this should parse JSON foo and build a proper data structure
- my @args = $cgi->param('arg');
-
- #work around konqueror bug!
- @args = map { s/\x00$//; $_; } @args;
-
- my $sub = $cgi->param('sub'); #????
-
- warn "FS::UI::Web::JSRPC::process:\n".
- " cgi=$cgi\n".
- " sub=$sub\n".
- " args=".join(', ',@args)."\n"
- if $DEBUG;
-
- if ( $sub eq 'start_job' ) {
-
- $self->start_job(@args);
-
- } elsif ( $sub eq 'job_status' ) {
-
- $self->job_status(@args);
-
- } else {
-
- die "unknown sub $sub";
-
- }
-
-}
-
-sub start_job {
- my $self = shift;
-
- warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG;
-# my %param = @_;
- my %param = ();
- while ( @_ ) {
- my( $field, $value ) = splice(@_, 0, 2);
- unless ( exists( $param{$field} ) ) {
- $param{$field} = $value;
- } elsif ( ! ref($param{$field}) ) {
- $param{$field} = [ $param{$field}, $value ];
- } else {
- push @{$param{$field}}, $value;
- }
- }
- $param{CurrentUser} = getotaker();
- $param{RootURL} = rooturl($self->{cgi}->self_url);
- warn "FS::UI::Web::start_job\n".
- join('', map {
- if ( ref($param{$_}) ) {
- " $_ => [ ". join(', ', @{$param{$_}}). " ]\n";
- } else {
- " $_ => $param{$_}\n";
- }
- } keys %param )
- if $DEBUG;
-
- #first get the CGI params shipped off to a job ASAP so an id can be returned
- #to the caller
-
- my $job = new FS::queue { 'job' => $self->{'job'} };
-
- #too slow to insert all the cgi params as individual args..,?
- #my $error = $queue->insert('_JOB', $cgi->Vars);
-
- #warn 'froze string of size '. length(nfreeze(\%param)). " for job args\n"
- # if $DEBUG;
-
- my $error = $job->insert( '_JOB', encode_base64(nfreeze(\%param)) );
-
- if ( $error ) {
-
- warn "job not inserted: $error\n"
- if $DEBUG;
-
- $error; #this doesn't seem to be handled well,
- # will trigger "illegal jobnum" below?
- # (should never be an error inserting the job, though, only thing
- # would be Pg f%*kage)
- } else {
-
- warn "job inserted successfully with jobnum ". $job->jobnum. "\n"
- if $DEBUG;
-
- $job->jobnum;
- }
-
-}
-
-sub job_status {
- my( $self, $jobnum ) = @_; #$url ???
-
- sleep 1; # XXX could use something better...
-
- my $job;
- if ( $jobnum =~ /^(\d+)$/ ) {
- $job = qsearchs('queue', { 'jobnum' => $jobnum } );
- } else {
- die "FS::UI::Web::job_status: illegal jobnum $jobnum\n";
- }
-
- my @return;
- if ( $job && $job->status ne 'failed' && $job->status ne 'done' ) {
- my ($progress, $action) = split ',', $job->statustext, 2;
- $action ||= 'Server processing job';
- @return = ( 'progress', $progress, $action );
- } elsif ( !$job ) { #handle job gone case : job successful
- # so close popup, redirect parent window...
- @return = ( 'complete' );
- } elsif ( $job->status eq 'done' ) {
- @return = ( 'done', $job->statustext, '' );
- } else {
- @return = ( 'error', $job ? $job->statustext : $jobnum );
- }
-
- #to_json(\@return); #waiting on deb 5.0 for new JSON.pm?
- objToJson(\@return);
-
-}
-
-1;
-
diff --git a/FS/FS/UI/Web/small_custview.pm b/FS/FS/UI/Web/small_custview.pm
deleted file mode 100644
index 36dd30c..0000000
--- a/FS/FS/UI/Web/small_custview.pm
+++ /dev/null
@@ -1,149 +0,0 @@
-package FS::UI::Web::small_custview;
-
-use strict;
-use vars qw(@EXPORT_OK @ISA);
-use Exporter;
-use HTML::Entities;
-use FS::Msgcat;
-use FS::Record qw(qsearchs);
-use FS::cust_main;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw( small_custview );
-
-=item small_custview CUSTNUM || CUST_MAIN_OBJECT, COUNTRYDEFAULT, NOBALANCE_FLAG, URL
-
-Sheesh. I did switch to mason, but this is still hanging around. Figure out
-some better way to sling mason components to self-service & RT.
-
-=cut
-
-sub small_custview {
-
- my $arg = shift;
- my $countrydefault = shift || 'US';
- my $nobalance = shift;
- my $url = shift;
-
- my $cust_main = ref($arg) ? $arg
- : qsearchs('cust_main', { 'custnum' => $arg } )
- or die "unknown custnum $arg";
-
- my $html;
-
- $html = qq!View <A HREF="$url?! . $cust_main->custnum . '">'
- if $url;
-
- $html .= 'Customer #<B>'. $cust_main->display_custnum. '</B></A>'.
- ' - <B><FONT COLOR="#'. $cust_main->statuscolor. '">'.
- ucfirst($cust_main->status). '</FONT></B>';
-
- my @part_tag = $cust_main->part_tag;
- if ( @part_tag ) {
- $html .= '<TABLE>';
- foreach my $part_tag ( @part_tag ) {
- $html .= '<TR><TD>'.
- '<FONT '. ( length($part_tag->tagcolor)
- ? 'STYLE="background-color:#'.$part_tag->tagcolor.'"'
- : ''
- ).
- '>'.
- encode_entities($part_tag->tagname.': '. $part_tag->tagdesc).
- '</FONT>'.
- '</TD></TR>';
- }
- $html .= '</TABLE>';
- }
-
- $html .=
- ntable('#e8e8e8'). '<TR><TD VALIGN="top">'. ntable("#cccccc",2).
- '<TR><TD ALIGN="right" VALIGN="top">Billing<BR>Address</TD><TD BGCOLOR="#ffffff">'.
- $cust_main->getfield('last'). ', '. $cust_main->first. '<BR>';
-
- $html .= $cust_main->company. '<BR>' if $cust_main->company;
- $html .= $cust_main->address1. '<BR>';
- $html .= $cust_main->address2. '<BR>' if $cust_main->address2;
- $html .= $cust_main->city. ', '. $cust_main->state. ' '. $cust_main->zip. '<BR>';
- $html .= $cust_main->country. '<BR>'
- if $cust_main->country && $cust_main->country ne $countrydefault;
-
- $html .= '</TD></TR><TR><TD></TD><TD BGCOLOR="#ffffff">';
- if ( $cust_main->daytime && $cust_main->night ) {
- $html .= ( FS::Msgcat::_gettext('daytime') || 'Day' ).
- ' '. $cust_main->daytime.
- '<BR>'. ( FS::Msgcat::_gettext('night') || 'Night' ).
- ' '. $cust_main->night;
- } elsif ( $cust_main->daytime || $cust_main->night ) {
- $html .= $cust_main->daytime || $cust_main->night;
- }
- if ( $cust_main->fax ) {
- $html .= '<BR>Fax '. $cust_main->fax;
- }
-
- $html .= '</TD></TR></TABLE></TD>';
-
- if ( defined $cust_main->dbdef_table->column('ship_last') ) {
-
- my $pre = $cust_main->ship_last ? 'ship_' : '';
-
- $html .= '<TD VALIGN="top">'. ntable("#cccccc",2).
- '<TR><TD ALIGN="right" VALIGN="top">Service<BR>Address</TD><TD BGCOLOR="#ffffff">'.
- $cust_main->get("${pre}last"). ', '.
- $cust_main->get("${pre}first"). '<BR>';
- $html .= $cust_main->get("${pre}company"). '<BR>'
- if $cust_main->get("${pre}company");
- $html .= $cust_main->get("${pre}address1"). '<BR>';
- $html .= $cust_main->get("${pre}address2"). '<BR>'
- if $cust_main->get("${pre}address2");
- $html .= $cust_main->get("${pre}city"). ', '.
- $cust_main->get("${pre}state"). ' '.
- $cust_main->get("${pre}zip"). '<BR>';
- $html .= $cust_main->get("${pre}country"). '<BR>'
- if $cust_main->get("${pre}country")
- && $cust_main->get("${pre}country") ne $countrydefault;
-
- $html .= '</TD></TR><TR><TD></TD><TD BGCOLOR="#ffffff">';
-
- if ( $cust_main->get("${pre}daytime") && $cust_main->get("${pre}night") ) {
- use FS::Msgcat;
- $html .= ( FS::Msgcat::_gettext('daytime') || 'Day' ).
- ' '. $cust_main->get("${pre}daytime").
- '<BR>'. ( FS::Msgcat::_gettext('night') || 'Night' ).
- ' '. $cust_main->get("${pre}night");
- } elsif ( $cust_main->get("${pre}daytime")
- || $cust_main->get("${pre}night") ) {
- $html .= $cust_main->get("${pre}daytime")
- || $cust_main->get("${pre}night");
- }
- if ( $cust_main->get("${pre}fax") ) {
- $html .= '<BR>Fax '. $cust_main->get("${pre}fax");
- }
-
- $html .= '</TD></TR></TABLE></TD>';
- }
-
- $html .= '</TR></TABLE>';
-
- $html .= '<BR>Balance: <B>$'. $cust_main->balance. '</B><BR>'
- unless $nobalance;
-
- # last payment might be good here too?
-
- $html;
-}
-
-#bah. don't want to pull in all of FS::CGI, that's the whole problem in the
-#first place
-sub ntable {
- my $col = shift;
- my $cellspacing = shift || 0;
- if ( $col ) {
- qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing>!;
- } else {
- '<TABLE BORDER CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">';
- }
-
-}
-
-1;
-
diff --git a/FS/FS/UI/bytecount.pm b/FS/FS/UI/bytecount.pm
deleted file mode 100644
index 7e78bf5..0000000
--- a/FS/FS/UI/bytecount.pm
+++ /dev/null
@@ -1,101 +0,0 @@
-package FS::UI::bytecount;
-
-use strict;
-use vars qw($DEBUG $me @ISA @EXPORT_OK);
-use Exporter;
-use FS::Conf;
-use Number::Format 1.50;
-
-@ISA = qw( Exporter );
-
-@EXPORT_OK = qw( bytecount_unexact parse_bytecount display_bytecount );
-
-$DEBUG = 0;
-$me = '[FS::UID::bytecount]';
-
-=head1 NAME
-
-FS::UI::bytecount - Subroutines for parsing and displaying byte counters
-
-=head1 SYNOPSIS
-
- use FS::UI::bytecount;
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item bytecount_unexact COUNT
-
-Returns a two decimal place value for COUNT followed by bytes, Kbytes, Mbytes,
-or GBytes as appropriate.
-
-=cut
-
-sub bytecount_unexact {
- my $bc = shift;
- return("$bc bytes")
- if ($bc < 1000);
- return(sprintf("%.2f Kbytes", $bc/1024))
- if ($bc < 1048576);
- return(sprintf("%.2f Mbytes", $bc/1048576))
- if ($bc < 1073741824);
- return(sprintf("%.2f Gbytes", $bc/1073741824));
-}
-
-=item parse_bytecount AMOUNT
-
-Accepts a number (digits and a decimal point) possibly followed by k, m, g, or
-t (and an optional 'b') in either case. Returns a pure number representing
-the input or the input itself if unparsable. Discards commas as noise.
-
-=cut
-
-sub parse_bytecount {
- my $bc = shift;
- return $bc if (($bc =~ tr/.//) > 1);
- $bc =~ /^\s*([,\d.]*)\s*([kKmMgGtT]?)[bB]?\s*$/ or return $bc;
- my $base = $1;
- $base =~ tr/,//d;
- return $bc unless length $base;
- my $exponent = index ' kmgt', lc($2);
- return $bc if ($exponent < 0 && $2);
- $exponent = 0 if ($exponent < 0);
- return int($base * 1024 ** $exponent); #bytecounts are integer values
-}
-
-=item display_bytecount AMOUNT
-
-Converts a pure number to a value followed possibly followed by k, m, g, or
-t via Number::Format
-
-=cut
-
-sub display_bytecount {
- my $bc = shift;
- return $bc unless ($bc =~ /^(\d+)$/);
- my $conf = new FS::Conf;
- my $f = new Number::Format;
- my $precision = ( $conf->exists('datavolume-significantdigits') &&
- $conf->config('datavolume-significantdigits') =~ /^\s*\d+\s*$/ )
- ? $conf->config('datavolume-significantdigits')
- : 3;
- my $unit = $conf->exists('datavolume-forcemegabytes') ? 'M' : 'A';
-
- return $f->format_bytes($bc, precision => $precision, unit => $unit);
-}
-
-=back
-
-=head1 BUGS
-
-Fly
-
-=head1 SEE ALSO
-
-L<Number::Format>
-
-=cut
-
-1;
-
diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm
deleted file mode 100644
index e042c05..0000000
--- a/FS/FS/UID.pm
+++ /dev/null
@@ -1,405 +0,0 @@
-package FS::UID;
-
-use strict;
-use vars qw(
- @ISA @EXPORT_OK $DEBUG $me $cgi $freeside_uid $user $conf_dir $cache_dir
- $secrets $datasrc $db_user $db_pass $schema $dbh $driver_name
- $AutoCommit %callback @callback $callback_hack $use_confcompat
-);
-use subs qw(
- getsecrets cgisetotaker
-);
-use Exporter;
-use Carp qw(carp croak cluck confess);
-use DBI;
-use IO::File;
-use FS::CurrentUser;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
- getotaker dbh datasrc getsecrets driver_name myconnect
- use_confcompat);
-
-$DEBUG = 0;
-$me = '[FS::UID]';
-
-$freeside_uid = scalar(getpwnam('freeside'));
-
-$conf_dir = "%%%FREESIDE_CONF%%%";
-$cache_dir = "%%%FREESIDE_CACHE%%%";
-
-$AutoCommit = 1; #ours, not DBI
-$use_confcompat = 1;
-$callback_hack = 0;
-
-=head1 NAME
-
-FS::UID - Subroutines for database login and assorted other stuff
-
-=head1 SYNOPSIS
-
- use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
- checkeuid checkruid);
-
- adminsuidsetup $user;
-
- $cgi = new CGI;
- $dbh = cgisuidsetup($cgi);
-
- $dbh = dbh;
-
- $datasrc = datasrc;
-
- $driver_name = driver_name;
-
-=head1 DESCRIPTION
-
-Provides a hodgepodge of subroutines.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item adminsuidsetup USER
-
-Sets the user to USER (see config.html from the base documentation).
-Cleans the environment.
-Make sure the script is running as freeside, or setuid freeside.
-Opens a connection to the database.
-Swaps real and effective UIDs.
-Runs any defined callbacks (see below).
-Returns the DBI database handle (usually you don't need this).
-
-=cut
-
-sub adminsuidsetup {
- $dbh->disconnect if $dbh;
- &forksuidsetup(@_);
-}
-
-sub forksuidsetup {
- $user = shift;
- my $olduser = $user;
- warn "$me forksuidsetup starting for $user\n" if $DEBUG;
-
- if ( $FS::CurrentUser::upgrade_hack ) {
- $user = 'fs_bootstrap';
- } else {
- croak "fatal: adminsuidsetup called without arguements" unless $user;
-
- $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
- $user = $1;
- }
-
- $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
- $ENV{'SHELL'} = '/bin/sh';
- $ENV{'IFS'} = " \t\n";
- $ENV{'CDPATH'} = '';
- $ENV{'ENV'} = '';
- $ENV{'BASH_ENV'} = '';
-
- croak "Not running uid freeside (\$>=$>, \$<=$<)\n" unless checkeuid();
-
- warn "$me forksuidsetup connecting to database\n" if $DEBUG;
- if ( $FS::CurrentUser::upgrade_hack && $olduser ) {
- $dbh = &myconnect($olduser);
- } else {
- $dbh = &myconnect();
- }
- warn "$me forksuidsetup connected to database with handle $dbh\n" if $DEBUG;
-
- warn "$me forksuidsetup loading schema\n" if $DEBUG;
- use FS::Schema qw(reload_dbdef dbdef);
- reload_dbdef("$conf_dir/dbdef.$datasrc")
- unless $FS::Schema::setup_hack;
-
- warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG;
-
- if ( ! $FS::Schema::setup_hack && dbdef->table('conf') ) {
-
- my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
- $sth->execute or die $sth->errstr;
- my $confcount = $sth->fetchrow_arrayref->[0];
-
- if ($confcount) {
- $use_confcompat = 0;
- }else{
- warn "NO CONFIGURATION RECORDS FOUND";
- }
-
- } else {
- warn "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack;
- }
-
- unless ( $callback_hack ) {
- warn "$me calling callbacks\n" if $DEBUG;
- foreach ( keys %callback ) {
- &{$callback{$_}};
- # breaks multi-database installs # delete $callback{$_}; #run once
- }
-
- &{$_} foreach @callback;
- } else {
- warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
- }
-
- warn "$me forksuidsetup loading user\n" if $DEBUG;
- FS::CurrentUser->load_user($user);
-
- $dbh;
-}
-
-sub myconnect {
- my $handle = DBI->connect( getsecrets(@_), { 'AutoCommit' => 0,
- 'ChopBlanks' => 1,
- 'ShowErrorStatement' => 1,
- }
- )
- or die "DBI->connect error: $DBI::errstr\n";
-
- if ( $schema ) {
- use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack
- my $driver = _load_driver($handle);
- if ( $driver =~ /^Pg/ ) {
- no warnings 'redefine';
- eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}";
- die $@ if $@;
- }
- }
-
- $handle;
-}
-
-=item install_callback
-
-A package can install a callback to be run in adminsuidsetup by passing
-a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
-run already, the callback will also be run immediately.
-
- $coderef = sub { warn "Hi, I'm returning your call!" };
- FS::UID->install_callback($coderef);
-
- install_callback FS::UID sub {
- warn "Hi, I'm returning your call!"
- };
-
-=cut
-
-sub install_callback {
- my $class = shift;
- my $callback = shift;
- push @callback, $callback;
- &{$callback} if $dbh;
-}
-
-=item cgisuidsetup CGI_object
-
-Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
-object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup.
-
-=cut
-
-sub cgisuidsetup {
- $cgi=shift;
- if ( $cgi->isa('CGI::Base') ) {
- carp "Use of CGI::Base is depriciated";
- } elsif ( $cgi->isa('Apache') ) {
-
- } elsif ( ! $cgi->isa('CGI') ) {
- croak "fatal: unrecognized object $cgi";
- }
- cgisetotaker;
- adminsuidsetup($user);
-}
-
-=item cgi
-
-Returns the CGI (see L<CGI>) object.
-
-=cut
-
-sub cgi {
- carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
- $cgi;
-}
-
-=item dbh
-
-Returns the DBI database handle.
-
-=cut
-
-sub dbh {
- $dbh;
-}
-
-=item datasrc
-
-Returns the DBI data source.
-
-=cut
-
-sub datasrc {
- $datasrc;
-}
-
-=item driver_name
-
-Returns just the driver name portion of the DBI data source.
-
-=cut
-
-sub driver_name {
- return $driver_name if defined $driver_name;
- $driver_name = ( split(':', $datasrc) )[1];
-}
-
-sub suidsetup {
- croak "suidsetup depriciated";
-}
-
-=item getotaker
-
-Returns the current Freeside user.
-
-=cut
-
-sub getotaker {
- $user;
-}
-
-=item cgisetotaker
-
-Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
-object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base
-and derived classes is depriciated.
-
-=cut
-
-sub cgisetotaker {
- if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
- carp "Use of CGI::Base is depriciated";
- $user = lc ( $cgi->var('REMOTE_USER') );
- } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
- $user = lc ( $cgi->remote_user );
- } elsif ( $cgi && $cgi->isa('Apache') ) {
- $user = lc ( $cgi->connection->user );
- } else {
- die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
- "Apache user authentication as documented in httemplate/docs/install.html";
- }
- $user;
-}
-
-=item checkeuid
-
-Returns true if effective UID is that of the freeside user.
-
-=cut
-
-sub checkeuid {
- #$> = $freeside_uid unless $>; #huh. mpm-itk hack
- ( $> == $freeside_uid );
-}
-
-=item checkruid
-
-Returns true if the real UID is that of the freeside user.
-
-=cut
-
-sub checkruid {
- ( $< == $freeside_uid );
-}
-
-=item getsecrets [ USER ]
-
-Sets the user to USER, if supplied.
-Sets and returns the DBI datasource, username and password for this user from
-the `/usr/local/etc/freeside/mapsecrets' file.
-
-=cut
-
-sub getsecrets {
- my($setuser) = shift;
- $user = $setuser if $setuser;
-
- if ( -e "$conf_dir/mapsecrets" ) {
- die "No user!" unless $user;
- my($line) = grep /^\s*($user|\*)\s/,
- map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/mapsecrets");
- confess "User $user not found in mapsecrets!" unless $line;
- $line =~ /^\s*($user|\*)\s+(.*)$/;
- $secrets = $2;
- die "Illegal mapsecrets line for user?!" unless $secrets;
- } else {
- # no mapsecrets file at all, so do the default thing
- $secrets = 'secrets';
- }
-
- ($datasrc, $db_user, $db_pass, $schema) =
- map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/$secrets")
- or die "Can't get secrets: $conf_dir/$secrets: $!\n";
- undef $driver_name;
-
- ($datasrc, $db_user, $db_pass);
-}
-
-=item use_confcompat
-
-Returns true whenever we should use 1.7 configuration compatibility.
-
-=cut
-
-sub use_confcompat {
- $use_confcompat;
-}
-
-=back
-
-=head1 CALLBACKS
-
-Warning: this interface is (still) likely to change in future releases.
-
-New (experimental) callback interface:
-
-A package can install a callback to be run in adminsuidsetup by passing
-a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
-run already, the callback will also be run immediately.
-
- $coderef = sub { warn "Hi, I'm returning your call!" };
- FS::UID->install_callback($coderef);
-
- install_callback FS::UID sub {
- warn "Hi, I'm returning your call!"
- };
-
-Old (deprecated) callback interface:
-
-A package can install a callback to be run in adminsuidsetup by putting a
-coderef into the hash %FS::UID::callback :
-
- $coderef = sub { warn "Hi, I'm returning your call!" };
- $FS::UID::callback{'Package::Name'} = $coderef;
-
-=head1 BUGS
-
-Too many package-global variables.
-
-Not OO.
-
-No capabilities yet. When mod_perl and Authen::DBI are implemented,
-cgisuidsetup will go away as well.
-
-Goes through contortions to support non-OO syntax with multiple datasrc's.
-
-Callbacks are (still) inelegant.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm
deleted file mode 100644
index ba4a085..0000000
--- a/FS/FS/Upgrade.pm
+++ /dev/null
@@ -1,378 +0,0 @@
-package FS::Upgrade;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK $DEBUG );
-use Exporter;
-use Tie::IxHash;
-use FS::UID qw( dbh driver_name );
-use FS::Conf;
-use FS::Record qw(qsearchs str2time_sql);
-
-use FS::svc_domain;
-$FS::svc_domain::whois_hack = 1;
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( upgrade_schema upgrade_config upgrade upgrade_sqlradius );
-
-$DEBUG = 1;
-
-=head1 NAME
-
-FS::Upgrade - Database upgrade routines
-
-=head1 SYNOPSIS
-
- use FS::Upgrade;
-
-=head1 DESCRIPTION
-
-Currently this module simply provides a place to store common subroutines for
-database upgrades.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item upgrade_config
-
-=cut
-
-#config upgrades
-sub upgrade_config {
- my %opt = @_;
-
- my $conf = new FS::Conf;
-
- $conf->touch('payment_receipt')
- if $conf->exists('payment_receipt_email')
- || $conf->config('payment_receipt_msgnum');
-
-}
-
-=item upgrade
-
-=cut
-
-sub upgrade {
- my %opt = @_;
-
- my $data = upgrade_data(%opt);
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- local $FS::UID::AutoCommit = 0;
-
- foreach my $table ( keys %$data ) {
-
- my $class = "FS::$table";
- eval "use $class;";
- die $@ if $@;
-
- if ( $class->can('_upgrade_data') ) {
- warn "Upgrading $table...\n";
-
- my $start = time;
-
- $class->_upgrade_data(%opt);
-
- if ( $oldAutoCommit ) {
- warn " committing\n";
- dbh->commit or die dbh->errstr;
- }
-
- #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
- warn " done in ". (time-$start). " seconds\n";
-
- } else {
- warn "WARNING: asked for upgrade of $table,".
- " but FS::$table has no _upgrade_data method\n";
- }
-
-# my @records = @{ $data->{$table} };
-#
-# foreach my $record ( @records ) {
-# my $args = delete($record->{'_upgrade_args'}) || [];
-# my $object = $class->new( $record );
-# my $error = $object->insert( @$args );
-# die "error inserting record into $table: $error\n"
-# if $error;
-# }
-
- }
-
-}
-
-=item upgrade_data
-
-=cut
-
-sub upgrade_data {
- my %opt = @_;
-
- tie my %hash, 'Tie::IxHash',
-
- #cust_main (remove paycvv from history)
- 'cust_main' => [],
-
- #msgcat
- 'msgcat' => [],
-
- #reason type and reasons
- 'reason_type' => [],
- 'cust_pkg_reason' => [],
-
- #need part_pkg before cust_credit...
- 'part_pkg' => [],
-
- #customer credits
- 'cust_credit' => [],
-
- #duplicate history records
- 'h_cust_svc' => [],
-
- #populate cust_pay.otaker
- 'cust_pay' => [],
-
- #populate part_pkg_taxclass for starters
- 'part_pkg_taxclass' => [],
-
- #remove bad pending records
- 'cust_pay_pending' => [],
-
- #replace invnum and pkgnum with billpkgnum
- 'cust_bill_pkg_detail' => [],
-
- #usage_classes if we have none
- 'usage_class' => [],
-
- #phone_type if we have none
- 'phone_type' => [],
-
- #fixup access rights
- 'access_right' => [],
-
- #change recur_flat and enable_prorate
- 'part_pkg_option' => [],
-
- #add weights to pkg_category
- 'pkg_category' => [],
-
- #cdrbatch fixes
- 'cdr' => [],
-
- #otaker->usernum
- 'cust_attachment' => [],
- #'cust_credit' => [],
- #'cust_main' => [],
- 'cust_main_note' => [],
- #'cust_pay' => [],
- 'cust_pay_void' => [],
- 'cust_pkg' => [],
- #'cust_pkg_reason' => [],
- 'cust_pkg_discount' => [],
- 'cust_refund' => [],
- 'banned_pay' => [],
-
- #default namespace
- 'payment_gateway' => [],
-
- #migrate to templates
- 'msg_template' => [],
-
- #return unprovisioned numbers to availability
- 'phone_avail' => [],
-
- #insert scripcondition
- 'TicketSystem' => [],
-
- ;
-
- \%hash;
-
-}
-
-=item upgrade_schema
-
-=cut
-
-sub upgrade_schema {
- my %opt = @_;
-
- my $data = upgrade_schema_data(%opt);
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- local $FS::UID::AutoCommit = 0;
-
- foreach my $table ( keys %$data ) {
-
- my $class = "FS::$table";
- eval "use $class;";
- die $@ if $@;
-
- if ( $class->can('_upgrade_schema') ) {
- warn "Upgrading $table schema...\n";
-
- my $start = time;
-
- $class->_upgrade_schema(%opt);
-
- if ( $oldAutoCommit ) {
- warn " committing\n";
- dbh->commit or die dbh->errstr;
- }
-
- #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
- warn " done in ". (time-$start). " seconds\n";
-
- } else {
- warn "WARNING: asked for schema upgrade of $table,".
- " but FS::$table has no _upgrade_schema method\n";
- }
-
- }
-
-}
-
-=item upgrade_schema_data
-
-=cut
-
-sub upgrade_schema_data {
- my %opt = @_;
-
- tie my %hash, 'Tie::IxHash',
-
- #fix classnum character(1)
- 'cust_bill_pkg_detail' => [],
-
- ;
-
- \%hash;
-
-}
-
-sub upgrade_sqlradius {
- #my %opt = @_;
-
- my $conf = new FS::Conf;
-
- my @part_export = FS::part_export::sqlradius->all_sqlradius_withaccounting();
-
- foreach my $part_export ( @part_export ) {
-
- my $errmsg = 'Error adding FreesideStatus to '.
- $part_export->option('datasrc'). ': ';
-
- my $dbh = DBI->connect(
- ( map $part_export->option($_), qw ( datasrc username password ) ),
- { PrintError => 0, PrintWarn => 0 }
- ) or do {
- warn $errmsg.$DBI::errstr;
- next;
- };
-
- my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
- my $group = "UserName";
- $group .= ",Realm"
- if ref($part_export) =~ /withdomain/
- || $dbh->{Driver}->{Name} =~ /^Pg/; #hmm
-
- my $sth_alter = $dbh->prepare(
- "ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL"
- );
- if ( $sth_alter ) {
- if ( $sth_alter->execute ) {
- my $sth_update = $dbh->prepare(
- "UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL"
- ) or die $errmsg.$dbh->errstr;
- $sth_update->execute or die $errmsg.$sth_update->errstr;
- } else {
- my $error = $sth_alter->errstr;
- warn $errmsg.$error
- unless $error =~ /Duplicate column name/i #mysql
- || $error =~ /already exists/i; #Pg
-;
- }
- } else {
- my $error = $dbh->errstr;
- warn $errmsg.$error; #unless $error =~ /exists/i;
- }
-
- my $sth_index = $dbh->prepare(
- "CREATE INDEX FreesideStatus ON radacct ( FreesideStatus )"
- );
- if ( $sth_index ) {
- unless ( $sth_index->execute ) {
- my $error = $sth_index->errstr;
- warn $errmsg.$error
- unless $error =~ /Duplicate key name/i #mysql
- || $error =~ /already exists/i; #Pg
- }
- } else {
- my $error = $dbh->errstr;
- warn $errmsg.$error. ' (preparing statement)';#unless $error =~ /exists/i;
- }
-
- my $times = ($dbh->{Driver}->{Name} =~ /^mysql/)
- ? ' AcctStartTime != 0 AND AcctStopTime != 0 '
- : ' AcctStartTime IS NOT NULL AND AcctStopTime IS NOT NULL ';
-
- my $sth = $dbh->prepare("SELECT UserName,
- Realm,
- $str2time max(AcctStartTime)),
- $str2time max(AcctStopTime))
- FROM radacct
- WHERE FreesideStatus = 'done'
- AND $times
- GROUP BY $group
- ")
- or die $errmsg.$dbh->errstr;
- $sth->execute() or die $errmsg.$sth->errstr;
-
- while (my $row = $sth->fetchrow_arrayref ) {
- my ($username, $realm, $start, $stop) = @$row;
-
- $username = lc($username) unless $conf->exists('username-uppercase');
-
- my $exportnum = $part_export->exportnum;
- my $extra_sql = " AND exportnum = $exportnum ".
- " AND exportsvcnum IS NOT NULL ";
-
- if ( ref($part_export) =~ /withdomain/ ) {
- $extra_sql = " AND '$realm' = ( SELECT domain FROM svc_domain
- WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
- }
-
- my $svc_acct = qsearchs({
- 'select' => 'svc_acct.*',
- 'table' => 'svc_acct',
- 'addl_from' => 'LEFT JOIN cust_svc USING ( svcnum )'.
- 'LEFT JOIN export_svc USING ( svcpart )',
- 'hashref' => { 'username' => $username },
- 'extra_sql' => $extra_sql,
- });
-
- if ($svc_acct) {
- $svc_acct->last_login($start)
- if $start && (!$svc_acct->last_login || $start > $svc_acct->last_login);
- $svc_acct->last_logout($stop)
- if $stop && (!$svc_acct->last_logout || $stop > $svc_acct->last_logout);
- }
- }
- }
-
-}
-
-=back
-
-=head1 BUGS
-
-Sure.
-
-=head1 SEE ALSO
-
-=cut
-
-1;
-
diff --git a/FS/FS/XMLRPC.pm b/FS/FS/XMLRPC.pm
deleted file mode 100644
index 73ce13f..0000000
--- a/FS/FS/XMLRPC.pm
+++ /dev/null
@@ -1,166 +0,0 @@
- package FS::XMLRPC;
-
-use strict;
-use vars qw( $DEBUG );
-use Frontier::RPC2;
-
-# Instead of 'use'ing freeside modules on the fly below, just preload them now.
-use FS;
-use FS::CGI;
-use FS::Conf;
-use FS::Record;
-use FS::cust_main;
-
-use FS::Maestro;
-
-use Data::Dumper;
-
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::XMLRPC - Object methods for handling XMLRPC requests
-
-=head1 SYNOPSIS
-
- use FS::XMLRPC;
-
- $xmlrpc = new FS::XMLRPC;
-
- ($error, $response_xml) = $xmlrpc->serve($request_xml);
-
-=head1 DESCRIPTION
-
-The FS::XMLRPC object is a mechanisim to access read-only data from freeside's subroutines. It does not, at least not at this point, give you the ability to access methods of freeside objects remotely. It can, however, be used to call subroutines such as FS::cust_main::smart_search and FS::Record::qsearch.
-
-See the serve method below for calling syntax.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-Provides a FS::XMLRPC object used to handle incoming XMLRPC requests.
-
-=cut
-
-sub new {
-
- my $class = shift;
- my $self = {};
- bless($self, $class);
-
- $self->{_coder} = new Frontier::RPC2;
-
- return $self;
-
-}
-
-=item serve REQUEST_XML_SCALAR
-
-The serve method takes a scalar containg an XMLRPC request for one of freeside's subroutines (not object methods). Parameters passed in the 'methodCall' will be passed as a list to the subroutine untouched. The return value of the called subroutine _must_ be a freeside object reference (eg. qsearchs) or a list of freeside object references (eg. qsearch, smart_search), _and_, the object(s) returned must support the hashref method. This will be checked first by calling UNIVERSAL::can('FS::class::subroutine', 'hashref').
-
-Return value is an XMLRPC methodResponse containing the results of the call. The result of the subroutine call itself will be coded in the methodResponse as an array of structs, regardless of whether there was many or a single object returned. In other words, after you decode the response, you'll always have an array.
-
-=cut
-
-sub serve {
-
- my ($self, $request_xml) = (shift, shift);
- my $response_xml;
-
- my $coder = $self->{_coder};
- my $call = $coder->decode($request_xml);
-
- warn "Got methodCall with method_name='" . $call->{method_name} . "'"
- if $DEBUG;
-
- $response_xml = $coder->encode_response(&_serve($call->{method_name}, $call->{value}));
-
- return ('', $response_xml);
-
-}
-
-sub _serve { #Subroutine, not method
-
- my ($method_name, $params) = (shift, shift);
-
-
- #die 'Called _serve without parameters' unless ref($params) eq 'ARRAY';
- $params = [] unless (ref($params) eq 'ARRAY');
-
- if ($method_name =~ /^(\w+)\.(\w+)/) {
-
- #my ($class, $sub) = split(/\./, $method_name);
- my ($class, $sub) = ($1, $2);
- my $fssub = "FS::${class}::${sub}";
- warn "fssub: ${fssub}" if $DEBUG;
- warn "params: " . Dumper($params) if $DEBUG;
-
- my @result;
-
- if ($class eq 'Conf') { #Special case for FS::Conf because we need an obj.
-
- if ($sub eq 'config') {
- my $conf = new FS::Conf;
- @result = ($conf->config(@$params));
- } else {
- warn "FS::XMLRPC: Can't call undefined subroutine '${fssub}'";
- }
-
- } else {
-
- unless (UNIVERSAL::can("FS::${class}", $sub)) {
- warn "FS::XMLRPC: Can't call undefined subroutine '${fssub}'";
- # Should we encode an error in the response,
- # or just break silently to the remote caller and complain locally?
- return [];
- }
-
- eval {
- no strict 'refs';
- my $fssub = "FS::${class}::${sub}";
- @result = (&$fssub(@$params));
- };
-
- if ($@) {
- warn "FS::XMLRPC: Error while calling '${fssub}': $@";
- return [];
- }
-
- }
-
- if ( scalar(@result) == 1 && ref($result[0]) eq 'HASH' ) {
- return $result[0];
- } elsif (grep { UNIVERSAL::can($_, 'hashref') ? 0 : 1 } @result) {
- #warn "FS::XMLRPC: One or more objects returned from '${fssub}' doesn't " .
- # "support the 'hashref' method.";
-
- # If they're not FS::Record decendants, just return the results unmap'd?
- # This is more flexible, but possibly more error-prone.
- return [ @result ];
- } else {
- return [ map { $_->hashref } @result ];
- }
- } elsif ($method_name eq 'version') {
- return [ $FS::VERSION ];
- } # else...
-
- warn "Unhandled XMLRPC request '${method_name}'";
- return {};
-
-}
-
-=head1 BUGS
-
-Probably lots.
-
-=head1 SEE ALSO
-
-L<Frontier::RPC2>.
-
-=cut
-
-1;
-
diff --git a/FS/FS/Yori.pm b/FS/FS/Yori.pm
deleted file mode 100644
index b5bdc0c..0000000
--- a/FS/FS/Yori.pm
+++ /dev/null
@@ -1,94 +0,0 @@
-package FS::Yori;
-# a reporting program, to report information to the MCP
-
-use strict;
-use base 'Exporter';
-
-our @EXPORT_OK = qw( reports report );
-
-sub reports { #should be autogenerated i guess
- qw( freeside_version debian_version pg_version
- apache_version apache_mpm
- payment_gateways
- );
- #ssh_vulnkey
-}
-
-sub report {
- my $report = shift;
- $report =~ /^(\w+)$/ or die;
- eval "report_$report();";
-}
-
-sub report_all {
- foreach my $report ( reports() ) {
- print "$report: ". report($report). "\n";
- }
-}
-
-sub report_freeside_version {
- chomp( my $fs_version =
- `grep '^VERSION=' /home/ivan/freeside/Makefile | cut -d= -f2`
- );
- $fs_version;
-}
-
-sub report_debian_version {
- chomp( my $deb_version = `cat /etc/debian_version` );
- $deb_version;
-}
-
-sub report_pg_version {
- chomp( my $pg_version = `echo 'show server_version' | psql -t freeside` );
- chomp($pg_version); #two?
- $pg_version =~ s/^ +//;
- $pg_version;
-}
-
-sub report_apache_version {
- chomp( my $apache_version =
- `/usr/sbin/apache2 -v | head -1 | cut -d: -f2 | cut -d/ -f2 | cut -d' ' -f1`
- );
- $apache_version;
-}
-
-sub report_apache_mpm {
- chomp( my $apache_mpm =
- `/usr/sbin/apache2 -V | grep '^Server MPM' | cut -d: -f2`
- );
- $apache_mpm =~ s/^ +//;
- $apache_mpm;
-}
-
-sub report_payment_gateways {
- my @gateways = split(/\n/,
- `aptitude -F '%c %p' search 'libbusiness-onlinepayment-.*' | grep '^i ' | grep -v '^i libbusiness-onlinepayment-perl' | cut -c29- | cut -d- -f1`
- );
- join(', ', @gateways);
-}
-
-#sub report_ssh_vulnkey{
-# my $ssh_vulnkey = `ssh-vulnkey -a | grep COMPROMISED`;
-# $ssh_vulnkey;
-#}
-
-sub report_load {
- open LOAD, "</proc/loadavg" || return;
- my($one, $five, $fifteen) = split ' ', <LOAD>;
- close LOAD;
- ($one, $five, $fifteen);
-}
-
-sub report_freememory {
- open MEM, "</proc/meminfo" || return;
- my $free = 0;
- my @interesting = qw( MemFree Cached SwapFree );
- while (<MEM>) {
- /^(\w*):\s*(\d*) kB$/ || next;
- next unless grep { $_ eq $1 } @interesting;
- $free += $2;
- }
- close MEM;
- $free;
-}
-
diff --git a/FS/FS/access_group.pm b/FS/FS/access_group.pm
deleted file mode 100644
index b5b693a..0000000
--- a/FS/FS/access_group.pm
+++ /dev/null
@@ -1,162 +0,0 @@
-package FS::access_group;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::m2name_Common;
-use FS::access_groupagent;
-use FS::access_right;
-
-@ISA = qw(FS::m2m_Common FS::m2name_Common FS::Record);
-
-=head1 NAME
-
-FS::access_group - Object methods for access_group records
-
-=head1 SYNOPSIS
-
- use FS::access_group;
-
- $record = new FS::access_group \%hash;
- $record = new FS::access_group { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::access_group object represents an access group. FS::access_group inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item groupnum - primary key
-
-=item groupname - Access group name
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new access group. To add the access group 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 { 'access_group'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid access group. 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('groupnum')
- || $self->ut_text('groupname')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item access_groupagent
-
-Returns all associated FS::access_groupagent records.
-
-=cut
-
-sub access_groupagent {
- my $self = shift;
- qsearch('access_groupagent', { 'groupnum' => $self->groupnum } );
-}
-
-=item access_rights
-
-Returns all associated FS::access_right records.
-
-=cut
-
-sub access_rights {
- my $self = shift;
- qsearch('access_right', { 'righttype' => 'FS::access_group',
- 'rightobjnum' => $self->groupnum
- }
- );
-}
-
-=item access_right RIGHTNAME
-
-Returns the specified FS::access_right record. Can be used as a boolean, to
-test if this group has the given RIGHTNAME.
-
-=cut
-
-sub access_right {
- my( $self, $name ) = @_;
- qsearchs('access_right', { 'righttype' => 'FS::access_group',
- 'rightobjnum' => $self->groupnum,
- 'rightname' => $name,
- }
- );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/access_groupagent.pm b/FS/FS/access_groupagent.pm
deleted file mode 100644
index bacc013..0000000
--- a/FS/FS/access_groupagent.pm
+++ /dev/null
@@ -1,146 +0,0 @@
-package FS::access_groupagent;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::agent;
-use FS::access_group;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::access_groupagent - Object methods for access_groupagent records
-
-=head1 SYNOPSIS
-
- use FS::access_groupagent;
-
- $record = new FS::access_groupagent \%hash;
- $record = new FS::access_groupagent { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::access_groupagent object represents an group reseller virtualization. FS::access_groupagent inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item groupagentnum - primary key
-
-=item groupnum -
-
-=item agentnum -
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new group reseller virtualization. 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 { 'access_groupagent'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid group reseller virtualization. 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('groupagentnum')
- || $self->ut_foreign_key('groupnum', 'access_group', 'groupnum')
- || $self->ut_foreign_key('agentnum', 'agent', 'agentnum')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item agent
-
-Returns the associated FS::agent object.
-
-=cut
-
-sub agent {
- my $self = shift;
- qsearchs('agent', { 'agentnum' => $self->agentnum } );
-}
-
-=item access_group
-
-Returns the associated FS::access_group object.
-
-=cut
-
-sub access_group {
- my $self = shift;
- qsearchs('access_group', { 'groupnum' => $self->groupnum } );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm
deleted file mode 100644
index ef8cc6c..0000000
--- a/FS/FS/access_right.pm
+++ /dev/null
@@ -1,198 +0,0 @@
-package FS::access_right;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::access_right - Object methods for access_right records
-
-=head1 SYNOPSIS
-
- use FS::access_right;
-
- $record = new FS::access_right \%hash;
- $record = new FS::access_right { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::access_right object represents a granted access right. FS::access_right
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item rightnum - primary key
-
-=item righttype -
-
-=item rightobjnum -
-
-=item rightname -
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new right. To add the right 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 { 'access_right'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid right. 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('rightnum')
- || $self->ut_text('righttype')
- || $self->ut_text('rightobjnum')
- || $self->ut_text('rightname')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-# _upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
-
- my @unmigrated = ( qsearch( 'access_right',
- { 'righttype'=>'FS::access_group',
- 'rightname'=>'Engineering configuration',
- }
- ),
- qsearch( 'access_right',
- { 'righttype'=>'FS::access_group',
- 'rightname'=>'Engineering global configuration',
- }
- )
- );
- foreach ( @unmigrated ) {
- my $rightname = $_->rightname;
- $rightname =~ s/Engineering/Dialup/;
- $_->rightname($rightname);
- my $error = $_->replace;
- die "Failed to update access right: $error"
- if $error;
- my $broadband = new FS::access_right { $_->hash };
- $rightname =~ s/Dialup/Broadband/;
- $broadband->rightnum('');
- $broadband->rightname($rightname);
- $error = $broadband->insert;
- die "Failed to insert access right: $error"
- if $error;
- }
-
- my %migrate = (
- 'Post payment' => [ 'Post check payment', 'Post cash payment' ],
- 'Process payment' => [ 'Process credit card payment', 'Process Echeck payment' ],
- 'Post refund' => [ 'Post check refund', 'Post cash refund' ],
- 'Refund payment' => [ 'Refund credit card payment', 'Refund Echeck payment' ],
- );
-
- foreach my $oldright (keys %migrate) {
- my @old = qsearch('access_right', { 'righttype'=>'FS::access_group',
- 'rightname'=>$oldright,
- }
- );
-
- foreach my $old ( @old ) {
-
- foreach my $newright ( @{ $migrate{$oldright} } ) {
- my %hash = (
- 'righttype' => 'FS::access_group',
- 'rightobjnum' => $old->rightobjnum,
- 'rightname' => $newright,
- );
- next if qsearchs('access_right', \%hash);
- my $access_right = new FS::access_right \%hash;
- my $error = $access_right->insert;
- die $error if $error;
- }
-
- #after the WEST stuff is sorted, etc.
- #my $error = $old->delete;
- #die $error if $error;
-
- }
-
- }
-
- '';
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm
deleted file mode 100644
index 075733a..0000000
--- a/FS/FS/access_user.pm
+++ /dev/null
@@ -1,544 +0,0 @@
-package FS::access_user;
-
-use strict;
-use base qw( FS::m2m_Common FS::option_Common );
-use vars qw( $DEBUG $me $conf $htpasswd_file );
-use FS::UID;
-use FS::Conf;
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::access_user_pref;
-use FS::access_usergroup;
-use FS::agent;
-use FS::cust_main;
-
-$DEBUG = 0;
-$me = '[FS::access_user]';
-
-#kludge htpasswd for now (i hope this bootstraps okay)
-FS::UID->install_callback( sub {
- $conf = new FS::Conf;
- $htpasswd_file = $conf->base_dir. '/htpasswd';
-} );
-
-=head1 NAME
-
-FS::access_user - Object methods for access_user records
-
-=head1 SYNOPSIS
-
- use FS::access_user;
-
- $record = new FS::access_user \%hash;
- $record = new FS::access_user { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::access_user object represents an internal access user. FS::access_user
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item usernum - primary key
-
-=item username -
-
-=item _password -
-
-=item last -
-
-=item first -
-
-=item disabled - empty or 'Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new internal access user. To add the user 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 { 'access_user'; }
-
-sub _option_table { 'access_user_pref'; }
-sub _option_namecol { 'prefname'; }
-sub _option_valuecol { 'prefvalue'; }
-
-=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;
-
- my $error = $self->check;
- return $error if $error;
-
- 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;
-
- $error = $self->htpasswd_kludge();
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- return $error;
- }
-
- $error = $self->SUPER::insert(@_);
-
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
-
- #make sure it isn't a dup username? or you could nuke people's passwords
- #blah. really just should do our own login w/cookies
- #and auth out of the db in the first place
- #my $hterror = $self->htpasswd_kludge('-D');
- #$error .= " - additionally received error cleaning up htpasswd file: $hterror"
- return $error;
-
- } else {
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
- }
-
-}
-
-sub htpasswd_kludge {
- my $self = shift;
-
- return '' if $self->is_system_user;
-
- unshift @_, '-c' unless -e $htpasswd_file;
- if (
- system('htpasswd', '-b', @_,
- $htpasswd_file,
- $self->username,
- $self->_password,
- ) == 0
- )
- {
- return '';
- } else {
- return 'htpasswd exited unsucessfully';
- }
-}
-
-=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->htpasswd_kludge('-D')
- ;
-
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- return $error;
- } else {
- $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 = ( ref($_[0]) eq ref($new) )
- ? 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;
-
- if ( $new->_password ne $old->_password ) {
- my $error = $new->htpasswd_kludge();
- if ( $error ) {
- $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, @_);
-
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- return $error;
- } else {
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
- }
-
-}
-
-=item check
-
-Checks all fields to make sure this is a valid internal access user. 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('usernum')
- || $self->ut_alpha_lower('username')
- || $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;
-
- $self->SUPER::check;
-}
-
-=item name
-
-Returns a name string for this user: "Last, First".
-
-=cut
-
-sub name {
- my $self = shift;
- return $self->username
- if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
- return $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
-objects (see L<FS::access_usergroup>).
-
-=cut
-
-sub access_usergroup {
- my $self = shift;
- qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
-}
-
-#=item access_groups
-#
-#=cut
-#
-#sub access_groups {
-#
-#}
-#
-#=item access_groupnames
-#
-#=cut
-#
-#sub access_groupnames {
-#
-#}
-
-=item agentnums
-
-Returns a list of agentnums this user can view (via group membership).
-
-=cut
-
-sub agentnums {
- my $self = shift;
- my $sth = dbh->prepare(
- "SELECT DISTINCT agentnum FROM access_usergroup
- JOIN access_groupagent USING ( groupnum )
- WHERE usernum = ?"
- ) or die dbh->errstr;
- $sth->execute($self->usernum) or die $sth->errstr;
- map { $_->[0] } @{ $sth->fetchall_arrayref };
-}
-
-=item agentnums_href
-
-Returns a hashref of agentnums this user can view.
-
-=cut
-
-sub agentnums_href {
- my $self = shift;
- scalar( { map { $_ => 1 } $self->agentnums } );
-}
-
-=item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
-
-Returns an sql fragement to select only agentnums this user can view.
-
-Options are passed as a hashref or a list. Available options are:
-
-=over 4
-
-=item null
-
-The frament will also allow the selection of null agentnums.
-
-=item null_right
-
-The fragment will also allow the selection of null agentnums if the current
-user has the provided access right
-
-=item table
-
-Optional table name in which agentnum is being checked. Sometimes required to
-resolve 'column reference "agentnum" is ambiguous' errors.
-
-=item viewall_right
-
-All agents will be viewable if the current user has the provided access right.
-Defaults to 'View customers of all agents'.
-
-=back
-
-=cut
-
-sub agentnums_sql {
- my( $self ) = shift;
- my %opt = ref($_[0]) ? %{$_[0]} : @_;
-
- my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
-
- my @or = ();
-
- my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
- if ( $self->access_right($viewall_right) ) {
- push @or, "$agentnum IS NOT NULL";
- } else {
- push @or, "$agentnum IN (". join(',', $self->agentnums). ')';
- }
-
- push @or, "$agentnum IS NULL"
- if $opt{'null'}
- || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
-
- return ' 1 = 0 ' unless scalar(@or);
- '( '. join( ' OR ', @or ). ' )';
-
-}
-
-=item agentnum
-
-Returns true if the user can view the specified agent.
-
-=cut
-
-sub agentnum {
- my( $self, $agentnum ) = @_;
- my $sth = dbh->prepare(
- "SELECT COUNT(*) FROM access_usergroup
- JOIN access_groupagent USING ( groupnum )
- WHERE usernum = ? AND agentnum = ?"
- ) or die dbh->errstr;
- $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
-}
-
-=item agents [ HASHREF | OPTION => VALUE ... ]
-
-Returns the list of agents this user can view (via group membership), as
-FS::agent objects. Accepts the same options as the agentnums_sql method.
-
-=cut
-
-sub agents {
- my $self = shift;
- qsearch({
- 'table' => 'agent',
- 'hashref' => { disabled=>'' },
- 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
- });
-}
-
-=item access_right RIGHTNAME | LISTREF
-
-Given a right name or a list reference of right names, returns true if this
-user has this right, or, for a list, one of the rights (currently via group
-membership, eventually also via user overrides).
-
-=cut
-
-sub access_right {
- my( $self, $rightname ) = @_;
-
- $rightname = [ $rightname ] unless ref($rightname);
-
- warn "$me access_right called on ". join(', ', @$rightname). "\n"
- if $DEBUG;
-
- #some caching of ACL requests for low-hanging fruit perf improvement
- #since we get a new $CurrentUser object each page view there shouldn't be any
- #issues with stickiness
- if ( $self->{_ACLcache} ) {
-
- unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
- warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
- if $DEBUG;
- return grep $self->{_ACLcache}{$_}, @$rightname
- }
-
- warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
- if $DEBUG;
-
- } else {
-
- warn "initializing ACL cache\n"
- if $DEBUG;
- $self->{_ACLcache} = {};
-
- }
-
- my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
-
- my $sth = dbh->prepare("
- SELECT groupnum FROM access_usergroup
- LEFT JOIN access_group USING ( groupnum )
- LEFT JOIN access_right
- ON ( access_group.groupnum = access_right.rightobjnum )
- WHERE usernum = ?
- AND righttype = 'FS::access_group'
- AND $has_right
- LIMIT 1
- ") or die dbh->errstr;
- $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
- my $row = $sth->fetchrow_arrayref;
-
- my $return = $row ? $row->[0] : '';
-
- #just caching the single-rightname hits should be enough of a win for now
- if ( scalar(@$rightname) == 1 ) {
- $self->{_ACLcache}{${$rightname}[0]} = $return;
- }
-
- $return;
-
-}
-
-=item default_customer_view
-
-Returns the default customer view for this user, from the
-"default_customer_view" user preference, the "cust_main-default_view" config,
-or the hardcoded default, "jumbo" (may change to "basics" in the near future).
-
-=cut
-
-sub default_customer_view {
- my $self = shift;
-
- $self->option('default_customer_view')
- || $conf->config('cust_main-default_view')
- || 'jumbo'; #'basics' in 1.9.1?
-
-}
-
-=item is_system_user
-
-Returns true if this user has the name of a known system account. These
-users will not appear in the htpasswd file and can't have passwords set.
-
-=cut
-
-sub is_system_user {
- my $self = shift;
- return grep { $_ eq $self->username } ( qw(
- fs_queue
- fs_daily
- fs_selfservice
- fs_signup
- fs_bootstrap
- fs_selfserv
-) );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/access_user_pref.pm b/FS/FS/access_user_pref.pm
deleted file mode 100644
index a445d31..0000000
--- a/FS/FS/access_user_pref.pm
+++ /dev/null
@@ -1,129 +0,0 @@
-package FS::access_user_pref;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::access_user_pref - Object methods for access_user_pref records
-
-=head1 SYNOPSIS
-
- use FS::access_user_pref;
-
- $record = new FS::access_user_pref \%hash;
- $record = new FS::access_user_pref { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::access_user_pref object represents an per-user preference. Preferenaces
-are also used to store transient state information (server-side "cookies").
-FS::access_user_pref inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item prefnum - primary key
-
-=item usernum - Internal access user (see L<FS::access_user>)
-
-=item prefname -
-
-=item prefvalue -
-
-=item expiration -
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new preference. To add the preference 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 { 'access_user_pref'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid preference. 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('prefnum')
- || $self->ut_number('usernum')
- || $self->ut_text('prefname')
- #|| $self->ut_textn('prefvalue')
- || $self->ut_anything('prefvalue')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::access_user>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/access_usergroup.pm b/FS/FS/access_usergroup.pm
deleted file mode 100644
index 8511fe5..0000000
--- a/FS/FS/access_usergroup.pm
+++ /dev/null
@@ -1,143 +0,0 @@
-package FS::access_usergroup;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::access_user;
-use FS::access_group;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::access_usergroup - Object methods for access_usergroup records
-
-=head1 SYNOPSIS
-
- use FS::access_usergroup;
-
- $record = new FS::access_usergroup \%hash;
- $record = new FS::access_usergroup { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::access_usergroup object represents an internal access user's membership
-in a group. FS::access_usergroup inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item usergroupnum - primary key
-
-=item usernum -
-
-=item groupnum -
-
-
-=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 { 'access_usergroup'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('usergroupnum')
- || $self->ut_number('usernum')
- || $self->ut_number('groupnum')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item access_user
-
-=cut
-
-sub access_user {
- my $self = shift;
- qsearchs( 'access_user', { 'usernum' => $self->usernum } );
-}
-
-=item access_group
-
-=cut
-
-sub access_group {
- my $self = shift;
- qsearchs( 'access_group', { 'groupnum' => $self->groupnum } );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/acct_rt_transaction.pm b/FS/FS/acct_rt_transaction.pm
deleted file mode 100644
index ef0a275..0000000
--- a/FS/FS/acct_rt_transaction.pm
+++ /dev/null
@@ -1,316 +0,0 @@
-package FS::acct_rt_transaction;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs dbh );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::acct_rt_transaction - Object methods for acct_rt_transaction records
-
-=head1 SYNOPSIS
-
- use FS::acct_rt_transaction;
-
- $record = new FS::acct_rt_transaction \%hash;
- $record = new FS::acct_rt_transaction { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::acct_rt_transaction object represents an application of time
-from a rt transaction to a svc_acct. FS::acct_rt_transaction inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcrtid
-
-Primary key
-
-=item svcnum
-
-The svcnum of the svc_acct to which the time applies
-
-=item transaction_id
-
-The id of the rt transtaction from which the time applies
-
-=item seconds
-
-The amount of time applied from tickets
-
-=item support
-
-The amount of time applied to support services
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new acct_rt_transaction. To add the example 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 { 'acct_rt_transaction'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my( $self, %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;
-
- my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- my $svc_acct = qsearchs('svc_acct', {'svcnum' => $self->svcnum});
- unless ($svc_acct) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't find svc_acct " . $self->svcnum;
- }
-
- $error = $svc_acct->decrement_seconds($self->support);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error incrementing service seconds: $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;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- my $svc_acct = qsearchs('svc_acct', {'svcnum' => $self->svcnum});
- unless ($svc_acct) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't find svc_acct " . $self->svcnum;
- }
-
- $error = $svc_acct->increment_seconds($self->support);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error incrementing service seconds: $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
-
-=item check
-
-Checks all fields to make sure this is a valid acct_rt_transaction. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my ($selfref) = $self->hashref;
-
- my $error =
- $self->ut_numbern('svcrtid')
- || $self->ut_numbern('svcnum')
- || $self->ut_number('transaction_id')
- || $self->ut_numbern('_date')
- || $self->ut_snumber('seconds')
- || $self->ut_snumber('support')
- ;
- return $error if $error;
-
- $self->_date(time) unless $self->_date;
-
- if ($selfref->{custnum}) {
- my $conf = new FS::Conf;
- my %packages = map { $_ => 1 } $conf->config('support_packages');
- my $cust_main = qsearchs('cust_main',{ 'custnum' => $selfref->{custnum} } );
- return "Invalid custnum: " . $selfref->{custnum} unless $cust_main;
-
- my (@svcs) = map { $_->svcnum } $cust_main->support_services;
- return "svcnum ". $self->svcnum. " invalid for custnum ".$selfref->{custnum}
- unless (!$self->svcnum || scalar(grep { $_ == $self->svcnum } @svcs));
-
- $self->svcnum($svcs[0]) unless $self->svcnum;
- return "Can't find support service for custnum ".$selfref->{custnum}
- unless $self->svcnum;
- }
-
- $self->SUPER::check;
-}
-
-=item creator
-
-Returns the creator of the RT transaction associated with this object.
-
-=cut
-
-sub creator {
- my $self = shift;
- FS::TicketSystem->transaction_creator($self->transaction_id);
-}
-
-=item ticketid
-
-Returns the number of the RT ticket associated with this object.
-
-=cut
-
-sub ticketid {
- my $self = shift;
- FS::TicketSystem->transaction_ticketid($self->transaction_id);
-}
-
-=item subject
-
-Returns the subject of the RT ticket associated with this object.
-
-=cut
-
-sub subject {
- my $self = shift;
- FS::TicketSystem->transaction_subject($self->transaction_id);
-}
-
-=item status
-
-Returns the status of the RT ticket associated with this object.
-
-=cut
-
-sub status {
- my $self = shift;
- FS::TicketSystem->transaction_status($self->transaction_id);
-}
-
-=item batch_insert SVC_ACCT_RT_TRANSACTION_OBJECT, ...
-
-Class method which inserts multiple time applications. Takes a list of
-FS::acct_rt_transaction objects. If there is an error inserting any
-application, the entire transaction is rolled back, i.e. all time is applied
-or none is.
-
-For example:
-
- my $errors = FS::acct_rt_transaction->batch_insert(@transactions);
- if ( $error ) {
- #success; all payments were inserted
- } else {
- #failure; no payments were inserted.
- }
-
-=cut
-
-sub batch_insert {
- my $self = shift; #class method
-
- 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;
- foreach (@_) {
- $error = $_->insert;
- last if $error;
- }
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- } else {
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- }
-
- $error;
-
-}
-
-=back
-
-=head1 BUGS
-
-Possibly the delete method or others.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/acct_snarf.pm b/FS/FS/acct_snarf.pm
deleted file mode 100644
index 9816de9..0000000
--- a/FS/FS/acct_snarf.pm
+++ /dev/null
@@ -1,215 +0,0 @@
-package FS::acct_snarf;
-
-use strict;
-use vars qw( @ISA );
-use Tie::IxHash;
-use FS::Record qw( qsearchs );
-use FS::cust_svc;
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::acct_snarf - Object methods for acct_snarf records
-
-=head1 SYNOPSIS
-
- use FS::acct_snarf;
-
- $record = new FS::acct_snarf \%hash;
- $record = new FS::acct_snarf { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::svc_acct object represents an external mail account, typically for
-download of mail. FS::acct_snarf inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item snarfnum - primary key
-
-=item snarfname - Label
-
-=item svcnum - Account (see L<FS::svc_acct>)
-
-=item machine - external machine to download mail from
-
-=item protocol - protocol (pop3, imap, etc.)
-
-=item username - external login username
-
-=item _password - external login password
-
-=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
-
-sub table { 'acct_snarf'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item cust_svc
-
-=cut
-
-sub cust_svc {
- my $self = shift;
- qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
-}
-
-
-=item svc_export
-
-Calls the replace export for any communigate exports attached to this rule's
-service.
-
-=cut
-
-sub svc_export {
- my $self = shift;
-
- my $cust_svc = $self->cust_svc;
- my $svc_x = $cust_svc->svc_x;
-
- #_singledomain too
- my @exports = $cust_svc->part_svc->part_export('communigate_pro');
- my @errors = map $_->export_replace($svc_x, $svc_x), @exports;
-
- @errors ? join(' / ', @errors) : '';
-
-}
-
-=item check
-
-Checks all fields to make sure this is a valid external mail account. If
-there is an error, returns the error, otherwise returns false. Called by the
-insert and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
- my $error =
- $self->ut_numbern('snarfnum')
- || $self->ut_textn('snarfname') #alphasn?
- || $self->ut_number('svcnum')
- || $self->ut_foreign_key('svcnum', 'svc_acct', 'svcnum')
- || $self->ut_domain('machine')
- || $self->ut_alphan('protocol')
- || $self->ut_textn('username')
- || $self->ut_numbern('check_freq')
- || $self->ut_enum('leavemail', [ '', 'Y' ])
- || $self->ut_enum('apop', [ '', 'Y' ])
- || $self->ut_enum('tls', [ '', 'Y' ])
- || $self->ut_alphan('mailbox')
- ;
- return $error if $error;
-
- $self->_password =~ /^[^\t\n]*$/ or return "illegal password";
- $self->_password($1);
-
- ''; #no error
-}
-
-sub check_freq_labels {
-
- tie my %hash, 'Tie::IxHash',
- 0 => 'Never',
- 60 => 'minute',
- 120 => '2 minutes',
- 180 => '3 minutes',
- 300 => '5 minutes',
- 600 => '10 minutes',
- 900 => '15 minutes',
- 1800 => '30 minutes',
- 3600 => 'hour',
- 7200 => '2 hours',
- 10800 => '3 hours',
- 21600 => '6 hours',
- 43200 => '12 hours',
- 86400 => 'day',
- 172800 => '2 days',
- 259200 => '3 days',
- 604800 => 'week',
- 1000000000 => 'Disabled',
- ;
-
- \%hash;
-}
-
-=item cgp_hashref
-
-Returns a hashref representing this external mail account, suitable for
-Communigate Pro API commands:
-
-=cut
-
-sub cgp_hashref {
- my $self = shift;
- {
- 'authName' => $self->username,
- 'domain' => $self->machine,
- 'password' => $self->_password,
- 'period' => $self->check_freq.'s',
- 'APOP' => ( $self->apop eq 'Y' ? 'YES' : 'NO' ),
- 'TLS' => ( $self->tls eq 'Y' ? 'YES' : 'NO' ),
- 'Leave' => ( $self->leavemail eq 'Y' ? 'YES' : 'NO' ), #XXX leave??
- };
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm
deleted file mode 100755
index 0fe2476..0000000
--- a/FS/FS/addr_block.pm
+++ /dev/null
@@ -1,385 +0,0 @@
-package FS::addr_block;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs qsearch dbh );
-use FS::router;
-use FS::svc_broadband;
-use FS::Conf;
-use NetAddr::IP;
-use Carp qw( carp );
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::addr_block - Object methods for addr_block records
-
-=head1 SYNOPSIS
-
- use FS::addr_block;
-
- $record = new FS::addr_block \%hash;
- $record = new FS::addr_block { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::addr_block record describes an address block assigned for broadband
-access. FS::addr_block inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item blocknum - primary key, used in FS::svc_broadband to associate
-services to the block.
-
-=item routernum - the router (see FS::router) to which this
-block is assigned.
-
-=item ip_gateway - the gateway address used by customers within this block.
-
-=item ip_netmask - the netmask of the block, expressed as an integer.
-
-=item manual_flag - prohibit automatic ip assignment from this block when true.
-
-=item agentnum - optional agent number (see L<FS::agent>)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Create a new record. To add the record to the database, see "insert".
-
-=cut
-
-sub table { 'addr_block'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-sub delete {
- my $self = shift;
- return 'Block must be deallocated before deletion'
- if $self->router;
-
- $self->SUPER::delete;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-At present it's not possible to reallocate a block to a different router
-except by deallocating it first, which requires that none of its addresses
-be assigned. This is probably as it should be.
-
-sub replace_check {
- my ( $new, $old ) = ( shift, shift );
-
- unless($new->routernum == $old->routernum) {
- my @svc = $self->svc_broadband;
- if (@svc) {
- return 'Block has assigned addresses: '.
- join ', ', map {$_->ip_addr} @svc;
- }
-
- return 'Block is already allocated'
- if($new->routernum && $old->routernum);
-
- }
-
- '';
-}
-
-=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
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_number('routernum')
- || $self->ut_ip('ip_gateway')
- || $self->ut_number('ip_netmask')
- || $self->ut_enum('manual_flag', [ '', 'Y' ])
- || $self->ut_agentnum_acl('agentnum', 'Broadband global configuration')
- ;
- return $error if $error;
-
-
- # A routernum of 0 indicates an unassigned block and is allowed
- return "Unknown routernum"
- if ($self->routernum and not $self->router);
-
- my $self_addr = $self->NetAddr;
- return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask
- unless $self_addr;
-
- if (not $self->blocknum) {
- my @block = grep {
- my $block_addr = $_->NetAddr;
- if($block_addr->contains($self_addr)
- or $self_addr->contains($block_addr)) { $_; };
- } qsearch( 'addr_block', {});
- foreach(@block) {
- return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask;
- }
- }
-
- $self->SUPER::check;
-}
-
-
-=item router
-
-Returns the FS::router object corresponding to this object. If the
-block is unassigned, returns undef.
-
-=cut
-
-sub router {
- my $self = shift;
- return qsearchs('router', { routernum => $self->routernum });
-}
-
-=item svc_broadband
-
-Returns a list of FS::svc_broadband objects associated
-with this object.
-
-=cut
-
-sub svc_broadband {
- my $self = shift;
- return qsearch('svc_broadband', { blocknum => $self->blocknum });
-}
-
-=item NetAddr
-
-Returns a NetAddr::IP object for this block's address and netmask.
-
-=cut
-
-sub NetAddr {
- my $self = shift;
- new NetAddr::IP ($self->ip_gateway, $self->ip_netmask);
-}
-
-=item cidr
-
-Returns a CIDR string for this block's address and netmask, i.e. 10.4.20.0/24
-
-=cut
-
-sub cidr {
- my $self = shift;
- $self->NetAddr->cidr;
-}
-
-=item next_free_addr
-
-Returns a NetAddr::IP object corresponding to the first unassigned address
-in the block (other than the network, broadcast, or gateway address). If
-there are no free addresses, returns false. There are never free addresses
-when manual_flag is true.
-
-=cut
-
-sub next_free_addr {
- my $self = shift;
-
- return '' if $self->manual_flag;
-
- my $conf = new FS::Conf;
- my @excludeaddr = $conf->config('exclude_ip_addr');
-
-my @used =
-( (map { $_->NetAddr->addr }
- ($self,
- qsearch('svc_broadband', { blocknum => $self->blocknum }))
- ), @excludeaddr
-);
-
- my @free = $self->NetAddr->hostenum;
- while (my $ip = shift @free) {
- if (not grep {$_ eq $ip->addr;} @used) { return $ip; };
- }
-
- '';
-
-}
-
-=item allocate -- deprecated
-
-Allocates this address block to a router. Takes an FS::router object
-as an argument.
-
-At present it's not possible to reallocate a block to a different router
-except by deallocating it first, which requires that none of its addresses
-be assigned. This is probably as it should be.
-
-=cut
-
-sub allocate {
- my ($self, $router) = @_;
- carp "deallocate deprecated -- use replace";
-
- return 'Block must be allocated to a router'
- unless(ref $router eq 'FS::router');
-
- my $new = new FS::addr_block {$self->hash};
- $new->routernum($router->routernum);
- return $new->replace($self);
-
-}
-
-=item deallocate -- deprecated
-
-Deallocates the block (i.e. sets the routernum to 0). If any addresses in the
-block are assigned to services, it fails.
-
-=cut
-
-sub deallocate {
- carp "deallocate deprecated -- use replace";
- my $self = shift;
-
- my $new = new FS::addr_block {$self->hash};
- $new->routernum(0);
- return $new->replace($self);
-}
-
-=item split_block
-
-Splits this address block into two equal blocks, occupying the same space as
-the original block. The first of the two will also have the same blocknum.
-The gateway address of each block will be set to the first usable address, i.e.
-(network address)+1. Since this method is designed for use on unallocated
-blocks, this is probably the correct behavior.
-
-(At present, splitting allocated blocks is disallowed. Anyone who wants to
-implement this is reminded that each split costs three addresses, and any
-customers who were using these addresses will have to be moved; depending on
-how full the block was before being split, they might have to be moved to a
-different block. Anyone who I<still> wants to implement it is asked to tie it
-to a configuration switch so that site admins can disallow it.)
-
-=cut
-
-sub split_block {
-
- # We should consider using Attribute::Handlers/Aspect/Hook::LexWrap/
- # something to atomicize functions, so that we can say
- #
- # sub split_block : atomic {
- #
- # instead of repeating all this AutoCommit verbage in every
- # sub that does more than one database operation.
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $self = shift;
- my $error;
-
- if ($self->router) {
- return 'Block is already allocated';
- }
-
- #TODO: Smallest allowed block should be a config option.
- if ($self->NetAddr->masklen() ge 30) {
- return 'Cannot split blocks with a mask length >= 30';
- }
-
- my (@new, @ip);
- $ip[0] = $self->NetAddr;
- @ip = map {$_->first()} $ip[0]->split($self->ip_netmask + 1);
-
- foreach (0,1) {
- $new[$_] = new FS::addr_block {$self->hash};
- $new[$_]->ip_gateway($ip[$_]->addr);
- $new[$_]->ip_netmask($ip[$_]->masklen);
- }
-
- $new[1]->blocknum('');
-
- $error = $new[0]->replace($self);
- if ($error) {
- $dbh->rollback;
- return $error;
- }
-
- $error = $new[1]->insert;
- if ($error) {
- $dbh->rollback;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return '';
-}
-
-=item merge
-
-To be implemented.
-
-=item agent
-
-Returns the agent (see L<FS::agent>) for this address block, if one exists.
-
-=cut
-
-sub agent {
- qsearchs('agent', { 'agentnum' => shift->agentnum } );
-}
-
-=item label
-
-Returns text including the router name, gateway ip, and netmask for this
-block.
-
-=cut
-
-sub label {
- my $self = shift;
- my $router = $self->router;
- ($router ? $router->routername : '(unallocated)'). ':'. $self->NetAddr;
-}
-
-=back
-
-=head1 BUGS
-
-Minimum block size should be a config option. It's hardcoded at /30 right
-now because that's the smallest block that makes any sense at all.
-
-=cut
-
-1;
-
diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm
deleted file mode 100644
index 3794d3f..0000000
--- a/FS/FS/agent.pm
+++ /dev/null
@@ -1,592 +0,0 @@
-package FS::agent;
-
-use strict;
-use vars qw( @ISA );
-#use Crypt::YAPassGen;
-use Business::CreditCard 0.28;
-use FS::Record qw( dbh qsearch qsearchs );
-use FS::cust_main;
-use FS::cust_pkg;
-use FS::agent_type;
-use FS::reg_code;
-use FS::TicketSystem;
-use FS::Conf;
-
-@ISA = qw( FS::m2m_Common FS::Record );
-
-=head1 NAME
-
-FS::agent - Object methods for agent records
-
-=head1 SYNOPSIS
-
- use FS::agent;
-
- $record = new FS::agent \%hash;
- $record = new FS::agent { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $agent_type = $record->agent_type;
-
- $hashref = $record->pkgpart_hashref;
- #may purchase $pkgpart if $hashref->{$pkgpart};
-
-=head1 DESCRIPTION
-
-An FS::agent object represents an agent. Every customer has an agent. Agents
-can be used to track things like resellers or salespeople. FS::agent inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item agentnum - primary key (assigned automatically for new agents)
-
-=item agent - Text name of this agent
-
-=item typenum - Agent type (see L<FS::agent_type>)
-
-=item ticketing_queueid - Ticketing Queue
-
-=item invoice_template - Invoice template name
-
-=item agent_custnum - Optional agent customer (see L<FS::cust_main>)
-
-=item disabled - Disabled flag, empty or 'Y'
-
-=item prog - Deprecated (never used)
-
-=item freq - Deprecated (never used)
-
-=item username - (Deprecated) Username for the Agent interface
-
-=item _password - (Deprecated) Password for the Agent interface
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new agent. To add the agent to the database, see L<"insert">.
-
-=cut
-
-sub table { 'agent'; }
-
-=item insert
-
-Adds this agent to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this agent from the database. Only agents with no customers can be
-deleted. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub delete {
- my $self = shift;
-
- return "Can't delete an agent with customers!"
- if qsearch( 'cust_main', { 'agentnum' => $self->agentnum } );
-
- $self->SUPER::delete;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid agent. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('agentnum')
- || $self->ut_text('agent')
- || $self->ut_number('typenum')
- || $self->ut_numbern('freq')
- || $self->ut_textn('prog')
- || $self->ut_textn('invoice_template')
- || $self->ut_foreign_keyn('agent_custnum', 'cust_main', 'custnum' )
- ;
- return $error if $error;
-
- if ( $self->dbdef_table->column('disabled') ) {
- $error = $self->ut_enum('disabled', [ '', 'Y' ] );
- return $error if $error;
- }
-
- if ( $self->dbdef_table->column('username') ) {
- $error = $self->ut_alphan('username');
- return $error if $error;
- if ( length($self->username) ) {
- my $conflict = qsearchs('agent', { 'username' => $self->username } );
- return 'duplicate agent username (with '. $conflict->agent. ')'
- if $conflict && $conflict->agentnum != $self->agentnum;
- $error = $self->ut_text('password'); # ut_text... arbitrary choice
- } else {
- $self->_password('');
- }
- }
-
- return "Unknown typenum!"
- unless $self->agent_type;
-
- $self->SUPER::check;
-}
-
-=item agent_type
-
-Returns the FS::agent_type object (see L<FS::agent_type>) for this agent.
-
-=cut
-
-sub agent_type {
- my $self = shift;
- qsearchs( 'agent_type', { 'typenum' => $self->typenum } );
-}
-
-=item agent_cust_main
-
-Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
-agent.
-
-=cut
-
-sub agent_cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->agent_custnum } );
-}
-
-=item pkgpart_hashref
-
-Returns a hash reference. The keys of the hash are pkgparts. The value is
-true if this agent may purchase the specified package definition. See
-L<FS::part_pkg>.
-
-=cut
-
-sub pkgpart_hashref {
- my $self = shift;
- $self->agent_type->pkgpart_hashref;
-}
-
-=item ticketing_queue
-
-Returns the queue name corresponding with the id from the I<ticketing_queueid>
-field, or the empty string.
-
-=cut
-
-sub ticketing_queue {
- my $self = shift;
- FS::TicketSystem->queue($self->ticketing_queueid);
-};
-
-=item payment_gateway [ OPTION => VALUE, ... ]
-
-Returns a payment gateway object (see L<FS::payment_gateway>) for this agent.
-
-Currently available options are I<nofatal>, I<invnum>, I<method>, and I<payinfo>.
-
-If I<nofatal> is set, and no gateway is available, then the empty string
-will be returned instead of throwing a fatal exception.
-
-If I<invnum> is set to the number of an invoice (see L<FS::cust_bill>) then
-an attempt will be made to select a gateway suited for the taxes paid on
-the invoice.
-
-The I<method> and I<payinfo> options can be used to influence the choice
-as well. Presently only 'CC' and 'ECHECK' methods are meaningful.
-
-When the I<method> is 'CC' then the card number in I<payinfo> can direct
-this routine to route to a gateway suited for that type of card.
-
-=cut
-
-sub payment_gateway {
- my ( $self, %options ) = @_;
-
- my $taxclass = '';
- if ( $options{invnum} ) {
-
- my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{invnum} } );
- die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
-
- my @part_pkg =
- map { $_->part_pkg }
- grep { $_ }
- map { $_->cust_pkg }
- $cust_bill->cust_bill_pkg;
-
- my @taxclasses = map $_->taxclass, @part_pkg;
-
- $taxclass = $taxclasses[0]
- unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are
- #different taxclasses
- }
-
- #look for an agent gateway override first
- my $cardtype;
- if ( $options{method} && $options{method} eq 'CC' && $options{payinfo} ) {
- $cardtype = cardtype($options{payinfo});
- } elsif ( $options{method} && $options{method} eq 'ECHECK' ) {
- $cardtype = 'ACH';
- } else {
- $cardtype = $options{method} || '';
- }
-
- my $override =
- qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
- cardtype => $cardtype,
- taxclass => $taxclass, } )
- || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
- cardtype => '',
- taxclass => $taxclass, } )
- || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
- cardtype => $cardtype,
- taxclass => '', } )
- || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
- cardtype => '',
- taxclass => '', } );
-
- my $payment_gateway;
- my $conf = new FS::Conf;
- if ( $override ) { #use a payment gateway override
-
- $payment_gateway = $override->payment_gateway;
-
- $payment_gateway->gateway_namespace('Business::OnlinePayment')
- unless $payment_gateway->gateway_namespace;
-
- } else { #use the standard settings from the config
-
- # the standard settings from the config could be moved to a null agent
- # agent_payment_gateway referenced payment_gateway
-
- unless ( $conf->exists('business-onlinepayment') ) {
- if ( $options{'nofatal'} ) {
- return '';
- } else {
- die "Real-time processing not enabled\n";
- }
- }
-
- #load up config
- my $bop_config = 'business-onlinepayment';
- $bop_config .= '-ach'
- if ( $options{method}
- && $options{method} =~ /^(ECHECK|CHEK)$/
- && $conf->exists($bop_config. '-ach')
- );
- my ( $processor, $login, $password, $action, @bop_options ) =
- $conf->config($bop_config);
- $action ||= 'normal authorization';
- pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
- die "No real-time processor is enabled - ".
- "did you set the business-onlinepayment configuration value?\n"
- unless $processor;
-
- $payment_gateway = new FS::payment_gateway;
-
- $payment_gateway->gateway_namespace( $conf->config('business-onlinepayment-namespace') ||
- 'Business::OnlinePayment');
- $payment_gateway->gateway_module($processor);
- $payment_gateway->gateway_username($login);
- $payment_gateway->gateway_password($password);
- $payment_gateway->gateway_action($action);
- $payment_gateway->set('options', [ @bop_options ]);
-
- }
-
- unless ( $payment_gateway->gateway_namespace ) {
- $payment_gateway->gateway_namespace(
- scalar($conf->config('business-onlinepayment-namespace'))
- || 'Business::OnlinePayment'
- );
- }
-
- $payment_gateway;
-}
-
-=item num_prospect_cust_main
-
-Returns the number of prospects (customers with no packages ever ordered) for
-this agent.
-
-=cut
-
-sub num_prospect_cust_main {
- shift->num_sql(FS::cust_main->prospect_sql);
-}
-
-sub num_sql {
- my( $self, $sql ) = @_;
- my $statement = "SELECT COUNT(*) FROM cust_main WHERE agentnum = ? AND $sql";
- my $sth = dbh->prepare($statement) or die dbh->errstr." preparing $statement";
- $sth->execute($self->agentnum) or die $sth->errstr. " executing $statement";
- $sth->fetchrow_arrayref->[0];
-}
-
-=item prospect_cust_main
-
-Returns the prospects (customers with no packages ever ordered) for this agent,
-as cust_main objects.
-
-=cut
-
-sub prospect_cust_main {
- shift->cust_main_sql(FS::cust_main->prospect_sql);
-}
-
-sub cust_main_sql {
- my( $self, $sql ) = @_;
- qsearch( 'cust_main',
- { 'agentnum' => $self->agentnum },
- '',
- " AND $sql"
- );
-}
-
-=item num_active_cust_main
-
-Returns the number of active customers for this agent (customers with active
-recurring packages).
-
-=cut
-
-sub num_active_cust_main {
- shift->num_sql(FS::cust_main->active_sql);
-}
-
-=item active_cust_main
-
-Returns the active customers for this agent, as cust_main objects.
-
-=cut
-
-sub active_cust_main {
- shift->cust_main_sql(FS::cust_main->active_sql);
-}
-
-=item num_inactive_cust_main
-
-Returns the number of inactive customers for this agent (customers with no
-active recurring packages, but otherwise unsuspended/uncancelled).
-
-=cut
-
-sub num_inactive_cust_main {
- shift->num_sql(FS::cust_main->inactive_sql);
-}
-
-=item inactive_cust_main
-
-Returns the inactive customers for this agent, as cust_main objects.
-
-=cut
-
-sub inactive_cust_main {
- shift->cust_main_sql(FS::cust_main->inactive_sql);
-}
-
-
-=item num_susp_cust_main
-
-Returns the number of suspended customers for this agent.
-
-=cut
-
-sub num_susp_cust_main {
- shift->num_sql(FS::cust_main->susp_sql);
-}
-
-=item susp_cust_main
-
-Returns the suspended customers for this agent, as cust_main objects.
-
-=cut
-
-sub susp_cust_main {
- shift->cust_main_sql(FS::cust_main->susp_sql);
-}
-
-=item num_cancel_cust_main
-
-Returns the number of cancelled customer for this agent.
-
-=cut
-
-sub num_cancel_cust_main {
- shift->num_sql(FS::cust_main->cancel_sql);
-}
-
-=item cancel_cust_main
-
-Returns the cancelled customers for this agent, as cust_main objects.
-
-=cut
-
-sub cancel_cust_main {
- shift->cust_main_sql(FS::cust_main->cancel_sql);
-}
-
-=item num_active_cust_pkg
-
-Returns the number of active customer packages for this agent.
-
-=cut
-
-sub num_active_cust_pkg {
- shift->num_pkg_sql(FS::cust_pkg->active_sql);
-}
-
-sub num_pkg_sql {
- my( $self, $sql ) = @_;
- my $statement =
- "SELECT COUNT(*) FROM cust_pkg LEFT JOIN cust_main USING ( custnum )".
- " WHERE agentnum = ? AND $sql";
- my $sth = dbh->prepare($statement) or die dbh->errstr." preparing $statement";
- $sth->execute($self->agentnum) or die $sth->errstr. "executing $statement";
- $sth->fetchrow_arrayref->[0];
-}
-
-=item num_inactive_cust_pkg
-
-Returns the number of inactive customer packages (one-time packages otherwise
-unsuspended/uncancelled) for this agent.
-
-=cut
-
-sub num_inactive_cust_pkg {
- shift->num_pkg_sql(FS::cust_pkg->inactive_sql);
-}
-
-=item num_susp_cust_pkg
-
-Returns the number of suspended customer packages for this agent.
-
-=cut
-
-sub num_susp_cust_pkg {
- shift->num_pkg_sql(FS::cust_pkg->susp_sql);
-}
-
-=item num_cancel_cust_pkg
-
-Returns the number of cancelled customer packages for this agent.
-
-=cut
-
-sub num_cancel_cust_pkg {
- shift->num_pkg_sql(FS::cust_pkg->cancel_sql);
-}
-
-=item generate_reg_codes NUM PKGPART_ARRAYREF
-
-Generates the specified number of registration codes, allowing purchase of the
-specified package definitions. Returns an array reference of the newly
-generated codes, or a scalar error message.
-
-=cut
-
-#false laziness w/prepay_credit::generate
-sub generate_reg_codes {
- my( $self, $num, $pkgparts ) = @_;
-
- my @codeset = ( 'A'..'Z' );
-
- 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 @codes = ();
- for ( 1 ... $num ) {
- my $reg_code = new FS::reg_code {
- 'agentnum' => $self->agentnum,
- 'code' => join('', map($codeset[int(rand $#codeset)], (0..7) ) ),
- };
- my $error = $reg_code->insert($pkgparts);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- push @codes, $reg_code->code;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- \@codes;
-
-}
-
-=item num_reg_code
-
-Returns the number of unused registration codes for this agent.
-
-=cut
-
-sub num_reg_code {
- my $self = shift;
- my $sth = dbh->prepare(
- "SELECT COUNT(*) FROM reg_code WHERE agentnum = ?"
- ) or die dbh->errstr;
- $sth->execute($self->agentnum) or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
-}
-
-=item num_prepay_credit
-
-Returns the number of unused prepaid cards for this agent.
-
-=cut
-
-sub num_prepay_credit {
- my $self = shift;
- my $sth = dbh->prepare(
- "SELECT COUNT(*) FROM prepay_credit WHERE agentnum = ?"
- ) or die dbh->errstr;
- $sth->execute($self->agentnum) or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
-}
-
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::agent_type>, L<FS::cust_main>, L<FS::part_pkg>,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/agent_payment_gateway.pm b/FS/FS/agent_payment_gateway.pm
deleted file mode 100644
index bd99d0c..0000000
--- a/FS/FS/agent_payment_gateway.pm
+++ /dev/null
@@ -1,139 +0,0 @@
-package FS::agent_payment_gateway;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::payment_gateway;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::agent_payment_gateway - Object methods for agent_payment_gateway records
-
-=head1 SYNOPSIS
-
- use FS::agent_payment_gateway;
-
- $record = new FS::agent_payment_gateway \%hash;
- $record = new FS::agent_payment_gateway { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::agent_payment_gateway object represents a payment gateway override for
-a specific agent. FS::agent_payment_gateway inherits from FS::Record. The
-following fields are currently supported:
-
-=over 4
-
-=item agentgatewaynum - primary key
-
-=item agentnum -
-
-=item gatewaynum -
-
-=item cardtype -
-
-=item taxclass -
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new override. To add the override 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 { 'agent_payment_gateway'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid override. 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('agentgatewaynum')
- || $self->ut_foreign_key('agentnum', 'agent', 'agentnum')
- || $self->ut_foreign_key('gatewaynum', 'payment_gateway', 'gatewaynum' )
- || $self->ut_textn('cardtype')
- || $self->ut_textn('taxclass')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item payment_gateway
-
-=cut
-
-sub payment_gateway {
- my $self = shift;
- qsearchs('payment_gateway', { 'gatewaynum' => $self->gatewaynum } );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::payment_gateway>, L<FS::agent>, L<FS::Record>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/agent_type.pm b/FS/FS/agent_type.pm
deleted file mode 100644
index 5d6b94e..0000000
--- a/FS/FS/agent_type.pm
+++ /dev/null
@@ -1,195 +0,0 @@
-package FS::agent_type;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch dbh );
-use FS::m2m_Common;
-use FS::agent;
-use FS::type_pkgs;
-
-@ISA = qw( FS::m2m_Common FS::Record );
-
-=head1 NAME
-
-FS::agent_type - Object methods for agent_type records
-
-=head1 SYNOPSIS
-
- use FS::agent_type;
-
- $record = new FS::agent_type \%hash;
- $record = new FS::agent_type { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $hashref = $record->pkgpart_hashref;
- #may purchase $pkgpart if $hashref->{$pkgpart};
-
- @type_pkgs = $record->type_pkgs;
-
- @pkgparts = $record->pkgpart;
-
-=head1 DESCRIPTION
-
-An FS::agent_type object represents an agent type. Every agent (see
-L<FS::agent>) has an agent type. Agent types define which packages (see
-L<FS::part_pkg>) may be purchased by customers (see L<FS::cust_main>), via
-FS::type_pkgs records (see L<FS::type_pkgs>). FS::agent_type inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item typenum - primary key (assigned automatically for new agent types)
-
-=item atype - Text name of this agent type
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new agent type. To add the agent type to the database, see
-L<"insert">.
-
-=cut
-
-sub table { 'agent_type'; }
-
-=item insert
-
-Adds this agent type to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this agent type from the database. Only agent types with no agents
-can be deleted. If there is an error, returns the error, otherwise returns
-false.
-
-=cut
-
-sub delete {
- my $self = shift;
-
- return "Can't delete an agent_type with agents!"
- if qsearch( 'agent', { 'typenum' => $self->typenum } );
-
- $self->SUPER::delete;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid agent type. If there is an
-error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->ut_numbern('typenum')
- or $self->ut_text('atype')
- or $self->SUPER::check;
-
-}
-
-=item pkgpart_hashref
-
-Returns a hash reference. The keys of the hash are pkgparts. The value is
-true iff this agent may purchase the specified package definition. See
-L<FS::part_pkg>.
-
-=cut
-
-sub pkgpart_hashref {
- my $self = shift;
- my %pkgpart;
- $pkgpart{$_}++ foreach $self->pkgpart;
- \%pkgpart;
-}
-
-=item type_pkgs
-
-Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this agent type.
-
-=cut
-
-sub type_pkgs {
- my $self = shift;
- qsearch('type_pkgs', { 'typenum' => $self->typenum } );
-}
-
-=item type_pkgs_enabled
-
-Returns all FS::type_pkg objects (see L<FS::type_pkgs>) that link to enabled
-package definitions (see L<FS::part_pkg>).
-
-An additional strange feature is that the returned type_pkg objects also have
-all fields of the associated part_pkg object.
-
-=cut
-
-sub type_pkgs_enabled {
- my $self = shift;
- qsearch({
- 'table' => 'type_pkgs',
- 'addl_from' => 'JOIN part_pkg USING ( pkgpart )',
- 'hashref' => { 'typenum' => $self->typenum },
- 'extra_sql' => " AND ( disabled = '' OR disabled IS NULL )".
- " ORDER BY pkg",
- });
-}
-
-=item pkgpart
-
-Returns the pkgpart of all package definitions (see L<FS::part_pkg>) for this
-agent type.
-
-=cut
-
-sub pkgpart {
- my $self = shift;
-
- #map $_->pkgpart, $self->type_pkgs;
-
- my $sql = 'SELECT pkgpart FROM type_pkgs WHERE typenum = ?';
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute( $self->typenum ) or die $sth->errstr;
- map $_->[0], @{ $sth->fetchall_arrayref };
-}
-
-=back
-
-=head1 BUGS
-
-type_pkgs_enabled should order itself by something (pkg?)
-
-type_pkgs_enabled should populate something that caches for the part_pkg method
-rather than add fields to this object, right? In fact we need a "poop" object
-framework that does that automatically for any joined search at some point....
-right?
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::agent>, L<FS::type_pkgs>, L<FS::cust_main>,
-L<FS::part_pkg>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/banned_pay.pm b/FS/FS/banned_pay.pm
deleted file mode 100644
index 3379653..0000000
--- a/FS/FS/banned_pay.pm
+++ /dev/null
@@ -1,141 +0,0 @@
-package FS::banned_pay;
-
-use strict;
-use base qw( FS::otaker_Mixin FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::UID qw( getotaker );
-use FS::CurrentUser;
-
-=head1 NAME
-
-FS::banned_pay - Object methods for banned_pay records
-
-=head1 SYNOPSIS
-
- use FS::banned_pay;
-
- $record = new FS::banned_pay \%hash;
- $record = new FS::banned_pay { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::banned_pay object represents an banned credit card or ACH account.
-FS::banned_pay inherits from FS::Record. The following fields are currently
-supported:
-
-=over 4
-
-=item bannum - primary key
-
-=item payby - I<CARD> or I<CHEK>
-
-=item payinfo - fingerprint of banned card (base64-encoded MD5 digest)
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item usernum - order taker (assigned automatically, see L<FS::access_user>)
-
-=item reason - reason (text)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new ban. To add the ban 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 { 'banned_pay'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid ban. 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('bannum')
- || $self->ut_enum('payby', [ 'CARD', 'CHEK' ] )
- || $self->ut_text('payinfo')
- || $self->ut_numbern('_date')
- || $self->ut_textn('reason')
- ;
- return $error if $error;
-
- $self->_date(time) unless $self->_date;
-
- $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
-
- $self->SUPER::check;
-}
-
-# Used by FS::Upgrade to migrate to a new database.
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
- $class->_upgrade_otaker(%opts);
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/bill_batch.pm b/FS/FS/bill_batch.pm
deleted file mode 100644
index 136db0d..0000000
--- a/FS/FS/bill_batch.pm
+++ /dev/null
@@ -1,151 +0,0 @@
-package FS::bill_batch;
-
-use strict;
-use vars qw( @ISA $me $DEBUG );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::cust_bill_batch;
-
-@ISA = qw( FS::Record );
-$me = '[ FS::bill_batch ]';
-$DEBUG=0;
-
-sub table { 'bill_batch' }
-
-sub nohistory_fields { 'pdf' }
-
-=head1 NAME
-
-FS::bill_batch - Object methods for bill_batch records
-
-=head1 SYNOPSIS
-
- use FS::bill_batch;
-
- $open_batch = FS::bill_batch->get_open_batch;
-
- my $pdf = $open_batch->print_pdf;
-
- $error = $open_batch->close;
-
-=head1 DESCRIPTION
-
-An FS::bill_batch object represents a batch of invoices. FS::bill_batch
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item batchnum - primary key
-
-=item status - either 'O' (open) or 'R' (resolved/closed).
-
-=item pdf - blob field for temporarily storing the invoice as a PDF.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item print_pdf
-
-Typeset the entire batch as a PDF file. Returns the PDF as a string.
-
-=cut
-
-sub print_pdf {
- eval 'use CAM::PDF';
- warn "Failed to load CAM::PDF: '$@'\n" if $@;
-
- my $self = shift;
- my $job = shift;
- $job->update_statustext(0) if $job;
- my @invoices = sort { $a->invnum <=> $b->invnum }
- qsearch('cust_bill_batch', { batchnum => $self->batchnum });
- return "No invoices in batch ".$self->batchnum.'.' if !@invoices;
-
- my $pdf_out;
- my $num = 0;
- foreach my $invoice (@invoices) {
- my $part = $invoice->cust_bill->print_pdf({$invoice->options});
- die 'Failed creating PDF from invoice '.$invoice->invnum.'\n' if !$part;
-
- if($pdf_out) {
- $pdf_out->appendPDF(CAM::PDF->new($part));
- }
- else {
- $pdf_out = CAM::PDF->new($part);
- }
- if($job) {
- # update progressbar
- $num++;
- my $error = $job->update_statustext(int(100 * $num/scalar(@invoices)));
- die $error if $error;
- }
- }
-
- return $pdf_out->toPDF;
-}
-
-=item close
-
-Set the status of the batch to 'R' (resolved).
-
-=cut
-
-sub close {
- my $self = shift;
- $self->status('R');
- return $self->replace;
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=item get_open_batch
-
-Returns the currently open batch. There should only be one at a time.
-
-=cut
-
-sub get_open_batch {
- my $class = shift;
- my $batch = qsearchs('bill_batch', { status => 'O' });
- return $batch if $batch;
- $batch = FS::bill_batch->new({status => 'O'});
- my $error = $batch->insert;
- die $error if $error;
- return $batch;
-}
-
-use Storable 'thaw';
-use Data::Dumper;
-use MIME::Base64;
-
-sub process_print_pdf {
- my $job = shift;
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
- die "no batchnum specified!\n" if ! exists($param->{batchnum});
- my $batch = FS::bill_batch->by_key($param->{batchnum});
- die "batch '$param->{batchnum}' not found!\n" if !$batch;
-
- my $pdf = $batch->print_pdf($job);
- $batch->pdf($pdf);
- my $error = $batch->replace;
- die $error if $error;
-}
-
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/category_Common.pm b/FS/FS/category_Common.pm
deleted file mode 100644
index c239a78..0000000
--- a/FS/FS/category_Common.pm
+++ /dev/null
@@ -1,87 +0,0 @@
-package FS::category_Common;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch );
-
-=head1 NAME
-
-FS::category_Common - Base class for category (group of classifications) classes
-
-=head1 SYNOPSIS
-
-use base qw( FS::category_Common );
-use FS::class_table; #should use this
-
-#optional for non-standard names
-sub _class_table { 'table_name'; } #default is to replace s/category/class/
-
-=head1 DESCRIPTION
-
-FS::category_Common is a base class for classes which provide a categorization
-(group of classifications) for other classes, such as pkg_category or
-cust_category.
-
-=item delete
-
-Deletes this category from the database. Only categories with no associated
-classifications can be deleted. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub delete {
- my $self = shift;
-
- return "Can't delete a ". $self->table.
- " with ". $self->_class_table. " records!"
- if qsearch( $self->_class_table, { 'categorynum' => $self->categorynum } );
-
- $self->SUPER::delete;
-}
-
-=item check
-
-Checks all fields to make sure this is a valid package category. If there is an
-error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->ut_numbern('categorynum')
- or $self->ut_text('categoryname')
- or $self->ut_snumbern('weight')
- or $self->ut_enum('disabled', [ '', 'Y' ])
- or $self->SUPER::check;
-
-}
-
-=back
-
-=cut
-
-#defaults
-
-use vars qw( $_class_table );
-sub _class_table {
- return $_class_table if $_class_table;
- my $self = shift;
- $_class_table = $self->table;
- $_class_table =~ s/category/cclass/ # s/_category$/_class/
- or die "can't determine an automatic class table for $_class_table";
- $_class_table;
-}
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>
-
-=cut
-
-1;
-
diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm
deleted file mode 100644
index f7402ee..0000000
--- a/FS/FS/cdr.pm
+++ /dev/null
@@ -1,950 +0,0 @@
-package FS::cdr;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK $DEBUG $me );
-use Exporter;
-use Tie::IxHash;
-use Date::Parse;
-use Date::Format;
-use Time::Local;
-use FS::UID qw( dbh );
-use FS::Conf;
-use FS::Record qw( qsearch qsearchs );
-use FS::cdr_type;
-use FS::cdr_calltype;
-use FS::cdr_carrier;
-use FS::cdr_batch;
-use FS::cdr_termination;
-
-@ISA = qw(FS::Record);
-@EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker );
-
-$DEBUG = 0;
-$me = '[FS::cdr]';
-
-=head1 NAME
-
-FS::cdr - Object methods for cdr records
-
-=head1 SYNOPSIS
-
- use FS::cdr;
-
- $record = new FS::cdr \%hash;
- $record = new FS::cdr { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cdr object represents an Call Data Record, typically from a telephony
-system or provider of some sort. FS::cdr inherits from FS::Record. The
-following fields are currently supported:
-
-=over 4
-
-=item acctid - primary key
-
-=item calldate - Call timestamp (SQL timestamp)
-
-=item clid - Caller*ID with text
-
-=item src - Caller*ID number / Source number
-
-=item dst - Destination extension
-
-=item dcontext - Destination context
-
-=item channel - Channel used
-
-=item dstchannel - Destination channel if appropriate
-
-=item lastapp - Last application if appropriate
-
-=item lastdata - Last application data
-
-=item startdate - Start of call (UNIX-style integer timestamp)
-
-=item answerdate - Answer time of call (UNIX-style integer timestamp)
-
-=item enddate - End time of call (UNIX-style integer timestamp)
-
-=item duration - Total time in system, in seconds
-
-=item billsec - Total time call is up, in seconds
-
-=item disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
-
-=item amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode.
-
-=cut
-
- #ignore the "omit" and "documentation" AMAs??
- #AMA = Automated Message Accounting.
- #default: Sets the system default.
- #omit: Do not record calls.
- #billing: Mark the entry for billing
- #documentation: Mark the entry for documentation.
-
-=item accountcode - CDR account number to use: account
-
-=item uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
-
-=item userfield - CDR user-defined field
-
-=item cdr_type - CDR type - see L<FS::cdr_type> (Usage = 1, S&E = 7, OC&C = 8)
-
-=item charged_party - Service number to be billed
-
-=item upstream_currency - Wholesale currency from upstream
-
-=item upstream_price - Wholesale price from upstream
-
-=item upstream_rateplanid - Upstream rate plan ID
-
-=item rated_price - Rated (or re-rated) price
-
-=item distance - km (need units field?)
-
-=item islocal - Local - 1, Non Local = 0
-
-=item calltypenum - Type of call - see L<FS::cdr_calltype>
-
-=item description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc)
-
-=item quantity - Number of items (cdr_type 7&8 only)
-
-=item carrierid - Upstream Carrier ID (see L<FS::cdr_carrier>)
-
-=cut
-
-#Telstra =1, Optus = 2, RSL COM = 3
-
-=item upstream_rateid - Upstream Rate ID
-
-=item svcnum - Link to customer service (see L<FS::cust_svc>)
-
-=item freesidestatus - NULL, done (or something)
-
-=item freesiderewritestatus - NULL, done (or something)
-
-=item cdrbatch
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new CDR. To add the CDR 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 { 'cdr'; }
-
-sub table_info {
- {
- 'fields' => {
-#XXX fill in some (more) nice names
- #'acctid' => '',
- 'calldate' => 'Call date',
- 'clid' => 'Caller ID',
- 'src' => 'Source',
- 'dst' => 'Destination',
- 'dcontext' => 'Dest. context',
- 'channel' => 'Channel',
- 'dstchannel' => 'Destination channel',
- #'lastapp' => '',
- #'lastdata' => '',
- 'startdate' => 'Start date',
- 'answerdate' => 'Answer date',
- 'enddate' => 'End date',
- 'duration' => 'Duration',
- 'billsec' => 'Billable seconds',
- 'disposition' => 'Disposition',
- 'amaflags' => 'AMA flags',
- 'accountcode' => 'Account code',
- #'uniqueid' => '',
- 'userfield' => 'User field',
- #'cdrtypenum' => '',
- 'charged_party' => 'Charged party',
- #'upstream_currency' => '',
- 'upstream_price' => 'Upstream price',
- #'upstream_rateplanid' => '',
- #'ratedetailnum' => '',
- 'rated_price' => 'Rated price',
- #'distance' => '',
- #'islocal' => '',
- #'calltypenum' => '',
- #'description' => '',
- #'quantity' => '',
- 'carrierid' => 'Carrier ID',
- #'upstream_rateid' => '',
- 'svcnum' => 'Freeside service',
- 'freesidestatus' => 'Freeside status',
- 'freesiderewritestatus' => 'Freeside rewrite status',
- 'cdrbatch' => 'Legacy batch',
- 'cdrbatchnum' => 'Batch',
- },
-
- };
-
-}
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid CDR. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-Note: Unlike most types of records, we don't want to "reject" a CDR and we want
-to process them as quickly as possible, so we allow the database to check most
-of the data.
-
-=cut
-
-sub check {
- my $self = shift;
-
-# we don't want to "reject" a CDR like other sorts of input...
-# my $error =
-# $self->ut_numbern('acctid')
-## || $self->ut_('calldate')
-# || $self->ut_text('clid')
-# || $self->ut_text('src')
-# || $self->ut_text('dst')
-# || $self->ut_text('dcontext')
-# || $self->ut_text('channel')
-# || $self->ut_text('dstchannel')
-# || $self->ut_text('lastapp')
-# || $self->ut_text('lastdata')
-# || $self->ut_numbern('startdate')
-# || $self->ut_numbern('answerdate')
-# || $self->ut_numbern('enddate')
-# || $self->ut_number('duration')
-# || $self->ut_number('billsec')
-# || $self->ut_text('disposition')
-# || $self->ut_number('amaflags')
-# || $self->ut_text('accountcode')
-# || $self->ut_text('uniqueid')
-# || $self->ut_text('userfield')
-# || $self->ut_numbern('cdrtypenum')
-# || $self->ut_textn('charged_party')
-## || $self->ut_n('upstream_currency')
-## || $self->ut_n('upstream_price')
-# || $self->ut_numbern('upstream_rateplanid')
-## || $self->ut_n('distance')
-# || $self->ut_numbern('islocal')
-# || $self->ut_numbern('calltypenum')
-# || $self->ut_textn('description')
-# || $self->ut_numbern('quantity')
-# || $self->ut_numbern('carrierid')
-# || $self->ut_numbern('upstream_rateid')
-# || $self->ut_numbern('svcnum')
-# || $self->ut_textn('freesidestatus')
-# || $self->ut_textn('freesiderewritestatus')
-# ;
-# return $error if $error;
-
- for my $f ( grep { $self->$_ =~ /\D/ } qw(startdate answerdate enddate)){
- $self->$f( str2time($self->$f) );
- }
-
- $self->calldate( $self->startdate_sql )
- if !$self->calldate && $self->startdate;
-
- #was just for $format eq 'taqua' but can't see the harm... add something to
- #disable if it becomes a problem
- if ( $self->duration eq '' && $self->enddate && $self->startdate ) {
- $self->duration( $self->enddate - $self->startdate );
- }
- if ( $self->billsec eq '' && $self->enddate && $self->answerdate ) {
- $self->billsec( $self->enddate - $self->answerdate );
- }
-
- $self->set_charged_party;
-
- #check the foreign keys even?
- #do we want to outright *reject* the CDR?
- my $error =
- $self->ut_numbern('acctid')
-
- #add a config option to turn these back on if someone needs 'em
- #
- # #Usage = 1, S&E = 7, OC&C = 8
- # || $self->ut_foreign_keyn('cdrtypenum', 'cdr_type', 'cdrtypenum' )
- #
- # #the big list in appendix 2
- # || $self->ut_foreign_keyn('calltypenum', 'cdr_calltype', 'calltypenum' )
- #
- # # Telstra =1, Optus = 2, RSL COM = 3
- # || $self->ut_foreign_keyn('carrierid', 'cdr_carrier', 'carrierid' )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item is_tollfree [ COLUMN ]
-
-Returns true when the cdr represents a toll free number and false otherwise.
-
-By default, inspects the dst field, but an optional column name can be passed
-to inspect other field.
-
-=cut
-
-sub is_tollfree {
- my $self = shift;
- my $field = scalar(@_) ? shift : 'dst';
- ( $self->$field() =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0;
-}
-
-=item set_charged_party
-
-If the charged_party field is already set, does nothing. Otherwise:
-
-If the cdr-charged_party-accountcode config option is enabled, sets the
-charged_party to the accountcode.
-
-Otherwise sets the charged_party normally: to the src field in most cases,
-or to the dst field if it is a toll free number.
-
-=cut
-
-sub set_charged_party {
- my $self = shift;
-
- my $conf = new FS::Conf;
-
- unless ( $self->charged_party ) {
-
- if ( $conf->exists('cdr-charged_party-accountcode') && $self->accountcode ){
-
- my $charged_party = $self->accountcode;
- $charged_party =~ s/^0+//
- if $conf->exists('cdr-charged_party-accountcode-trim_leading_0s');
- $self->charged_party( $charged_party );
-
- } elsif ( $conf->exists('cdr-charged_party-field') ) {
-
- my $field = $conf->config('cdr-charged_party-field');
- $self->charged_party( $self->$field() );
-
- } else {
-
- if ( $self->is_tollfree ) {
- $self->charged_party($self->dst);
- } else {
- $self->charged_party($self->src);
- }
-
- }
-
- }
-
-# my $prefix = $conf->config('cdr-charged_party-truncate_prefix');
-# my $prefix_len = length($prefix);
-# my $trunc_len = $conf->config('cdr-charged_party-truncate_length');
-#
-# $self->charged_party( substr($self->charged_party, 0, $trunc_len) )
-# if $prefix_len && $trunc_len
-# && substr($self->charged_party, 0, $prefix_len) eq $prefix;
-
-}
-
-=item set_status_and_rated_price STATUS [ RATED_PRICE [ SVCNUM ] ]
-
-Sets the status to the provided string. If there is an error, returns the
-error, otherwise returns false.
-
-=cut
-
-sub set_status_and_rated_price {
- my($self, $status, $rated_price, $svcnum, %opt) = @_;
- if($opt{'inbound'}) {
- my $term = qsearchs('cdr_termination', {
- acctid => $self->acctid,
- termpart => 1 # inbound
- });
- my $error;
- if($term) {
- warn "replacing existing cdr status (".$self->acctid.")\n" if $term;
- $error = $term->delete;
- return $error if $error;
- }
- $term = FS::cdr_termination->new({
- acctid => $self->acctid,
- termpart => 1,
- rated_price => $rated_price,
- status => $status,
- svcnum => $svcnum,
- });
- return $term->insert;
- }
- else {
- $self->freesidestatus($status);
- $self->rated_price($rated_price);
- $self->svcnum($svcnum) if $svcnum;
- return $self->replace();
- }
-}
-
-=item calldate_unix
-
-Parses the calldate in SQL string format and returns a UNIX timestamp.
-
-=cut
-
-sub calldate_unix {
- str2time(shift->calldate);
-}
-
-=item startdate_sql
-
-Parses the startdate in UNIX timestamp format and returns a string in SQL
-format.
-
-=cut
-
-sub startdate_sql {
- my($sec,$min,$hour,$mday,$mon,$year) = localtime(shift->startdate);
- $mon++;
- $year += 1900;
- "$year-$mon-$mday $hour:$min:$sec";
-}
-
-=item cdr_carrier
-
-Returns the FS::cdr_carrier object associated with this CDR, or false if no
-carrierid is defined.
-
-=cut
-
-my %carrier_cache = ();
-
-sub cdr_carrier {
- my $self = shift;
- return '' unless $self->carrierid;
- $carrier_cache{$self->carrierid} ||=
- qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } );
-}
-
-=item carriername
-
-Returns the carrier name (see L<FS::cdr_carrier>), or the empty string if
-no FS::cdr_carrier object is assocated with this CDR.
-
-=cut
-
-sub carriername {
- my $self = shift;
- my $cdr_carrier = $self->cdr_carrier;
- $cdr_carrier ? $cdr_carrier->carriername : '';
-}
-
-=item cdr_calltype
-
-Returns the FS::cdr_calltype object associated with this CDR, or false if no
-calltypenum is defined.
-
-=cut
-
-my %calltype_cache = ();
-
-sub cdr_calltype {
- my $self = shift;
- return '' unless $self->calltypenum;
- $calltype_cache{$self->calltypenum} ||=
- qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } );
-}
-
-=item calltypename
-
-Returns the call type name (see L<FS::cdr_calltype>), or the empty string if
-no FS::cdr_calltype object is assocated with this CDR.
-
-=cut
-
-sub calltypename {
- my $self = shift;
- my $cdr_calltype = $self->cdr_calltype;
- $cdr_calltype ? $cdr_calltype->calltypename : '';
-}
-
-=item downstream_csv [ OPTION => VALUE, ... ]
-
-=cut
-
-my %export_names = (
- 'simple' => {
- 'name' => 'Simple',
- 'invoice_header' => "Date,Time,Name,Destination,Duration,Price",
- },
- 'simple2' => {
- 'name' => 'Simple with source',
- 'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
- #"Date,Time,Name,Called From,Destination,Duration,Price",
- },
- 'default' => {
- 'name' => 'Default',
- 'invoice_header' => 'Date,Time,Number,Destination,Duration,Price',
- },
- 'source_default' => {
- 'name' => 'Default with source',
- 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price',
- },
- 'accountcode_default' => {
- 'name' => 'Default plus accountcode',
- 'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price',
- },
-);
-
-my %export_formats = ();
-sub export_formats {
- #my $self = shift;
-
- return %export_formats if keys %export_formats;
-
- my $conf = new FS::Conf;
- my $date_format = $conf->config('date_format') || '%m/%d/%Y';
-
- # This is now smarter, and shows the call duration in the
- # largest units that accurately reflect the granularity.
- my $duration_sub = sub {
- my($cdr, %opt) = @_;
- my $sec = $opt{seconds} || $cdr->billsec;
- if ( length($opt{granularity}) &&
- $opt{granularity} == 0 ) { #per call
- return '1 call';
- }
- elsif ( $opt{granularity} == 60 ) {#full minutes
- return sprintf("%.0fm",$sec/60);
- }
- else { #anything else
- return sprintf("%dm %ds", $sec/60, $sec%60);
- }
- };
-
- %export_formats = (
- 'simple' => [
- sub { time2str($date_format, shift->calldate_unix ) }, #DATE
- sub { time2str('%r', shift->calldate_unix ) }, #TIME
- 'userfield', #USER
- 'dst', #NUMBER_DIALED
- $duration_sub, #DURATION
- #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
- sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE
- ],
- 'simple2' => [
- sub { time2str($date_format, shift->calldate_unix ) }, #DATE
- sub { time2str('%r', shift->calldate_unix ) }, #TIME
- #'userfield', #USER
- 'src', #called from
- 'dst', #NUMBER_DIALED
- $duration_sub, #DURATION
- #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
- sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE
- ],
- 'default' => [
-
- #DATE
- sub { time2str($date_format, shift->calldate_unix ) },
- # #time2str("%Y %b %d - %r", $cdr->calldate_unix ),
-
- #TIME
- sub { time2str('%r', shift->calldate_unix ) },
- # time2str("%c", $cdr->calldate_unix), #XXX this should probably be a config option dropdown so they can select US vs- rest of world dates or whatnot
-
- #DEST ("Number")
- sub { my($cdr, %opt) = @_; $opt{pretty_dst} || $cdr->dst; },
-
- #REGIONNAME ("Destination")
- sub { my($cdr, %opt) = @_; $opt{dst_regionname}; },
-
- #DURATION
- $duration_sub,
-
- #PRICE
- sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; },
-
- ],
- );
- $export_formats{'source_default'} = [ 'src', @{ $export_formats{'default'} }, ];
- $export_formats{'accountcode_default'} =
- [ @{ $export_formats{'default'} }[0,1],
- 'accountcode',
- @{ $export_formats{'default'} }[2..5],
- ];
-
- %export_formats
-}
-
-sub downstream_csv {
- my( $self, %opt ) = @_;
-
- my $format = $opt{'format'};
- my %formats = $self->export_formats;
- return "Unknown format $format" unless exists $formats{$format};
-
- #my $conf = new FS::Conf;
- #$opt{'money_char'} ||= $conf->config('money_char') || '$';
- $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
- my $csv = new Text::CSV_XS;
-
- my @columns =
- map {
- ref($_) ? &{$_}($self, %opt) : $self->$_();
- }
- @{ $formats{$format} };
-
- my $status = $csv->combine(@columns);
- die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV"
- unless $status;
-
- $csv->string;
-
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item invoice_formats
-
-Returns an ordered list of key value pairs containing invoice format names
-as keys (for use with part_pkg::voip_cdr) and "pretty" format names as values.
-
-=cut
-
-sub invoice_formats {
- map { ($_ => $export_names{$_}->{'name'}) }
- grep { $export_names{$_}->{'invoice_header'} }
- keys %export_names;
-}
-
-=item invoice_header FORMAT
-
-Returns a scalar containing the CSV column header for invoice format FORMAT.
-
-=cut
-
-sub invoice_header {
- my $format = shift;
- $export_names{$format}->{'invoice_header'};
-}
-
-=item import_formats
-
-Returns an ordered list of key value pairs containing import format names
-as keys (for use with batch_import) and "pretty" format names as values.
-
-=cut
-
-#false laziness w/part_pkg & part_export
-
-my %cdr_info;
-foreach my $INC ( @INC ) {
- warn "globbing $INC/FS/cdr/*.pm\n" if $DEBUG;
- foreach my $file ( glob("$INC/FS/cdr/*.pm") ) {
- warn "attempting to load CDR format info from $file\n" if $DEBUG;
- $file =~ /\/(\w+)\.pm$/ or do {
- warn "unrecognized file in $INC/FS/cdr/: $file\n";
- next;
- };
- my $mod = $1;
- my $info = eval "use FS::cdr::$mod; ".
- "\\%FS::cdr::$mod\::info;";
- if ( $@ ) {
- die "error using FS::cdr::$mod (skipping): $@\n" if $@;
- next;
- }
- unless ( keys %$info ) {
- warn "no %info hash found in FS::cdr::$mod, skipping\n";
- next;
- }
- warn "got CDR format info from FS::cdr::$mod: $info\n" if $DEBUG;
- if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
- warn "skipping disabled CDR format FS::cdr::$mod" if $DEBUG;
- next;
- }
- $cdr_info{$mod} = $info;
- }
-}
-
-tie my %import_formats, 'Tie::IxHash',
- map { $_ => $cdr_info{$_}->{'name'} }
- sort { $cdr_info{$a}->{'weight'} <=> $cdr_info{$b}->{'weight'} }
- grep { exists($cdr_info{$_}->{'import_fields'}) }
- keys %cdr_info;
-
-sub import_formats {
- %import_formats;
-}
-
-sub _cdr_min_parser_maker {
- my $field = shift;
- my @fields = ref($field) ? @$field : ($field);
- @fields = qw( billsec duration ) unless scalar(@fields) && $fields[0];
- return sub {
- my( $cdr, $min ) = @_;
- my $sec = eval { _cdr_min_parse($min) };
- die "error parsing seconds for @fields from $min minutes: $@\n" if $@;
- $cdr->$_($sec) foreach @fields;
- };
-}
-
-sub _cdr_min_parse {
- my $min = shift;
- sprintf('%.0f', $min * 60 );
-}
-
-sub _cdr_date_parser_maker {
- my $field = shift;
- my %options = @_;
- my @fields = ref($field) ? @$field : ($field);
- return sub {
- my( $cdr, $datestring ) = @_;
- my $unixdate = eval { _cdr_date_parse($datestring, %options) };
- die "error parsing date for @fields from $datestring: $@\n" if $@;
- $cdr->$_($unixdate) foreach @fields;
- };
-}
-
-sub _cdr_date_parse {
- my $date = shift;
- my %options = @_;
-
- return '' unless length($date); #that's okay, it becomes NULL
- return '' if $date eq 'NA'; #sansay
-
- if ( $date =~ /^([a-z]{3})\s+([a-z]{3})\s+(\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s+(\d{4})$/i && $7 > 1970 ) {
- my $time = str2time($date);
- return $time if $time > 100000; #just in case
- }
-
- my($year, $mon, $day, $hour, $min, $sec);
-
- #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/
- #taqua #2007-10-31 08:57:24.113000000
-
- if ( $date =~ /^\s*(\d{4})\D(\d{1,2})\D(\d{1,2})\D+(\d{1,2})\D(\d{1,2})\D(\d{1,2})(\D|$)/ ) {
- ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
- } elsif ( $date =~ /^\s*(\d{1,2})\D(\d{1,2})\D(\d{4})\s+(\d{1,2})\D(\d{1,2})(?:\D(\d{1,2}))?(\D|$)/ ) {
- # 8/26/2010 12:20:01
- # optionally without seconds
- ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
- $sec = 0 if !defined($sec);
- } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d+\.\d+)(\D|$)/ ) {
- # broadsoft: 20081223201938.314
- ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
- } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\d+(\D|$)/ ) {
- # Taqua OM: 20050422203450943
- ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
- } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ ) {
- # WIP: 20100329121420
- ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
- } elsif ( $date =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z$/) {
- # Telos
- ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 );
- $options{gmt} = 1;
- } else {
- die "unparsable date: $date"; #maybe we shouldn't die...
- }
-
- return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1
- && $hour == 0 && $min == 0 && $sec == 0;
-
- if ($options{gmt}) {
- timegm($sec, $min, $hour, $day, $mon-1, $year);
- } else {
- timelocal($sec, $min, $hour, $day, $mon-1, $year);
- }
-}
-
-=item batch_import HASHREF
-
-Imports CDR records. Available options are:
-
-=over 4
-
-=item file
-
-Filename
-
-=item format
-
-=item params
-
-Hash reference of preset fields, typically cdrbatch
-
-=item empty_ok
-
-Set true to prevent throwing an error on empty imports
-
-=back
-
-=cut
-
-my %import_options = (
- 'table' => 'cdr',
-
- 'batch_keycol' => 'cdrbatchnum',
- 'batch_table' => 'cdr_batch',
- 'batch_namecol' => 'cdrbatch',
-
- 'formats' => { map { $_ => $cdr_info{$_}->{'import_fields'}; }
- keys %cdr_info
- },
-
- #drop the || 'csv' to allow auto xls for csv types?
- 'format_types' => { map { $_ => ( lc($cdr_info{$_}->{'type'}) || 'csv' ); }
- keys %cdr_info
- },
-
- 'format_headers' => { map { $_ => ( $cdr_info{$_}->{'header'} || 0 ); }
- keys %cdr_info
- },
-
- 'format_sep_chars' => { map { $_ => $cdr_info{$_}->{'sep_char'}; }
- keys %cdr_info
- },
-
- 'format_fixedlength_formats' =>
- { map { $_ => $cdr_info{$_}->{'fixedlength_format'}; }
- keys %cdr_info
- },
-
- 'format_xml_formats' =>
- { map { $_ => $cdr_info{$_}->{'xml_format'}; }
- keys %cdr_info
- },
-
- 'format_row_callbacks' => { map { $_ => $cdr_info{$_}->{'row_callback'}; }
- keys %cdr_info
- },
-);
-
-sub _import_options {
- \%import_options;
-}
-
-sub batch_import {
- my $opt = shift;
-
- my $iopt = _import_options;
- $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
-
- FS::Record::batch_import( $opt );
-
-}
-
-=item process_batch_import
-
-=cut
-
-sub process_batch_import {
- my $job = shift;
-
- my $opt = _import_options;
-# $opt->{'params'} = [ 'format', 'cdrbatch' ];
-
- FS::Record::process_batch_import( $job, $opt, @_ );
-
-}
-# if ( $format eq 'simple' ) { #should be a callback or opt in FS::cdr::simple
-# @columns = map { s/^ +//; $_; } @columns;
-# }
-
-# _ upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-
-sub _upgrade_data {
- my ($class, %opts) = @_;
-
- warn "$me upgrading $class\n" if $DEBUG;
-
- my $sth = dbh->prepare(
- 'SELECT DISTINCT(cdrbatch) FROM cdr WHERE cdrbatch IS NOT NULL'
- ) or die dbh->errstr;
-
- $sth->execute or die $sth->errstr;
-
- my %cdrbatchnum = ();
- while (my $row = $sth->fetchrow_arrayref) {
-
- my $cdr_batch = qsearchs( 'cdr_batch', { 'cdrbatch' => $row->[0] } );
- unless ( $cdr_batch ) {
- $cdr_batch = new FS::cdr_batch { 'cdrbatch' => $row->[0] };
- my $error = $cdr_batch->insert;
- die $error if $error;
- }
-
- $cdrbatchnum{$row->[0]} = $cdr_batch->cdrbatchnum;
- }
-
- $sth = dbh->prepare('UPDATE cdr SET cdrbatch = NULL, cdrbatchnum = ? WHERE cdrbatch IS NOT NULL AND cdrbatch = ?') or die dbh->errstr;
-
- foreach my $cdrbatch (keys %cdrbatchnum) {
- $sth->execute($cdrbatchnum{$cdrbatch}, $cdrbatch) or die $sth->errstr;
- }
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cdr/asterisk.pm b/FS/FS/cdr/asterisk.pm
deleted file mode 100644
index 8b29642..0000000
--- a/FS/FS/cdr/asterisk.pm
+++ /dev/null
@@ -1,45 +0,0 @@
-package FS::cdr::asterisk;
-
-use strict;
-use vars qw(@ISA %info);
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-#http://www.the-asterisk-book.com/unstable/funktionen-cdr.html
-my %amaflags = (
- DEFAULT => 0,
- OMIT => 1, #asterisk 1.4+
- IGNORE => 1, #asterisk 1.2
- BILLING => 2, #asterisk 1.4+
- BILL => 2, #asterisk 1.2
- DOCUMENTATION => 3,
- #? '' => 0,
-);
-
-%info = (
- 'name' => 'Asterisk',
- 'weight' => 10,
- 'import_fields' => [
- 'accountcode',
- 'src',
- 'dst',
- 'dcontext',
- 'clid',
- 'channel',
- 'dstchannel',
- 'lastapp',
- 'lastdata',
- _cdr_date_parser_maker('startdate'),
- _cdr_date_parser_maker('answerdate'),
- _cdr_date_parser_maker('enddate'),
- 'duration',
- 'billsec',
- 'disposition',
- sub { my($cdr, $amaflags) = @_; $cdr->amaflags($amaflags{$amaflags}); },
- 'uniqueid',
- 'userfield',
- ],
-);
-
-1;
diff --git a/FS/FS/cdr/bell_west.pm b/FS/FS/cdr/bell_west.pm
deleted file mode 100644
index f745bb1..0000000
--- a/FS/FS/cdr/bell_west.pm
+++ /dev/null
@@ -1,122 +0,0 @@
-package FS::cdr::bell_west;
-
-use strict;
-use base qw( FS::cdr );
-use vars qw( %info $tmp_mon $tmp_mday $tmp_year );
-use Time::Local;
-#use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker );
-
-%info = (
- 'name' => 'Bell West',
- 'weight' => 210,
- 'header' => 1,
- 'type' => 'xls',
-
- 'import_fields' => [
-
- # CDR FIELD / REQUIRED / Notes
-
- # CHG TYPE / No / Internal Code only (no need to import)
- sub {},
-
- # ACCOUNT # / No / Internal Number only (no need to import)
- sub {},
-
- # DATE / Yes / "DATE" Excel date format MM/DD/YYYY
- # XXX false laziness w/troop.pm
- sub { my($cdr, $date) = @_;
-
- my $datetime = DateTime::Format::Excel->parse_datetime( $date );
- $tmp_mon = $datetime->mon_0;
- $tmp_mday = $datetime->mday;
- $tmp_year = $datetime->year;
- },
-
- # CUST NO / Yes / "TIME" "075959" Text based time
- # Note: This is really the start time but Bell header says "Cust No" which
- # is wrong
- sub { my($cdr, $time) = @_;
- #my($sec, $min, $hour, $mday, $mon, $year)= localtime($cdr->startdate);
- $time =~ /^(\d{2})(\d{2})(\d{2})$/
- or die "unparsable time: $time"; #maybe we shouldn't die...
- #$cdr->startdate( timelocal($3, $2, $1 ,$mday, $mon, $year) );
- $cdr->startdate(
- timelocal($3, $2, $1 ,$tmp_mday, $tmp_mon, $tmp_year)
- );
- },
-
- # BTN / Yes / Main billing number but not DID or real number
- # (put in SRC field)
- 'src',
-
- # ORIG CITY / No / We will use your Freeside rating and description name
- 'channel',
-
- # TERM / YES / All calls should be billed, however all calls are
- # missing "1+" and "011+" & DIR ASST = "411"
- 'dst',
-
- # TERM CITY / No / We will use your Freeside rating and description name
- 'dstchannel',
-
- # WTN / Yes / Bill to number (put in "charged_party")
- 'charged_party',
-
- # CODE / Yes / Account Code (security) and we need on invoice
- 'accountcode',
-
- # PROV/COUNTRY / No / We will use your Freeside rating and description name
- # (but use this to add "011" for "International" calls)
- sub { my( $cdr, $prov ) = @_;
- my $pre = ( $prov =~ /^\s*International\s*/i ) ? '011' : '1';
- $cdr->dst( $pre. $cdr->dst ) unless $cdr->dst =~ /^$pre/;
- },
-
- # CALL TYPE / Possibly / Not sure if you need this to determine correct
- # billing method ?
- # DDD normal call (Direct Dial Dsomething? ="LD"?)
- # TF Toll Free
- # (toll free dst# should be sufficient to rate)
- # DAT Directory AssisTance
- # (dst# 411 "area code" should be sufficient to rate)
- # DNS (Another sort of directory assistance?... only one record with
- # "8195551212" in the dst#)
- 'dcontext', #probably don't need... map to cdr_type? calltypenum?
-
- # DURATION Yes Units = seconds
- 'billsec', #need to trim .00 ?
-
- # AMOUNT CHARGED No Will use Freeside rating and description name
- sub { my( $cdr, $amount) = @_;
- $amount =~ s/^\$//;
- $cdr->upstream_price( $amount );
- },
-
- ],
-
-);
-
-1;
-
-__END__
-
-CHG TYPE (unused)
-ACCOUNT # (unused)
-
-DATE startdate (+ CUST NO)
-CUST NO (startdate time)
- - Start of call (UNIX-style integer timestamp)
-
-BTN *src - Caller*ID number / Source number
-ORIG CITY channel - Channel used
-TERM # *dst - Destination extension
-TERM CITY dstchannel - Destination channel if appropriate
-WTN *charged_party - Service number to be billed
-CODE *accountcode - CDR account number to use: account
-
-PROV/COUNTRY (used to prefix TERM # w/ 1 or 011)
-
-CALL TYPE dcontext - Destination context
-DURATION *billsec - Total time call is up, in seconds
-AMOUNT CHARGED *upstream_price - Wholesale price from upstream
-
diff --git a/FS/FS/cdr/broadsoft.pm b/FS/FS/cdr/broadsoft.pm
deleted file mode 100644
index 423e96f..0000000
--- a/FS/FS/cdr/broadsoft.pm
+++ /dev/null
@@ -1,108 +0,0 @@
-package FS::cdr::broadsoft;
-
-use strict;
-use base qw( FS::cdr );
-use vars qw( %info );
-use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker );
-
-%info = (
- 'name' => 'Broadsoft',
- 'weight' => 500,
- 'header' => 1, #0 default, set to 1 to ignore the first line, or
- # to higher numbers to ignore that number of lines
- 'type' => 'csv', #csv (default), fixedlength or xls
- 'sep_char' => ',', #for csv, defaults to ,
- 'disabled' => 0, #0 default, set to 1 to disable
-
- #listref of what to do with each field from the CDR, in order
- 'import_fields' => [
-
- skip(2),
- sub { my($cdr, $data, $conf, $param) = @_;
- $param->{skiprow} = 1 if lc($data) ne 'normal';
- '' }, # 3: type
-
- trim('accountcode'), # 4: userNumber
- skip(2),
- trim('src'), # 7: callingNumber
- skip(1),
- trim('dst'), # 9: calledNumber
-
- _cdr_date_parser_maker('startdate'), # 10: startTime
- skip(1),
- sub { my($cdr, $data) = @_;
- $cdr->disposition(
- lc($data) eq 'yes' ?
- 'ANSWERED' : 'NO ANSWER') }, # 12: answerIndicator
- _cdr_date_parser_maker('answerdate'), # 13: answerTime
- _cdr_date_parser_maker('enddate'), # 14: releaseTime
-
- ],
-
-);
-
-sub trim {
- my $fieldname = shift;
- return sub {
- my($cdr, $data) = @_;
- $data =~ s/^\+1//;
- $cdr->$fieldname($data);
- ''
- }
-}
-
-sub skip {
- map { undef } (1..$_[0]);
-}
-
-1;
-
-__END__
-
-list of freeside CDR fields, useful ones marked with *
-
- acctid - primary key
- *[1] calldate - Call timestamp (SQL timestamp)
- clid - Caller*ID with text
-7 * src - Caller*ID number / Source number
-9 * dst - Destination extension
- dcontext - Destination context
- channel - Channel used
- dstchannel - Destination channel if appropriate
- lastapp - Last application if appropriate
- lastdata - Last application data
-10 * startdate - Start of call (UNIX-style integer timestamp)
-13 answerdate - Answer time of call (UNIX-style integer timestamp)
-14 * enddate - End time of call (UNIX-style integer timestamp)
- * duration - Total time in system, in seconds
- * billsec - Total time call is up, in seconds
-12 *[2] disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
- amaflags - What flags to use: BILL, IGNORE etc, specified on a per
- channel basis like accountcode.
-4 *[3] accountcode - CDR account number to use: account
- uniqueid - Unique channel identifier
- userfield - CDR user-defined field
- cdr_type - CDR type - see FS::cdr_type (Usage = 1, S&E = 7, OC&C = 8)
- *[4] charged_party - Service number to be billed
- upstream_currency - Wholesale currency from upstream
- *[5] upstream_price - Wholesale price from upstream
- upstream_rateplanid - Upstream rate plan ID
- rated_price - Rated (or re-rated) price
- distance - km (need units field?)
- islocal - Local - 1, Non Local = 0
- *[6] calltypenum - Type of call - see FS::cdr_calltype
- description - Description (cdr_type 7&8 only) (used for
- cust_bill_pkg.itemdesc)
- quantity - Number of items (cdr_type 7&8 only)
- carrierid - Upstream Carrier ID (see FS::cdr_carrier)
- upstream_rateid - Upstream Rate ID
- svcnum - Link to customer service (see FS::cust_svc)
- freesidestatus - NULL, done (or something)
-
-[1] Auto-populated from startdate if not present
-[2] Package options available to ignore calls without a specific disposition
-[3] When using 'cdr-charged_party-accountcode' config
-[4] Auto-populated from src (normal calls) or dst (toll free calls) if not present
-[5] When using 'upstream_simple' rating method.
-[6] Set to usage class classnum when using pre-rated CDRs and usage class-based
- taxation (local/intrastate/interstate/international)
diff --git a/FS/FS/cdr/cia.pm b/FS/FS/cdr/cia.pm
deleted file mode 100644
index 6134333..0000000
--- a/FS/FS/cdr/cia.pm
+++ /dev/null
@@ -1,39 +0,0 @@
-package FS::cdr::cia;
-
-use strict;
-use vars qw( @ISA %info );
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'Client Instant Access',
- 'weight' => 510,
- 'header' => 1,
- 'type' => 'csv',
- 'sep_char' => "\t",
- 'import_fields' => [
- skip(2), # Reseller Account Number, Confirmation Number
- 'description', # Conference Name
- skip(3), # Organization Name, Bill Code, Q&A Active
- 'userfield', # Chairperson Name
- skip(2), # Conference Start Time, Conference End Time
- _cdr_date_parser_maker('startdate'), # Connect Time
- _cdr_date_parser_maker('enddate'), # Disconnect Time
- sub { my($cdr, $data, $conf, $param) = @_;
- $cdr->duration($data);
- $cdr->billsec( $data);
- }, # Duration
- skip(2), # Roundup Duration, User Name
- 'dst', # DNIS
- 'src', # ANI
- skip(2), # Call Type, Toll Free,
- skip(1), # Chair Conference Entry Code
- 'accountcode', # Participant Conference Entry Code,
- ],
-
-);
-
-sub skip { map {''} (1..$_[0]) }
-
-1;
diff --git a/FS/FS/cdr/genband.pm b/FS/FS/cdr/genband.pm
deleted file mode 100644
index 619d908..0000000
--- a/FS/FS/cdr/genband.pm
+++ /dev/null
@@ -1,120 +0,0 @@
-package FS::cdr::genband;
-
-use strict;
-use vars qw(@ISA %info);
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'GenBand (Tekelec)', #'Genband G6 (Tekelec T6000)',
- 'weight' => 140,
- 'type' => 'fixedlength',
- 'fixedlength_format' => [qw(
- Type:2:1:2
- Sequence:4:3:6
- OIDCall:30:7:36
- StartTime:19:37:55
- AnswerTime:19:56:74
- EndTime:19:75:93
- SourceName:30:94:123
- SourceEndName:30:124:153
- SourceCallerID:20:154:173
- SourceCallerName:30:174:203
- DestinationName:30:204:233
- DestinationEndName:30:234:263
- DestCallerID:20:264:283
- DestCallerIDInfo:30:284:313
- DialedDigits:30:314:343
- Billing:30:344:373
- AuthCode:30:374:403
- CallDirection:1:404:404
- ExtendedCall:1:405:405
- ExternalCall:1:406:406
- Duration:9:407:415
- SIPCallID:64:416:479
- IncomingDigits:30:480:509
- OutpulsedDigits:30:510:539
- CarrierIdentificationCode:4:540:543
- CompletionReason:4:544:547
- OriginationPartition:30:548:577
- DestinationPartition:30:578:607
- BilledSourceDID:20:608:627
- OriginalCall:30:628:657
- VideoCall:1:658:658
- )],
- 'import_fields' => [
- sub {}, #Type:2:1:2
- sub {}, #Sequence:4:3:6
- 'uniqueid', #OIDCall:30:7:36
- _cdr_date_parser_maker('startdate'), #StartTime:19:37:55
- _cdr_date_parser_maker('answerdate'), #AnswerTime:19:56:74
- _cdr_date_parser_maker('enddate'), #EndTime:19:75:93
- sub {}, #SourceName:30:94:123
- 'channel', #SourceEndName:30:124:153
- 'src', #SourceCallerID:20:154:173
- 'clid', #SourceCallerName:30:174:203
- sub {}, #DestinationName:30:204:233
- 'dstchannel', #DestinationEndName:30:234:263
- 'dst', #DestCallerID:20:264:283
- sub {}, #DestCallerIDInfo:30:284:313
- sub {}, #DialedDigits:30:314:343
- sub {}, #Billing:30:344:373
- sub {}, #AuthCode:30:374:403
- sub {}, #CallDirection:1:404:404
- sub {}, #ExtendedCall:1:405:405
- sub {}, #ExternalCall:1:406:406
- sub { my( $cdr, $duration ) = @_;
- $cdr->duration($duration);
- $cdr->billsec($duration); }, #'duration', #Duration:9:407:415
- sub {}, #SIPCallID:64:416:479
- sub {}, #IncomingDigits:30:480:509
- sub {}, #OutpulsedDigits:30:510:539
- sub {}, #CarrierIdentificationCode:4:540:543
- sub {}, #CompletionReason:4:544:547
- sub {}, #OriginationPartition:30:548:577
- sub {}, #DestinationPartition:30:578:607
- sub {}, #BilledSourceDID:20:608:627
- sub {}, #OriginalCall:30:628:657
- sub {}, #VideoCall:1:658:658
- ],
-);
-# acctid - primary key
-# calldate - Call timestamp (SQL timestamp)
-# clid - Caller*ID with text
-# src - Caller*ID number / Source number
-# dst - Destination extension
-# dcontext - Destination context
-# channel - Channel used
-# dstchannel - Destination channel if appropriate
-# lastapp - Last application if appropriate
-# lastdata - Last application data
-# startdate - Start of call (UNIX-style integer timestamp)
-# answerdate - Answer time of call (UNIX-style integer timestamp)
-# enddate - End time of call (UNIX-style integer timestamp)
-# duration - Total time in system, in seconds
-# billsec - Total time call is up, in seconds
-# disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
-# amaflags - What flags to use: BILL, IGNORE etc, specified on a per
-# channel basis like accountcode.
-# accountcode - CDR account number to use: account
-# uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
-# userfield - CDR user-defined field
-# cdr_type - CDR type - see FS::cdr_type (Usage = 1, S&E = 7, OC&C = 8)
-# charged_party - Service number to be billed
-# upstream_currency - Wholesale currency from upstream
-# upstream_price - Wholesale price from upstream
-# upstream_rateplanid - Upstream rate plan ID
-# rated_price - Rated (or re-rated) price
-# distance - km (need units field?)
-# islocal - Local - 1, Non Local = 0
-# calltypenum - Type of call - see FS::cdr_calltype
-# description - Description (cdr_type 7&8 only) (used for
-# cust_bill_pkg.itemdesc)
-# quantity - Number of items (cdr_type 7&8 only)
-# carrierid - Upstream Carrier ID (see FS::cdr_carrier)
-# upstream_rateid - Upstream Rate ID
-# svcnum - Link to customer service (see FS::cust_svc)
-# freesidestatus - NULL, done (or something)
-
-1;
diff --git a/FS/FS/cdr/genband_meetme.pm b/FS/FS/cdr/genband_meetme.pm
deleted file mode 100644
index d87dd8f..0000000
--- a/FS/FS/cdr/genband_meetme.pm
+++ /dev/null
@@ -1,17 +0,0 @@
-package FS::cdr::genband_meetme;
-
-use strict;
-use vars qw(@ISA %info);
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'Genband (Tekelec) Meet-Me Conference', #'Genband G6 (Tekelec T6000) Meet-Me Conference Log Records',
- 'weight' => 145,
- 'disabled' => 1,
- 'import_fields' => [
- ],
-);
-
-1;
diff --git a/FS/FS/cdr/indosoft.pm b/FS/FS/cdr/indosoft.pm
deleted file mode 100644
index cb25089..0000000
--- a/FS/FS/cdr/indosoft.pm
+++ /dev/null
@@ -1,71 +0,0 @@
-package FS::cdr::indosoft;
-
-use strict;
-use base qw( FS::cdr );
-use vars qw( %info );
-use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker );
-
-%info = (
- 'name' => 'Indosoft Conference Bridge',
- 'weight' => 300,
- 'header' => 1,
- 'type' => 'csv',
-
- #listref of what to do with each field from the CDR, in order
- 'import_fields' => [
-
- #cdr_id
- 'uniqueid',
-
- #connect_time
- _cdr_date_parser_maker( ['startdate', 'answerdate' ] ),
-
- #disconnect_time
- _cdr_date_parser_maker('enddate'),
-
- #account_id
- 'accountcode',
-
- #conference_id
- 'userfield',
-
- #client_id
- 'charged_party',
-
- #pin_used
- 'dcontext',
-
- #channel
- 'channel',
-
- #clid
- #'src',
- sub { my($cdr, $clid) = @_;
- $cdr->clid( $clid ); #because they called it 'clid' explicitly
- $cdr->src( $clid );
- },
-
- #dnis
- 'dst',
-
- #call_status
- 'disposition',
-
- #conf_billing_code
- 'lastapp', #arbitrary
-
- #participant_id
- 'lastdata', #arbitrary
-
- #codr_id
- 'dstchannel', #arbitrary
-
- #call_type
- 'description',
-
- ],
-
-);
-
-1;
-
diff --git a/FS/FS/cdr/infinite.pm b/FS/FS/cdr/infinite.pm
deleted file mode 100644
index 90560c8..0000000
--- a/FS/FS/cdr/infinite.pm
+++ /dev/null
@@ -1,41 +0,0 @@
-package FS::cdr::infinite;
-
-use strict;
-use vars qw( @ISA %info );
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'Infinite Conferencing',
- 'weight' => 520,
- 'header' => 1,
- 'type' => 'csv',
- 'sep_char' => ',',
- 'import_fields' => [
- 'uniqueid', # billid
- skip(3), # confid, invoicenum, acctgrpid
- 'accountcode', # accountid ("Room Confirmation Number")
- skip(2), # billingcode ("Room Billingcode"), confname
- skip(1), # participant_type
- 'startdate', # starttime_t
- skip(2), # startdate, starttime
- sub { my($cdr, $data, $conf, $param) = @_;
- $cdr->duration($data * 60);
- $cdr->billsec( $data * 60);
- }, # minutes
- 'dst', # dnis
- 'src', # ani
- skip(8), # calltype, calltype_text, confstart_t, confstartdate,
- # confstarttime, confminutes, conflegs, ppm
- 'upstream_price', # callcost
- skip(13), # confcost, rppm, rcallcost, rconfcost,
- # auxdata[1..4], ldval, sysname, username, cec, pec
- 'userfield', # unnamed field
- ],
-
-);
-
-sub skip { map {''} (1..$_[0]) }
-
-1;
diff --git a/FS/FS/cdr/netcentrex.pm b/FS/FS/cdr/netcentrex.pm
deleted file mode 100644
index a434d5d..0000000
--- a/FS/FS/cdr/netcentrex.pm
+++ /dev/null
@@ -1,783 +0,0 @@
-package FS::cdr::netcentrex;
-
-use strict;
-use vars qw(@ISA %info);
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-#close enough http://wiki.freeswitch.org/wiki/Hangup_causes
-#my %disposition = (
-# 16 => 'ANSWERED',
-# 17 => 'BUSY',
-# 18 => 'NO USER RESPONSE',
-# 19 => 'NO ANSWER',
-# 156 => '??' #???
-#);
-
-%info = (
- 'name' => 'NetCentrex',
- 'weight' => 150,
- 'type' => 'csv',
- 'sep_char' => ';',
- 'import_fields' => [
- '', #00 SU Identifier
- '', #01 SU IP Address
- '', #02 Conference ID
- '', #03 Call ID
- '', #04 Leg number (all 0)
- _cdr_date_parser_maker('startdate'), #05 Authorize timestamp
- _cdr_date_parser_maker('answerdate'), #06 Start timestamp
- sub { my( $cdr, $duration ) = @_; #07 Duration
- $cdr->duration($duration);
- $cdr->billsec( $duration);
- },
- _e164_parser_maker('src', 'charged_party'), #08 Caller
- _e164_parser_maker('dcontext', 'dst', 'norewrite_pivotonly'=>1) ,#09 Callee
- 'channel', #10 Source IP
- 'dstchannel', #11 Destination IP
- 'userfield', #12 selector Tag
- '', #13 *service Tag
- '', #14 *announcement Tag
- '', #15 *route Table Tag
- '', #16 vTrunkGroup Tag
- '', #17 vTrunk Tag XXX ? another userfield?
- '', #18 *termination Tag
- '', #19 *location group Tag
- '', #20 *GK Originating IP
- '', #21 *GK Terminating IP
- '', #22 *GK Originating Domain
- '', #23 *GK Terminating Domain
- '', #24 Malicious Call (all 0)
- '', #25 Service (all 0)
- 'disposition', #26 Termination Cause 16/17/18/156
- '', #27 Simulation Call (all 0) supposedly don't bill 1
- '', #28 Type (all C)
- _cdr_date_parser_maker('enddate'), #29 ReleaseTimeStamp
- #seems empty from here in sampes...
- '', #30
- '', #31
- '', #32
- '', #33
- '', #34
- '', #35
- '', #36
- '', #37
- '', #38
- '', #39
- '', #40
- '', #41
- '', #42
- '', #43
- '', #44
- '', #45
- '', #46
- '', #47
- '', #48
- '', #49
- '', #50
-
- # * empty
- ],
-
-);
-
-sub _e164_parser_maker {
- my( $field, $pivot_field, %opt ) = @_;
- return sub {
- my( $cdr, $e164 ) = @_;
- my( $pivot, $number ) = _e164_parse($e164);
- if ( $opt{'norewrite_pivotonly'} && ! $pivot ) {
- $cdr->$pivot_field( $number );
- } else {
- $cdr->$field( $number );
- $cdr->$pivot_field( $pivot );
- }
- };
-}
-
-sub _e164_parse {
- my $e164 = shift;
-
- $e164 =~ s/^e164://;
-
- my ($pivot, $number);
- if ( $e164 =~ /^O(\d+)$/ ) {
- $pivot = ''; #?
- $number = $1;
- } elsif ( $e164 =~ /^000000(\d+)$/ ) {
- $pivot = '';
- $number = $1;
- } elsif ( $e164 =~ /^(1\d{5})(\d+)$/ ) {
- $pivot = $1;
- $number = $2;
- } else {
- $pivot = '';
- $number = $e164; #unparsable...
- }
-
- ( $pivot, $number );
-}
-
-1;
-
-=pod
-
- calldate - Call timestamp (SQL timestamp)
- clid - Caller*ID with text
- src - Caller*ID number / Source number
- dst - Destination extension
- dcontext - Destination context
- channel - Channel used
- dstchannel - Destination channel if appropriate
- lastapp - Last application if appropriate
- lastdata - Last application data
- startdate - Start of call (UNIX-style integer timestamp)
- answerdate - Answer time of call (UNIX-style integer timestamp)
- enddate - End time of call (UNIX-style integer timestamp)
- duration - Total time in system, in seconds
- billsec - Total time call is up, in seconds
- disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
- amaflags - What flags to use: BILL, IGNORE etc, specified on a per
- channel basis like accountcode.
- accountcode - CDR account number to use: account
- uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
- userfield - CDR user-defined field
- cdr_type - CDR type - see FS::cdr_type (Usage = 1, S&E = 7, OC&C = 8)
- charged_party - Service number to be billed
- upstream_currency - Wholesale currency from upstream
- upstream_price - Wholesale price from upstream
- upstream_rateplanid - Upstream rate plan ID
- rated_price - Rated (or re-rated) price
- distance - km (need units field?)
- islocal - Local - 1, Non Local = 0
- calltypenum - Type of call - see FS::cdr_calltype
- description - Description (cdr_type 7&8 only) (used for
- cust_bill_pkg.itemdesc)
- quantity - Number of items (cdr_type 7&8 only)
- carrierid - Upstream Carrier ID (see FS::cdr_carrier)
- upstream_rateid - Upstream Rate ID
- svcnum - Link to customer service (see FS::cust_svc)
- freesidestatus - NULL, done (or something)
- cdrbatch
-
-No. Field Type/Length Format / Remarks Description Example
-00 SU Identifier String This field is never empty. SU Identifier (as defined by su- su01
- <= 16 chars core.ini/[SU]/SUInstance key at SU
- 192.168.121.1
- initialization).
- By default, the SUInstance is set to
- a string that represents the SU
- private IP address.
-01 SU IP address String ipv4:xx.xx.xx.xx<:port> SU IP address (and ASM port) as ipv4:213.56.136.29: 2518
- <= 26 chars provided by su-
- This field is never empty.
- crouting.ini/[crRouting]/localASMa
- ddress key.
-02 Conference ID String When [CDR_FIELDS] Unique call session identifier Advised format
- <= 64 chars ReadlIDFormat is set to 1 in provided by the SU, as received in (ReadlIDFormat=1):
- ncx-cdr-wrapper.ini (advised call initiation message (H.225 910a4b12 cd67d93f
- format): conferenceID field in Setup or 4300abd2 cc10a0a0
- ARQ).
- 4x4 bytes as an hexadecimal RealIDFormat=0:
- string; double words are
- 12.123.54.125.67.235.255.2
- space-separated
- 31.9.12.4.3.7.19.245.65
- When [CDR_FIELDS]
- ReadlIDFormat is set to 0 in
- ncx-cdr-wrapper.ini:
- 16xdecimal notation of a 1-
- byte number (0..255), dot-
- separated.
- This field is never empty.
-03 Call ID String When [CDR_FIELDS] Call identifier provided by the ASM Advised format
- <= 64 chars ReadlIDFormat is set to 1 in in the SU (it can be the CallID or (ReadlIDFormat=1):
- ncx-cdr-wrapper.ini (advised the RealCallID according to what is 910a4b12 cd67d93f
- format): set in the ncx-cdr-wrapper.ini 4300abd2 cc10a0a0
- UseRealCallID field). It is received
- 4x4 bytes as an hexadecimal RealIDFormat=0:
- in call initiation message (H.225
- string; double words are
- callID field in Setup or ARQ). 12.123.54.125.67.235.255.2
- space-separated
- 31.9.12.4.3.7.19.245.65
- When [CDR_FIELDS]
- ReadlIDFormat is set to 0 in
- ncx-cdr-wrapper.ini:
- 16xdecimal notation of a 1-
- byte number (0..255), dot-
- separated.
- This field may be empty if no
- H.225 callID is present in
- ARQ.
-04 Leg number Integer Always set to 0 when the call Call attempt index, starting at 0. 0
- ~ 1 char is not deflected. Incremented whenever a call leg
- to a new destination is created.
- This field is never empty.
- A single call without any call
- forward service will only have 1
- CDR line, whose Leg number is set
- to 0.
- If a call is redirected (on
- CFU/CFB/CNFR), it will generate a
- second CDR line, leg number 1.
- The leg number is then
- incremented on each subsequent
- redirection.
-
-05 Authorize Long It can have two formats as Authorize date and time of the call 1039189431
- timestamp 10 chars given in the ncx-cdr- leg => enable to have a date and
- wrapper.ini by the time if a call is not connected.
- TimestampFormat field. UTC.
- If TimestampFormat is set to This is the ARQ or SETUP or
- 0, the result string INVITE reception timestamp for
- corresponds to the "epoch" the first call leg. For next tickets,
- time, the number of elapsed this is the call deflection processing
- seconds since 1970/01/01 start time. Thus, this value may
- 00:00:00 (UTC) vary in tickets related to a
- complete call.
- If TimestampFormat is set to
- 1, the result string is 20 chars
- in length (format: YYYY-MM-
- DD HH:MM:SS)
- NOTE: if you choose
- TimestampFormat = 0 you
- can have the tenth of second
- (UseTenthOfSecond = 1) or
- the micro second
- (UseMicroSecond = 1)
- NOTE: you can hide
- timestamp equal to 0 (or
- 1970/01/01 00:00:00) with
- the key HideNullTimestamp
- set to 1.
- This field is never empty.
-06 Start timestamp Long It can have two formats as Starting date and time of the call 1039189431
- 10 chars given in the ncx-cdr- leg. UTC.
- wrapper.ini by the
- This is the CONNECT or OK (after
- TimestampFormat field.
- INVITE) reception timestamp. It is
- If TimestampFormat is set to set to the same value for all tickets
- 0, the result string related to a call.
- corresponds to the "epoch"
- time, the number of elapsed
- seconds since 1970/01/01
- 00:00:00 (UTC)
- If TimestampFormat is set to
- 1, the result string is 20 chars
- in length (format: YYYY-MM-
- DD HH:MM:SS)
- 0 (or 1970/01/01 00:00:00)
- means the connection was not
- established for this call leg.
- NOTE: if you choose
- TimestampFormat = 0 you
- can have the tenth of second
- (UseTenthOfSecond = 1) or
- the micro second
- (UseMicroSecond = 1)
- NOTE: you can hide
- timestamp equal to 0 (or
- 1970/01/01 00:00:00) with
- the key HideNullTimestamp
- set to 1.
- This field may be empty if the
- call is not connected.
-07 Duration Long In seconds (0 means the Duration of the call leg (in 6
- <= 10 chars connection was not seconds), after the connection was
- established for this call leg). established.
- NOTE: you can have the tenth Set to 0 for SIP NOTIFICATION
- of second (UseTenthOfSecond and SIP MESSAGE reports.
- = 1) or the micro second
- (UseMicroSecond = 1)
- This field is never empty.
-08 Caller String e164:[number] or h323:[alias] Main Source Alias in pivot format e164:0010033575
- or email:[alias] (provided by the ASM)
- <= 128 chars
- This field may be empty if the If pivot format cannot be
- Caller pivot alias cannot be computed then the main source
- computed. alias is presented in originating
- format and the "O" char is inserted
- See Use Cases section for
- at the beginning of the alias or
- possible cases.
- number.
- NOTE: the phone-context and
- trunk-context are set if present.
-09 Callee String e164:[number] or h323:[alias] E.164 Called Party Number alias or e164:0010033762
- or email:[alias] H323 destination ID in pivot
- <= 128 chars
- format (provided by the ASM)
- This field may be empty if the
- Callee pivot alias cannot be If pivot format cannot be
- computed. computed then the originating
- format is presented and the "O"
- char is inserted at the beginning of
- the alias or number.
- NOTE: the phone-context and
- trunk-context are set if present.
-10 Source IP String ipv4:xx.xx.xx.xx<:port> If ncx-cdr-wrapper.ini/useFullIP = ipv4:192.168.1.2:34123
- 0:
- <= 26 chars This field may be empty if the
- Source IP cannot be retrieved Source IP address of the caller, as
- in IP message mode. used for IP filtering (thus, may be
- either Packet IP address or
- CallSignalAddress, depending on
- su-
- crouting.ini/[defaultH323Parameter
- s]/ipFiltering key
- It can also be changed by the
- selector "extended actions"
- parameter. See "selector extended
- actions" dedicated documentation
- for further information.
- If ncx-cdr-wrapper.ini/useFullIP =
- 1:
- Source IP packet address for the
- call leg
-11 Destination IP String ipv4:xx.xx.xx.xx<:port> If ncx-cdr-wrapper.ini/useFullIP = ipv4:213.56.162.17
- 0:
- <= 26 chars This field may be empty if
- destination IP cannot be Destination IP signaling address
- resolved. for the call leg
- If ncx-cdr-wrapper.ini/useFullIP =
- 1:
- Destination IP packet address for
- the call leg
- NOTE: Can be different from the
- signaling address when routing
- through a proxy group. This field
- refers to the proxy IP address.
- Otherwise IP signaling address and
- IP packet address are the same.
-12 selector Tag String This field is empty for non Extensible tag. See extension tag in=33231412345,vp=165,si
- <= 199 chars Business Services managed format below. =123 tz=Europe/Berlin,
- sources and for Sites with no
- Selector Tag placed on the selector
- PSTN ranges allocated.
- for this call
- See [ref: 2] and [ref: 3] for further
- 2 2
- information.
-13 service Tag Full alphanumeric This field is empty for now. Service Tag placed on the selector
- string or on the vTrunkGroup for this call.
- See [ref: 2] and [ref: 3] for further
- 2
- information.
-14 announcement Full alphanumeric This field is empty for now. Announcement Tag placed on the
- Tag string selector, routeTable or
- vTrunkGroup for this call.
- See [ref: 2]and [ref: 3] for further
- 2
- information.
-15 route Table Tag Full alphanumeric This field is empty for now. Route table Tag placed on the
- string route table for this call.
- See [ref: 2] and [ref: 3] for further
- 2 2
- information.
-16 vTrunkGroup Full alphanumeric This field is empty for now. vTrunkGroupTag placed on the
- Tag string vTrunkGroup for this call.
- See [ref: 2] and [ref: 3] for further
- 2
- information.
-17 vTrunk Tag String This field is empty for non Extensible tag. See extension tag in=33156341289,vp=4232,s
- <= 199 chars Business Services managed format below. i=132,tz=Europe/Paris
- destinations and for Sites with
- vTrunk Tag placed on the vTrunk
- no PSTN ranges allocated.
- for this call.
- See [ref: 2] and [ref: 3] for further
- 2 2
- information.
-18 termination Tag Full alphanumeric This field is empty for now. Termination Tag placed on the
- string Termination for this call.
- See [ref: 2] and [ref: 3] for further
- 2 2
- information.
-19 location group Full alphanumeric This field is empty for now. location group Tag placed on the
- Tag string selector for this call.
- See [ref: 2] and [ref: 3] for further
- 2 2
- information.
-20 GK Originating Full alphanumeric This field is empty for now. Parameter provided by the ASM in
- IP string the SU (reserved for future usage).
-21 GK Terminating Full alphanumeric This field is empty for now. Parameter provided by the ASM in
- IP string the SU (reserved for future usage).
-22 GK Originating Full alphanumeric This field is empty for now. Parameter provided by the ASM in
- Domain string the SU (reserved for future usage).
-23 GK Terminating Full alphanumeric This field is empty for now. Parameter provided by the ASM in
- Domain string the SU (reserved for future usage).
-24 Malicious Call Boolean 0/1 Indicate if a call is malicious or 0
- not. All calls to a specific called
- 1 char
- party will be tagged as malicious
- when the malicious feature has
- been activated.
-25 Service Long 0..31 Bit mask for activated services for 6: at least one
- <= 3 chars this call. TECHNOLOGY and one
- This field is never empty.
- REMOVE service objects
- This is a combination between the
- have been used during
- following values:
- routing process
- 1: if at least one CLIR service
- 10: at least one BASIC-
- object has been used during
- XACTION and one REMOVE
- routing process
- service objects have been
- 2: if at least one REMOVE service used during routing process
- object has been used during
- routing process
- 4: if at least one TECHNOLOGY
- service object has been used
- during routing process
- 8: if at least one BASIC-XACTION
- service object has been used
- during routing process
- 16: if at least one SUBSTITUTION
- service object has been used
- during routing process
- This is independent from the su-
- crouting.ini configuration file and
- in particular from the SPE
- activation.
-26 Termination Long Causes in the range [1-127] Cause of the call termination. 16
- Cause <= 3 chars are standard Q.850 causes
- Causes >= 128 are specific
- Comverse extension causes.
- See [ref. 5] for possible values
- and meanings.
- This field is never empty.
-27 Simulation Call Boolean 0/1 Indicates if a call is a simulation 0
- 1 char call or not.
- This field is never empty.
- SIMULATION CALLS MUST NOT BE
- BILLED.
- Simulation calls can only be
- generated through the Telnet
- interface (tests and diagnostic
- only).
-28 Type One character Optional field depending on Type of CDR: C
- the UseType entry in ncx-cdr-
- 1 char - Call ('C'): for INVITE and SETUP
- wrapper.ini. If set to 1, a
- value in this field will be - Notification ('N') for SIP
- always printed: 'C' by default. NOTIFICATION
- 'C', 'N' or 'M'. - Message ('M') for SIP MESSAGE
- This field is never empty.
-29 ReleaseTimeSta Long Optional field depending of Release date of the leg. 1039189431
- mp 10 chars the UseReleaseTimeStamp
- entry in ncx-cdr-wrapper.ini.
- It can have two formats as
- given in the ncx-cdr-
- wrapper.ini by the
- TimestampFormat field.
- If TimestampFormat is set to
- 0, the result string
- corresponds to the "epoch"
- time, the number of elapsed
- seconds since 1970/01/01
- 00:00:00 (UTC)
- If TimestampFormat is set to
- 1, the result string is 20 chars
- in length (format: YYYY-MM-
- DD HH:MM:SS)
- NOTE: if you choose
- TimestampFormat = 0 you
- can have the tenth of second
- (UseTenthOfSecond = 1) or
- the micro second
- (UseMicroSecond = 1)
- NOTE: you can hide
- timestamp equal to 0 (or
- 1970/01/01 00:00:00) with
- the key HideNullTimestamp
- set to 1.
- This field is empty when no
- CRR message is received and
- therefore it will be empty for
- the CDR describing presence
- message (SIP NOTIFY and SIP
- MESSAGE). It is also empty
- when the CDR is closed by the
- AMU (e.g. if the SU is
- detected as DOWN).
- In all other cases, this field is
- never empty
-30 cgIdentity Tag Full alphanumeric Optional: this field is filled if Extensible tag for Calling Party. pu=33231345123,pr=23
- string usecgidentitytag is set to 1 in See extension tag format below.
- <= 132 chars ncx-cdr-wrapper.ini.
- This field is empty for non
- Business Services/class V
- managed sources.
- The content of this field differs
- between BS and MyCall
- solutions.
-31 cdIdentity Tag Full alphanumeric Optional: this field is filled if Extensible tag for Called Party. See pr=1111,bi=ADMIN
- string usecdidentitytag is set to 1 in extension tag format below.
- <= 132 chars ncx-cdr-wrapper.ini
- This field is empty for non
- Business Services/class V
- managed destinations.
- The content of this field differs
- between BS and MyCall
- solutions.
-32 Originating String Optional: this field is filled if E.164 Main Source alias or H323 e164:0010033575
- Caller <= 128 chars useoriginatingcaller is set to 1 source ID in originating format (as
- in ncx-cdr-wrapper.ini received from the network)
- e164:[number] or h323:[alias] The Main Source alias is computed
- or email:[alias] according to su-core.ini
- configuration.
- NOTE: the phone-context and
- trunk-context are set if present.
-33 Originating String Optional: this field is filled if E.164 Main Destination alias or e164:0010033762
- Callee <= 128 chars useoriginatingcallee is set to 1 H323 destination ID in originating
- in ncx-cdr-wrapper.ini format (as received from the
- network)
- e164:[number] or h323:[alias]
- or email:[alias] The Main Destination alias is
- computed according to su-core.ini
- configuration.
- NOTE: the phone-context and
- trunk-context are set if present.
-34 Terminating String Optional: this field is filled if E.164 Calling Party Number alias or e164:0010033575
- Caller <= 128 chars useterminatingcaller is set to 1 H323 source ID in terminating
- in ncx-cdr-wrapper.ini format (as provided to the
- network).
- e164:[number] or h323:[alias]
- or email:[alias] NOTE: the phone-context and
- trunk-context are set if present.
-35 Terminating String Optional: this field is filled if E.164 Called Party Number alias or e164:0010033762
- Callee <= 128 chars useterminatingcallee is set to H323 destination ID in terminating
- 1 in ncx-cdr-wrapper.ini. format (as provided to the
- network).
- e164:[number] or h323:[alias]
- or email:[alias] NOTE: the phone-context and
- trunk-context are set if present.
- This field may be empty if no
- terminating destination aliases
- can be computed by the CRE
- (missing vtrunk transformation
- or unable to found a vtrunk
- for whatever routing reason),
- or if the pivot to terminating
- destination alias
- transformation leads to an
- empty alias.
-36 Network Long Optional: this field is filled if For H.323 the network timestamp 1039189431
- Timestamp 10 chars usenetworkcompletiontimesta is measured at the first Progress or
- mp is set to 1 in ncx-cdr- ALERT or CONNECT received by
- wrapper.ini. the CCS for direct call.
- For redirected call, the network
- It can have two formats as
- timestamp is measured by the
- given in the ncx-cdr-
- CCS at the redirection decision
- wrapper.ini by the
- point,
- TimestampFormat field.
- NOTE: For H.323 calls, the tcp-ack
- If TimestampFormat is set to
- of the outgoing TCP connection is
- 0, the result string
- not considered in the measure of
- corresponds to the "epoch"
- network timestamp
- time, the number of elapsed
- seconds since 1970/01/01 For SIP the network timestamp is
- 00:00:00 (UTC) measured at the first SESSION
- PROGRESS or RINGING or OK
- If TimestampFormat is set to
- received by the CCS for direct call.
- 1, the result string is 20 chars
- in length (format: YYYY-MM- The network timestamp is
- DD HH:MM:SS) measured at the redirection
- decision point for redirected call.
- NOTE: if you choose
- TimestampFormat = 0 you
- can have the tenth of second
- (UseTenthOfSecond = 1) or
- the micro second
- (UseMicroSecond = 1)
- NOTE: you can hide
- timestamp equal to 0 (or
- 1970/01/01 00:00:00) with
- the key HideNullTimestamp
- set to 1.
- This field may be empty if the
- callee does not answer.
-37 Targeted Integer Optional: this field is filled if Provides information on the 12
- adaptor UseTargetedAdaptors is set to adaptor that has been used: "1"
- <= 2 chars
- 1 in ncx-cdr-wrapper.ini. for adaptor1, "2" for adaptor2 and
- "12" for adaptor1 and adaptor2
- "1", "2" or "12"
- See the amu-core.ini file section
- for further details on adaptors
- definition.
-38 Adaptor1 errors String Optional: this field is filled if Report errors on adaptor1 at the cra,crr
- UseAdaptor1Errors is set to 1 adaptor API level.
- <= 15 chars
- in ncx-cdr-wrapper.ini.
- "nca" (error on the new call
- authorize)
- "cra" (error on the call re-
- authorize)
- "ncr" (error on the new call
- report)
- "crr" (error on the call release
- report)
- When several errors occurred,
- comma separated notation will
- be used.
- Empty when no error has
- been detected.
-39 Source signaling String Optional: this field is filled in Source IP signaling address for the ipv4:192.168.1.2:34123
- IP only if useFullIP is set to 1 in call leg.
- <= 26 chars
- the ncx-cdr-wrapper.ini file.
- It can be changed by the selector
- ipv4:xx.xx.xx.xx<:port> "extended actions" parameter. See
- "selector extended actions"
- This field may be empty if the
- dedicated documentation for
- Source IP cannot be retrieved
- further information.
- in IP message mode.
-40 Destination String Optional: this fields is filled in Destination IP signaling address ipv4:213.56.162.17
- signaling IP only if useFullIP is set to 1 in for the call leg
- <= 26 chars
- ncx-cdr-wrapper.ini file.
- ipv4:xx.xx.xx.xx<:port>, can
- be empty if destination IP
- cannot be resolved.
-41 Source point Unsigned integer Optional: this field is filled in SS7 point code, node identifier 1234
- code only if usePC is set to 1 in the
- <= 5 chars
- ncx-cdr-wrapper.ini file.
- SIP: FROM header [TG-TEL]:
- PC is Encoded in the trunk-
- group part of a "tel" URI
- extension (see also RFC
- 3966).
- H.323: H.225/circuitInfo:
- Encoded in an
- sourceCircuitID.cic.pointCode.
-42 Destination point Unsigned integer Optional: this field is filled in SS7 point code, node identifier 1234
- code only if usePC is set to 1 in the
- <= 5 chars
- ncx-cdr-wrapper.ini file.
- SIP: TO header [TG-TEL]: PC
- is encoded in the trunk-group
- part of a "tel" URI extension
- (see also RFC 3966).
- H.323: H.225/circuitInfo:
- Encoded in a
- destinationCircuitID.cic.pointC
- ode.
-43 Origination tag Full alphanumeric Optional: this field is filled in Origination tag placed on the crr=...,poi=...
- string only if useOriginationTag is origination for this call.
- set to 1 in the ncx-cdr-
- wrapper.ini file.
-44 Proxy group tag Full alphanumeric Optional: this field is filled in Proxy group Tag placed on the
- string only if useProxyGroupTag is proxy group for this call.
- set to 1 in the ncx-cdr-
- wrapper.ini file.
- This field is empty for now.
-45 Advice of Charge String Optional: this field only is filled AOC received. rend=10.2,unit=EURO
- in if UseAoc is set to 1 in ncx-
- <= 50 chars cdr-wrapper.ini file. Available with CCS 3.8.4.
- This field may be empty if
- AOC service is not used or if
- no AOC value is available.
- <aocType>=<amount>,unit=
- <string> with:
- 1. <aocType> (max length:
- 7 chars):
- Received AOC-D: 'rduring'
- Received AOC-E, 'rend'
- Other AOC types are not yet
- supported by the su-core and
- therefore are ignored.
- 2. <amount> (max length:
- 14 chars):
- The amount is decoded from
- the received AOC-D or AOC-E.
- This value is mandatory in an
- AOC.
- 3. unit=<string> (max length:
- 15 chars):
- The unit string is the decoded
- unit value in the received
- AOC-D or AOC-E. This value is
- mandatory in an AOC.
-46 Routing Context String Optional Routing context of the leg. basic
- <= 5 chars 3 possible values: For IMS calls, routing context has
- the value "orig" or "term".
- - basic Otherwise, it is set to "basic".
- - orig
- Dependencies:
- - term
- - amu-core-4.8.0
- - adaptor-generic-cdr-
- 1.8.0
- - ncx-cdr-wrapper-1.8.0
-47 Originating String Optional: this field is filled if E164 Main Source alias or H323 e164:33762
- Original Caller <= 128 chars useoriginatingoriginalcaller is source ID in originating format (as
- set to 1 in ncx-cdr- received from the network) of the
- wrapper.ini. original caller.
- e164:[number] or h323:[alias] The main source alias is computed
- or email:[alias] according to su-core.ini
- configuration.
- NOTE: the phone-context and
- trunk-context are set if present.
- Dependencies:
- - amu-core-4.10.0
- - adaptor-generic-cdr-
- 1.10.0
- - ncx-cdr-wrapper-1.10.0
-48 Pivot Original String Optional: this field is filled if E164 Main Source alias or H323 E164:0010033762
- Caller <= 128 chars usepivotoriginalcaller is set to source ID in pivot format (as
- 1 in ncx-cdr-wrapper.ini. received from the network) of the
- original caller
- e164:[number] or h323:[alias]
- or email:[alias] They are sent if present by SU if
- su-
- crouting.ini/[compatibility]/aliasRe
- porting is 5_0_0 or greater
- NOTE: the phone-context and
- trunk-context are set if present.
- Dependencies:
- - amu-core-4.10.0
- - adaptor-generic-cdr-
- 1.10.0
- - ncx-cdr-wrapper-1.10.0
-49 Terminating String Optional: this field is filled if E164 Main Source alias or H323 E164:0010033762
- Original Caller <= 128 chars useterminatingoriginalcaller is source ID in terminating format (as
- set to 1 in ncx-cdr- received from the network) of the
- wrapper.ini. original caller.
- e164:[number] or h323:[alias] They are sent if present by SU if
- or email:[alias] su-
- crouting.ini/[compatibility]/aliasRe
- porting is 5_0_0 or greater
- NOTE: the phone-context and
- trunk-context are set if present.
- Dependencies:
- - amu-core-4.10.0
- - adaptor-generic-cdr-
- 1.10.0
- - ncx-cdr-wrapper-1.10.0
-50 Pivotclir Boolean Optional: this field is filled if Pivot CLIR calculated with caller clir=0
- UsePivotClir is set to 1 in ncx- information.
- 6 chars cdr-wrapper.ini.
- Dependencies:
- 0 means that Calling Line
- Identification is showed. - amu-core-4.12.0
- 1 means that Calling Line - adaptor-generic-cdr-
- Identification is hidden. 1.12.0
- - ncx-cdr-wrapper-1.12.0
-
diff --git a/FS/FS/cdr/nextone.pm b/FS/FS/cdr/nextone.pm
deleted file mode 100644
index 22e6e86..0000000
--- a/FS/FS/cdr/nextone.pm
+++ /dev/null
@@ -1,26 +0,0 @@
-package FS::cdr::nextone;
-
-use strict;
-use vars qw(@ISA %info);
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'Nextone',
- 'weight' => 200,
- 'header' => 1,
- 'import_fields' => [
- 'userfield', #CallZoneData ???userfield
- 'channel', #OrigGw
- 'dstchannel', #TermGw
- sub { my( $cdr, $duration ) = @_;
- $cdr->duration($duration);
- $cdr->billsec($duration); }, #Duration
- 'dst', #CallDTMF
- 'src', #Ani
- 'startdate', #DateTimeInt
- ],
-);
-
-1;
diff --git a/FS/FS/cdr/openser.pm b/FS/FS/cdr/openser.pm
deleted file mode 100644
index 87fb822..0000000
--- a/FS/FS/cdr/openser.pm
+++ /dev/null
@@ -1,24 +0,0 @@
-package FS::cdr::openser;
-
-use strict;
-use vars qw(@ISA %info);
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'OpenSER',
- 'weight' => 15,
- 'header' => 1,
- 'import_fields' => [
- _cdr_date_parser_maker('startdate'),
- _cdr_date_parser_maker('enddate'),
- 'src',
- 'dst',
- 'duration',
- 'channel',
- 'dstchannel',
- ],
-);
-
-1;
diff --git a/FS/FS/cdr/sansay.pm b/FS/FS/cdr/sansay.pm
deleted file mode 100644
index 8087c57..0000000
--- a/FS/FS/cdr/sansay.pm
+++ /dev/null
@@ -1,408 +0,0 @@
-package FS::cdr::sansay;
-
-use strict;
-use base qw( FS::cdr );
-use vars qw( %info );
-use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker );
-
-%info = (
- 'name' => 'Sansay VSX',
- 'weight' => 135,
- 'header' => 0, #0 default, set to 1 to ignore the first line, or
- # to higher numbers to ignore that number of lines
- 'type' => 'csv', #csv (default), fixedlength or xls
- 'sep_char' => ';', #for csv, defaults to ,
- 'disabled' => 0, #0 default, set to 1 to disable
-
-
- #listref of what to do with each field from the CDR, in order
- 'import_fields' => [
-
- # "Header" (I do not think this means what you think it means)
- #002452502;V1.10;R;
-
- # Record Sequence Number 9 Unique identification of this record
- 'uniqueid',
-
- '', #Version Number 5 Format version number of records to follow
- # "V1.10"
- '', #Record Type 1 Type of CDR being generated
- # R ­ Normal CDR record, A - Audit
-
- # "Body"
- #WithMedia;181-1071459514@192.188.0.28;0001;Mon Dec 15 11:38:34 2003;Mon Dec 15 11:38:41 2003;Mon Dec 15 11:38:48 2003;480;EndedByRemoteUser;3;T;000200;H323;;192.188.0.38;9001;192.188.0.28;f0faff54-2e6c-11d8-8c4b-bd4d562c2265;192.188.0.38;18044;192.188.0.28;10756;G.729b;240;460;6066;14060;0;0;0;000200;H323;;192.188.0.28;8811;192.188.0.38;e83af3d3-1d2d-d811-9f98-003048424934;192.188.0.38;19236;192.188.0.28;10758;G.729b;460;240;14060;6066;0;0;0;F;9001;305;2;15;305000;00000011 44934567 45231267 2300BCC0;8587542200;
-
- '', #ConnectionType 16 Type of connection : Media or No Media
- '', #SessionID 32 Unique ID assigned to the call by
- # SSM subsystem
- '', #XXX #Release Cause 4 2.4 Internal process Release Cause
-
- #Cause Code Descriptions
- #01 Normal answered call
- #02 No Answer, tear down by originator
- #03 No answer, tear down by the termination
- #04 NORMAL_NO_ANSWER, tear down by
- # system
- #402 Service Not Available
- #403 Termination capability un-compatible
- #404 Outbound digit translation failed
- #405 Termination reject for some other reasons
- #406 Termination Route is blocked
- #500 Originator is not in the Authorized list
- # (source verification failed)
- #501 Origination digit translation failed
- #502 Origination direction is not bi-directional or
- # inbound
- #503 Origination is not in service state
- #600 Max system call handling reached
- #601 System reject call
- #602 System outbound digit translation error
- # (maybe invalid configuration)
- #603 System inbound digit translation error
- # (Maybe invalid configuration)
-
-
- #Start Time of Date 32 Indicates Time of Date when the call
- # entered the system
- _cdr_date_parser_maker('startdate'),
-
- #Answer Time of Date 32 Indicates TOD when the call was
- # answered
- _cdr_date_parser_maker('answerdate'),
-
- #Release TOD 32 Indicates the TOD when the call was
- # disconnected
- _cdr_date_parser_maker('enddate'),
-
- #Minutes West of 32 Minutes West of Greenwich Mean
- #Greenwich Mean Time Time. Used to calculate the time
- # zone.
- '', #XXX use this
-
- #Release Cause from 32 Release cause string from either H323
- #Protocol Stack or SIP protocol stack
- #4. Release Cause String (Field #8 in CDR)
- #- a string of text further identifying the teardown circumstance from terminating protocol message.
- '',
-
- #Binary Value of Release 4 Binary value of the protocol release
- #Cause from Protocol cause
- #stack
- #
- #3. Release Cause from Stack ( Field # 9 in CDR)
- #- an integer value based on the releasing dialogues protocol.
- # a. For a H.323 call leg originated release it will be the real Q.931 value received from the far
- # side.
- #Some of the Q.931 release causes;
- #3: No route to destination
- #16; Normal Clearing
- #17: User Busy
- #19: NO Answer from User
- #21; Call Rejected
- #28: Address Incomplete
- #34: No Circuit Channel Available
- #....
- # b. For a SIP call leg originated release, it's a RFC 3261 release cause value received from the
- # far side.
- #The following is the list that VSX generated if certain event happen:
- #"400 Parse Failed" - Malformed Message
- #"405 Method Not Allowed" - Unsupported Method
- #"480 Temporarily Unavailable" - Overload Throttle Rejection, Max Sessions
- #Exceeded, Demo License Expired, Capacity Exceeded on Route, Radius Server Timeout
- #"415 No valid codec" - No valid codec could be supported between origination and
- #term call legs.
- #"481 Transaction Does Not Exist" - Unknown Transaction or Dialog
- #"487 Transaction Terminated" - Origination Cancel
- #"488 ReInvite Rejected" - Relay of ReInvite was Rejected
- #"504 Server Time-out" - Internal VSX Failure
- #"500 Sequence Out of Order" - CSeq counter violation
- # c. For a VSX system originated release, it an internal release cause for teardown.
- #If the VSX initiates a call teardown, the following cause values and strings are written into the CDR:
- #999, "Demo Licence Expired!"
- #999, "VSX Capacity Exceeded"
- #999, "VSX Operator Reset"
- #999, "Route Rejected"
- #999, "Radius Rejected"
- #999, "Radius Access Timeout"
- #999, "Gatekeeper Reject"
- #999, "Enum Server Reject"
- #999, "Enum Server Timeout"
- #999, "DNS Server Reject"
- #999, "DNS/GK Timeout"
- #999, "Could not allocate media"
- #999, "No Response to INVITE"
- #999, "Ring No Answer Timeout"
- #999, "200 OK Timeout"
- #999, "Maximum Duration Exceeded"
- #987, "Termination Capacity Exceeded"
- #987, "Origination Capacity Exceeded"
- #987, "Term CPS Capacity Exceeded"
- #987, "Orig CPS Capacity Exceeded"
- #987, "Max H323 Legs Exceeded"
- '',
-
- #1st release dialogue 1 O: origination, T: termination
- #2. 1st Release Dialogue ( Field #10 in CDR)
- #- one character value identifying the side of the call that i
- # ,,O ­ origination initiated the teardown.
- # ,,T ­ termination initiated the teardown.
- # ,,N ­ the VSX internally initiated the teardown.
- '',
-
- #Trunk ID -- Origination 6 TrunkID for origination GW(resources)
- 'accountcode', # right? # use cdr-charged_party-accountcode
-
- #VoIP Protocol - Origination 6 VoIP protocol for origination dialogue
- '',
-
- #Origination Source Number 128 Source Number in Origination Dialogue
- 'src',
-
- #Origination Source Host Name 128 FQDN or IP address for Source GW in Origination Dialogue
- 'channel',
-
- #Origination Destination Number 128 Destination Number in Origination
- #Dialogue
- 'dst',
-
- #Origination Destination Host Name 128 FQDN or IP address for Destination
- #GW in Origination Dialogue
- 'dstchannel',
-
- #Origination Call ID 128 Unique ID for the origination dialogue(leg)
- '', #'clid', #? that's not really the same call ID
-
- #Origination Remote 16 Remote Payload IP address for
- # Payload IP origination dialogue
- # Address
- '',
-
- #Origination Remote 6 Remote Payload UDP address for
- # Payload UDP origination dialogue
- # Address
- '',
-
- #Origination Local 16 Local(SG) Payload IP address for
- # Payload IP origination dialogue
- # Address
- '',
-
- #Origination Local 6 Local(SG) Payload UDP address for
- # Payload UDP origination dialogue
- # Address
- '',
-
- #Origination Codec List 128 Supported Codec list( separated by
- # comma) for origination dialogue
- '',
-
- #Origination Ingress 10 Number of Ingress( into Sansay
- # Packets system) payload packets in
- # origination dialogue
- '',
-
- #Origination Egress 10 Number of Egress( out from Sansay
- # Packets system) payload packets in
- # origination dialogue
- '',
-
- #Origination Ingress 10 Number of Ingress( into Sansay
- # Octets system) payload octets in origination
- # dialogue
- '',
-
- #Origination Egress 10 Number of Egress( out from Sansay
- # Octets system) payload octets in origination
- # dialogue
- '',
-
- #Origination Ingress 10 Number of Ingress( into Sansay
- # Packet Loss system) payload packet loss in
- # origination dialogue
- '',
-
- #Origination Ingress 10 Average Ingress( into Sansay system)
- # Delay payload packets delay ( in ms) in
- # origination dialogue
- '',
-
- #Origination Ingress 10 Average of Ingress( into Sansay
- # Packet Jitter system) payload packet Jitter ( in ms)
- # in origination dialogue
- '',
-
- #Trunk ID -- Termination 6 Trunk ID for termination GW(resources)
- 'carrierid',
-
- #VoIP Protocol - 6 VoIP protocol from termination GW
- # Termination
- '',
-
- #Termination Source 128 Source Number in Termination
- # Number Dialogue
- '',
-
- #Termination Source Host 128 FQDN or IP address for Source GW
- # Name in Termination Dialogue
- '',
-
- #Termination Destination 128 Destination Number in Termination
- # Number Dialogue
- '',
-
- #Termination Destination 128 FQDN or IP address for Destination
- # Host Name GW in Termination Dialogue
- '',
-
- #Termination Call ID 128 Unique ID for the termination
- # dialogue(leg)
- '',
-
- #Termination Remote 16 Remote Payload IP address for
- # Payload IP termination dialogue
- # Address
- '',
-
- #Termination Remote 6 Remote Payload UDP address for
- # Payload UDP termination dialogue
- # Address
- '',
-
- #Termination Local 16 Local(SG) Payload IP address for
- # Payload IP termination dialogue
- # Address
- '',
-
- #Termination Local 6 Local(SG) Payload UDP address for
- # Payload UDP termination dialogue
- # Address
- '',
-
- #Termination Codec List 128 Supported Codec list( separated by
- # comma) for termination dialogue
- '',
-
- #Termination Ingress 10 Number of Ingress( into Sansay
- # Packets system) payload packets in
- # termination dialogue
- '',
-
- #Termination Egress 10 Number of Egress( out from Sansay
- # Packets system) payload packets in
- # termination dialogue
- '',
-
- #Termination Ingress 10 Number of Ingress( into Sansay
- # Octets system) payload octets in
- # termination dialogue
- '',
-
- #Termination Egress 10 Number of Egress( out from Sansay
- # Octets system) payload octets in
- # termination dialogue
- '',
-
- #Termination Ingress 10 Number of Ingress( into Sansay
- # Packet Loss system) payload packet loss in
- # termination dialogue
- '',
-
- #Termination Ingress 10 Average Ingress( into Sansay system)
- # Delay payload packets delay ( in ms) in
- # termination dialogue
- '',
-
- #Termination Ingress 10 Average of Ingress( into Sansay
- # Packet Jitter system) payload packet Jitter ( in ms)
- # in termination dialogue
- '',
-
- #Final Route Indication 1 F: Final Route Selection,
- # I: Intermediate Route Attempts
- '',
-
- #Routing Digits 64 Routing Digit (Digit after Inbound
- # translation, before Outbound
- # Translation). This may also be the
- # LRN if LNP feature is enabled
- '',
-
- #Call Duration in Second 6 Call Duration in Seconds. 0 if this is
- # failed call
- 'billsec',
-
- #Post Dial Delay in 6 Post dial delay (from call attempt to
- # Seconds ring). 0 if this is failed call
- '',
-
- #Ring Time in Second 6 Ring Time in Seconds. 0 if this is
- # failed call
- '',
-
- #Duration in milliseconds 10 Call duration in milliseconds.
- '',
-
- #Conf ID 36 Unique Conference ID for this call in
- # Cisco format
- '',
-
- #RPID/ANI 32 Inbound Remote Party ID line or
- # Proxy Asserted Identity if provided
- 'clid', #?
-
- ],
-
-);
-
-1;
-
-__END__
-
-list of freeside CDR fields, useful ones marked with *
-
-N/A acctid - primary key
-FILLED_IN *[1] calldate - Call timestamp (SQL timestamp)
-DONE clid - Caller*ID with text
-DONE * src - Caller*ID number / Source number
-DONE * dst - Destination extension
- dcontext - Destination context
-DONE channel - Channel used
-DONE dstchannel - Destination channel if appropriate
- lastapp - Last application if appropriate
- lastdata - Last application data
-DONE * startdate - Start of call (UNIX-style integer timestamp)
-DONE answerdate - Answer time of call (UNIX-style integer timestamp)
-DONE * enddate - End time of call (UNIX-style integer timestamp)
-* duration - Total time in system, in seconds
-DONE * billsec - Total time call is up, in seconds
-*[2] disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
- amaflags - What flags to use: BILL, IGNORE etc, specified on a per
- channel basis like accountcode.
-DONE *[3] accountcode - CDR account number to use: account
- uniqueid - Unique channel identifier
- userfield - CDR user-defined field
- cdr_type - CDR type - see FS::cdr_type (Usage = 1, S&E = 7, OC&C = 8)
-FILLED_IN *[4] charged_party - Service number to be billed
- upstream_currency - Wholesale currency from upstream
-*[5] upstream_price - Wholesale price from upstream
- upstream_rateplanid - Upstream rate plan ID
- rated_price - Rated (or re-rated) price
- distance - km (need units field?)
- islocal - Local - 1, Non Local = 0
-*[6] calltypenum - Type of call - see FS::cdr_calltype
- description - Description (cdr_type 7&8 only) (used for
- cust_bill_pkg.itemdesc)
- quantity - Number of items (cdr_type 7&8 only)
-DONE carrierid - Upstream Carrier ID (see FS::cdr_carrier)
- upstream_rateid - Upstream Rate ID
- svcnum - Link to customer service (see FS::cust_svc)
- freesidestatus - NULL, done (or something)
-
-[1] Auto-populated from startdate if not present
-[2] Package options available to ignore calls without a specific disposition
-[3] When using 'cdr-charged_party-accountcode' config
-[4] Auto-populated from src (normal calls) or dst (toll free calls) if not present
-[5] When using 'upstream_simple' rating method.
-[6] Set to usage class classnum when using pre-rated CDRs and usage class-based
- taxation (local/intrastate/interstate/international)
-
diff --git a/FS/FS/cdr/simple.pm b/FS/FS/cdr/simple.pm
deleted file mode 100644
index 197b0eb..0000000
--- a/FS/FS/cdr/simple.pm
+++ /dev/null
@@ -1,52 +0,0 @@
-package FS::cdr::simple;
-
-use strict;
-use vars qw( @ISA %info $tmp_mon $tmp_mday $tmp_year );
-use Time::Local;
-use FS::cdr qw(_cdr_min_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'Simple',
- 'weight' => 20,
- 'header' => 1,
- 'import_fields' => [
-
- # Date (MM/DD/YY)
- sub { my($cdr, $date) = @_;
- $date =~ /^(\d{1,2})\/(\d{1,2})\/(\d\d(\d\d)?)$/
- or die "unparsable date: $date"; #maybe we shouldn't die...
- #$cdr->startdate( timelocal(0, 0, 0 ,$2, $1-1, $3) );
- ($tmp_mday, $tmp_mon, $tmp_year) = ( $2, $1-1, $3 );
- },
-
- # Time
- sub { my($cdr, $time) = @_;
- #my($sec, $min, $hour, $mday, $mon, $year)= localtime($cdr->startdate);
- $time =~ /^(\d{1,2}):(\d{1,2}):(\d{1,2})$/
- or die "unparsable time: $time"; #maybe we shouldn't die...
- #$cdr->startdate( timelocal($3, $2, $1 ,$mday, $mon, $year) );
- $cdr->startdate(
- timelocal($3, $2, $1 ,$tmp_mday, $tmp_mon, $tmp_year)
- );
- },
-
- # Source_Number
- 'src',
-
- # Terminating_Number
- 'dst',
-
- # Duration
- _cdr_min_parser_maker, #( [qw( billsec duration)] ),
- #sub { my($cdr, $min) = @_;
- # my $sec = sprintf('%.0f', $min * 60 );
- # $cdr->billsec( $sec );
- # $cdr->duration( $sec );
- # },
-
- ],
-);
-
-1;
diff --git a/FS/FS/cdr/simple2.pm b/FS/FS/cdr/simple2.pm
deleted file mode 100644
index 2e4fb90..0000000
--- a/FS/FS/cdr/simple2.pm
+++ /dev/null
@@ -1,51 +0,0 @@
-package FS::cdr::simple2;
-
-use strict;
-use vars qw( @ISA %info $tmp_mon $tmp_mday $tmp_year );
-use Time::Local;
-use FS::cdr qw(_cdr_min_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'Simple (Prerated)',
- 'weight' => 25,
- 'header' => 1,
- 'import_fields' => [
- sub {}, #TEXT_TIME (redundant w/Time)
- sub {}, #Blank
- 'src', #Calling.
-
- #Date (YY/MM/DD)
- sub { my($cdr, $date) = @_;
- $date =~ /^(\d\d(\d\d)?)\/(\d{1,2})\/(\d{1,2})$/
- or die "unparsable date: $date"; #maybe we shouldn't die...
- #$cdr->startdate( timelocal(0, 0, 0 ,$3, $2-1, $1) );
- ($tmp_mday, $tmp_mon, $tmp_year) = ( $4, $3-1, $1 );
- },
-
- #Time
- sub { my($cdr, $time) = @_;
- $time =~ /^(\d{1,2}):(\d{1,2}):(\d{1,2})$/
- or die "unparsable time: $time"; #maybe we shouldn't die...
- #$cdr->startdate( timelocal($3, $2, $1 ,$mday, $mon, $year) );
- $cdr->startdate(
- timelocal($3, $2, $1 ,$tmp_mday, $tmp_mon, $tmp_year)
- );
- },
-
- 'dst', #Dest
- 'userfield', #? #DestinationDesc
-
- #Min
- _cdr_min_parser_maker, #( [qw( billsec duration)] ),
-
- sub {}, #Rate XXX do something w/this, informationally???
- 'upstream_price', #Total
-
- 'accountcode', #ServCode
- 'description', #Service_Type
- ],
-);
-
-
diff --git a/FS/FS/cdr/taqua.pm b/FS/FS/cdr/taqua.pm
deleted file mode 100644
index 26c0bda..0000000
--- a/FS/FS/cdr/taqua.pm
+++ /dev/null
@@ -1,190 +0,0 @@
-package FS::cdr::taqua;
-
-use strict;
-use vars qw(@ISA %info $da_rewrite);
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'Taqua',
- 'weight' => 130,
- 'header' => 1,
- 'import_fields' => [ #some of these are kind arbitrary...
-
- #0
- #RecordType
- sub {
- my($cdr, $field, $conf, $hashref) = @_;
- $hashref->{skiprow} = 1 unless ($field == 0 && $cdr->disposition == 100);
- $cdr->cdrtypenum($field);
- },
-
- sub { my($cdr, $field) = @_; }, #all10#RecordVersion
- sub { my($cdr, $field) = @_; }, #OrigShelfNumber
- sub { my($cdr, $field) = @_; }, #OrigCardNumber
- sub { my($cdr, $field) = @_; }, #OrigCircuit
- sub { my($cdr, $field) = @_; }, #OrigCircuitType
- 'uniqueid', #SequenceNumber
- 'accountcode', #SessionNumber
- 'src', #CallingPartyNumber
- #'dst', #CalledPartyNumber
- #CalledPartyNumber
- sub {
- my( $cdr, $field, $conf ) = @_;
- if ( $cdr->calltypenum == 6 && $cdr->cdrtypenum == 0 ) {
- $cdr->dst("+$field");
- } else {
- $cdr->dst($field);
- }
- },
-
- #10
- _cdr_date_parser_maker('startdate', 'gmt' => 1), #CallArrivalTime
- _cdr_date_parser_maker('enddate', 'gmt' => 1), #CallCompletionTime
-
- #Disposition
- #sub { my($cdr, $d ) = @_; $cdr->disposition( $disposition{$d}): },
- 'disposition',
- # -1 => '',
- # 0 => '',
- # 100 => '',
- # 101 => '',
- # 102 => '',
- # 103 => '',
- # 104 => '',
- # 105 => '',
- # 201 => '',
- # 203 => '',
-
- _cdr_date_parser_maker('answerdate', 'gmt' => 1), #DispositionTime
- sub { my($cdr, $field) = @_; }, #TCAP
- sub { my($cdr, $field) = @_; }, #OutboundCarrierConnectTime
- sub { my($cdr, $field) = @_; }, #OutboundCarrierDisconnectTime
-
- #TermTrunkGroup
- #it appears channels are actually part of trunk groups, but this data
- #is interesting and we need a source and destination place to put it
- 'dstchannel', #TermTrunkGroup
-
-
- sub { my($cdr, $field) = @_; }, #TermShelfNumber
- sub { my($cdr, $field) = @_; }, #TermCardNumber
-
- #20
- sub { my($cdr, $field) = @_; }, #TermCircuit
- sub { my($cdr, $field) = @_; }, #TermCircuitType
- 'carrierid', #OutboundCarrierId
-
- #BillingNumber
- #'charged_party',
- sub {
- my( $cdr, $field, $conf ) = @_;
-
- #could be more efficient for the no config case, if anyone ever needs that
- $da_rewrite ||= $conf->config('cdr-taqua-da_rewrite');
-
- if ( $da_rewrite && $field =~ /\d/ ) {
- my $rewrite = $da_rewrite;
- $rewrite =~ s/\s//g;
- my @rewrite = split(',', $conf->config('cdr-taqua-da_rewrite') );
- if ( grep { $field eq $_ } @rewrite ) {
- $cdr->charged_party( $cdr->src() );
- $cdr->calltypenum(12);
- return;
- }
- }
- if ( $cdr->is_tollfree ) { # thankfully this is already available
- $cdr->charged_party($cdr->dst); # and this
- } else {
- $cdr->charged_party($field);
- }
- },
-
- sub { my($cdr, $field) = @_; }, #SubscriberNumber
- 'lastapp', #ServiceName
- sub { my($cdr, $field) = @_; }, #some weirdness #ChargeTime
- 'lastdata', #ServiceInformation
- sub { my($cdr, $field) = @_; }, #FacilityInfo
- sub { my($cdr, $field) = @_; }, #all 1900-01-01 0#CallTraceTime
-
- #30
- sub { my($cdr, $field) = @_; }, #all-1#UniqueIndicator
- sub { my($cdr, $field) = @_; }, #all-1#PresentationIndicator
- sub { my($cdr, $field) = @_; }, #empty#Pin
- 'calltypenum', #CallType
-
- #nothing below is used by QIS...
-
- sub { my($cdr, $field) = @_; }, #Balt/empty #OrigRateCenter
- sub { my($cdr, $field) = @_; }, #Balt/empty #TermRateCenter
-
- #OrigTrunkGroup
- #it appears channels are actually part of trunk groups, but this data
- #is interesting and we need a source and destination place to put it
- 'channel', #OrigTrunkGroup
-
- 'userfield', #empty#UserDefined
- sub { my($cdr, $field) = @_; }, #empty#PseudoDestinationNumber
- sub { my($cdr, $field) = @_; }, #all-1#PseudoCarrierCode
-
- #40
- sub { my($cdr, $field) = @_; }, #empty#PseudoANI
- sub { my($cdr, $field) = @_; }, #all-1#PseudoFacilityInfo
- sub { my($cdr, $field) = @_; }, #OrigDialedDigits
- sub { my($cdr, $field) = @_; }, #all-1#OrigOutboundCarrier
- sub { my($cdr, $field) = @_; }, #IncomingCarrierID
- 'dcontext', #JurisdictionInfo
- sub { my($cdr, $field) = @_; }, #OrigDestDigits
- sub { my($cdr, $field) = @_; }, #huh?#InsertTime
- sub { my($cdr, $field) = @_; }, #key
- sub { my($cdr, $field) = @_; }, #empty#AMALineNumber
-
- #50
- sub { my($cdr, $field) = @_; }, #empty#AMAslpID
- sub { my($cdr, $field) = @_; }, #empty#AMADigitsDialedWC
- sub { my($cdr, $field) = @_; }, #OpxOffHook
- sub { my($cdr, $field) = @_; }, #OpxOnHook
-
- #acctid - primary key
- #AUTO #calldate - Call timestamp (SQL timestamp)
-#clid - Caller*ID with text
- #XXX src - Caller*ID number / Source number
- #XXX dst - Destination extension
- #dcontext - Destination context
- #channel - Channel used
- #dstchannel - Destination channel if appropriate
- #lastapp - Last application if appropriate
- #lastdata - Last application data
- #startdate - Start of call (UNIX-style integer timestamp)
- #answerdate - Answer time of call (UNIX-style integer timestamp)
- #enddate - End time of call (UNIX-style integer timestamp)
- #HACK#duration - Total time in system, in seconds
- #HACK#XXX billsec - Total time call is up, in seconds
- #disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
-#INT amaflags - What flags to use: BILL, IGNORE etc, specified on a per channel basis like accountcode.
- #accountcode - CDR account number to use: account
-
- #uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
- #userfield - CDR user-defined field
-
- #X cdrtypenum - CDR type - see FS::cdr_type (Usage = 1, S&E = 7, OC&C = 8)
- #XXX charged_party - Service number to be billed
-#upstream_currency - Wholesale currency from upstream
-#X upstream_price - Wholesale price from upstream
-#upstream_rateplanid - Upstream rate plan ID
-#rated_price - Rated (or re-rated) price
-#distance - km (need units field?)
-#islocal - Local - 1, Non Local = 0
-#calltypenum - Type of call - see FS::cdr_calltype
-#X description - Description (cdr_type 7&8 only) (used for cust_bill_pkg.itemdesc)
-#quantity - Number of items (cdr_type 7&8 only)
-#carrierid - Upstream Carrier ID (see FS::cdr_carrier)
-#upstream_rateid - Upstream Rate ID
-
- #svcnum - Link to customer service (see FS::cust_svc)
- #freesidestatus - NULL, done (or something)
- ],
-);
-
-1;
diff --git a/FS/FS/cdr/taqua_om.pm b/FS/FS/cdr/taqua_om.pm
deleted file mode 100644
index c94ea59..0000000
--- a/FS/FS/cdr/taqua_om.pm
+++ /dev/null
@@ -1,19 +0,0 @@
-package FS::cdr::taqua_om;
-
-use strict;
-use vars qw( %info );
-use base qw( FS::cdr::taqua );
-
-%info = (
- %FS::cdr::taqua::info,
- 'name' => 'Taqua OM',
- 'weight' => 132,
- 'header' => 0,
- 'sep_char' => ';',
- 'row_callback' => sub { my $row = shift;
- $row =~ s/^<\d+>\|[\da-f\|]+\|(\d+;)/$1/;
- $row;
- },
-);
-
-1;
diff --git a/FS/FS/cdr/telos_csv.pm b/FS/FS/cdr/telos_csv.pm
deleted file mode 100644
index 3faff79..0000000
--- a/FS/FS/cdr/telos_csv.pm
+++ /dev/null
@@ -1,60 +0,0 @@
-package FS::cdr::telos_csv;
-
-use strict;
-use vars qw( @ISA %info $tmp_mon $tmp_mday $tmp_year );
-use Time::Local;
-use FS::cdr qw(_cdr_min_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'Telos (CSV)',
- 'weight' => 535,
- 'header' => 1,
- 'import_fields' => [
-
- # Date (MM/DD/YY)
- sub { my($cdr, $date) = @_;
- $date =~ /^(\d{1,2})\/(\d{1,2})\/(\d\d(\d\d)?)$/
- or die "unparsable date: $date";
- ($tmp_mday, $tmp_mon, $tmp_year) = ( $2, $1-1, $3 );
- },
-
- # Time
- sub { my($cdr, $time) = @_;
- $time =~ /^(\d{1,2}):(\d{1,2}):(\d{1,2})$/
- or die "unparsable time: $time";
- $cdr->enddate(
- timelocal($3, $2, $1 ,$tmp_mday, $tmp_mon, $tmp_year)
- );
- },
- '', #RAS-Client
- sub { #Record-Type
- my($cdr, $rectype, $conf, $param) = @_;
- $param->{skiprow} = 1 if lc($rectype) ne 'stop';
- },
- skip(24), #Full-Name, Auth-Type, User-Name, NAS-IP-Address, NAS-Port,
- #Service-Type, Framed-Protocol, Framed-IP-Address,
- #Framed-IP-Netmask, Framed-Routing, Filter-ID, Framed-MTU,
- #Framed-Compression, Login-IP-Host, Login-Service, Login-TCP-Port,
- #Callback-Number, Callback-ID, Framed-Route, Framed-IPX-Network,
- #Class, Session-Timeout, Idle-Timeout, Termination-Action
- #I told you it was a RADIUS log
- 'dst', # Called-Station-ID, always 'X' in sample data
- 'src', # Calling-Station-ID
- skip(8), #NAS-Identifier, Proxy-State, Acct-Status-Type, Acct-Delay-Time,
- #Acct-Input-Octets, Acct-Output-Octets, Acct-Session-Id,
- #Acct-Authentic
- sub {
- my ($cdr, $sec) = @_;
- $cdr->duration($sec);
- $cdr->billsec($sec);
- $cdr->startdate($cdr->enddate - $sec);
- },
- skip(75), #everything else
- ],
-);
-
-sub skip { map {''} (1..$_[0]) }
-
-1;
diff --git a/FS/FS/cdr/telos_xml.pm b/FS/FS/cdr/telos_xml.pm
deleted file mode 100644
index a144f0b..0000000
--- a/FS/FS/cdr/telos_xml.pm
+++ /dev/null
@@ -1,36 +0,0 @@
-package FS::cdr::telos_xml;
-
-use strict;
-use vars qw( @ISA %info );
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'Telos (XML)',
- 'weight' => 530,
- 'type' => 'xml',
- 'xml_format' => {
- 'xmlrow' => [ 'Telos_CDRS', 'CDRecord' ],
- 'xmlkeys' => [ qw(
- seq_num
- a_party_num
- b_party_num
- seize
- answer
- disc
- ) ],
- },
-
- 'import_fields' => [
- 'uniqueid',
- 'src',
- 'dst', # usually empty for some reason
- _cdr_date_parser_maker('startdate'),
- _cdr_date_parser_maker('answerdate'),
- _cdr_date_parser_maker('enddate'),
- ],
-
-);
-
-1;
diff --git a/FS/FS/cdr/transnexus.pm b/FS/FS/cdr/transnexus.pm
deleted file mode 100644
index 0ed7ad4..0000000
--- a/FS/FS/cdr/transnexus.pm
+++ /dev/null
@@ -1,66 +0,0 @@
-package FS::cdr::transnexus;
-
-use strict;
-use base qw( FS::cdr );
-use vars qw( %info );
-use MIME::Base64;
-use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker );
-
-%info = (
- 'name' => 'Transnexus',
- 'weight' => 18,
- 'type' => 'csv',
- 'sep_char' => "\t",
-
- #listref of what to do with each field from the CDR, in order
- 'import_fields' => [
-
- _cdr_date_parser_maker('startddate'), #O_CallStartTime
- 'src', #CallingNumberReported
- 'dst', #CalledNumberReported
- 'channel', #SourceDeviceName / O_ReportingDeviceName
- 'dstchannel', #O_ReportingDeviceName / DestinationDeviceName
- sub { $_[0]->clid( decode_base64($_[1]) ); }, #CallId
- 'uniqueid', #TransactionId
- 'duration', #RatedDuration
- 'billsec', #O_BillingDuration
- 'upstream_price', #O_BillingAmountCustCurr
- ],
-);
-
-1;
-
-__END__
-
-O_CallStartTime - Date and time stamp of the call setup as reported in the CDR from the source device.
-
-CallingNumberReported - Calling number from the source device reported in authorization request to the OSPrey server.
-
-CalledNumberReported - Called number from the source device reported in authorization request to the OSPrey server.
-
-----
-1.1.1 Customer CDR Archive File
-
-SourceDeviceName - The IP address or Domain Name of the device which is the call source.
-
-O_ReportingDeviceName - IP address or Domain Name of the source (Originating) device reporting the CDR to the OSPrey Server. If a proxy is used, (such as SIP proxy for signaling or FreeRADIUS for CDR reporting) this field is the IP address of the proxy device, not the actual source device.
-
----
-or 1.1.2 Provider CDR Archive File
-
-O_ReportingDeviceName - IP address or Domain Name of the source (Originating) device reporting the CDR to the OSPrey Server. If a proxy is used, (such as SIP proxy for signaling or FreeRADIUS for CDR reporting) this field is the IP address of the proxy device, not the actual source device.
-
-DestinationDeviceName - The IP address or Domain Name of the destination device.
-
-----
-
-CallId - The Call Identifier generated by the source VoIP device.
-
-TransactionId - The unique Transaction Identification number created by the OSPrey server for each call
-
-RatedDuration - The rateable duration calculated by NexOSS.
-
-O_BillingDuration - The duration used to calculate the billable amount for a call from the source (Originating) network. This value is derived from RatedDuration and rounded up based on the ¿First Increment¿ or ¿Next Increment¿ rules defined in the Product or Customer Rate Plan used to rate the call.
-
-O_BillingAmountCustCurr - Amount billable to the source (Originating) Customer. Provided in the currency of the Product or Customer Rate Plan.
-
diff --git a/FS/FS/cdr/troop.pm b/FS/FS/cdr/troop.pm
deleted file mode 100644
index 020af2b..0000000
--- a/FS/FS/cdr/troop.pm
+++ /dev/null
@@ -1,128 +0,0 @@
-package FS::cdr::troop;
-
-use strict;
-use base qw( FS::cdr );
-use vars qw( %info $tmp_mon $tmp_mday $tmp_year );
-use Time::Local;
-#use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker );
-
-%info = (
- 'name' => 'Troop',
- 'weight' => 220,
- 'header' => 2,
- 'type' => 'xls',
-
- 'import_fields' => [
-
- # CDR FIELD / REQUIRED / Notes
-
- # / No / CDR sequence number
- sub {},
-
- # WTN / Yes
- 'charged_party',
-
- # Account Code / Yes / Account Code (security) and we need on invoice
- 'accountcode',
-
- # DT / Yes / "DATE" Excel
- # XXX false laziness w/bell_west.pm
- sub { my($cdr, $date) = @_;
-
- my $datetime = DateTime::Format::Excel->parse_datetime( $date );
- $tmp_mon = $datetime->mon_0;
- $tmp_mday = $datetime->mday;
- $tmp_year = $datetime->year;
- },
-
- # Time / Yes / "TIME" excel
- sub { my($cdr, $time) = @_;
- #my($sec, $min, $hour, $mday, $mon, $year)= localtime($cdr->startdate);
-
- #$sec = $time * 86400;
- my $sec = int( $time * 86400 + .5);
-
- #$cdr->startdate( timelocal($3, $2, $1 ,$mday, $mon, $year) );
- $cdr->startdate(
- timelocal(0, 0, 0, $tmp_mday, $tmp_mon, $tmp_year) + $sec
- );
- },
-
-
- # Dur. / Yes / Units = seconds
- 'billsec',
-
- # OVS Type / Maybe / add "011" to international calls
- # N = DOM LD / normal
- # Z = INTL LD
- # O = INTL LD
- # others...?
- sub { my($cdr, $ovs) = @_;
- my $pre = ( $ovs =~ /^\s*[OZ]\s*$/i ) ? '011' : '1';
- $cdr->dst( $pre. $cdr->dst ) unless $cdr->dst =~ /^$pre/;
- },
-
- # Number / YES
- 'src',
-
- # City / No
- 'channel',
-
- # Prov/State / No / We will use your Freeside rating and description name
- sub { my($cdr, $state) = @_;
- $cdr->channel( $cdr->channel. ", $state" )
- if $state;
- },
-
- # Number / Yes
- 'dst',
-
- # City / No
- 'dstchannel',
-
- # Prov/State / No / We will use your Freeside rating and description name
- sub { my($cdr, $state) = @_;
- $cdr->dstchannel( $cdr->dstchannel. ", $state" )
- if $state;
- },
-
- # OVS / Maybe
- # Would help to add "011" to international calls (if you are willing)
- # (using ovs above)
- sub { my($cdr, $ovs) = @_;
- my @ignore = ( 'BELL', 'CANADA', 'UNITED STATES', );
- $cdr->dstchannel( $cdr->dstchannel. ", $ovs" )
- if $ovs && ! grep { $ovs =~ /^\s*$_\s*$/ } @ignore;
- },
-
- # CC Ind. / No / Does show if Calling card but should not be required
- #'N' or 'E'
- sub {},
-
- # Call Charge / No / Bell billing info and is not required
- 'upstream_price',
-
- # Account # / No / Bell billing info and is not required
- sub {},
-
- # Net Charge / No / Bell billing info and is not required
- sub {},
-
- # Surcharge / No / Taxes and is not required
- sub {},
-
- # GST / No / Taxes and is not required
- sub {},
-
- # PST / No / Taxes and is not required
- sub {},
-
- # HST / No / Taxes and is not required
- sub {},
-
- ],
-
-);
-
-1;
-
diff --git a/FS/FS/cdr/unitel.pm b/FS/FS/cdr/unitel.pm
deleted file mode 100644
index df34a57..0000000
--- a/FS/FS/cdr/unitel.pm
+++ /dev/null
@@ -1,39 +0,0 @@
-package FS::cdr::unitel;
-
-use strict;
-use vars qw(@ISA %info);
-use FS::cdr;
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'Unitel/RSLCOM',
- 'weight' => 500,
- 'import_fields' => [
- 'uniqueid',
- #'cdr_type',
- 'cdrtypenum',
- 'calldate', # may need massaging? huh maybe not...
- #'billsec', #XXX duration and billsec?
- sub { $_[0]->billsec( $_[1] );
- $_[0]->duration( $_[1] );
- },
- 'src',
- 'dst', # XXX needs to have "+61" prepended unless /^\+/ ???
- 'charged_party',
- 'upstream_currency',
- 'upstream_price',
- 'upstream_rateplanid',
- 'distance',
- 'islocal',
- 'calltypenum',
- 'startdate', #XXX needs massaging
- 'enddate', #XXX same
- 'description',
- 'quantity',
- 'carrierid',
- 'upstream_rateid',
- ]
-);
-
-1;
diff --git a/FS/FS/cdr/vitelity.pm b/FS/FS/cdr/vitelity.pm
deleted file mode 100644
index 97ed0c3..0000000
--- a/FS/FS/cdr/vitelity.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-package FS::cdr::vitelity;
-
-use strict;
-use vars qw( @ISA %info );
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'Vitelity',
- 'weight' => 100,
- 'header' => 1,
- 'import_fields' => [
- # Cheers to Vitelity for their concise, readable CDR format.
- _cdr_date_parser_maker('startdate'),
- 'src',
- 'dst',
- 'duration',
- 'clid',
- 'disposition',
- 'upstream_price',
- ],
-);
-
-1;
diff --git a/FS/FS/cdr/wip.pm b/FS/FS/cdr/wip.pm
deleted file mode 100644
index 19c45c6..0000000
--- a/FS/FS/cdr/wip.pm
+++ /dev/null
@@ -1,48 +0,0 @@
-package FS::cdr::wip;
-
-use strict;
-use vars qw( @ISA %info );
-use FS::cdr qw(_cdr_date_parser_maker);
-
-@ISA = qw(FS::cdr);
-
-%info = (
- 'name' => 'WIP',
- 'weight' => 100,
- 'header' => 1,
- 'type' => 'csv',
- 'sep_char' => ':',
- 'import_fields' => [
-# All of these are based on the January 2010 version of the spec,
-# except that we assume that before all the fields mentioned in the
-# spec, there's a counter field.
- skip(4), # counter, id, APCSJursID, RecordType
- sub { my($cdr, $data, $conf, $param) = @_;
- $param->{skiprow} = 1 if $data == 1;
- $cdr->uniqueid($data);
- }, # CDRID; is 1 for line charge records
- skip(1), # AccountNumber; empty
- 'charged_party', # ServiceNumber
- skip(1), # ServiceNumberType
- 'src', # PointOrigin
- 'dst', # PointTarget
- 'calltypenum', # Jurisdiction: need to remap
- _cdr_date_parser_maker('startdate'), #TransactionDate
- skip(3), # BillClass, TypeIDUsage, ElementID
- 'duration', # PrimaryUnits
- skip(6), # CompletionStatus, Latitude, Longitude,
- # OriginDescription, TargetDescription, RatePeriod
- 'billsec', # RatedUnits; seems to always be equal to PrimaryUnits
- skip(6), #SecondsUnits, ThirdUnits, FileID, OriginalExtractSequenceNumber,
- #RateClass, #ProviderClass
- skip(8), #ProviderID, CurrencyCode, EquipmentTypeCode, ClassOfServiceCode,
- #RateUnitsType, DistanceBandID, ZoneClass, CDRStatus
- 'upstream_price', # ISPBuy
- skip(2), # EUBuy, CDRFromCarrier
- ],
-
-);
-
-sub skip { map {''} (1..$_[0]) }
-
-1;
diff --git a/FS/FS/cdr_batch.pm b/FS/FS/cdr_batch.pm
deleted file mode 100644
index 59cfd2c..0000000
--- a/FS/FS/cdr_batch.pm
+++ /dev/null
@@ -1,128 +0,0 @@
-package FS::cdr_batch;
-
-use strict;
-use base qw( FS::Record );
-#use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::cdr_batch - Object methods for cdr_batch records
-
-=head1 SYNOPSIS
-
- use FS::cdr_batch;
-
- $record = new FS::cdr_batch \%hash;
- $record = new FS::cdr_batch { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cdr_batch object represents a CDR batch. FS::cdr_batch inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item cdrbatchnum
-
-primary key
-
-=item cdrbatch
-
-cdrbatch
-
-=item _date
-
-_date
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new batch. To add the batch 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 { 'cdr_batch'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid batch. 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('cdrbatchnum')
- || $self->ut_textn('cdrbatch')
- || $self->ut_numbern('_date')
- ;
- return $error if $error;
-
- $self->_date(time) unless $self->_date;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cdr>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cdr_calltype.pm b/FS/FS/cdr_calltype.pm
deleted file mode 100644
index fe45608..0000000
--- a/FS/FS/cdr_calltype.pm
+++ /dev/null
@@ -1,115 +0,0 @@
-package FS::cdr_calltype;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cdr_calltype - Object methods for cdr_calltype records
-
-=head1 SYNOPSIS
-
- use FS::cdr_calltype;
-
- $record = new FS::cdr_calltype \%hash;
- $record = new FS::cdr_calltype { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cdr_calltype object represents an CDR call type. FS::cdr_calltype
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item calltypenum - primary key
-
-=item calltypename - CDR call type name
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new call type. To add the call type 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 { 'cdr_calltype'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid call type. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('calltypenum')
- || $self->ut_text('calltypename')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cdr_carrier.pm b/FS/FS/cdr_carrier.pm
deleted file mode 100644
index 609c939..0000000
--- a/FS/FS/cdr_carrier.pm
+++ /dev/null
@@ -1,116 +0,0 @@
-package FS::cdr_carrier;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cdr_carrier - Object methods for cdr_carrier records
-
-=head1 SYNOPSIS
-
- use FS::cdr_carrier;
-
- $record = new FS::cdr_carrier \%hash;
- $record = new FS::cdr_carrier { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cdr_carrier object represents an CDR carrier or upstream.
-FS::cdr_carrier inherits from FS::Record. The following fields are currently
-supported:
-
-=over 4
-
-=item carrierid - primary key
-
-=item carriername - Carrier name
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new carrier. To add the carrier 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 { 'cdr_carrier'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid carrier. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('carrierid')
- || $self->ut_text('carriername')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cdr_termination.pm b/FS/FS/cdr_termination.pm
deleted file mode 100644
index 5e30805..0000000
--- a/FS/FS/cdr_termination.pm
+++ /dev/null
@@ -1,155 +0,0 @@
-package FS::cdr_termination;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::cdr_termination - Object methods for cdr_termination records
-
-=head1 SYNOPSIS
-
- use FS::cdr_termination;
-
- $record = new FS::cdr_termination \%hash;
- $record = new FS::cdr_termination { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cdr_termination object represents an CDR termination status.
-FS::cdr_termination inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item cdrtermnum
-
-primary key
-
-=item acctid
-
-acctid
-
-=item termpart
-
-termpart
-
-=item rated_price
-
-rated_price
-
-=item status
-
-status
-
-=item svcnum
-
-svc_phone record associated with this transaction, if there is one.
-
-=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 { 'cdr_termination'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('cdrtermnum')
- || $self->ut_foreign_key('acctid', 'cdr', 'acctid')
- #|| $self->ut_foreign_key('termpart', 'part_termination', 'termpart')
- || $self->ut_number('termpart')
- || $self->ut_float('rated_price')
- || $self->ut_enum('status', [ '', 'done' ] ) # , 'skipped' ] )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-#=item set_status_and_rated_price STATUS [ RATED_PRICE ]
-#
-#Sets the status to the provided string. If there is an error, returns the
-#error, otherwise returns false.
-#
-#=cut
-#
-#sub set_status_and_rated_price {
-# my($self, $status, $rated_price) = @_;
-# $self->status($status);
-# $self->rated_price($rated_price);
-# $self->replace();
-#}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cdr>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cdr_type.pm b/FS/FS/cdr_type.pm
deleted file mode 100644
index e258bf8..0000000
--- a/FS/FS/cdr_type.pm
+++ /dev/null
@@ -1,119 +0,0 @@
-package FS::cdr_type;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cdr_type - Object methods for cdr_type records
-
-=head1 SYNOPSIS
-
- use FS::cdr_type;
-
- $record = new FS::cdr_type \%hash;
- $record = new FS::cdr_type { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cdr_type object represents an CDR type. FS::cdr_type inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item cdrtypenum - primary key
-
-=item typename - CDR type name
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new CDR type. To add the CDR type 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 { 'cdr_type'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid CDR type. 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('cdrtypenum')
- || $self->ut_text('typename')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cgp_rule.pm b/FS/FS/cgp_rule.pm
deleted file mode 100644
index e9c5090..0000000
--- a/FS/FS/cgp_rule.pm
+++ /dev/null
@@ -1,363 +0,0 @@
-package FS::cgp_rule;
-
-use strict;
-use base qw( FS::o2m_Common FS::Record );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::cust_svc;
-use FS::cgp_rule_condition;
-use FS::cgp_rule_action;
-
-=head1 NAME
-
-FS::cgp_rule - Object methods for cgp_rule records
-
-=head1 SYNOPSIS
-
- use FS::cgp_rule;
-
- $record = new FS::cgp_rule \%hash;
- $record = new FS::cgp_rule { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cgp_rule object represents a mail filtering rule. FS::cgp_rule
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item rulenum
-
-primary key
-
-=item name
-
-name
-
-=item comment
-
-comment
-
-=item svcnum
-
-svcnum
-
-=item priority
-
-priority
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new rule. To add the rule 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 { 'cgp_rule'; }
-
-=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(@_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- #conditions and actions not in yet
- #$error = $self->svc_export;
- #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 @del = $self->cgp_rule_condition;
- push @del, $self->cgp_rule_action;
-
- foreach my $del (@del) {
- my $error = $del->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my $error = $self->SUPER::delete(@_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $error = $self->svc_export;
- 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 = ( ref($_[0]) eq ref($new) )
- ? 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, @_);
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- return $error;
- }
-
- #conditions and actions not in yet
- #$error = $new->svc_export;
- #if ( $error ) {
- # $dbh->rollback if $oldAutoCommit;
- # return $error;
- #}
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item svc_export
-
-Calls the replace export for any communigate exports attached to this rule's
-service.
-
-=cut
-
-sub svc_export {
- my $self = shift;
-
- my $cust_svc = $self->cust_svc;
- my $svc_x = $cust_svc->svc_x;
-
- #_singledomain too
- my @exports = $cust_svc->part_svc->part_export('communigate_pro');
- my @errors = map $_->export_replace($svc_x, $svc_x), @exports;
-
- @errors ? join(' / ', @errors) : '';
-
-}
-
-=item check
-
-Checks all fields to make sure this is a valid rule. 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('rulenum')
- || $self->ut_text('name')
- || $self->ut_textn('comment')
- || $self->ut_foreign_key('svcnum', 'cust_svc', 'svcnum')
- || $self->ut_number('priority')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item clone NEW_SVCNUM
-
-Clones this rule into an identical rule for the specified new service.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-#should return the newly inserted rule instead? used in misc/clone-cgp_rule.html
-
-#i should probably be transactionalized so i'm all-or-nothing
-sub clone {
- my( $self, $svcnum ) = @_;
-
- my $new = $self->new( { $self->hash } );
- $new->rulenum('');
- $new->svcnum( $svcnum );
- my $error = $new->insert;
- return $error if $error;
-
- my @dup = $self->cgp_rule_condition;
- push @dup, $self->cgp_rule_action;
-
- foreach my $dup (@dup) {
- my $new_dup = $dup->new( { $dup->hash } );
- my $pk = $new_dup->primary_key;
- $new_dup->$pk('');
- $new_dup->rulenum( $new->rulenum );
-
- $error = $new_dup->insert;
- return $error if $error;
-
- }
-
- $error = $new->svc_export;
- return $error if $error;
-
- '';
-
-}
-
-=item cust_svc
-
-=cut
-
-sub cust_svc {
- my $self = shift;
- qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
-}
-
-=item cgp_rule_condition
-
-Returns the conditions associated with this rule, as FS::cgp_rule_condition
-objects.
-
-=cut
-
-sub cgp_rule_condition {
- my $self = shift;
- qsearch('cgp_rule_condition', { 'rulenum' => $self->rulenum } );
-}
-
-=item cgp_rule_action
-
-Returns the actions associated with this rule, as FS::cgp_rule_action
-objects.
-
-=cut
-
-sub cgp_rule_action {
- my $self = shift;
- qsearch('cgp_rule_action', { 'rulenum' => $self->rulenum } );
-}
-
-=item arrayref
-
-Returns an arraref representing this rule, suitable for Communigate Pro API
-commands:
-
-The first element specifies the rule priority.
-
-The second element specifies the rule name.
-
-The third element specifies the rule conditions.
-
-The fourth element specifies the rule actions.
-
-The fifth element specifies the rule comment.
-
-=cut
-
-sub arrayref {
- my $self = shift;
- [ $self->priority,
- $self->name,
- [ map $_->arrayref, $self->cgp_rule_condition ],
- [ map $_->arrayref, $self->cgp_rule_action ],
- $self->comment,
- ],
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cgp_rule_action.pm b/FS/FS/cgp_rule_action.pm
deleted file mode 100644
index 71605a9..0000000
--- a/FS/FS/cgp_rule_action.pm
+++ /dev/null
@@ -1,141 +0,0 @@
-package FS::cgp_rule_action;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::cgp_rule;
-
-=head1 NAME
-
-FS::cgp_rule_action - Object methods for cgp_rule_action records
-
-=head1 SYNOPSIS
-
- use FS::cgp_rule_action;
-
- $record = new FS::cgp_rule_action \%hash;
- $record = new FS::cgp_rule_action { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cgp_rule_action object represents a mail filtering action.
-FS::cgp_rule_action inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item ruleactionnum
-
-primary key
-
-=item action
-
-action
-
-=item params
-
-params
-
-=item rulenum
-
-rulenum
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new action. To add the action 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 { 'cgp_rule_action'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid action. 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('ruleactionnum')
- || $self->ut_text('action')
- || $self->ut_textn('params')
- || $self->ut_foreign_key('rulenum', 'cgp_rule', 'rulenum')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item arrayref
-
-=cut
-
-sub arrayref {
- my $self = shift;
- [ $self->action, $self->params ];
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cgp_rule_condition.pm b/FS/FS/cgp_rule_condition.pm
deleted file mode 100644
index 772e189..0000000
--- a/FS/FS/cgp_rule_condition.pm
+++ /dev/null
@@ -1,148 +0,0 @@
-package FS::cgp_rule_condition;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::cgp_rule;
-
-=head1 NAME
-
-FS::cgp_rule_condition - Object methods for cgp_rule_condition records
-
-=head1 SYNOPSIS
-
- use FS::cgp_rule_condition;
-
- $record = new FS::cgp_rule_condition \%hash;
- $record = new FS::cgp_rule_condition { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cgp_rule_condition object represents a mail filtering condition.
-FS::cgp_rule_condition inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item ruleconditionnum
-
-primary key
-
-=item conditionname
-
-condition
-
-=item op
-
-op
-
-=item params
-
-params
-
-=item rulenum
-
-rulenum
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new condition. To add the condition 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 { 'cgp_rule_condition'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid condition. 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('ruleconditionnum')
- || $self->ut_text('conditionname')
- || $self->ut_textn('op')
- || $self->ut_textn('params')
- || $self->ut_foreign_key('rulenum', 'cgp_rule', 'rulenum')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item arrayref
-
-Returns an array reference of the conditionname, op and params fields.
-
-=cut
-
-sub arrayref {
- my $self = shift;
- [ map $self->$_, qw( conditionname op params ) ];
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/class_Common.pm b/FS/FS/class_Common.pm
deleted file mode 100644
index 5ee8208..0000000
--- a/FS/FS/class_Common.pm
+++ /dev/null
@@ -1,143 +0,0 @@
-package FS::class_Common;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::class_Common - Base class for classification classes
-
-=head1 SYNOPSIS
-
-use base qw( FS::class_Common );
-use FS::category_table; #should use this
-
-#required
-sub _target_table { 'table_name'; }
-
-#optional for non-standard names
-sub _target_column { 'classnum'; } #default is classnum
-sub _category_table { 'table_name'; } #default is to replace s/class/category/
-
-=head1 DESCRIPTION
-
-FS::class_Common is a base class for classes which provide a classification for
-other classes, such as pkg_class or cust_class.
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new classification. To add the classfication to the database, see
-L<"insert">.
-
-=cut
-
-=item insert
-
-Adds this classification to the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item delete
-
-Deletes this classification from the database. Only classifications with no
-associated target objects can be deleted. If there is an error, returns
-the error, otherwise returns false.
-
-=cut
-
-sub delete {
- my $self = shift;
-
- return "Can't delete a ". $self->table.
- " with ". $self->_target_table. " records!"
- if qsearch( $self->_target_table,
- { $self->_target_column => $self->classnum }
- );
-
- $self->SUPER::delete;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid package classification. If
-there is an error, returns the error, otherwise returns false. Called by the
-insert and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->ut_numbern('classnum')
- or $self->ut_text('classname')
- or $self->ut_foreign_keyn( 'categorynum',
- $self->_category_table,
- 'categorynum',
- )
- or $self->ut_enum('disabled', [ '', 'Y' ] )
- or $self->SUPER::check;
-
-}
-
-=item category
-
-Returns the category record associated with this class, or false if there is
-none.
-
-=cut
-
-sub category {
- my $self = shift;
- qsearchs($self->_category_table, { 'categorynum' => $self->categorynum } );
-}
-
-=item categoryname
-
-Returns the category name associated with this class, or false if there
-is none.
-
-=cut
-
-sub categoryname {
- my $category = shift->category;
- $category ? $category->categoryname : '';
-}
-
-#required
-sub _target_table {
- my $self = shift;
- die "_target_table unspecified for $self";
-}
-
-#defaults
-
-sub _target_column { 'classnum'; }
-
-use vars qw( $_category_table );
-sub _category_table {
- return $_category_table if $_category_table;
- my $self = shift;
- $_category_table = $self->table;
- $_category_table =~ s/class/category/ # s/_class$/_category/
- or die "can't determine an automatic category table for $_category_table";
- $_category_table;
-}
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::category_Common>, L<FS::pkg_class>, L<FS::cust_class>
-
-=cut
-
-1;
diff --git a/FS/FS/clientapi_session.pm b/FS/FS/clientapi_session.pm
deleted file mode 100644
index f71a126..0000000
--- a/FS/FS/clientapi_session.pm
+++ /dev/null
@@ -1,121 +0,0 @@
-package FS::clientapi_session;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::clientapi_session - Object methods for clientapi_session records
-
-=head1 SYNOPSIS
-
- use FS::clientapi_session;
-
- $record = new FS::clientapi_session \%hash;
- $record = new FS::clientapi_session { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::clientapi_session object represents an FS::ClientAPI session.
-FS::clientapi_session inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item sessionnum - primary key
-
-=item sessionid - session ID
-
-=item namespace - session namespace
-
-=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 { 'clientapi_session'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('primary_key')
- || $self->ut_number('validate_other_fields')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::ClientAPI>, <FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/clientapi_session_field.pm b/FS/FS/clientapi_session_field.pm
deleted file mode 100644
index 085e956..0000000
--- a/FS/FS/clientapi_session_field.pm
+++ /dev/null
@@ -1,124 +0,0 @@
-package FS::clientapi_session_field;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::clientapi_session_field - Object methods for clientapi_session_field records
-
-=head1 SYNOPSIS
-
- use FS::clientapi_session_field;
-
- $record = new FS::clientapi_session_field \%hash;
- $record = new FS::clientapi_session_field { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::clientapi_session_field object represents a FS::ClientAPI session data
-field. FS::clientapi_session_field inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item fieldnum - primary key
-
-=item sessionnum - Base ClientAPI sesison (see L<FS::clientapi_session>)
-
-=item fieldname
-
-=item fieldvalie
-
-=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 { 'clientapi_session_field'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('primary_key')
- || $self->ut_number('validate_other_fields')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::clientapi_session>, L<FS::ClientAPI>, L<FS::Record>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/conf.pm b/FS/FS/conf.pm
deleted file mode 100644
index 3faab14..0000000
--- a/FS/FS/conf.pm
+++ /dev/null
@@ -1,114 +0,0 @@
-package FS::conf;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::conf - Object methods for conf records
-
-=head1 SYNOPSIS
-
- use FS::conf;
-
- $record = new FS::conf \%hash;
- $record = new FS::conf { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::conf object represents a configuration value. FS::conf inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item confnum - primary key
-
-=item agentnum - the agent to which this configuration value applies
-
-=item name - the name of the configuration value
-
-=item value - the configuration value
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new configuration value. To add the example 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 { 'conf'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid configuration value. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('confnum')
- || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
- || $self->ut_text('name')
- || $self->ut_anything('value')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/contact.pm b/FS/FS/contact.pm
deleted file mode 100644
index 774aed0..0000000
--- a/FS/FS/contact.pm
+++ /dev/null
@@ -1,300 +0,0 @@
-package FS::contact;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::prospect_main;
-use FS::cust_main;
-use FS::cust_location;
-use FS::contact_phone;
-use FS::contact_email;
-
-=head1 NAME
-
-FS::contact - Object methods for contact records
-
-=head1 SYNOPSIS
-
- use FS::contact;
-
- $record = new FS::contact \%hash;
- $record = new FS::contact { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::contact object represents an example. FS::contact inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item contactnum
-
-primary key
-
-=item prospectnum
-
-prospectnum
-
-=item custnum
-
-custnum
-
-=item locationnum
-
-locationnum
-
-=item last
-
-last
-
-=item first
-
-first
-
-=item title
-
-title
-
-=item comment
-
-comment
-
-=item disabled
-
-disabled
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new example. To add the example 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 { 'contact'; }
-
-=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{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) =~ /\S/ }
- keys %{ $self->hashref } ) {
- $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
- my $phonetypenum = $1;
-
- my $contact_phone = new FS::contact_phone {
- 'contactnum' => $self->contactnum,
- 'phonetypenum' => $phonetypenum,
- _parse_phonestring( $self->get($pf) ),
- };
- $error = $contact_phone->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- if ( $self->get('emailaddress') =~ /\S/ ) {
- my $contact_email = new FS::contact_email {
- 'contactnum' => $self->contactnum,
- 'emailaddress' => $self->get('emailaddress'),
- };
- $error = $contact_email->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
-
-# the delete method can be inherited from FS::Record
-
-# XXX delete contact_phone, contact_email
-
-=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 $self = shift;
-
- 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::replace(@_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) }
- keys %{ $self->hashref } ) {
- $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
- my $phonetypenum = $1;
-
- my %cp = ( 'contactnum' => $self->contactnum,
- 'phonetypenum' => $phonetypenum,
- );
- my $contact_phone = qsearchs('contact_phone', \%cp)
- || new FS::contact_phone \%cp;
-
- my %cpd = _parse_phonestring( $self->get($pf) );
- $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
-
- my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
-
- $error = $contact_phone->$method;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-#i probably belong in contact_phone.pm
-sub _parse_phonestring {
- my $value = shift;
-
- my($countrycode, $extension) = ('1', '');
-
- #countrycode
- if ( $value =~ s/^\s*\+\s*(\d+)// ) {
- $countrycode = $1;
- } else {
- $value =~ s/^\s*1//;
- }
- #extension
- if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
- $extension = $2;
- }
-
- ( 'countrycode' => $countrycode,
- 'phonenum' => $value,
- 'extension' => $extension,
- );
-}
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('contactnum')
- || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
- || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum')
- || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
- || $self->ut_textn('last')
- || $self->ut_textn('first')
- || $self->ut_textn('title')
- || $self->ut_textn('comment')
- || $self->ut_enum('disabled', [ '', 'Y' ])
- ;
- return $error if $error;
-
- return "No prospect or customer!" unless $self->prospectnum || $self->custnum;
- return "Prospect and customer!" if $self->prospectnum && $self->custnum;
-
- return "One of first name, last name, or title must have a value"
- if ! grep $self->$_(), qw( first last title);
-
- $self->SUPER::check;
-}
-
-sub line {
- my $self = shift;
- my $data = $self->first. ' '. $self->last;
- $data .= ', '. $self->title
- if $self->title;
- $data .= ' ('. $self->comment. ')'
- if $self->comment;
- $data;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/contact_email.pm b/FS/FS/contact_email.pm
deleted file mode 100644
index 1276d8d..0000000
--- a/FS/FS/contact_email.pm
+++ /dev/null
@@ -1,128 +0,0 @@
-package FS::contact_email;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::contact_email - Object methods for contact_email records
-
-=head1 SYNOPSIS
-
- use FS::contact_email;
-
- $record = new FS::contact_email \%hash;
- $record = new FS::contact_email { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::contact_email object represents an example. FS::contact_email inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item contactemailnum
-
-primary key
-
-=item contactnum
-
-contactnum
-
-=item emailaddress
-
-emailaddress
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new example. To add the example 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 { 'contact_email'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('contactemailnum')
- || $self->ut_number('contactnum')
- || $self->ut_text('emailaddress')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-The author forgot to customize this manpage.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/contact_phone.pm b/FS/FS/contact_phone.pm
deleted file mode 100644
index ad8e8f7..0000000
--- a/FS/FS/contact_phone.pm
+++ /dev/null
@@ -1,143 +0,0 @@
-package FS::contact_phone;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::contact_phone - Object methods for contact_phone records
-
-=head1 SYNOPSIS
-
- use FS::contact_phone;
-
- $record = new FS::contact_phone \%hash;
- $record = new FS::contact_phone { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::contact_phone object represents an example. FS::contact_phone inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item contactphonenum
-
-primary key
-
-=item contactnum
-
-contactnum
-
-=item phonetypenum
-
-phonetypenum
-
-=item countrycode
-
-countrycode
-
-=item phonenum
-
-phonenum
-
-=item extension
-
-extension
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new example. To add the example 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 { 'contact_phone'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('contactphonenum')
- || $self->ut_number('contactnum')
- || $self->ut_number('phonetypenum')
- || $self->ut_text('countrycode')
- || $self->ut_text('phonenum')
- || $self->ut_textn('extension')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-The author forgot to customize this manpage.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_attachment.pm b/FS/FS/cust_attachment.pm
deleted file mode 100644
index 5e5e076..0000000
--- a/FS/FS/cust_attachment.pm
+++ /dev/null
@@ -1,199 +0,0 @@
-package FS::cust_attachment;
-
-use strict;
-use base qw( FS::otaker_Mixin FS::Record );
-use Carp;
-use FS::Record qw( qsearch qsearchs );
-use FS::Conf;
-
-=head1 NAME
-
-FS::cust_attachment - Object methods for cust_attachment records
-
-=head1 SYNOPSIS
-
- use FS::cust_attachment;
-
- $record = new FS::cust_attachment \%hash;
- $record = new FS::cust_attachment { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_attachment object represents a file attached to a L<FS::cust_main>
-object. FS::cust_attachment inherits from FS::Record. The following fields
-are currently supported:
-
-=over 4
-
-=item attachnum
-
-Primary key (assigned automatically).
-
-=item custnum
-
-Customer number (see L<FS::cust_main>).
-
-=item _date
-
-The date the record was last updated.
-
-=item usernum
-
-Order taker (see L<FS::access_user>)
-
-=item filename
-
-The file's name.
-
-=item mime_type
-
-The Content-Type of the file.
-
-=item body
-
-The contents of the file.
-
-=item disabled
-
-If the attachment was disabled, this contains the date it was disabled.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new attachment object.
-
-=cut
-
-# the new method can be inherited from FS::Record, if a table method is defined
-
-sub table { 'cust_attachment'; }
-
-sub nohistory_fields { 'body'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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 example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
-sub check {
- my $self = shift;
-
- my $conf = new FS::Conf;
- my $error;
- if($conf->config('disable_cust_attachment') ) {
- $error = 'Attachments disabled (see configuration)';
- }
-
- $error =
- $self->ut_numbern('attachnum')
- || $self->ut_number('custnum')
- || $self->ut_numbern('_date')
- || $self->ut_textn('otaker')
- || $self->ut_text('filename')
- || $self->ut_text('mime_type')
- || $self->ut_numbern('disabled')
- || $self->ut_anything('body')
- ;
- if($conf->config('max_attachment_size')
- and $self->size > $conf->config('max_attachment_size') ) {
- $error = 'Attachment too large'
- }
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item size
-
-Returns the size of the attachment in bytes.
-
-=cut
-
-sub size {
- my $self = shift;
- return length($self->body);
-}
-
-#false laziness w/otaker_Mixin & cust_main_note
-sub otaker {
- my $self = shift;
- if ( scalar(@_) ) { #set
- my $otaker = shift;
- my($l,$f) = (split(', ', $otaker));
- my $access_user = qsearchs('access_user', { 'username'=>$otaker } )
- || qsearchs('access_user', { 'first'=>$f, 'last'=>$l } )
- or croak "can't set otaker: $otaker not found!"; #confess?
- $self->usernum( $access_user->usernum );
- $otaker; #not sure return is used anywhere, but just in case
- } else { #get
- if ( $self->usernum ) {
- $self->access_user->username;
- } elsif ( length($self->get('otaker')) ) {
- $self->get('otaker');
- } else {
- '';
- }
- }
-}
-
-# Used by FS::Upgrade to migrate to a new database.
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
- $class->_upgrade_otaker(%opts);
-}
-
-=back
-
-=head1 BUGS
-
-Doesn't work on non-Postgres systems.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm
deleted file mode 100644
index 5a5aecb..0000000
--- a/FS/FS/cust_bill.pm
+++ /dev/null
@@ -1,4710 +0,0 @@
-package FS::cust_bill;
-
-use strict;
-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);
-use Date::Format;
-use Text::Template 1.20;
-use File::Temp 0.14;
-use String::ShellQuote;
-use HTML::Entities;
-use Locale::Country;
-use Storable qw( freeze thaw );
-use FS::UID qw( datasrc );
-use FS::Misc qw( send_email send_fax generate_ps generate_pdf do_print );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::cust_main_Mixin;
-use FS::cust_main;
-use FS::cust_statement;
-use FS::cust_bill_pkg;
-use FS::cust_bill_pkg_display;
-use FS::cust_bill_pkg_detail;
-use FS::cust_credit;
-use FS::cust_pay;
-use FS::cust_pkg;
-use FS::cust_credit_bill;
-use FS::pay_batch;
-use FS::cust_pay_batch;
-use FS::cust_bill_event;
-use FS::cust_event;
-use FS::part_pkg;
-use FS::cust_bill_pay;
-use FS::cust_bill_pay_batch;
-use FS::part_bill_event;
-use FS::payby;
-use FS::bill_batch;
-use FS::cust_bill_batch;
-
-@ISA = qw( FS::cust_main_Mixin FS::Record );
-
-$DEBUG = 0;
-$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';
- $rdate_format = $conf->config('date_format') || '%m/%d/%Y';
-} );
-
-=head1 NAME
-
-FS::cust_bill - Object methods for cust_bill records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill;
-
- $record = new FS::cust_bill \%hash;
- $record = new FS::cust_bill { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- ( $total_previous_balance, @previous_cust_bill ) = $record->previous;
-
- @cust_bill_pkg_objects = $cust_bill->cust_bill_pkg;
-
- ( $total_previous_credits, @previous_cust_credit ) = $record->cust_credit;
-
- @cust_pay_objects = $cust_bill->cust_pay;
-
- $tax_amount = $record->tax;
-
- @lines = $cust_bill->print_text;
- @lines = $cust_bill->print_text $time;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill object represents an invoice; a declaration that a customer
-owes you money. The specific charges are itemized as B<cust_bill_pkg> records
-(see L<FS::cust_bill_pkg>). FS::cust_bill inherits from FS::Record. The
-following fields are currently supported:
-
-Regular fields
-
-=over 4
-
-=item invnum - primary key (assigned automatically for new invoices)
-
-=item custnum - customer (see L<FS::cust_main>)
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item charged - amount of this invoice
-
-=item invoice_terms - optional terms override for this specific invoice
-
-=back
-
-Customer info at invoice generation time
-
-=over 4
-
-=item previous_balance
-
-=item billing_balance
-
-=back
-
-Deprecated
-
-=over 4
-
-=item printed - deprecated
-
-=back
-
-Specific use cases
-
-=over 4
-
-=item closed - books closed flag, empty or `Y'
-
-=item statementnum - invoice aggregation (see L<FS::cust_statement>)
-
-=item agent_invid - legacy invoice number
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new invoice. To add the invoice to the database, see L<"insert">.
-Invoices are normally created by calling the bill method of a customer object
-(see L<FS::cust_main>).
-
-=cut
-
-sub table { 'cust_bill'; }
-
-sub cust_linked { $_[0]->cust_main_custnum; }
-sub cust_unlinked_msg {
- my $self = shift;
- "WARNING: can't find cust_main.custnum ". $self->custnum.
- ' (cust_bill.invnum '. $self->invnum. ')';
-}
-
-=item insert
-
-Adds this invoice to the database ("Posts" the invoice). If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub insert {
- my $self = shift;
- warn "$me insert called\n" if $DEBUG;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $self->get('cust_bill_pkg') ) {
- foreach my $cust_bill_pkg ( @{$self->get('cust_bill_pkg')} ) {
- $cust_bill_pkg->invnum($self->invnum);
- my $error = $cust_bill_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't create invoice line item: $error";
- }
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item delete
-
-This method now works but you probably shouldn't use it. Instead, apply a
-credit against the invoice.
-
-Using this method to delete invoices outright is really, really bad. There
-would be no record you ever posted this invoice, and there are no check to
-make sure charged = 0 or that there are no associated cust_bill_pkg records.
-
-Really, don't use it.
-
-=cut
-
-sub delete {
- my $self = shift;
- return "Can't delete closed invoice" if $self->closed =~ /^Y/i;
-
- 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 $table (qw(
- cust_bill_event
- cust_event
- cust_credit_bill
- cust_bill_pay
- cust_bill_pay
- cust_credit_bill
- cust_pay_batch
- cust_bill_pay_batch
- cust_bill_pkg
- )) {
-
- foreach my $linked ( $self->$table() ) {
- my $error = $linked->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 ]
-
-You can, but probably shouldn't modify invoices...
-
-Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
-supplied, replaces this record. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-#replace can be inherited from Record.pm
-
-# replace_check is now the preferred way to #implement replace data checks
-# (so $object->replace() works without an argument)
-
-sub replace_check {
- my( $new, $old ) = ( shift, shift );
- return "Can't modify closed invoice" if $old->closed =~ /^Y/i;
- #return "Can't change _date!" unless $old->_date eq $new->_date;
- return "Can't change _date" unless $old->_date == $new->_date;
- return "Can't change charged" unless $old->charged == $new->charged
- || $old->charged == 0;
-
- '';
-}
-
-=item check
-
-Checks all fields to make sure this is a valid invoice. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('invnum')
- || $self->ut_foreign_key('custnum', 'cust_main', 'custnum' )
- || $self->ut_numbern('_date')
- || $self->ut_money('charged')
- || $self->ut_numbern('printed')
- || $self->ut_enum('closed', [ '', 'Y' ])
- || $self->ut_foreign_keyn('statementnum', 'cust_statement', 'statementnum' )
- || $self->ut_numbern('agent_invid') #varchar?
- ;
- return $error if $error;
-
- $self->_date(time) unless $self->_date;
-
- $self->printed(0) if $self->printed eq '';
-
- $self->SUPER::check;
-}
-
-=item display_invnum
-
-Returns the displayed invoice number for this invoice: agent_invid if
-cust_bill-default_agent_invid is set and it has a value, invnum otherwise.
-
-=cut
-
-sub display_invnum {
- my $self = shift;
- if ( $conf->exists('cust_bill-default_agent_invid') && $self->agent_invid ){
- return $self->agent_invid;
- } else {
- return $self->invnum;
- }
-}
-
-=item previous
-
-Returns a list consisting of the total previous balance for this customer,
-followed by the previous outstanding invoices (as FS::cust_bill objects also).
-
-=cut
-
-sub previous {
- my $self = shift;
- my $total = 0;
- my @cust_bill = sort { $a->_date <=> $b->_date }
- grep { $_->owed != 0 && $_->_date < $self->_date }
- qsearch( 'cust_bill', { 'custnum' => $self->custnum } )
- ;
- foreach ( @cust_bill ) { $total += $_->owed; }
- $total, @cust_bill;
-}
-
-=item cust_bill_pkg
-
-Returns the line items (see L<FS::cust_bill_pkg>) for this invoice.
-
-=cut
-
-sub cust_bill_pkg {
- my $self = shift;
- qsearch(
- { 'table' => 'cust_bill_pkg',
- 'hashref' => { 'invnum' => $self->invnum },
- 'order_by' => 'ORDER BY billpkgnum',
- }
- );
-}
-
-=item cust_bill_pkg_pkgnum PKGNUM
-
-Returns the line items (see L<FS::cust_bill_pkg>) for this invoice and
-specified pkgnum.
-
-=cut
-
-sub cust_bill_pkg_pkgnum {
- my( $self, $pkgnum ) = @_;
- qsearch(
- { 'table' => 'cust_bill_pkg',
- 'hashref' => { 'invnum' => $self->invnum,
- 'pkgnum' => $pkgnum,
- },
- 'order_by' => 'ORDER BY billpkgnum',
- }
- );
-}
-
-=item cust_pkg
-
-Returns the packages (see L<FS::cust_pkg>) corresponding to the line items for
-this invoice.
-
-=cut
-
-sub cust_pkg {
- my $self = shift;
- my @cust_pkg = map { $_->pkgnum > 0 ? $_->cust_pkg : () }
- $self->cust_bill_pkg;
- my %saw = ();
- grep { ! $saw{$_->pkgnum}++ } @cust_pkg;
-}
-
-=item no_auto
-
-Returns true if any of the packages (or their definitions) corresponding to the
-line items for this invoice have the no_auto flag set.
-
-=cut
-
-sub no_auto {
- my $self = shift;
- grep { $_->no_auto || $_->part_pkg->no_auto } $self->cust_pkg;
-}
-
-=item open_cust_bill_pkg
-
-Returns the open line items for this invoice.
-
-Note that cust_bill_pkg with both setup and recur fees are returned as two
-separate line items, each with only one fee.
-
-=cut
-
-# modeled after cust_main::open_cust_bill
-sub open_cust_bill_pkg {
- my $self = shift;
-
- # grep { $_->owed > 0 } $self->cust_bill_pkg
-
- my %other = ( 'recur' => 'setup',
- 'setup' => 'recur', );
- my @open = ();
- foreach my $field ( qw( recur setup )) {
- push @open, map { $_->set( $other{$field}, 0 ); $_; }
- grep { $_->owed($field) > 0 }
- $self->cust_bill_pkg;
- }
-
- @open;
-}
-
-=item cust_bill_event
-
-Returns the completed invoice events (deprecated, old-style events - see L<FS::cust_bill_event>) for this invoice.
-
-=cut
-
-sub cust_bill_event {
- my $self = shift;
- qsearch( 'cust_bill_event', { 'invnum' => $self->invnum } );
-}
-
-=item num_cust_bill_event
-
-Returns the number of completed invoice events (deprecated, old-style events - see L<FS::cust_bill_event>) for this invoice.
-
-=cut
-
-sub num_cust_bill_event {
- my $self = shift;
- my $sql =
- "SELECT COUNT(*) FROM cust_bill_event WHERE invnum = ?";
- my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
- $sth->execute($self->invnum) or die $sth->errstr. " executing $sql";
- $sth->fetchrow_arrayref->[0];
-}
-
-=item cust_event
-
-Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
-
-=cut
-
-#false laziness w/cust_pkg.pm
-sub cust_event {
- my $self = shift;
- qsearch({
- 'table' => 'cust_event',
- 'addl_from' => 'JOIN part_event USING ( eventpart )',
- 'hashref' => { 'tablenum' => $self->invnum },
- 'extra_sql' => " AND eventtable = 'cust_bill' ",
- });
-}
-
-=item num_cust_event
-
-Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
-
-=cut
-
-#false laziness w/cust_pkg.pm
-sub num_cust_event {
- my $self = shift;
- my $sql =
- "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
- " WHERE tablenum = ? AND eventtable = 'cust_bill'";
- my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
- $sth->execute($self->invnum) or die $sth->errstr. " executing $sql";
- $sth->fetchrow_arrayref->[0];
-}
-
-=item cust_main
-
-Returns the customer (see L<FS::cust_main>) for this invoice.
-
-=cut
-
-sub cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
-=item cust_suspend_if_balance_over AMOUNT
-
-Suspends the customer associated with this invoice if the total amount owed on
-this invoice and all older invoices is greater than the specified amount.
-
-Returns a list: an empty list on success or a list of errors.
-
-=cut
-
-sub cust_suspend_if_balance_over {
- my( $self, $amount ) = ( shift, shift );
- my $cust_main = $self->cust_main;
- if ( $cust_main->total_owed_date($self->_date) < $amount ) {
- return ();
- } else {
- $cust_main->suspend(@_);
- }
-}
-
-=item cust_credit
-
-Depreciated. See the cust_credited method.
-
- #Returns a list consisting of the total previous credited (see
- #L<FS::cust_credit>) and unapplied for this customer, followed by the previous
- #outstanding credits (FS::cust_credit objects).
-
-=cut
-
-sub cust_credit {
- use Carp;
- croak "FS::cust_bill->cust_credit depreciated; see ".
- "FS::cust_bill->cust_credit_bill";
- #my $self = shift;
- #my $total = 0;
- #my @cust_credit = sort { $a->_date <=> $b->_date }
- # grep { $_->credited != 0 && $_->_date < $self->_date }
- # qsearch('cust_credit', { 'custnum' => $self->custnum } )
- #;
- #foreach (@cust_credit) { $total += $_->credited; }
- #$total, @cust_credit;
-}
-
-=item cust_pay
-
-Depreciated. See the cust_bill_pay method.
-
-#Returns all payments (see L<FS::cust_pay>) for this invoice.
-
-=cut
-
-sub cust_pay {
- use Carp;
- croak "FS::cust_bill->cust_pay depreciated; see FS::cust_bill->cust_bill_pay";
- #my $self = shift;
- #sort { $a->_date <=> $b->_date }
- # qsearch( 'cust_pay', { 'invnum' => $self->invnum } )
- #;
-}
-
-sub cust_pay_batch {
- my $self = shift;
- qsearch('cust_pay_batch', { 'invnum' => $self->invnum } );
-}
-
-sub cust_bill_pay_batch {
- my $self = shift;
- qsearch('cust_bill_pay_batch', { 'invnum' => $self->invnum } );
-}
-
-=item cust_bill_pay
-
-Returns all payment applications (see L<FS::cust_bill_pay>) for this invoice.
-
-=cut
-
-sub cust_bill_pay {
- my $self = shift;
- map { $_ } #return $self->num_cust_bill_pay unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_bill_pay', { 'invnum' => $self->invnum } );
-}
-
-=item cust_credited
-
-=item cust_credit_bill
-
-Returns all applied credits (see L<FS::cust_credit_bill>) for this invoice.
-
-=cut
-
-sub cust_credited {
- my $self = shift;
- map { $_ } #return $self->num_cust_credit_bill unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_credit_bill', { 'invnum' => $self->invnum } )
- ;
-}
-
-sub cust_credit_bill {
- shift->cust_credited(@_);
-}
-
-=item cust_bill_pay_pkgnum PKGNUM
-
-Returns all payment applications (see L<FS::cust_bill_pay>) for this invoice
-with matching pkgnum.
-
-=cut
-
-sub cust_bill_pay_pkgnum {
- my( $self, $pkgnum ) = @_;
- map { $_ } #return $self->num_cust_bill_pay_pkgnum($pkgnum) unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_bill_pay', { 'invnum' => $self->invnum,
- 'pkgnum' => $pkgnum,
- }
- );
-}
-
-=item cust_credited_pkgnum PKGNUM
-
-=item cust_credit_bill_pkgnum PKGNUM
-
-Returns all applied credits (see L<FS::cust_credit_bill>) for this invoice
-with matching pkgnum.
-
-=cut
-
-sub cust_credited_pkgnum {
- my( $self, $pkgnum ) = @_;
- map { $_ } #return $self->num_cust_credit_bill_pkgnum($pkgnum) unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_credit_bill', { 'invnum' => $self->invnum,
- 'pkgnum' => $pkgnum,
- }
- );
-}
-
-sub cust_credit_bill_pkgnum {
- shift->cust_credited_pkgnum(@_);
-}
-
-=item tax
-
-Returns the tax amount (see L<FS::cust_bill_pkg>) for this invoice.
-
-=cut
-
-sub tax {
- my $self = shift;
- my $total = 0;
- my @taxlines = qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum ,
- 'pkgnum' => 0 } );
- foreach (@taxlines) { $total += $_->setup; }
- $total;
-}
-
-=item owed
-
-Returns the amount owed (still outstanding) on this invoice, which is charged
-minus all payment applications (see L<FS::cust_bill_pay>) and credit
-applications (see L<FS::cust_credit_bill>).
-
-=cut
-
-sub owed {
- my $self = shift;
- my $balance = $self->charged;
- $balance -= $_->amount foreach ( $self->cust_bill_pay );
- $balance -= $_->amount foreach ( $self->cust_credited );
- $balance = sprintf( "%.2f", $balance);
- $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
- $balance;
-}
-
-sub owed_pkgnum {
- my( $self, $pkgnum ) = @_;
-
- #my $balance = $self->charged;
- my $balance = 0;
- $balance += $_->setup + $_->recur for $self->cust_bill_pkg_pkgnum($pkgnum);
-
- $balance -= $_->amount for $self->cust_bill_pay_pkgnum($pkgnum);
- $balance -= $_->amount for $self->cust_credited_pkgnum($pkgnum);
-
- $balance = sprintf( "%.2f", $balance);
- $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
- $balance;
-}
-
-=item apply_payments_and_credits [ OPTION => VALUE ... ]
-
-Applies unapplied payments and credits to this invoice.
-
-A hash of optional arguments may be passed. Currently "manual" is supported.
-If true, a payment receipt is sent instead of a statement when
-'payment_receipt_email' configuration option is set.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub apply_payments_and_credits {
- my( $self, %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;
-
- $self->select_for_update; #mutex
-
- my @payments = grep { $_->unapplied > 0 } $self->cust_main->cust_pay;
- my @credits = grep { $_->credited > 0 } $self->cust_main->cust_credit;
-
- if ( $conf->exists('pkg-balances') ) {
- # limit @payments & @credits to those w/ a pkgnum grepped from $self
- my %pkgnums = map { $_ => 1 } map $_->pkgnum, $self->cust_bill_pkg;
- @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
- @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
- }
-
- while ( $self->owed > 0 and ( @payments || @credits ) ) {
-
- my $app = '';
- if ( @payments && @credits ) {
-
- #decide which goes first by weight of top (unapplied) line item
-
- my @open_lineitems = $self->open_cust_bill_pkg;
-
- my $max_pay_weight =
- max( map { $_->part_pkg->pay_weight || 0 }
- grep { $_ }
- map { $_->cust_pkg }
- @open_lineitems
- );
- my $max_credit_weight =
- max( map { $_->part_pkg->credit_weight || 0 }
- grep { $_ }
- map { $_->cust_pkg }
- @open_lineitems
- );
-
- #if both are the same... payments first? it has to be something
- if ( $max_pay_weight >= $max_credit_weight ) {
- $app = 'pay';
- } else {
- $app = 'credit';
- }
-
- } elsif ( @payments ) {
- $app = 'pay';
- } elsif ( @credits ) {
- $app = 'credit';
- } else {
- die "guru meditation #12 and 35";
- }
-
- my $unapp_amount;
- if ( $app eq 'pay' ) {
-
- my $payment = shift @payments;
- $unapp_amount = $payment->unapplied;
- $app = new FS::cust_bill_pay { 'paynum' => $payment->paynum };
- $app->pkgnum( $payment->pkgnum )
- if $conf->exists('pkg-balances') && $payment->pkgnum;
-
- } elsif ( $app eq 'credit' ) {
-
- my $credit = shift @credits;
- $unapp_amount = $credit->credited;
- $app = new FS::cust_credit_bill { 'crednum' => $credit->crednum };
- $app->pkgnum( $credit->pkgnum )
- if $conf->exists('pkg-balances') && $credit->pkgnum;
-
- } else {
- die "guru meditation #12 and 35";
- }
-
- my $owed;
- if ( $conf->exists('pkg-balances') && $app->pkgnum ) {
- warn "owed_pkgnum ". $app->pkgnum;
- $owed = $self->owed_pkgnum($app->pkgnum);
- } else {
- $owed = $self->owed;
- }
- next unless $owed > 0;
-
- warn "min ( $unapp_amount, $owed )\n" if $DEBUG;
- $app->amount( sprintf('%.2f', min( $unapp_amount, $owed ) ) );
-
- $app->invnum( $self->invnum );
-
- my $error = $app->insert(%options);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error inserting ". $app->table. " record: $error";
- }
- die $error if $error;
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-
-}
-
-=item generate_email OPTION => VALUE ...
-
-Options:
-
-=over 4
-
-=item from
-
-sender address, required
-
-=item tempate
-
-alternate template name, optional
-
-=item print_text
-
-text attachment arrayref, optional
-
-=item subject
-
-email subject, optional
-
-=item notice_name
-
-notice name instead of "Invoice", optional
-
-=back
-
-Returns an argument list to be passed to L<FS::Misc::send_email>.
-
-=cut
-
-use MIME::Entity;
-
-sub generate_email {
-
- my $self = shift;
- my %args = @_;
-
- my $me = '[FS::cust_bill::generate_email]';
-
- my %return = (
- 'from' => $args{'from'},
- 'subject' => (($args{'subject'}) ? $args{'subject'} : 'Invoice'),
- );
-
- my %opt = (
- 'unsquelch_cdr' => $conf->exists('voip-cdr_email'),
- 'template' => $args{'template'},
- 'notice_name' => ( $args{'notice_name'} || 'Invoice' ),
- );
-
- my $cust_main = $self->cust_main;
-
- if (ref($args{'to'}) eq 'ARRAY') {
- $return{'to'} = $args{'to'};
- } else {
- $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
- $cust_main->invoicing_list
- ];
- }
-
- if ( $conf->exists('invoice_html') ) {
-
- warn "$me creating HTML/text multipart message"
- if $DEBUG;
-
- $return{'nobody'} = 1;
-
- my $alternative = build MIME::Entity
- 'Type' => 'multipart/alternative',
- 'Encoding' => '7bit',
- 'Disposition' => 'inline'
- ;
-
- my $data;
- if ( $conf->exists('invoice_email_pdf')
- and scalar($conf->config('invoice_email_pdf_note')) ) {
-
- warn "$me using 'invoice_email_pdf_note' in multipart message"
- if $DEBUG;
- $data = [ map { $_ . "\n" }
- $conf->config('invoice_email_pdf_note')
- ];
-
- } else {
-
- warn "$me not using 'invoice_email_pdf_note' in multipart message"
- if $DEBUG;
- if ( ref($args{'print_text'}) eq 'ARRAY' ) {
- $data = $args{'print_text'};
- } else {
- $data = [ $self->print_text(\%opt) ];
- }
-
- }
-
- $alternative->attach(
- 'Type' => 'text/plain',
- #'Encoding' => 'quoted-printable',
- 'Encoding' => '7bit',
- 'Data' => $data,
- 'Disposition' => 'inline',
- );
-
- $args{'from'} =~ /\@([\w\.\-]+)/;
- my $from = $1 || 'example.com';
- my $content_id = join('.', rand()*(2**32), $$, time). "\@$from";
-
- my $logo;
- my $agentnum = $cust_main->agentnum;
- if ( defined($args{'template'}) && length($args{'template'})
- && $conf->exists( 'logo_'. $args{'template'}. '.png', $agentnum )
- )
- {
- $logo = 'logo_'. $args{'template'}. '.png';
- } else {
- $logo = "logo.png";
- }
- my $image_data = $conf->config_binary( $logo, $agentnum);
-
- my $image = build MIME::Entity
- 'Type' => 'image/png',
- 'Encoding' => 'base64',
- 'Data' => $image_data,
- 'Filename' => 'logo.png',
- 'Content-ID' => "<$content_id>",
- ;
-
- $alternative->attach(
- 'Type' => 'text/html',
- 'Encoding' => 'quoted-printable',
- 'Data' => [ '<html>',
- ' <head>',
- ' <title>',
- ' '. encode_entities($return{'subject'}),
- ' </title>',
- ' </head>',
- ' <body bgcolor="#e8e8e8">',
- $self->print_html({ 'cid'=>$content_id, %opt }),
- ' </body>',
- '</html>',
- ],
- 'Disposition' => 'inline',
- #'Filename' => 'invoice.pdf',
- );
-
- my @otherparts = ();
- if ( $cust_main->email_csv_cdr ) {
-
- push @otherparts, build MIME::Entity
- 'Type' => 'text/csv',
- 'Encoding' => '7bit',
- 'Data' => [ map { "$_\n" }
- $self->call_details('prepend_billed_number' => 1)
- ],
- 'Disposition' => 'attachment',
- 'Filename' => 'usage-'. $self->invnum. '.csv',
- ;
-
- }
-
- if ( $conf->exists('invoice_email_pdf') ) {
-
- #attaching pdf too:
- # multipart/mixed
- # multipart/related
- # multipart/alternative
- # text/plain
- # text/html
- # image/png
- # application/pdf
-
- my $related = build MIME::Entity 'Type' => 'multipart/related',
- 'Encoding' => '7bit';
-
- #false laziness w/Misc::send_email
- $related->head->replace('Content-type',
- $related->mime_type.
- '; boundary="'. $related->head->multipart_boundary. '"'.
- '; type=multipart/alternative'
- );
-
- $related->add_part($alternative);
-
- $related->add_part($image);
-
- my $pdf = build MIME::Entity $self->mimebuild_pdf(\%opt);
-
- $return{'mimeparts'} = [ $related, $pdf, @otherparts ];
-
- } else {
-
- #no other attachment:
- # multipart/related
- # multipart/alternative
- # text/plain
- # text/html
- # image/png
-
- $return{'content-type'} = 'multipart/related';
- $return{'mimeparts'} = [ $alternative, $image, @otherparts ];
- $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
- #$return{'disposition'} = 'inline';
-
- }
-
- } else {
-
- if ( $conf->exists('invoice_email_pdf') ) {
- warn "$me creating PDF attachment"
- if $DEBUG;
-
- #mime parts arguments a la MIME::Entity->build().
- $return{'mimeparts'} = [
- { $self->mimebuild_pdf(\%opt) }
- ];
- }
-
- if ( $conf->exists('invoice_email_pdf')
- and scalar($conf->config('invoice_email_pdf_note')) ) {
-
- warn "$me using 'invoice_email_pdf_note'"
- if $DEBUG;
- $return{'body'} = [ map { $_ . "\n" }
- $conf->config('invoice_email_pdf_note')
- ];
-
- } else {
-
- warn "$me not using 'invoice_email_pdf_note'"
- if $DEBUG;
- if ( ref($args{'print_text'}) eq 'ARRAY' ) {
- $return{'body'} = $args{'print_text'};
- } else {
- $return{'body'} = [ $self->print_text(\%opt) ];
- }
-
- }
-
- }
-
- %return;
-
-}
-
-=item mimebuild_pdf
-
-Returns a list suitable for passing to MIME::Entity->build(), representing
-this invoice as PDF attachment.
-
-=cut
-
-sub mimebuild_pdf {
- my $self = shift;
- (
- 'Type' => 'application/pdf',
- 'Encoding' => 'base64',
- 'Data' => [ $self->print_pdf(@_) ],
- 'Disposition' => 'attachment',
- 'Filename' => 'invoice-'. $self->invnum. '.pdf',
- );
-}
-
-=item send HASHREF | [ TEMPLATE [ , AGENTNUM [ , INVOICE_FROM [ , AMOUNT ] ] ] ]
-
-Sends this invoice to the destinations configured for this customer: sends
-email, prints and/or faxes. See L<FS::cust_main_invoice>.
-
-Options can be passed as a hashref (recommended) or as a list of up to
-four values for templatename, agentnum, invoice_from and amount.
-
-I<template>, if specified, is the name of a suffix for alternate invoices.
-
-I<agentnum>, if specified, means that this invoice will only be sent for customers
-of the specified agent or agent(s). AGENTNUM can be a scalar agentnum (for a
-single agent) or an arrayref of agentnums.
-
-I<invoice_from>, if specified, overrides the default email invoice From: address.
-
-I<amount>, if specified, only sends the invoice if the total amount owed on this
-invoice and all older invoices is greater than the specified amount.
-
-I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required)
-
-=cut
-
-sub queueable_send {
- my %opt = @_;
-
- my $self = qsearchs('cust_bill', { 'invnum' => $opt{invnum} } )
- or die "invalid invoice number: " . $opt{invnum};
-
- my @args = ( $opt{template}, $opt{agentnum} );
- push @args, $opt{invoice_from}
- if exists($opt{invoice_from}) && $opt{invoice_from};
-
- my $error = $self->send( @args );
- die $error if $error;
-
-}
-
-sub send {
- my $self = shift;
-
- my( $template, $invoice_from, $notice_name );
- my $agentnums = '';
- my $balance_over = 0;
-
- if ( ref($_[0]) ) {
- my $opt = shift;
- $template = $opt->{'template'} || '';
- if ( $agentnums = $opt->{'agentnum'} ) {
- $agentnums = [ $agentnums ] unless ref($agentnums);
- }
- $invoice_from = $opt->{'invoice_from'};
- $balance_over = $opt->{'balance_over'} if $opt->{'balance_over'};
- $notice_name = $opt->{'notice_name'};
- } else {
- $template = scalar(@_) ? shift : '';
- if ( scalar(@_) && $_[0] ) {
- $agentnums = ref($_[0]) ? shift : [ shift ];
- }
- $invoice_from = shift if scalar(@_);
- $balance_over = shift if scalar(@_) && $_[0] !~ /^\s*$/;
- }
-
- return 'N/A' unless ! $agentnums
- or grep { $_ == $self->cust_main->agentnum } @$agentnums;
-
- return ''
- unless $self->cust_main->total_owed_date($self->_date) > $balance_over;
-
- $invoice_from ||= $self->_agent_invoice_from || #XXX should go away
- $conf->config('invoice_from', $self->cust_main->agentnum );
-
- my %opt = (
- 'template' => $template,
- 'invoice_from' => $invoice_from,
- 'notice_name' => ( $notice_name || 'Invoice' ),
- );
-
- my @invoicing_list = $self->cust_main->invoicing_list;
-
- #$self->email_invoice(\%opt)
- $self->email(\%opt)
- if grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list or !@invoicing_list;
-
- #$self->print_invoice(\%opt)
- $self->print(\%opt)
- if grep { $_ eq 'POST' } @invoicing_list; #postal
-
- $self->fax_invoice(\%opt)
- if grep { $_ eq 'FAX' } @invoicing_list; #fax
-
- '';
-
-}
-
-=item email HASHREF | [ TEMPLATE [ , INVOICE_FROM ] ]
-
-Emails this invoice.
-
-Options can be passed as a hashref (recommended) or as a list of up to
-two values for templatename and invoice_from.
-
-I<template>, if specified, is the name of a suffix for alternate invoices.
-
-I<invoice_from>, if specified, overrides the default email invoice From: address.
-
-I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required)
-
-=cut
-
-sub queueable_email {
- my %opt = @_;
-
- my $self = qsearchs('cust_bill', { 'invnum' => $opt{invnum} } )
- or die "invalid invoice number: " . $opt{invnum};
-
- my @args = ( $opt{template} );
- push @args, $opt{invoice_from}
- if exists($opt{invoice_from}) && $opt{invoice_from};
-
- my $error = $self->email( @args );
- die $error if $error;
-
-}
-
-#sub email_invoice {
-sub email {
- my $self = shift;
-
- my( $template, $invoice_from, $notice_name );
- if ( ref($_[0]) ) {
- my $opt = shift;
- $template = $opt->{'template'} || '';
- $invoice_from = $opt->{'invoice_from'};
- $notice_name = $opt->{'notice_name'} || 'Invoice';
- } else {
- $template = scalar(@_) ? shift : '';
- $invoice_from = shift if scalar(@_);
- $notice_name = 'Invoice';
- }
-
- $invoice_from ||= $self->_agent_invoice_from || #XXX should go away
- $conf->config('invoice_from', $self->cust_main->agentnum );
-
- my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ }
- $self->cust_main->invoicing_list;
-
- #better to notify this person than silence
- @invoicing_list = ($invoice_from) unless @invoicing_list;
-
- my $subject = $self->email_subject($template);
-
- my $error = send_email(
- $self->generate_email(
- 'from' => $invoice_from,
- 'to' => [ grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list ],
- 'subject' => $subject,
- 'template' => $template,
- 'notice_name' => $notice_name,
- )
- );
- die "can't email invoice: $error\n" if $error;
- #die "$error\n" if $error;
-
-}
-
-sub email_subject {
- my $self = shift;
-
- #my $template = scalar(@_) ? shift : '';
- #per-template?
-
- my $subject = $conf->config('invoice_subject', $self->cust_main->agentnum)
- || 'Invoice';
-
- my $cust_main = $self->cust_main;
- my $name = $cust_main->name;
- my $name_short = $cust_main->name_short;
- my $invoice_number = $self->invnum;
- my $invoice_date = $self->_date_pretty;
-
- eval qq("$subject");
-}
-
-=item lpr_data HASHREF | [ TEMPLATE ]
-
-Returns the postscript or plaintext for this invoice as an arrayref.
-
-Options can be passed as a hashref (recommended) or as a single optional value
-for template.
-
-I<template>, if specified, is the name of a suffix for alternate invoices.
-
-I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required)
-
-=cut
-
-sub lpr_data {
- my $self = shift;
- my( $template, $notice_name );
- if ( ref($_[0]) ) {
- my $opt = shift;
- $template = $opt->{'template'} || '';
- $notice_name = $opt->{'notice_name'} || 'Invoice';
- } else {
- $template = scalar(@_) ? shift : '';
- $notice_name = 'Invoice';
- }
-
- my %opt = (
- 'template' => $template,
- 'notice_name' => $notice_name,
- );
-
- my $method = $conf->exists('invoice_latex') ? 'print_ps' : 'print_text';
- [ $self->$method( \%opt ) ];
-}
-
-=item print HASHREF | [ TEMPLATE ]
-
-Prints this invoice.
-
-Options can be passed as a hashref (recommended) or as a single optional
-value for template.
-
-I<template>, if specified, is the name of a suffix for alternate invoices.
-
-I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required)
-
-=cut
-
-#sub print_invoice {
-sub print {
- my $self = shift;
- my( $template, $notice_name );
- if ( ref($_[0]) ) {
- my $opt = shift;
- $template = $opt->{'template'} || '';
- $notice_name = $opt->{'notice_name'} || 'Invoice';
- } else {
- $template = scalar(@_) ? shift : '';
- $notice_name = 'Invoice';
- }
-
- my %opt = (
- 'template' => $template,
- 'notice_name' => $notice_name,
- );
-
- if($conf->exists('invoice_print_pdf')) {
- # Add the invoice to the current batch.
- $self->batch_invoice(\%opt);
- }
- else {
- do_print $self->lpr_data(\%opt);
- }
-}
-
-=item fax_invoice HASHREF | [ TEMPLATE ]
-
-Faxes this invoice.
-
-Options can be passed as a hashref (recommended) or as a single optional
-value for template.
-
-I<template>, if specified, is the name of a suffix for alternate invoices.
-
-I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required)
-
-=cut
-
-sub fax_invoice {
- my $self = shift;
- my( $template, $notice_name );
- if ( ref($_[0]) ) {
- my $opt = shift;
- $template = $opt->{'template'} || '';
- $notice_name = $opt->{'notice_name'} || 'Invoice';
- } else {
- $template = scalar(@_) ? shift : '';
- $notice_name = 'Invoice';
- }
-
- die 'FAX invoice destination not (yet?) supported with plain text invoices.'
- unless $conf->exists('invoice_latex');
-
- my $dialstring = $self->cust_main->getfield('fax');
- #Check $dialstring?
-
- my %opt = (
- 'template' => $template,
- 'notice_name' => $notice_name,
- );
-
- my $error = send_fax( 'docdata' => $self->lpr_data(\%opt),
- 'dialstring' => $dialstring,
- );
- die $error if $error;
-
-}
-
-=item batch_invoice [ HASHREF ]
-
-Place this invoice into the open batch (see C<FS::bill_batch>). If there
-isn't an open batch, one will be created.
-
-=cut
-
-sub batch_invoice {
- my ($self, $opt) = @_;
- my $batch = FS::bill_batch->get_open_batch;
- my $cust_bill_batch = FS::cust_bill_batch->new({
- batchnum => $batch->batchnum,
- invnum => $self->invnum,
- });
- return $cust_bill_batch->insert($opt);
-}
-
-=item ftp_invoice [ TEMPLATENAME ]
-
-Sends this invoice data via FTP.
-
-TEMPLATENAME is unused?
-
-=cut
-
-sub ftp_invoice {
- my $self = shift;
- my $template = scalar(@_) ? shift : '';
-
- $self->send_csv(
- 'protocol' => 'ftp',
- 'server' => $conf->config('cust_bill-ftpserver'),
- 'username' => $conf->config('cust_bill-ftpusername'),
- 'password' => $conf->config('cust_bill-ftppassword'),
- 'dir' => $conf->config('cust_bill-ftpdir'),
- 'format' => $conf->config('cust_bill-ftpformat'),
- );
-}
-
-=item spool_invoice [ TEMPLATENAME ]
-
-Spools this invoice data (see L<FS::spool_csv>)
-
-TEMPLATENAME is unused?
-
-=cut
-
-sub spool_invoice {
- my $self = shift;
- my $template = scalar(@_) ? shift : '';
-
- $self->spool_csv(
- 'format' => $conf->config('cust_bill-spoolformat'),
- 'agent_spools' => $conf->exists('cust_bill-spoolagent'),
- );
-}
-
-=item send_if_newest [ TEMPLATENAME [ , AGENTNUM [ , INVOICE_FROM ] ] ]
-
-Like B<send>, but only sends the invoice if it is the newest open invoice for
-this customer.
-
-=cut
-
-sub send_if_newest {
- my $self = shift;
-
- return ''
- if scalar(
- grep { $_->owed > 0 }
- qsearch('cust_bill', {
- 'custnum' => $self->custnum,
- #'_date' => { op=>'>', value=>$self->_date },
- 'invnum' => { op=>'>', value=>$self->invnum },
- } )
- );
-
- $self->send(@_);
-}
-
-=item send_csv OPTION => VALUE, ...
-
-Sends invoice as a CSV data-file to a remote host with the specified protocol.
-
-Options are:
-
-protocol - currently only "ftp"
-server
-username
-password
-dir
-
-The file will be named "N-YYYYMMDDHHMMSS.csv" where N is the invoice number
-and YYMMDDHHMMSS is a timestamp.
-
-See L</print_csv> for a description of the output format.
-
-=cut
-
-sub send_csv {
- my($self, %opt) = @_;
-
- #create file(s)
-
- my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/cust_bill";
- mkdir $spooldir, 0700 unless -d $spooldir;
-
- my $tracctnum = $self->invnum. time2str('-%Y%m%d%H%M%S', time);
- my $file = "$spooldir/$tracctnum.csv";
-
- my ( $header, $detail ) = $self->print_csv(%opt, 'tracctnum' => $tracctnum );
-
- open(CSV, ">$file") or die "can't open $file: $!";
- print CSV $header;
-
- print CSV $detail;
-
- close CSV;
-
- my $net;
- if ( $opt{protocol} eq 'ftp' ) {
- eval "use Net::FTP;";
- die $@ if $@;
- $net = Net::FTP->new($opt{server}) or die @$;
- } else {
- die "unknown protocol: $opt{protocol}";
- }
-
- $net->login( $opt{username}, $opt{password} )
- or die "can't FTP to $opt{username}\@$opt{server}: login error: $@";
-
- $net->binary or die "can't set binary mode";
-
- $net->cwd($opt{dir}) or die "can't cwd to $opt{dir}";
-
- $net->put($file) or die "can't put $file: $!";
-
- $net->quit;
-
- unlink $file;
-
-}
-
-=item spool_csv
-
-Spools CSV invoice data.
-
-Options are:
-
-=over 4
-
-=item format - 'default' or 'billco'
-
-=item dest - if set (to POST, EMAIL or FAX), only sends spools invoices if the customer has the corresponding invoice destinations set (see L<FS::cust_main_invoice>).
-
-=item agent_spools - if set to a true value, will spool to per-agent files rather than a single global file
-
-=item balanceover - if set, only spools the invoice if the total amount owed on this invoice and all older invoices is greater than the specified amount.
-
-=back
-
-=cut
-
-sub spool_csv {
- my($self, %opt) = @_;
-
- my $cust_main = $self->cust_main;
-
- if ( $opt{'dest'} ) {
- my %invoicing_list = map { /^(POST|FAX)$/ or 'EMAIL' =~ /^(.*)$/; $1 => 1 }
- $cust_main->invoicing_list;
- return 'N/A' unless $invoicing_list{$opt{'dest'}}
- || ! keys %invoicing_list;
- }
-
- if ( $opt{'balanceover'} ) {
- return 'N/A'
- if $cust_main->total_owed_date($self->_date) < $opt{'balanceover'};
- }
-
- my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/cust_bill";
- mkdir $spooldir, 0700 unless -d $spooldir;
-
- my $tracctnum = $self->invnum. time2str('-%Y%m%d%H%M%S', time);
-
- my $file =
- "$spooldir/".
- ( $opt{'agent_spools'} ? 'agentnum'.$cust_main->agentnum : 'spool' ).
- ( lc($opt{'format'}) eq 'billco' ? '-header' : '' ) .
- '.csv';
-
- my ( $header, $detail ) = $self->print_csv(%opt, 'tracctnum' => $tracctnum );
-
- open(CSV, ">>$file") or die "can't open $file: $!";
- flock(CSV, LOCK_EX);
- seek(CSV, 0, 2);
-
- print CSV $header;
-
- if ( lc($opt{'format'}) eq 'billco' ) {
-
- flock(CSV, LOCK_UN);
- close CSV;
-
- $file =
- "$spooldir/".
- ( $opt{'agent_spools'} ? 'agentnum'.$cust_main->agentnum : 'spool' ).
- '-detail.csv';
-
- open(CSV,">>$file") or die "can't open $file: $!";
- flock(CSV, LOCK_EX);
- seek(CSV, 0, 2);
- }
-
- print CSV $detail;
-
- flock(CSV, LOCK_UN);
- close CSV;
-
- return '';
-
-}
-
-=item print_csv OPTION => VALUE, ...
-
-Returns CSV data for this invoice.
-
-Options are:
-
-format - 'default' or 'billco'
-
-Returns a list consisting of two scalars. The first is a single line of CSV
-header information for this invoice. The second is one or more lines of CSV
-detail information for this invoice.
-
-If I<format> is not specified or "default", the fields of the CSV file are as
-follows:
-
-record_type, invnum, custnum, _date, charged, first, last, company, address1, address2, city, state, zip, country, pkg, setup, recur, sdate, edate
-
-=over 4
-
-=item record type - B<record_type> is either C<cust_bill> or C<cust_bill_pkg>
-
-B<record_type> is C<cust_bill> for the initial header line only. The
-last five fields (B<pkg> through B<edate>) are irrelevant, and all other
-fields are filled in.
-
-B<record_type> is C<cust_bill_pkg> for detail lines. Only the first two fields
-(B<record_type> and B<invnum>) and the last five fields (B<pkg> through B<edate>)
-are filled in.
-
-=item invnum - invoice number
-
-=item custnum - customer number
-
-=item _date - invoice date
-
-=item charged - total invoice amount
-
-=item first - customer first name
-
-=item last - customer first name
-
-=item company - company name
-
-=item address1 - address line 1
-
-=item address2 - address line 1
-
-=item city
-
-=item state
-
-=item zip
-
-=item country
-
-=item pkg - line item description
-
-=item setup - line item setup fee (one or both of B<setup> and B<recur> will be defined)
-
-=item recur - line item recurring fee (one or both of B<setup> and B<recur> will be defined)
-
-=item sdate - start date for recurring fee
-
-=item edate - end date for recurring fee
-
-=back
-
-If I<format> is "billco", the fields of the header CSV file are as follows:
-
- +-------------------------------------------------------------------+
- | FORMAT HEADER FILE |
- |-------------------------------------------------------------------|
- | Field | Description | Name | Type | Width |
- | 1 | N/A-Leave Empty | RC | CHAR | 2 |
- | 2 | N/A-Leave Empty | CUSTID | CHAR | 15 |
- | 3 | Transaction Account No | TRACCTNUM | CHAR | 15 |
- | 4 | Transaction Invoice No | TRINVOICE | CHAR | 15 |
- | 5 | Transaction Zip Code | TRZIP | CHAR | 5 |
- | 6 | Transaction Company Bill To | TRCOMPANY | CHAR | 30 |
- | 7 | Transaction Contact Bill To | TRNAME | CHAR | 30 |
- | 8 | Additional Address Unit Info | TRADDR1 | CHAR | 30 |
- | 9 | Bill To Street Address | TRADDR2 | CHAR | 30 |
- | 10 | Ancillary Billing Information | TRADDR3 | CHAR | 30 |
- | 11 | Transaction City Bill To | TRCITY | CHAR | 20 |
- | 12 | Transaction State Bill To | TRSTATE | CHAR | 2 |
- | 13 | Bill Cycle Close Date | CLOSEDATE | CHAR | 10 |
- | 14 | Bill Due Date | DUEDATE | CHAR | 10 |
- | 15 | Previous Balance | BALFWD | NUM* | 9 |
- | 16 | Pmt/CR Applied | CREDAPPLY | NUM* | 9 |
- | 17 | Total Current Charges | CURRENTCHG | NUM* | 9 |
- | 18 | Total Amt Due | TOTALDUE | NUM* | 9 |
- | 19 | Total Amt Due | AMTDUE | NUM* | 9 |
- | 20 | 30 Day Aging | AMT30 | NUM* | 9 |
- | 21 | 60 Day Aging | AMT60 | NUM* | 9 |
- | 22 | 90 Day Aging | AMT90 | NUM* | 9 |
- | 23 | Y/N | AGESWITCH | CHAR | 1 |
- | 24 | Remittance automation | SCANLINE | CHAR | 100 |
- | 25 | Total Taxes & Fees | TAXTOT | NUM* | 9 |
- | 26 | Customer Reference Number | CUSTREF | CHAR | 15 |
- | 27 | Federal Tax*** | FEDTAX | NUM* | 9 |
- | 28 | State Tax*** | STATETAX | NUM* | 9 |
- | 29 | Other Taxes & Fees*** | OTHERTAX | NUM* | 9 |
- +-------+-------------------------------+------------+------+-------+
-
-If I<format> is "billco", the fields of the detail CSV file are as follows:
-
- FORMAT FOR DETAIL FILE
- | | | |
- Field | Description | Name | Type | Width
- 1 | N/A-Leave Empty | RC | CHAR | 2
- 2 | N/A-Leave Empty | CUSTID | CHAR | 15
- 3 | Account Number | TRACCTNUM | CHAR | 15
- 4 | Invoice Number | TRINVOICE | CHAR | 15
- 5 | Line Sequence (sort order) | LINESEQ | NUM | 6
- 6 | Transaction Detail | DETAILS | CHAR | 100
- 7 | Amount | AMT | NUM* | 9
- 8 | Line Format Control** | LNCTRL | CHAR | 2
- 9 | Grouping Code | GROUP | CHAR | 2
- 10 | User Defined | ACCT CODE | CHAR | 15
-
-=cut
-
-sub print_csv {
- my($self, %opt) = @_;
-
- eval "use Text::CSV_XS";
- die $@ if $@;
-
- my $cust_main = $self->cust_main;
-
- my $csv = Text::CSV_XS->new({'always_quote'=>1});
-
- if ( lc($opt{'format'}) eq 'billco' ) {
-
- my $taxtotal = 0;
- $taxtotal += $_->{'amount'} foreach $self->_items_tax;
-
- my $duedate = $self->due_date2str('%m/%d/%Y'); #date_format?
-
- my( $previous_balance, @unused ) = $self->previous; #previous balance
-
- my $pmt_cr_applied = 0;
- $pmt_cr_applied += $_->{'amount'}
- foreach ( $self->_items_payments, $self->_items_credits ) ;
-
- my $totaldue = sprintf('%.2f', $self->owed + $previous_balance);
-
- $csv->combine(
- '', # 1 | N/A-Leave Empty CHAR 2
- '', # 2 | N/A-Leave Empty CHAR 15
- $opt{'tracctnum'}, # 3 | Transaction Account No CHAR 15
- $self->invnum, # 4 | Transaction Invoice No CHAR 15
- $cust_main->zip, # 5 | Transaction Zip Code CHAR 5
- $cust_main->company, # 6 | Transaction Company Bill To CHAR 30
- #$cust_main->payname, # 7 | Transaction Contact Bill To CHAR 30
- $cust_main->contact, # 7 | Transaction Contact Bill To CHAR 30
- $cust_main->address2, # 8 | Additional Address Unit Info CHAR 30
- $cust_main->address1, # 9 | Bill To Street Address CHAR 30
- '', # 10 | Ancillary Billing Information CHAR 30
- $cust_main->city, # 11 | Transaction City Bill To CHAR 20
- $cust_main->state, # 12 | Transaction State Bill To CHAR 2
-
- # XXX ?
- time2str("%m/%d/%Y", $self->_date), # 13 | Bill Cycle Close Date CHAR 10
-
- # XXX ?
- $duedate, # 14 | Bill Due Date CHAR 10
-
- $previous_balance, # 15 | Previous Balance NUM* 9
- $pmt_cr_applied, # 16 | Pmt/CR Applied NUM* 9
- sprintf("%.2f", $self->charged), # 17 | Total Current Charges NUM* 9
- $totaldue, # 18 | Total Amt Due NUM* 9
- $totaldue, # 19 | Total Amt Due NUM* 9
- '', # 20 | 30 Day Aging NUM* 9
- '', # 21 | 60 Day Aging NUM* 9
- '', # 22 | 90 Day Aging NUM* 9
- 'N', # 23 | Y/N CHAR 1
- '', # 24 | Remittance automation CHAR 100
- $taxtotal, # 25 | Total Taxes & Fees NUM* 9
- $self->custnum, # 26 | Customer Reference Number CHAR 15
- '0', # 27 | Federal Tax*** NUM* 9
- sprintf("%.2f", $taxtotal), # 28 | State Tax*** NUM* 9
- '0', # 29 | Other Taxes & Fees*** NUM* 9
- );
-
- } else {
-
- $csv->combine(
- 'cust_bill',
- $self->invnum,
- $self->custnum,
- time2str("%x", $self->_date),
- sprintf("%.2f", $self->charged),
- ( map { $cust_main->getfield($_) }
- qw( first last company address1 address2 city state zip country ) ),
- map { '' } (1..5),
- ) or die "can't create csv";
- }
-
- my $header = $csv->string. "\n";
-
- my $detail = '';
- if ( lc($opt{'format'}) eq 'billco' ) {
-
- my $lineseq = 0;
- foreach my $item ( $self->_items_pkg ) {
-
- $csv->combine(
- '', # 1 | N/A-Leave Empty CHAR 2
- '', # 2 | N/A-Leave Empty CHAR 15
- $opt{'tracctnum'}, # 3 | Account Number CHAR 15
- $self->invnum, # 4 | Invoice Number CHAR 15
- $lineseq++, # 5 | Line Sequence (sort order) NUM 6
- $item->{'description'}, # 6 | Transaction Detail CHAR 100
- $item->{'amount'}, # 7 | Amount NUM* 9
- '', # 8 | Line Format Control** CHAR 2
- '', # 9 | Grouping Code CHAR 2
- '', # 10 | User Defined CHAR 15
- );
-
- $detail .= $csv->string. "\n";
-
- }
-
- } else {
-
- foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) {
-
- my($pkg, $setup, $recur, $sdate, $edate);
- if ( $cust_bill_pkg->pkgnum ) {
-
- ($pkg, $setup, $recur, $sdate, $edate) = (
- $cust_bill_pkg->part_pkg->pkg,
- ( $cust_bill_pkg->setup != 0
- ? sprintf("%.2f", $cust_bill_pkg->setup )
- : '' ),
- ( $cust_bill_pkg->recur != 0
- ? sprintf("%.2f", $cust_bill_pkg->recur )
- : '' ),
- ( $cust_bill_pkg->sdate
- ? time2str("%x", $cust_bill_pkg->sdate)
- : '' ),
- ($cust_bill_pkg->edate
- ?time2str("%x", $cust_bill_pkg->edate)
- : '' ),
- );
-
- } else { #pkgnum tax
- next unless $cust_bill_pkg->setup != 0;
- $pkg = $cust_bill_pkg->desc;
- $setup = sprintf('%10.2f', $cust_bill_pkg->setup );
- ( $sdate, $edate ) = ( '', '' );
- }
-
- $csv->combine(
- 'cust_bill_pkg',
- $self->invnum,
- ( map { '' } (1..11) ),
- ($pkg, $setup, $recur, $sdate, $edate)
- ) or die "can't create csv";
-
- $detail .= $csv->string. "\n";
-
- }
-
- }
-
- ( $header, $detail );
-
-}
-
-=item comp
-
-Pays this invoice with a compliemntary payment. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub comp {
- my $self = shift;
- my $cust_pay = new FS::cust_pay ( {
- 'invnum' => $self->invnum,
- 'paid' => $self->owed,
- '_date' => '',
- 'payby' => 'COMP',
- 'payinfo' => $self->cust_main->payinfo,
- 'paybatch' => '',
- } );
- $cust_pay->insert;
-}
-
-=item realtime_card
-
-Attempts to pay this invoice with a credit card payment via a
-Business::OnlinePayment realtime gateway. See
-http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment
-for supported processors.
-
-=cut
-
-sub realtime_card {
- my $self = shift;
- $self->realtime_bop( 'CC', @_ );
-}
-
-=item realtime_ach
-
-Attempts to pay this invoice with an electronic check (ACH) payment via a
-Business::OnlinePayment realtime gateway. See
-http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment
-for supported processors.
-
-=cut
-
-sub realtime_ach {
- my $self = shift;
- $self->realtime_bop( 'ECHECK', @_ );
-}
-
-=item realtime_lec
-
-Attempts to pay this invoice with phone bill (LEC) payment via a
-Business::OnlinePayment realtime gateway. See
-http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment
-for supported processors.
-
-=cut
-
-sub realtime_lec {
- my $self = shift;
- $self->realtime_bop( 'LEC', @_ );
-}
-
-sub realtime_bop {
- my( $self, $method ) = @_;
-
- my $cust_main = $self->cust_main;
- my $balance = $cust_main->balance;
- my $amount = ( $balance < $self->owed ) ? $balance : $self->owed;
- $amount = sprintf("%.2f", $amount);
- return "not run (balance $balance)" unless $amount > 0;
-
- my $description = 'Internet Services';
- if ( $conf->exists('business-onlinepayment-description') ) {
- my $dtempl = $conf->config('business-onlinepayment-description');
-
- my $agent_obj = $cust_main->agent
- or die "can't retreive agent for $cust_main (agentnum ".
- $cust_main->agentnum. ")";
- my $agent = $agent_obj->agent;
- my $pkgs = join(', ',
- map { $_->part_pkg->pkg }
- grep { $_->pkgnum } $self->cust_bill_pkg
- );
- $description = eval qq("$dtempl");
- }
-
- $cust_main->realtime_bop($method, $amount,
- 'description' => $description,
- 'invnum' => $self->invnum,
-#this didn't do what we want, it just calls apply_payments_and_credits
-# 'apply' => 1,
- 'apply_to_invoice' => 1,
- #what we want:
- #this changes application behavior: auto payments
- #triggered against a specific invoice are now applied
- #to that invoice instead of oldest open.
- #seem okay to me...
- );
-
-}
-
-=item batch_card OPTION => VALUE...
-
-Adds a payment for this invoice to the pending credit card batch (see
-L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
-runs the payment using a realtime gateway.
-
-=cut
-
-sub batch_card {
- my ($self, %options) = @_;
- my $cust_main = $self->cust_main;
-
- $options{invnum} = $self->invnum;
-
- $cust_main->batch_card(%options);
-}
-
-sub _agent_template {
- my $self = shift;
- $self->cust_main->agent_template;
-}
-
-sub _agent_invoice_from {
- my $self = shift;
- $self->cust_main->agent_invoice_from;
-}
-
-=item print_text HASHREF | [ TIME [ , TEMPLATE [ , OPTION => VALUE ... ] ] ]
-
-Returns an text invoice, as a list of lines.
-
-Options can be passed as a hashref (recommended) or as a list of time, template
-and then any key/value pairs for any other options.
-
-I<time>, if specified, is used to control the printing of overdue messages. The
-default is now. It isn't the date of the invoice; that's the `_date' field.
-It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-I<template>, if specified, is the name of a suffix for alternate invoices.
-
-I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required)
-
-=cut
-
-sub print_text {
- my $self = shift;
- my( $today, $template, %opt );
- if ( ref($_[0]) ) {
- %opt = %{ shift() };
- $today = delete($opt{'time'}) || '';
- $template = delete($opt{template}) || '';
- } else {
- ( $today, $template, %opt ) = @_;
- }
-
- my %params = ( 'format' => 'template' );
- $params{'time'} = $today if $today;
- $params{'template'} = $template if $template;
- $params{$_} = $opt{$_}
- foreach grep $opt{$_}, qw( unsquealch_cdr notice_name );
-
- $self->print_generic( %params );
-}
-
-=item print_latex HASHREF | [ TIME [ , TEMPLATE [ , OPTION => VALUE ... ] ] ]
-
-Internal method - returns a filename of a filled-in LaTeX template for this
-invoice (Note: add ".tex" to get the actual filename), and a filename of
-an associated logo (with the .eps extension included).
-
-See print_ps and print_pdf for methods that return PostScript and PDF output.
-
-Options can be passed as a hashref (recommended) or as a list of time, template
-and then any key/value pairs for any other options.
-
-I<time>, if specified, is used to control the printing of overdue messages. The
-default is now. It isn't the date of the invoice; that's the `_date' field.
-It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-I<template>, if specified, is the name of a suffix for alternate invoices.
-
-I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required)
-
-=cut
-
-sub print_latex {
- my $self = shift;
- my( $today, $template, %opt );
- if ( ref($_[0]) ) {
- %opt = %{ shift() };
- $today = delete($opt{'time'}) || '';
- $template = delete($opt{template}) || '';
- } else {
- ( $today, $template, %opt ) = @_;
- }
-
- my %params = ( 'format' => 'latex' );
- $params{'time'} = $today if $today;
- $params{'template'} = $template if $template;
- $params{$_} = $opt{$_}
- foreach grep $opt{$_}, qw( unsquealch_cdr notice_name );
-
- $template ||= $self->_agent_template;
-
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- my $lh = new File::Temp( TEMPLATE => 'invoice.'. $self->invnum. '.XXXXXXXX',
- DIR => $dir,
- SUFFIX => '.eps',
- UNLINK => 0,
- ) or die "can't open temp file: $!\n";
-
- my $agentnum = $self->cust_main->agentnum;
-
- if ( $template && $conf->exists("logo_${template}.eps", $agentnum) ) {
- print $lh $conf->config_binary("logo_${template}.eps", $agentnum)
- or die "can't write temp file: $!\n";
- } else {
- print $lh $conf->config_binary('logo.eps', $agentnum)
- or die "can't write temp file: $!\n";
- }
- close $lh;
- $params{'logo_file'} = $lh->filename;
-
- my @filled_in = $self->print_generic( %params );
-
- my $fh = new File::Temp( TEMPLATE => 'invoice.'. $self->invnum. '.XXXXXXXX',
- DIR => $dir,
- SUFFIX => '.tex',
- UNLINK => 0,
- ) or die "can't open temp file: $!\n";
- print $fh join('', @filled_in );
- close $fh;
-
- $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
- return ($1, $params{'logo_file'});
-
-}
-
-=item print_generic OPTION => VALUE ...
-
-Internal method - returns a filled-in template for this invoice as a scalar.
-
-See print_ps and print_pdf for methods that return PostScript and PDF output.
-
-Non optional options include
- format - latex, html, template
-
-Optional options include
-
-template - a value used as a suffix for a configuration template
-
-time - a value used to control the printing of overdue messages. The
-default is now. It isn't the date of the invoice; that's the `_date' field.
-It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-cid -
-
-unsquelch_cdr - overrides any per customer cdr squelching when true
-
-notice_name - overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required)
-
-=cut
-
-#what's with all the sprintf('%10.2f')'s in here? will it cause any
-# (alignment in text invoice?) problems to change them all to '%.2f' ?
-# yes: fixed width (dot matrix) text printing will be borked
-sub print_generic {
-
- my( $self, %params ) = @_;
- my $today = $params{today} ? $params{today} : time;
- warn "$me print_generic called on $self with suffix $params{template}\n"
- if $DEBUG;
-
- my $format = $params{format};
- die "Unknown format: $format"
- unless $format =~ /^(latex|html|template)$/;
-
- my $cust_main = $self->cust_main;
- $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') )
- unless $cust_main->payname
- && $cust_main->payby !~ /^(CARD|DCRD|CHEK|DCHK)$/;
-
- my %delimiters = ( 'latex' => [ '[@--', '--@]' ],
- 'html' => [ '<%=', '%>' ],
- 'template' => [ '{', '}' ],
- );
-
- #create the template
- my $template = $params{template} ? $params{template} : $self->_agent_template;
- my $templatefile = "invoice_$format";
- $templatefile .= "_$template"
- if length($template);
- my @invoice_template = map "$_\n", $conf->config($templatefile)
- or die "cannot load config data $templatefile";
-
- my $old_latex = '';
- if ( $format eq 'latex' && grep { /^%%Detail/ } @invoice_template ) {
- #change this to a die when the old code is removed
- warn "old-style invoice template $templatefile; ".
- "patch with conf/invoice_latex.diff or use new conf/invoice_latex*\n";
- $old_latex = 'true';
- @invoice_template = _translate_old_latex_format(@invoice_template);
- }
-
- my $text_template = new Text::Template(
- TYPE => 'ARRAY',
- SOURCE => \@invoice_template,
- DELIMITERS => $delimiters{$format},
- );
-
- $text_template->compile()
- or die "Can't compile $templatefile: $Text::Template::ERROR\n";
-
-
- # additional substitution could possibly cause breakage in existing templates
- my %convert_maps = (
- 'latex' => {
- 'notes' => sub { map "$_", @_ },
- 'footer' => sub { map "$_", @_ },
- 'smallfooter' => sub { map "$_", @_ },
- 'returnaddress' => sub { map "$_", @_ },
- 'coupon' => sub { map "$_", @_ },
- 'summary' => sub { map "$_", @_ },
- },
- 'html' => {
- 'notes' =>
- sub {
- map {
- s/%%(.*)$/<!-- $1 -->/g;
- s/\\section\*\{\\textsc\{(.)(.*)\}\}/<p><b><font size="+1">$1<\/font>\U$2<\/b>/g;
- s/\\begin\{enumerate\}/<ol>/g;
- s/\\item / <li>/g;
- s/\\end\{enumerate\}/<\/ol>/g;
- s/\\textbf\{(.*)\}/<b>$1<\/b>/g;
- s/\\\\\*/<br>/g;
- s/\\dollar ?/\$/g;
- s/\\#/#/g;
- s/~/&nbsp;/g;
- $_;
- } @_
- },
- 'footer' =>
- sub { map { s/~/&nbsp;/g; s/\\\\\*?\s*$/<BR>/; $_; } @_ },
- 'smallfooter' =>
- sub { map { s/~/&nbsp;/g; s/\\\\\*?\s*$/<BR>/; $_; } @_ },
- 'returnaddress' =>
- sub {
- map {
- s/~/&nbsp;/g;
- s/\\\\\*?\s*$/<BR>/;
- s/\\hyphenation\{[\w\s\-]+}//;
- s/\\([&])/$1/g;
- $_;
- } @_
- },
- 'coupon' => sub { "" },
- 'summary' => sub { "" },
- },
- 'template' => {
- 'notes' =>
- sub {
- map {
- s/%%.*$//g;
- s/\\section\*\{\\textsc\{(.*)\}\}/\U$1/g;
- s/\\begin\{enumerate\}//g;
- s/\\item / * /g;
- s/\\end\{enumerate\}//g;
- s/\\textbf\{(.*)\}/$1/g;
- s/\\\\\*/ /;
- s/\\dollar ?/\$/g;
- $_;
- } @_
- },
- 'footer' =>
- sub { map { s/~/ /g; s/\\\\\*?\s*$/\n/; $_; } @_ },
- 'smallfooter' =>
- sub { map { s/~/ /g; s/\\\\\*?\s*$/\n/; $_; } @_ },
- 'returnaddress' =>
- sub {
- map {
- s/~/ /g;
- s/\\\\\*?\s*$/\n/; # dubious
- s/\\hyphenation\{[\w\s\-]+}//;
- $_;
- } @_
- },
- 'coupon' => sub { "" },
- 'summary' => sub { "" },
- },
- );
-
-
- # hashes for differing output formats
- my %nbsps = ( 'latex' => '~',
- 'html' => '', # '&nbps;' would be nice
- 'template' => '', # not used
- );
- my $nbsp = $nbsps{$format};
-
- my %escape_functions = ( 'latex' => \&_latex_escape,
- 'html' => \&_html_escape_nbsp,#\&encode_entities,
- 'template' => sub { shift },
- );
- my $escape_function = $escape_functions{$format};
- my $escape_function_nonbsp = ($format eq 'html')
- ? \&_html_escape : $escape_function;
-
- my %date_formats = ( 'latex' => '%b %o, %Y',
- 'html' => '%b&nbsp;%o,&nbsp;%Y',
- 'template' => '%s',
- );
- my $date_format = $date_formats{$format};
-
- my %embolden_functions = ( 'latex' => sub { return '\textbf{'. shift(). '}'
- },
- 'html' => sub { return '<b>'. shift(). '</b>'
- },
- 'template' => sub { shift },
- );
- my $embolden_function = $embolden_functions{$format};
-
-
- # generate template variables
- my $returnaddress;
- if (
- defined( $conf->config_orbase( "invoice_${format}returnaddress",
- $template
- )
- )
- && length( $conf->config_orbase( "invoice_${format}returnaddress",
- $template
- )
- )
- ) {
-
- $returnaddress = join("\n",
- $conf->config_orbase("invoice_${format}returnaddress", $template)
- );
-
- } elsif ( grep /\S/,
- $conf->config_orbase('invoice_latexreturnaddress', $template) ) {
-
- my $convert_map = $convert_maps{$format}{'returnaddress'};
- $returnaddress =
- join( "\n",
- &$convert_map( $conf->config_orbase( "invoice_latexreturnaddress",
- $template
- )
- )
- );
- } elsif ( grep /\S/, $conf->config('company_address', $self->cust_main->agentnum) ) {
-
- my $convert_map = $convert_maps{$format}{'returnaddress'};
- $returnaddress = join( "\n", &$convert_map(
- map { s/( {2,})/'~' x length($1)/eg;
- s/$/\\\\\*/;
- $_
- }
- ( $conf->config('company_name', $self->cust_main->agentnum),
- $conf->config('company_address', $self->cust_main->agentnum),
- )
- )
- );
-
- } else {
-
- my $warning = "Couldn't find a return address; ".
- "do you need to set the company_address configuration value?";
- warn "$warning\n";
- $returnaddress = $nbsp;
- #$returnaddress = $warning;
-
- }
-
- my $agentnum = $self->cust_main->agentnum;
-
- my %invoice_data = (
-
- #invoice from info
- 'company_name' => scalar( $conf->config('company_name', $agentnum) ),
- 'company_address' => join("\n", $conf->config('company_address', $agentnum) ). "\n",
- 'returnaddress' => $returnaddress,
- 'agent' => &$escape_function($cust_main->agent->agent),
-
- #invoice info
- 'invnum' => $self->invnum,
- 'date' => time2str($date_format, $self->_date),
- 'today' => time2str('%b %o, %Y', $today),
- 'terms' => $self->terms,
- 'template' => $template, #params{'template'},
- 'notice_name' => ($params{'notice_name'} || 'Invoice'),#escape_function?
- 'current_charges' => sprintf("%.2f", $self->charged),
- 'duedate' => $self->due_date2str($rdate_format), #date_format?
-
- #customer info
- 'custnum' => $cust_main->display_custnum,
- 'agent_custid' => &$escape_function($cust_main->agent_custid),
- ( map { $_ => &$escape_function($cust_main->$_()) } qw(
- payname company address1 address2 city state zip fax
- )),
-
- #global config
- 'ship_enable' => $conf->exists('invoice-ship_address'),
- 'unitprices' => $conf->exists('invoice-unitprice'),
- 'smallernotes' => $conf->exists('invoice-smallernotes'),
- 'smallerfooter' => $conf->exists('invoice-smallerfooter'),
- 'balance_due_below_line' => $conf->exists('balance_due_below_line'),
-
- #layout info -- would be fancy to calc some of this and bury the template
- # here in the code
- 'topmargin' => scalar($conf->config('invoice_latextopmargin', $agentnum)),
- 'headsep' => scalar($conf->config('invoice_latexheadsep', $agentnum)),
- 'textheight' => scalar($conf->config('invoice_latextextheight', $agentnum)),
- 'extracouponspace' => scalar($conf->config('invoice_latexextracouponspace', $agentnum)),
- 'couponfootsep' => scalar($conf->config('invoice_latexcouponfootsep', $agentnum)),
- 'verticalreturnaddress' => $conf->exists('invoice_latexverticalreturnaddress', $agentnum),
- 'addresssep' => scalar($conf->config('invoice_latexaddresssep', $agentnum)),
- 'amountenclosedsep' => scalar($conf->config('invoice_latexcouponamountenclosedsep', $agentnum)),
- 'coupontoaddresssep' => scalar($conf->config('invoice_latexcoupontoaddresssep', $agentnum)),
- 'addcompanytoaddress' => $conf->exists('invoice_latexcouponaddcompanytoaddress', $agentnum),
-
- # better hang on to conf_dir for a while (for old templates)
- 'conf_dir' => "$FS::UID::conf_dir/conf.$FS::UID::datasrc",
-
- #these are only used when doing paged plaintext
- 'page' => 1,
- 'total_pages' => 1,
-
- );
-
- $invoice_data{finance_section} = '';
- if ( $conf->config('finance_pkgclass') ) {
- my $pkg_class =
- qsearchs('pkg_class', { classnum => $conf->config('finance_pkgclass') });
- $invoice_data{finance_section} = $pkg_class->categoryname;
- }
- $invoice_data{finance_amount} = '0.00';
- $invoice_data{finance_section} ||= 'Finance Charges'; #avoid config confusion
-
- my $countrydefault = $conf->config('countrydefault') || 'US';
- my $prefix = $cust_main->has_ship_address ? 'ship_' : '';
- foreach ( qw( contact company address1 address2 city state zip country fax) ){
- my $method = $prefix.$_;
- $invoice_data{"ship_$_"} = _latex_escape($cust_main->$method);
- }
- $invoice_data{'ship_country'} = ''
- if ( $invoice_data{'ship_country'} eq $countrydefault );
-
- $invoice_data{'cid'} = $params{'cid'}
- if $params{'cid'};
-
- if ( $cust_main->country eq $countrydefault ) {
- $invoice_data{'country'} = '';
- } else {
- $invoice_data{'country'} = &$escape_function(code2country($cust_main->country));
- }
-
- my @address = ();
- $invoice_data{'address'} = \@address;
- push @address,
- $cust_main->payname.
- ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo
- ? " (P.O. #". $cust_main->payinfo. ")"
- : ''
- )
- ;
- push @address, $cust_main->company
- if $cust_main->company;
- push @address, $cust_main->address1;
- push @address, $cust_main->address2
- if $cust_main->address2;
- push @address,
- $cust_main->city. ", ". $cust_main->state. " ". $cust_main->zip;
- push @address, $invoice_data{'country'}
- if $invoice_data{'country'};
- push @address, ''
- while (scalar(@address) < 5);
-
- $invoice_data{'logo_file'} = $params{'logo_file'}
- if $params{'logo_file'};
-
- my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance
-# my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits
- #my $balance_due = $self->owed + $pr_total - $cr_total;
- my $balance_due = $self->owed + $pr_total;
- $invoice_data{'true_previous_balance'} = sprintf("%.2f", ($self->previous_balance || 0) );
- $invoice_data{'balance_adjustments'} = sprintf("%.2f", ($self->previous_balance || 0) - ($self->billing_balance || 0) );
- $invoice_data{'previous_balance'} = sprintf("%.2f", $pr_total);
- $invoice_data{'balance'} = sprintf("%.2f", $balance_due);
-
- my $summarypage = '';
- if ( $conf->exists('invoice_usesummary', $agentnum) ) {
- $summarypage = 1;
- }
- $invoice_data{'summarypage'} = $summarypage;
-
- #do variable substitution in notes, footer, smallfooter
- foreach my $include (qw( notes footer smallfooter coupon )) {
-
- my $inc_file = $conf->key_orbase("invoice_${format}$include", $template);
- my @inc_src;
-
- if ( $conf->exists($inc_file, $agentnum)
- && length( $conf->config($inc_file, $agentnum) ) ) {
-
- @inc_src = $conf->config($inc_file, $agentnum);
-
- } else {
-
- $inc_file = $conf->key_orbase("invoice_latex$include", $template);
-
- my $convert_map = $convert_maps{$format}{$include};
-
- @inc_src = map { s/\[\@--/$delimiters{$format}[0]/g;
- s/--\@\]/$delimiters{$format}[1]/g;
- $_;
- }
- &$convert_map( $conf->config($inc_file, $agentnum) );
-
- }
-
- my $inc_tt = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", @inc_src ],
- DELIMITERS => $delimiters{$format},
- ) or die "Can't create new Text::Template object: $Text::Template::ERROR";
-
- unless ( $inc_tt->compile() ) {
- my $error = "Can't compile $inc_file template: $Text::Template::ERROR\n";
- warn $error. "Template:\n". join('', map "$_\n", @inc_src);
- die $error;
- }
-
- $invoice_data{$include} = $inc_tt->fill_in( HASH => \%invoice_data );
-
- $invoice_data{$include} =~ s/\n+$//
- if ($format eq 'latex');
- }
-
- $invoice_data{'po_line'} =
- ( $cust_main->payby eq 'BILL' && $cust_main->payinfo )
- ? &$escape_function("Purchase Order #". $cust_main->payinfo)
- : $nbsp;
-
- my %money_chars = ( 'latex' => '',
- 'html' => $conf->config('money_char') || '$',
- 'template' => '',
- );
- my $money_char = $money_chars{$format};
-
- my %other_money_chars = ( 'latex' => '\dollar ',#XXX should be a config too
- 'html' => $conf->config('money_char') || '$',
- 'template' => '',
- );
- my $other_money_char = $other_money_chars{$format};
- $invoice_data{'dollar'} = $other_money_char;
-
- my @detail_items = ();
- my @total_items = ();
- my @buf = ();
- my @sections = ();
-
- $invoice_data{'detail_items'} = \@detail_items;
- $invoice_data{'total_items'} = \@total_items;
- $invoice_data{'buf'} = \@buf;
- $invoice_data{'sections'} = \@sections;
-
- my $previous_section = { 'description' => 'Previous Charges',
- 'subtotal' => $other_money_char.
- sprintf('%.2f', $pr_total),
- 'summarized' => $summarypage ? 'Y' : '',
- };
- $previous_section->{posttotal} = '0 / 30 / 60/ 90 days overdue '.
- join(' / ', map { $cust_main->balance_date_range(@$_) }
- $self->_prior_month30s
- )
- if $conf->exists('invoice_include_aging');
-
- my $taxtotal = 0;
- my $tax_section = { 'description' => 'Taxes, Surcharges, and Fees',
- 'subtotal' => $taxtotal, # adjusted below
- 'summarized' => $summarypage ? 'Y' : '',
- };
- my $tax_weight = _pkg_category($tax_section->{description})
- ? _pkg_category($tax_section->{description})->weight
- : 0;
- $tax_section->{'summarized'} = $summarypage && !$tax_weight ? 'Y' : '';
- $tax_section->{'sort_weight'} = $tax_weight;
-
-
- my $adjusttotal = 0;
- my $adjust_section = { 'description' => 'Credits, Payments, and Adjustments',
- 'subtotal' => 0, # adjusted below
- 'summarized' => $summarypage ? 'Y' : '',
- };
- my $adjust_weight = _pkg_category($adjust_section->{description})
- ? _pkg_category($adjust_section->{description})->weight
- : 0;
- $adjust_section->{'summarized'} = $summarypage && !$adjust_weight ? 'Y' : '';
- $adjust_section->{'sort_weight'} = $adjust_weight;
-
- my $unsquelched = $params{unsquelch_cdr} || $cust_main->squelch_cdr ne 'Y';
- my $multisection = $conf->exists('invoice_sections', $cust_main->agentnum);
- $invoice_data{'multisection'} = $multisection;
- my $late_sections = [];
- my $extra_sections = [];
- my $extra_lines = ();
- if ( $multisection ) {
- ($extra_sections, $extra_lines) =
- $self->_items_extra_usage_sections($escape_function_nonbsp, $format)
- if $conf->exists('usage_class_as_a_section', $cust_main->agentnum);
-
- push @$extra_sections, $adjust_section if $adjust_section->{sort_weight};
-
- push @detail_items, @$extra_lines if $extra_lines;
- push @sections,
- $self->_items_sections( $late_sections, # this could stand a refactor
- $summarypage,
- $escape_function_nonbsp,
- $extra_sections,
- $format, #bah
- );
- if ($conf->exists('svc_phone_sections')) {
- my ($phone_sections, $phone_lines) =
- $self->_items_svc_phone_sections($escape_function_nonbsp, $format);
- push @{$late_sections}, @$phone_sections;
- push @detail_items, @$phone_lines;
- }
- }else{
- push @sections, { 'description' => '', 'subtotal' => '' };
- }
-
- unless ( $conf->exists('disable_previous_balance')
- || $conf->exists('previous_balance-summary_only')
- )
- {
-
- foreach my $line_item ( $self->_items_previous ) {
-
- my $detail = {
- ext_description => [],
- };
- $detail->{'ref'} = $line_item->{'pkgnum'};
- $detail->{'quantity'} = 1;
- $detail->{'section'} = $previous_section;
- $detail->{'description'} = &$escape_function($line_item->{'description'});
- if ( exists $line_item->{'ext_description'} ) {
- @{$detail->{'ext_description'}} = map {
- &$escape_function($_);
- } @{$line_item->{'ext_description'}};
- }
- $detail->{'amount'} = ( $old_latex ? '' : $money_char).
- $line_item->{'amount'};
- $detail->{'product_code'} = $line_item->{'pkgpart'} || 'N/A';
-
- push @detail_items, $detail;
- push @buf, [ $detail->{'description'},
- $money_char. sprintf("%10.2f", $line_item->{'amount'}),
- ];
- }
-
- }
-
- if ( @pr_cust_bill && !$conf->exists('disable_previous_balance') ) {
- push @buf, ['','-----------'];
- push @buf, [ 'Total Previous Balance',
- $money_char. sprintf("%10.2f", $pr_total) ];
- push @buf, ['',''];
- }
-
- foreach my $section (@sections, @$late_sections) {
-
- # begin some normalization
- $section->{'subtotal'} = $section->{'amount'}
- if $multisection
- && !exists($section->{subtotal})
- && exists($section->{amount});
-
- $invoice_data{finance_amount} = sprintf('%.2f', $section->{'subtotal'} )
- if ( $invoice_data{finance_section} &&
- $section->{'description'} eq $invoice_data{finance_section} );
-
- $section->{'subtotal'} = $other_money_char.
- sprintf('%.2f', $section->{'subtotal'})
- if $multisection;
-
- # continue some normalization
- $section->{'amount'} = $section->{'subtotal'}
- if $multisection;
-
-
- if ( $section->{'description'} ) {
- push @buf, ( [ &$escape_function($section->{'description'}), '' ],
- [ '', '' ],
- );
- }
-
- my $multilocation = scalar($cust_main->cust_location); #too expensive?
- my %options = ();
- $options{'section'} = $section if $multisection;
- $options{'format'} = $format;
- $options{'escape_function'} = $escape_function;
- $options{'format_function'} = sub { () } unless $unsquelched;
- $options{'unsquelched'} = $unsquelched;
- $options{'summary_page'} = $summarypage;
- $options{'skip_usage'} =
- scalar(@$extra_sections) && !grep{$section == $_} @$extra_sections;
- $options{'multilocation'} = $multilocation;
- $options{'multisection'} = $multisection;
-
- foreach my $line_item ( $self->_items_pkg(%options) ) {
- my $detail = {
- ext_description => [],
- };
- $detail->{'ref'} = $line_item->{'pkgnum'};
- $detail->{'quantity'} = $line_item->{'quantity'};
- $detail->{'section'} = $section;
- $detail->{'description'} = &$escape_function($line_item->{'description'});
- if ( exists $line_item->{'ext_description'} ) {
- @{$detail->{'ext_description'}} = @{$line_item->{'ext_description'}};
- }
- $detail->{'amount'} = ( $old_latex ? '' : $money_char ).
- $line_item->{'amount'};
- $detail->{'unit_amount'} = ( $old_latex ? '' : $money_char ).
- $line_item->{'unit_amount'};
- $detail->{'product_code'} = $line_item->{'pkgpart'} || 'N/A';
-
- push @detail_items, $detail;
- push @buf, ( [ $detail->{'description'},
- $money_char. sprintf("%10.2f", $line_item->{'amount'}),
- ],
- map { [ " ". $_, '' ] } @{$detail->{'ext_description'}},
- );
- }
-
- if ( $section->{'description'} ) {
- push @buf, ( ['','-----------'],
- [ $section->{'description'}. ' sub-total',
- $money_char. sprintf("%10.2f", $section->{'subtotal'})
- ],
- [ '', '' ],
- [ '', '' ],
- );
- }
-
- }
-
- $invoice_data{current_less_finance} =
- sprintf('%.2f', $self->charged - $invoice_data{finance_amount} );
-
- if ( $multisection && !$conf->exists('disable_previous_balance')
- || $conf->exists('previous_balance-summary_only') )
- {
- unshift @sections, $previous_section if $pr_total;
- }
-
- foreach my $tax ( $self->_items_tax ) {
-
- $taxtotal += $tax->{'amount'};
-
- my $description = &$escape_function( $tax->{'description'} );
- my $amount = sprintf( '%.2f', $tax->{'amount'} );
-
- if ( $multisection ) {
-
- my $money = $old_latex ? '' : $money_char;
- push @detail_items, {
- ext_description => [],
- ref => '',
- quantity => '',
- description => $description,
- amount => $money. $amount,
- product_code => '',
- section => $tax_section,
- };
-
- } else {
-
- push @total_items, {
- 'total_item' => $description,
- 'total_amount' => $other_money_char. $amount,
- };
-
- }
-
- push @buf,[ $description,
- $money_char. $amount,
- ];
-
- }
-
- if ( $taxtotal ) {
- my $total = {};
- $total->{'total_item'} = 'Sub-total';
- $total->{'total_amount'} =
- $other_money_char. sprintf('%.2f', $self->charged - $taxtotal );
-
- if ( $multisection ) {
- $tax_section->{'subtotal'} = $other_money_char.
- sprintf('%.2f', $taxtotal);
- $tax_section->{'pretotal'} = 'New charges sub-total '.
- $total->{'total_amount'};
- push @sections, $tax_section if $taxtotal;
- }else{
- unshift @total_items, $total;
- }
- }
- $invoice_data{'taxtotal'} = sprintf('%.2f', $taxtotal);
-
- push @buf,['','-----------'];
- push @buf,[( $conf->exists('disable_previous_balance')
- ? 'Total Charges'
- : 'Total New Charges'
- ),
- $money_char. sprintf("%10.2f",$self->charged) ];
- push @buf,['',''];
-
- {
- my $total = {};
- my $item = 'Total';
- $item = $conf->config('previous_balance-exclude_from_total')
- || 'Total New Charges'
- if $conf->exists('previous_balance-exclude_from_total');
- my $amount = $self->charged +
- ( $conf->exists('disable_previous_balance') ||
- $conf->exists('previous_balance-exclude_from_total')
- ? 0
- : $pr_total
- );
- $total->{'total_item'} = &$embolden_function($item);
- $total->{'total_amount'} =
- &$embolden_function( $other_money_char. sprintf( '%.2f', $amount ) );
- if ( $multisection ) {
- if ( $adjust_section->{'sort_weight'} ) {
- $adjust_section->{'posttotal'} = 'Balance Forward '. $other_money_char.
- sprintf("%.2f", ($self->billing_balance || 0) );
- } else {
- $adjust_section->{'pretotal'} = 'New charges total '. $other_money_char.
- sprintf('%.2f', $self->charged );
- }
- }else{
- push @total_items, $total;
- }
- push @buf,['','-----------'];
- push @buf,[$item,
- $money_char.
- sprintf( '%10.2f', $amount )
- ];
- push @buf,['',''];
- }
-
- unless ( $conf->exists('disable_previous_balance') ) {
- #foreach my $thing ( sort { $a->_date <=> $b->_date } $self->_items_credits, $self->_items_payments
-
- # credits
- my $credittotal = 0;
- foreach my $credit ( $self->_items_credits('trim_len'=>60) ) {
-
- my $total;
- $total->{'total_item'} = &$escape_function($credit->{'description'});
- $credittotal += $credit->{'amount'};
- $total->{'total_amount'} = '-'. $other_money_char. $credit->{'amount'};
- $adjusttotal += $credit->{'amount'};
- if ( $multisection ) {
- my $money = $old_latex ? '' : $money_char;
- push @detail_items, {
- ext_description => [],
- ref => '',
- quantity => '',
- description => &$escape_function($credit->{'description'}),
- amount => $money. $credit->{'amount'},
- product_code => '',
- section => $adjust_section,
- };
- } else {
- push @total_items, $total;
- }
-
- }
- $invoice_data{'credittotal'} = sprintf('%.2f', $credittotal);
-
- #credits (again)
- foreach my $credit ( $self->_items_credits('trim_len'=>32) ) {
- push @buf, [ $credit->{'description'}, $money_char.$credit->{'amount'} ];
- }
-
- # payments
- my $paymenttotal = 0;
- foreach my $payment ( $self->_items_payments ) {
- my $total = {};
- $total->{'total_item'} = &$escape_function($payment->{'description'});
- $paymenttotal += $payment->{'amount'};
- $total->{'total_amount'} = '-'. $other_money_char. $payment->{'amount'};
- $adjusttotal += $payment->{'amount'};
- if ( $multisection ) {
- my $money = $old_latex ? '' : $money_char;
- push @detail_items, {
- ext_description => [],
- ref => '',
- quantity => '',
- description => &$escape_function($payment->{'description'}),
- amount => $money. $payment->{'amount'},
- product_code => '',
- section => $adjust_section,
- };
- }else{
- push @total_items, $total;
- }
- push @buf, [ $payment->{'description'},
- $money_char. sprintf("%10.2f", $payment->{'amount'}),
- ];
- }
- $invoice_data{'paymenttotal'} = sprintf('%.2f', $paymenttotal);
-
- if ( $multisection ) {
- $adjust_section->{'subtotal'} = $other_money_char.
- sprintf('%.2f', $adjusttotal);
- push @sections, $adjust_section
- unless $adjust_section->{sort_weight};
- }
-
- {
- my $total;
- $total->{'total_item'} = &$embolden_function($self->balance_due_msg);
- $total->{'total_amount'} =
- &$embolden_function(
- $other_money_char. sprintf('%.2f', $summarypage
- ? $self->charged +
- $self->billing_balance
- : $self->owed + $pr_total
- )
- );
- if ( $multisection && !$adjust_section->{sort_weight} ) {
- $adjust_section->{'posttotal'} = $total->{'total_item'}. ' '.
- $total->{'total_amount'};
- }else{
- push @total_items, $total;
- }
- push @buf,['','-----------'];
- push @buf,[$self->balance_due_msg, $money_char.
- sprintf("%10.2f", $balance_due ) ];
- }
- }
-
- if ( $multisection ) {
- if ($conf->exists('svc_phone_sections')) {
- my $total;
- $total->{'total_item'} = &$embolden_function($self->balance_due_msg);
- $total->{'total_amount'} =
- &$embolden_function(
- $other_money_char. sprintf('%.2f', $self->owed + $pr_total)
- );
- my $last_section = pop @sections;
- $last_section->{'posttotal'} = $total->{'total_item'}. ' '.
- $total->{'total_amount'};
- push @sections, $last_section;
- }
- push @sections, @$late_sections
- if $unsquelched;
- }
-
- my @includelist = ();
- push @includelist, 'summary' if $summarypage;
- foreach my $include ( @includelist ) {
-
- my $inc_file = $conf->key_orbase("invoice_${format}$include", $template);
- my @inc_src;
-
- if ( length( $conf->config($inc_file, $agentnum) ) ) {
-
- @inc_src = $conf->config($inc_file, $agentnum);
-
- } else {
-
- $inc_file = $conf->key_orbase("invoice_latex$include", $template);
-
- my $convert_map = $convert_maps{$format}{$include};
-
- @inc_src = map { s/\[\@--/$delimiters{$format}[0]/g;
- s/--\@\]/$delimiters{$format}[1]/g;
- $_;
- }
- &$convert_map( $conf->config($inc_file, $agentnum) );
-
- }
-
- my $inc_tt = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", @inc_src ],
- DELIMITERS => $delimiters{$format},
- ) or die "Can't create new Text::Template object: $Text::Template::ERROR";
-
- unless ( $inc_tt->compile() ) {
- my $error = "Can't compile $inc_file template: $Text::Template::ERROR\n";
- warn $error. "Template:\n". join('', map "$_\n", @inc_src);
- die $error;
- }
-
- $invoice_data{$include} = $inc_tt->fill_in( HASH => \%invoice_data );
-
- $invoice_data{$include} =~ s/\n+$//
- if ($format eq 'latex');
- }
-
- $invoice_lines = 0;
- my $wasfunc = 0;
- foreach ( grep /invoice_lines\(\d*\)/, @invoice_template ) { #kludgy
- /invoice_lines\((\d*)\)/;
- $invoice_lines += $1 || scalar(@buf);
- $wasfunc=1;
- }
- die "no invoice_lines() functions in template?"
- if ( $format eq 'template' && !$wasfunc );
-
- if ($format eq 'template') {
-
- if ( $invoice_lines ) {
- $invoice_data{'total_pages'} = int( scalar(@buf) / $invoice_lines );
- $invoice_data{'total_pages'}++
- if scalar(@buf) % $invoice_lines;
- }
-
- #setup subroutine for the template
- sub FS::cust_bill::_template::invoice_lines {
- my $lines = shift || scalar(@FS::cust_bill::_template::buf);
- map {
- scalar(@FS::cust_bill::_template::buf)
- ? shift @FS::cust_bill::_template::buf
- : [ '', '' ];
- }
- ( 1 .. $lines );
- }
-
- my $lines;
- my @collect;
- while (@buf) {
- push @collect, split("\n",
- $text_template->fill_in( HASH => \%invoice_data,
- PACKAGE => 'FS::cust_bill::_template'
- )
- );
- $FS::cust_bill::_template::page++;
- }
- map "$_\n", @collect;
- }else{
- warn "filling in template for invoice ". $self->invnum. "\n"
- if $DEBUG;
- warn join("\n", map " $_ => ". $invoice_data{$_}, keys %invoice_data). "\n"
- if $DEBUG > 1;
-
- $text_template->fill_in(HASH => \%invoice_data);
- }
-}
-
-# helper routine for generating date ranges
-sub _prior_month30s {
- my $self = shift;
- my @ranges = (
- [ 1, 2592000 ], # 0-30 days ago
- [ 2592000, 5184000 ], # 30-60 days ago
- [ 5184000, 7776000 ], # 60-90 days ago
- [ 7776000, 0 ], # 90+ days ago
- );
-
- map { [ $_->[0] ? $self->_date - $_->[0] - 1 : '',
- $_->[1] ? $self->_date - $_->[1] - 1 : '',
- ] }
- @ranges;
-}
-
-=item print_ps HASHREF | [ TIME [ , TEMPLATE ] ]
-
-Returns an postscript invoice, as a scalar.
-
-Options can be passed as a hashref (recommended) or as a list of time, template
-and then any key/value pairs for any other options.
-
-I<time> an optional value used to control the printing of overdue messages. The
-default is now. It isn't the date of the invoice; that's the `_date' field.
-It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required)
-
-=cut
-
-sub print_ps {
- my $self = shift;
-
- my ($file, $lfile) = $self->print_latex(@_);
- my $ps = generate_ps($file);
- unlink($file.'.tex');
- unlink($lfile);
-
- $ps;
-}
-
-=item print_pdf HASHREF | [ TIME [ , TEMPLATE ] ]
-
-Returns an PDF invoice, as a scalar.
-
-Options can be passed as a hashref (recommended) or as a list of time, template
-and then any key/value pairs for any other options.
-
-I<time> an optional value used to control the printing of overdue messages. The
-default is now. It isn't the date of the invoice; that's the `_date' field.
-It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-I<template>, if specified, is the name of a suffix for alternate invoices.
-
-I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required)
-
-=cut
-
-sub print_pdf {
- my $self = shift;
-
- my ($file, $lfile) = $self->print_latex(@_);
- my $pdf = generate_pdf($file);
- unlink($file.'.tex');
- unlink($lfile);
-
- $pdf;
-}
-
-=item print_html HASHREF | [ TIME [ , TEMPLATE [ , CID ] ] ]
-
-Returns an HTML invoice, as a scalar.
-
-I<time> an optional value used to control the printing of overdue messages. The
-default is now. It isn't the date of the invoice; that's the `_date' field.
-It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-I<template>, if specified, is the name of a suffix for alternate invoices.
-
-I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required)
-
-I<cid> is a MIME Content-ID used to create a "cid:" URL for the logo image, used
-when emailing the invoice as part of a multipart/related MIME email.
-
-=cut
-
-sub print_html {
- my $self = shift;
- my %params;
- if ( ref($_[0]) ) {
- %params = %{ shift() };
- }else{
- $params{'time'} = shift;
- $params{'template'} = shift;
- $params{'cid'} = shift;
- }
-
- $params{'format'} = 'html';
-
- $self->print_generic( %params );
-}
-
-# quick subroutine for print_latex
-#
-# There are ten characters that LaTeX treats as special characters, which
-# means that they do not simply typeset themselves:
-# # $ % & ~ _ ^ \ { }
-#
-# TeX ignores blanks following an escaped character; if you want a blank (as
-# in "10% of ..."), you have to "escape" the blank as well ("10\%\ of ...").
-
-sub _latex_escape {
- my $value = shift;
- $value =~ s/([#\$%&~_\^{}])( )?/"\\$1". ( ( defined($2) && length($2) ) ? "\\$2" : '' )/ge;
- $value =~ s/([<>])/\$$1\$/g;
- $value;
-}
-
-sub _html_escape {
- my $value = shift;
- encode_entities($value);
- $value;
-}
-
-sub _html_escape_nbsp {
- my $value = _html_escape(shift);
- $value =~ s/ +/&nbsp;/g;
- $value;
-}
-
-#utility methods for print_*
-
-sub _translate_old_latex_format {
- warn "_translate_old_latex_format called\n"
- if $DEBUG;
-
- my @template = ();
- while ( @_ ) {
- my $line = shift;
-
- if ( $line =~ /^%%Detail\s*$/ ) {
-
- push @template, q![@--!,
- q! foreach my $_tr_line (@detail_items) {!,
- q! if ( scalar ($_tr_item->{'ext_description'} ) ) {!,
- q! $_tr_line->{'description'} .= !,
- q! "\\tabularnewline\n~~".!,
- q! join( "\\tabularnewline\n~~",!,
- q! @{$_tr_line->{'ext_description'}}!,
- q! );!,
- q! }!;
-
- while ( ( my $line_item_line = shift )
- !~ /^%%EndDetail\s*$/ ) {
- $line_item_line =~ s/'/\\'/g; # nice LTS
- $line_item_line =~ s/\\/\\\\/g; # escape quotes and backslashes
- $line_item_line =~ s/\$(\w+)/'. \$_tr_line->{$1}. '/g;
- push @template, " \$OUT .= '$line_item_line';";
- }
-
- push @template, '}',
- '--@]';
- #' doh, gvim
- } elsif ( $line =~ /^%%TotalDetails\s*$/ ) {
-
- push @template, '[@--',
- ' foreach my $_tr_line (@total_items) {';
-
- while ( ( my $total_item_line = shift )
- !~ /^%%EndTotalDetails\s*$/ ) {
- $total_item_line =~ s/'/\\'/g; # nice LTS
- $total_item_line =~ s/\\/\\\\/g; # escape quotes and backslashes
- $total_item_line =~ s/\$(\w+)/'. \$_tr_line->{$1}. '/g;
- push @template, " \$OUT .= '$total_item_line';";
- }
-
- push @template, '}',
- '--@]';
-
- } else {
- $line =~ s/\$(\w+)/[\@-- \$$1 --\@]/g;
- push @template, $line;
- }
-
- }
-
- if ($DEBUG) {
- warn "$_\n" foreach @template;
- }
-
- (@template);
-}
-
-sub terms {
- my $self = shift;
-
- #check for an invoice-specific override
- return $self->invoice_terms if $self->invoice_terms;
-
- #check for a customer- specific override
- my $cust_main = $self->cust_main;
- return $cust_main->invoice_terms if $cust_main->invoice_terms;
-
- #use configured default
- $conf->config('invoice_default_terms') || '';
-}
-
-sub due_date {
- my $self = shift;
- my $duedate = '';
- if ( $self->terms =~ /^\s*Net\s*(\d+)\s*$/ ) {
- $duedate = $self->_date() + ( $1 * 86400 );
- }
- $duedate;
-}
-
-sub due_date2str {
- my $self = shift;
- $self->due_date ? time2str(shift, $self->due_date) : '';
-}
-
-sub balance_due_msg {
- my $self = shift;
- my $msg = 'Balance Due';
- return $msg unless $self->terms;
- if ( $self->due_date ) {
- $msg .= ' - Please pay by '. $self->due_date2str($date_format);
- } elsif ( $self->terms ) {
- $msg .= ' - '. $self->terms;
- }
- $msg;
-}
-
-sub balance_due_date {
- my $self = shift;
- my $duedate = '';
- if ( $conf->exists('invoice_default_terms')
- && $conf->config('invoice_default_terms')=~ /^\s*Net\s*(\d+)\s*$/ ) {
- $duedate = time2str($rdate_format, $self->_date + ($1*86400) );
- }
- $duedate;
-}
-
-=item invnum_date_pretty
-
-Returns a string with the invoice number and date, for example:
-"Invoice #54 (3/20/2008)"
-
-=cut
-
-sub invnum_date_pretty {
- my $self = shift;
- 'Invoice #'. $self->invnum. ' ('. $self->_date_pretty. ')';
-}
-
-=item _date_pretty
-
-Returns a string with the date, for example: "3/20/2008"
-
-=cut
-
-sub _date_pretty {
- my $self = shift;
- time2str($date_format, $self->_date);
-}
-
-use vars qw(%pkg_category_cache);
-sub _items_sections {
- my $self = shift;
- my $late = shift;
- my $summarypage = shift;
- my $escape = shift;
- my $extra_sections = shift;
- my $format = shift;
-
- my %subtotal = ();
- my %late_subtotal = ();
- my %not_tax = ();
-
- foreach my $cust_bill_pkg ( $self->cust_bill_pkg )
- {
-
- my $usage = $cust_bill_pkg->usage;
-
- foreach my $display ($cust_bill_pkg->cust_bill_pkg_display) {
- next if ( $display->summary && $summarypage );
-
- my $section = $display->section;
- my $type = $display->type;
-
- $not_tax{$section} = 1
- unless $cust_bill_pkg->pkgnum == 0;
-
- if ( $display->post_total && !$summarypage ) {
- if (! $type || $type eq 'S') {
- $late_subtotal{$section} += $cust_bill_pkg->setup
- if $cust_bill_pkg->setup != 0;
- }
-
- if (! $type) {
- $late_subtotal{$section} += $cust_bill_pkg->recur
- if $cust_bill_pkg->recur != 0;
- }
-
- if ($type && $type eq 'R') {
- $late_subtotal{$section} += $cust_bill_pkg->recur - $usage
- if $cust_bill_pkg->recur != 0;
- }
-
- if ($type && $type eq 'U') {
- $late_subtotal{$section} += $usage
- unless scalar(@$extra_sections);
- }
-
- } else {
-
- next if $cust_bill_pkg->pkgnum == 0 && ! $section;
-
- if (! $type || $type eq 'S') {
- $subtotal{$section} += $cust_bill_pkg->setup
- if $cust_bill_pkg->setup != 0;
- }
-
- if (! $type) {
- $subtotal{$section} += $cust_bill_pkg->recur
- if $cust_bill_pkg->recur != 0;
- }
-
- if ($type && $type eq 'R') {
- $subtotal{$section} += $cust_bill_pkg->recur - $usage
- if $cust_bill_pkg->recur != 0;
- }
-
- if ($type && $type eq 'U') {
- $subtotal{$section} += $usage
- unless scalar(@$extra_sections);
- }
-
- }
-
- }
-
- }
-
- %pkg_category_cache = ();
-
- push @$late, map { { 'description' => &{$escape}($_),
- 'subtotal' => $late_subtotal{$_},
- 'post_total' => 1,
- 'sort_weight' => ( _pkg_category($_)
- ? _pkg_category($_)->weight
- : 0
- ),
- ((_pkg_category($_) && _pkg_category($_)->condense)
- ? $self->_condense_section($format)
- : ()
- ),
- } }
- sort _sectionsort keys %late_subtotal;
-
- my @sections;
- if ( $summarypage ) {
- @sections = grep { exists($subtotal{$_}) || ! _pkg_category($_)->disabled }
- map { $_->categoryname } qsearch('pkg_category', {});
- push @sections, '' if exists($subtotal{''});
- } else {
- @sections = keys %subtotal;
- }
-
- my @early = map { { 'description' => &{$escape}($_),
- 'subtotal' => $subtotal{$_},
- 'summarized' => $not_tax{$_} ? '' : 'Y',
- 'tax_section' => $not_tax{$_} ? '' : 'Y',
- 'sort_weight' => ( _pkg_category($_)
- ? _pkg_category($_)->weight
- : 0
- ),
- ((_pkg_category($_) && _pkg_category($_)->condense)
- ? $self->_condense_section($format)
- : ()
- ),
- }
- } @sections;
- push @early, @$extra_sections if $extra_sections;
-
- sort { $a->{sort_weight} <=> $b->{sort_weight} } @early;
-
-}
-
-#helper subs for above
-
-sub _sectionsort {
- _pkg_category($a)->weight <=> _pkg_category($b)->weight;
-}
-
-sub _pkg_category {
- my $categoryname = shift;
- $pkg_category_cache{$categoryname} ||=
- qsearchs( 'pkg_category', { 'categoryname' => $categoryname } );
-}
-
-my %condensed_format = (
- 'label' => [ qw( Description Qty Amount ) ],
- 'fields' => [
- sub { shift->{description} },
- sub { shift->{quantity} },
- sub { my($href, %opt) = @_;
- ($opt{dollar} || ''). $href->{amount};
- },
- ],
- 'align' => [ qw( l r r ) ],
- 'span' => [ qw( 5 1 1 ) ], # unitprices?
- 'width' => [ qw( 10.7cm 1.4cm 1.6cm ) ], # don't like this
-);
-
-sub _condense_section {
- my ( $self, $format ) = ( shift, shift );
- ( 'condensed' => 1,
- map { my $method = "_condensed_$_"; $_ => $self->$method($format) }
- qw( description_generator
- header_generator
- total_generator
- total_line_generator
- )
- );
-}
-
-sub _condensed_generator_defaults {
- my ( $self, $format ) = ( shift, shift );
- return ( \%condensed_format, ' ', ' ', ' ', sub { shift } );
-}
-
-my %html_align = (
- 'c' => 'center',
- 'l' => 'left',
- 'r' => 'right',
-);
-
-sub _condensed_header_generator {
- my ( $self, $format ) = ( shift, shift );
-
- my ( $f, $prefix, $suffix, $separator, $column ) =
- _condensed_generator_defaults($format);
-
- if ($format eq 'latex') {
- $prefix = "\\hline\n\\rule{0pt}{2.5ex}\n\\makebox[1.4cm]{}&\n";
- $suffix = "\\\\\n\\hline";
- $separator = "&\n";
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{\\textbf{$d}}}";
- };
- } elsif ( $format eq 'html' ) {
- $prefix = '<th></th>';
- $suffix = '';
- $separator = '';
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return qq!<th align="$html_align{$a}">$d</th>!;
- };
- }
-
- sub {
- my @args = @_;
- my @result = ();
-
- foreach (my $i = 0; $f->{label}->[$i]; $i++) {
- push @result,
- &{$column}( map { $f->{$_}->[$i] } qw(label align span width) );
- }
-
- $prefix. join($separator, @result). $suffix;
- };
-
-}
-
-sub _condensed_description_generator {
- my ( $self, $format ) = ( shift, shift );
-
- my ( $f, $prefix, $suffix, $separator, $column ) =
- _condensed_generator_defaults($format);
-
- my $money_char = '$';
- if ($format eq 'latex') {
- $prefix = "\\hline\n\\multicolumn{1}{c}{\\rule{0pt}{2.5ex}~} &\n";
- $suffix = '\\\\';
- $separator = " & \n";
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{\\textbf{$d}}}";
- };
- $money_char = '\\dollar';
- }elsif ( $format eq 'html' ) {
- $prefix = '"><td align="center"></td>';
- $suffix = '';
- $separator = '';
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return qq!<td align="$html_align{$a}">$d</td>!;
- };
- #$money_char = $conf->config('money_char') || '$';
- $money_char = ''; # this is madness
- }
-
- sub {
- #my @args = @_;
- my $href = shift;
- my @result = ();
-
- foreach (my $i = 0; $f->{label}->[$i]; $i++) {
- my $dollar = '';
- $dollar = $money_char if $i == scalar(@{$f->{label}})-1;
- push @result,
- &{$column}( &{$f->{fields}->[$i]}($href, 'dollar' => $dollar),
- map { $f->{$_}->[$i] } qw(align span width)
- );
- }
-
- $prefix. join( $separator, @result ). $suffix;
- };
-
-}
-
-sub _condensed_total_generator {
- my ( $self, $format ) = ( shift, shift );
-
- my ( $f, $prefix, $suffix, $separator, $column ) =
- _condensed_generator_defaults($format);
- my $style = '';
-
- if ($format eq 'latex') {
- $prefix = "& ";
- $suffix = "\\\\\n";
- $separator = " & \n";
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{$d}}";
- };
- }elsif ( $format eq 'html' ) {
- $prefix = '';
- $suffix = '';
- $separator = '';
- $style = 'border-top: 3px solid #000000;border-bottom: 3px solid #000000;';
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return qq!<td align="$html_align{$a}" style="$style">$d</td>!;
- };
- }
-
-
- sub {
- my @args = @_;
- my @result = ();
-
- # my $r = &{$f->{fields}->[$i]}(@args);
- # $r .= ' Total' unless $i;
-
- foreach (my $i = 0; $f->{label}->[$i]; $i++) {
- push @result,
- &{$column}( &{$f->{fields}->[$i]}(@args). ($i ? '' : ' Total'),
- map { $f->{$_}->[$i] } qw(align span width)
- );
- }
-
- $prefix. join( $separator, @result ). $suffix;
- };
-
-}
-
-=item total_line_generator FORMAT
-
-Returns a coderef used for generation of invoice total line items for this
-usage_class. FORMAT is either html or latex
-
-=cut
-
-# should not be used: will have issues with hash element names (description vs
-# total_item and amount vs total_amount -- another array of functions?
-
-sub _condensed_total_line_generator {
- my ( $self, $format ) = ( shift, shift );
-
- my ( $f, $prefix, $suffix, $separator, $column ) =
- _condensed_generator_defaults($format);
- my $style = '';
-
- if ($format eq 'latex') {
- $prefix = "& ";
- $suffix = "\\\\\n";
- $separator = " & \n";
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{$d}}";
- };
- }elsif ( $format eq 'html' ) {
- $prefix = '';
- $suffix = '';
- $separator = '';
- $style = 'border-top: 3px solid #000000;border-bottom: 3px solid #000000;';
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return qq!<td align="$html_align{$a}" style="$style">$d</td>!;
- };
- }
-
-
- sub {
- my @args = @_;
- my @result = ();
-
- foreach (my $i = 0; $f->{label}->[$i]; $i++) {
- push @result,
- &{$column}( &{$f->{fields}->[$i]}(@args),
- map { $f->{$_}->[$i] } qw(align span width)
- );
- }
-
- $prefix. join( $separator, @result ). $suffix;
- };
-
-}
-
-#sub _items_extra_usage_sections {
-# my $self = shift;
-# my $escape = shift;
-#
-# my %sections = ();
-#
-# my %usage_class = map{ $_->classname, $_ } qsearch('usage_class', {});
-# foreach my $cust_bill_pkg ( $self->cust_bill_pkg )
-# {
-# next unless $cust_bill_pkg->pkgnum > 0;
-#
-# foreach my $section ( keys %usage_class ) {
-#
-# my $usage = $cust_bill_pkg->usage($section);
-#
-# next unless $usage && $usage > 0;
-#
-# $sections{$section} ||= 0;
-# $sections{$section} += $usage;
-#
-# }
-#
-# }
-#
-# map { { 'description' => &{$escape}($_),
-# 'subtotal' => $sections{$_},
-# 'summarized' => '',
-# 'tax_section' => '',
-# }
-# }
-# sort {$usage_class{$a}->weight <=> $usage_class{$b}->weight} keys %sections;
-#
-#}
-
-sub _items_extra_usage_sections {
- my $self = shift;
- my $escape = shift;
- my $format = shift;
-
- my %sections = ();
- my %classnums = ();
- my %lines = ();
-
- my %usage_class = map { $_->classnum => $_ } qsearch( 'usage_class', {} );
- foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) {
- next unless $cust_bill_pkg->pkgnum > 0;
-
- foreach my $classnum ( keys %usage_class ) {
- my $section = $usage_class{$classnum}->classname;
- $classnums{$section} = $classnum;
-
- foreach my $detail ( $cust_bill_pkg->cust_bill_pkg_detail($classnum) ) {
- my $amount = $detail->amount;
- next unless $amount && $amount > 0;
-
- $sections{$section} ||= { 'subtotal'=>0, 'calls'=>0, 'duration'=>0 };
- $sections{$section}{amount} += $amount; #subtotal
- $sections{$section}{calls}++;
- $sections{$section}{duration} += $detail->duration;
-
- my $desc = $detail->regionname;
- my $description = $desc;
- $description = substr($desc, 0, 50). '...'
- if $format eq 'latex' && length($desc) > 50;
-
- $lines{$section}{$desc} ||= {
- description => &{$escape}($description),
- #pkgpart => $part_pkg->pkgpart,
- pkgnum => $cust_bill_pkg->pkgnum,
- ref => '',
- amount => 0,
- calls => 0,
- duration => 0,
- #unit_amount => $cust_bill_pkg->unitrecur,
- quantity => $cust_bill_pkg->quantity,
- product_code => 'N/A',
- ext_description => [],
- };
-
- $lines{$section}{$desc}{amount} += $amount;
- $lines{$section}{$desc}{calls}++;
- $lines{$section}{$desc}{duration} += $detail->duration;
-
- }
- }
- }
-
- my %sectionmap = ();
- foreach (keys %sections) {
- my $usage_class = $usage_class{$classnums{$_}};
- $sectionmap{$_} = { 'description' => &{$escape}($_),
- 'amount' => $sections{$_}{amount}, #subtotal
- 'calls' => $sections{$_}{calls},
- 'duration' => $sections{$_}{duration},
- 'summarized' => '',
- 'tax_section' => '',
- 'sort_weight' => $usage_class->weight,
- ( $usage_class->format
- ? ( map { $_ => $usage_class->$_($format) }
- qw( description_generator header_generator total_generator total_line_generator )
- )
- : ()
- ),
- };
- }
-
- my @sections = sort { $a->{sort_weight} <=> $b->{sort_weight} }
- values %sectionmap;
-
- my @lines = ();
- foreach my $section ( keys %lines ) {
- foreach my $line ( keys %{$lines{$section}} ) {
- my $l = $lines{$section}{$line};
- $l->{section} = $sectionmap{$section};
- $l->{amount} = sprintf( "%.2f", $l->{amount} );
- #$l->{unit_amount} = sprintf( "%.2f", $l->{unit_amount} );
- push @lines, $l;
- }
- }
-
- return(\@sections, \@lines);
-
-}
-
-sub _items_svc_phone_sections {
- my $self = shift;
- my $escape = shift;
- my $format = shift;
-
- my %sections = ();
- my %classnums = ();
- my %lines = ();
-
- my %usage_class = map { $_->classnum => $_ } qsearch( 'usage_class', {} );
- $usage_class{''} ||= new FS::usage_class { 'classname' => '', 'weight' => 0 };
-
- foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) {
- next unless $cust_bill_pkg->pkgnum > 0;
-
- my @header = $cust_bill_pkg->details_header;
- next unless scalar(@header);
-
- foreach my $detail ( $cust_bill_pkg->cust_bill_pkg_detail ) {
-
- my $phonenum = $detail->phonenum;
- next unless $phonenum;
-
- my $amount = $detail->amount;
- next unless $amount && $amount > 0;
-
- $sections{$phonenum} ||= { 'amount' => 0,
- 'calls' => 0,
- 'duration' => 0,
- 'sort_weight' => -1,
- 'phonenum' => $phonenum,
- };
- $sections{$phonenum}{amount} += $amount; #subtotal
- $sections{$phonenum}{calls}++;
- $sections{$phonenum}{duration} += $detail->duration;
-
- my $desc = $detail->regionname;
- my $description = $desc;
- $description = substr($desc, 0, 50). '...'
- if $format eq 'latex' && length($desc) > 50;
-
- $lines{$phonenum}{$desc} ||= {
- description => &{$escape}($description),
- #pkgpart => $part_pkg->pkgpart,
- pkgnum => '',
- ref => '',
- amount => 0,
- calls => 0,
- duration => 0,
- #unit_amount => '',
- quantity => '',
- product_code => 'N/A',
- ext_description => [],
- };
-
- $lines{$phonenum}{$desc}{amount} += $amount;
- $lines{$phonenum}{$desc}{calls}++;
- $lines{$phonenum}{$desc}{duration} += $detail->duration;
-
- my $line = $usage_class{$detail->classnum}->classname;
- $sections{"$phonenum $line"} ||=
- { 'amount' => 0,
- 'calls' => 0,
- 'duration' => 0,
- 'sort_weight' => $usage_class{$detail->classnum}->weight,
- 'phonenum' => $phonenum,
- 'header' => [ @header ],
- };
- $sections{"$phonenum $line"}{amount} += $amount; #subtotal
- $sections{"$phonenum $line"}{calls}++;
- $sections{"$phonenum $line"}{duration} += $detail->duration;
-
- $lines{"$phonenum $line"}{$desc} ||= {
- description => &{$escape}($description),
- #pkgpart => $part_pkg->pkgpart,
- pkgnum => '',
- ref => '',
- amount => 0,
- calls => 0,
- duration => 0,
- #unit_amount => '',
- quantity => '',
- product_code => 'N/A',
- ext_description => [],
- };
-
- $lines{"$phonenum $line"}{$desc}{amount} += $amount;
- $lines{"$phonenum $line"}{$desc}{calls}++;
- $lines{"$phonenum $line"}{$desc}{duration} += $detail->duration;
- push @{$lines{"$phonenum $line"}{$desc}{ext_description}},
- $detail->formatted('format' => $format);
-
- }
- }
-
- my %sectionmap = ();
- my $simple = new FS::usage_class { format => 'simple' }; #bleh
- foreach ( keys %sections ) {
- my @header = @{ $sections{$_}{header} || [] };
- my $usage_simple =
- new FS::usage_class { format => 'usage_'. (scalar(@header) || 6). 'col' };
- my $summary = $sections{$_}{sort_weight} < 0 ? 1 : 0;
- my $usage_class = $summary ? $simple : $usage_simple;
- my $ending = $summary ? ' usage charges' : '';
- my %gen_opt = ();
- unless ($summary) {
- $gen_opt{label} = [ map{ &{$escape}($_) } @header ];
- }
- $sectionmap{$_} = { 'description' => &{$escape}($_. $ending),
- 'amount' => $sections{$_}{amount}, #subtotal
- 'calls' => $sections{$_}{calls},
- 'duration' => $sections{$_}{duration},
- 'summarized' => '',
- 'tax_section' => '',
- 'phonenum' => $sections{$_}{phonenum},
- 'sort_weight' => $sections{$_}{sort_weight},
- 'post_total' => $summary, #inspire pagebreak
- (
- ( map { $_ => $usage_class->$_($format, %gen_opt) }
- qw( description_generator
- header_generator
- total_generator
- total_line_generator
- )
- )
- ),
- };
- }
-
- my @sections = sort { $a->{phonenum} cmp $b->{phonenum} ||
- $a->{sort_weight} <=> $b->{sort_weight}
- }
- values %sectionmap;
-
- my @lines = ();
- foreach my $section ( keys %lines ) {
- foreach my $line ( keys %{$lines{$section}} ) {
- my $l = $lines{$section}{$line};
- $l->{section} = $sectionmap{$section};
- $l->{amount} = sprintf( "%.2f", $l->{amount} );
- #$l->{unit_amount} = sprintf( "%.2f", $l->{unit_amount} );
- push @lines, $l;
- }
- }
-
- return(\@sections, \@lines);
-
-}
-
-sub _items {
- my $self = shift;
-
- #my @display = scalar(@_)
- # ? @_
- # : qw( _items_previous _items_pkg );
- # #: qw( _items_pkg );
- # #: qw( _items_previous _items_pkg _items_tax _items_credits _items_payments );
- my @display = qw( _items_previous _items_pkg );
-
- my @b = ();
- foreach my $display ( @display ) {
- push @b, $self->$display(@_);
- }
- @b;
-}
-
-sub _items_previous {
- my $self = shift;
- my $cust_main = $self->cust_main;
- my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance
- my @b = ();
- foreach ( @pr_cust_bill ) {
- my $date = $conf->exists('invoice_show_prior_due_date')
- ? 'due '. $_->due_date2str($date_format)
- : time2str($date_format, $_->_date);
- push @b, {
- 'description' => 'Previous Balance, Invoice #'. $_->invnum. " ($date)",
- #'pkgpart' => 'N/A',
- 'pkgnum' => 'N/A',
- 'amount' => sprintf("%.2f", $_->owed),
- };
- }
- @b;
-
- #{
- # 'description' => 'Previous Balance',
- # #'pkgpart' => 'N/A',
- # 'pkgnum' => 'N/A',
- # 'amount' => sprintf("%10.2f", $pr_total ),
- # 'ext_description' => [ map {
- # "Invoice ". $_->invnum.
- # " (". time2str("%x",$_->_date). ") ".
- # sprintf("%10.2f", $_->owed)
- # } @pr_cust_bill ],
-
- #};
-}
-
-sub _items_pkg {
- my $self = shift;
- my %options = @_;
- my @cust_bill_pkg = grep { $_->pkgnum } $self->cust_bill_pkg;
- my @items = $self->_items_cust_bill_pkg(\@cust_bill_pkg, @_);
- if ($options{section} && $options{section}->{condensed}) {
- my %itemshash = ();
- local $Storable::canonical = 1;
- foreach ( @items ) {
- my $item = { %$_ };
- delete $item->{ref};
- delete $item->{ext_description};
- my $key = freeze($item);
- $itemshash{$key} ||= 0;
- $itemshash{$key} ++; # += $item->{quantity};
- }
- @items = sort { $a->{description} cmp $b->{description} }
- map { my $i = thaw($_);
- $i->{quantity} = $itemshash{$_};
- $i->{amount} =
- sprintf( "%.2f", $i->{quantity} * $i->{amount} );#unit_amount
- $i;
- }
- keys %itemshash;
- }
- @items;
-}
-
-sub _taxsort {
- return 0 unless $a->itemdesc cmp $b->itemdesc;
- return -1 if $b->itemdesc eq 'Tax';
- return 1 if $a->itemdesc eq 'Tax';
- return -1 if $b->itemdesc eq 'Other surcharges';
- return 1 if $a->itemdesc eq 'Other surcharges';
- $a->itemdesc cmp $b->itemdesc;
-}
-
-sub _items_tax {
- my $self = shift;
- my @cust_bill_pkg = sort _taxsort grep { ! $_->pkgnum } $self->cust_bill_pkg;
- $self->_items_cust_bill_pkg(\@cust_bill_pkg, @_);
-}
-
-sub _items_cust_bill_pkg {
- my $self = shift;
- my $cust_bill_pkg = shift;
- my %opt = @_;
-
- my $format = $opt{format} || '';
- my $escape_function = $opt{escape_function} || sub { shift };
- my $format_function = $opt{format_function} || '';
- my $unsquelched = $opt{unsquelched} || '';
- my $section = $opt{section}->{description} if $opt{section};
- my $summary_page = $opt{summary_page} || '';
- my $multilocation = $opt{multilocation} || '';
- my $multisection = $opt{multisection} || '';
-
- my @b = ();
- my ($s, $r, $u) = ( undef, undef, undef );
- foreach my $cust_bill_pkg ( @$cust_bill_pkg )
- {
-
- foreach ( $s, $r, ($opt{skip_usage} ? () : $u ) ) {
- if ( $_ && !$cust_bill_pkg->hidden ) {
- $_->{amount} = sprintf( "%.2f", $_->{amount} ),
- $_->{amount} =~ s/^\-0\.00$/0.00/;
- $_->{unit_amount} = sprintf( "%.2f", $_->{unit_amount} ),
- push @b, { %$_ }
- unless $_->{amount} == 0;
- $_ = undef;
- }
- }
-
- foreach my $display ( grep { defined($section)
- ? $_->section eq $section
- : 1
- }
- #grep { !$_->summary || !$summary_page } # bunk!
- grep { !$_->summary || $multisection }
- $cust_bill_pkg->cust_bill_pkg_display
- )
- {
-
- my $type = $display->type;
-
- my $desc = $cust_bill_pkg->desc;
- $desc = substr($desc, 0, 50). '...'
- if $format eq 'latex' && length($desc) > 50;
-
- my %details_opt = ( 'format' => $format,
- 'escape_function' => $escape_function,
- 'format_function' => $format_function,
- );
-
- if ( $cust_bill_pkg->pkgnum > 0 ) {
-
- my $cust_pkg = $cust_bill_pkg->cust_pkg;
-
- if ( $cust_bill_pkg->setup != 0 && (!$type || $type eq 'S') ) {
-
- my $description = $desc;
- $description .= ' Setup' if $cust_bill_pkg->recur != 0;
-
- my @d = ();
- unless ( $cust_pkg->part_pkg->hide_svc_detail
- || $cust_bill_pkg->hidden )
- {
-
- push @d, map &{$escape_function}($_),
- $cust_pkg->h_labels_short($self->_date, undef, 'I')
- unless $cust_bill_pkg->pkgpart_override; #don't redisplay services
-
- if ( $multilocation ) {
- my $loc = $cust_pkg->location_label;
- $loc = substr($loc, 0, 50). '...'
- if $format eq 'latex' && length($loc) > 50;
- push @d, &{$escape_function}($loc);
- }
-
- }
-
- push @d, $cust_bill_pkg->details(%details_opt)
- if $cust_bill_pkg->recur == 0;
-
- if ( $cust_bill_pkg->hidden ) {
- $s->{amount} += $cust_bill_pkg->setup;
- $s->{unit_amount} += $cust_bill_pkg->unitsetup;
- push @{ $s->{ext_description} }, @d;
- } else {
- $s = {
- description => $description,
- #pkgpart => $part_pkg->pkgpart,
- pkgnum => $cust_bill_pkg->pkgnum,
- amount => $cust_bill_pkg->setup,
- unit_amount => $cust_bill_pkg->unitsetup,
- quantity => $cust_bill_pkg->quantity,
- ext_description => \@d,
- };
- };
-
- }
-
- if ( ( $cust_bill_pkg->recur != 0 || $cust_bill_pkg->setup == 0 ) &&
- ( !$type || $type eq 'R' || $type eq 'U' )
- )
- {
-
- my $is_summary = $display->summary;
- my $description = ($is_summary && $type && $type eq 'U')
- ? "Usage charges" : $desc;
-
- unless ( $conf->exists('disable_line_item_date_ranges') ) {
- $description .= " (" . time2str($date_format, $cust_bill_pkg->sdate).
- " - ". time2str($date_format, $cust_bill_pkg->edate). ")";
- }
-
- my @d = ();
-
- #at least until cust_bill_pkg has "past" ranges in addition to
- #the "future" sdate/edate ones... see #3032
- my @dates = ( $self->_date );
- my $prev = $cust_bill_pkg->previous_cust_bill_pkg;
- push @dates, $prev->sdate if $prev;
- push @dates, undef if !$prev;
-
- unless ( $cust_pkg->part_pkg->hide_svc_detail
- || $cust_bill_pkg->itemdesc
- || $cust_bill_pkg->hidden
- || $is_summary && $type && $type eq 'U' )
- {
-
- push @d, map &{$escape_function}($_),
- $cust_pkg->h_labels_short(@dates, 'I')
- #$cust_bill_pkg->edate,
- #$cust_bill_pkg->sdate)
- unless $cust_bill_pkg->pkgpart_override; #don't redisplay services
-
- if ( $multilocation ) {
- my $loc = $cust_pkg->location_label;
- $loc = substr($loc, 0, 50). '...'
- if $format eq 'latex' && length($loc) > 50;
- push @d, &{$escape_function}($loc);
- }
-
- }
-
- push @d, $cust_bill_pkg->details(%details_opt)
- unless ($is_summary || $type && $type eq 'R');
-
- my $amount = 0;
- if (!$type) {
- $amount = $cust_bill_pkg->recur;
- }elsif($type eq 'R') {
- $amount = $cust_bill_pkg->recur - $cust_bill_pkg->usage;
- }elsif($type eq 'U') {
- $amount = $cust_bill_pkg->usage;
- }
-
- if ( !$type || $type eq 'R' ) {
-
- if ( $cust_bill_pkg->hidden ) {
- $r->{amount} += $amount;
- $r->{unit_amount} += $cust_bill_pkg->unitrecur;
- push @{ $r->{ext_description} }, @d;
- } else {
- $r = {
- description => $description,
- #pkgpart => $part_pkg->pkgpart,
- pkgnum => $cust_bill_pkg->pkgnum,
- amount => $amount,
- unit_amount => $cust_bill_pkg->unitrecur,
- quantity => $cust_bill_pkg->quantity,
- ext_description => \@d,
- };
- }
-
- } else { # $type eq 'U'
-
- if ( $cust_bill_pkg->hidden ) {
- $u->{amount} += $amount;
- $u->{unit_amount} += $cust_bill_pkg->unitrecur;
- push @{ $u->{ext_description} }, @d;
- } else {
- $u = {
- description => $description,
- #pkgpart => $part_pkg->pkgpart,
- pkgnum => $cust_bill_pkg->pkgnum,
- amount => $amount,
- unit_amount => $cust_bill_pkg->unitrecur,
- quantity => $cust_bill_pkg->quantity,
- ext_description => \@d,
- };
- }
-
- }
-
- } # recurring or usage with recurring charge
-
- } else { #pkgnum tax or one-shot line item (??)
-
- if ( $cust_bill_pkg->setup != 0 ) {
- push @b, {
- 'description' => $desc,
- 'amount' => sprintf("%.2f", $cust_bill_pkg->setup),
- };
- }
- if ( $cust_bill_pkg->recur != 0 ) {
- push @b, {
- 'description' => "$desc (".
- time2str($date_format, $cust_bill_pkg->sdate). ' - '.
- time2str($date_format, $cust_bill_pkg->edate). ')',
- 'amount' => sprintf("%.2f", $cust_bill_pkg->recur),
- };
- }
-
- }
-
- }
-
- }
-
- foreach ( $s, $r, ($opt{skip_usage} ? () : $u ) ) {
- if ( $_ ) {
- $_->{amount} = sprintf( "%.2f", $_->{amount} ),
- $_->{amount} =~ s/^\-0\.00$/0.00/;
- $_->{unit_amount} = sprintf( "%.2f", $_->{unit_amount} ),
- push @b, { %$_ }
- unless $_->{amount} == 0;
- }
- }
-
- @b;
-
-}
-
-sub _items_credits {
- my( $self, %opt ) = @_;
- my $trim_len = $opt{'trim_len'} || 60;
-
- my @b;
- #credits
- foreach ( $self->cust_credited ) {
-
- #something more elaborate if $_->amount ne $_->cust_credit->credited ?
-
- my $reason = substr($_->cust_credit->reason, 0, $trim_len);
- $reason .= '...' if length($reason) < length($_->cust_credit->reason);
- $reason = " ($reason) " if $reason;
-
- push @b, {
- #'description' => 'Credit ref\#'. $_->crednum.
- # " (". time2str("%x",$_->cust_credit->_date) .")".
- # $reason,
- 'description' => 'Credit applied '.
- time2str($date_format,$_->cust_credit->_date). $reason,
- 'amount' => sprintf("%.2f",$_->amount),
- };
- }
-
- @b;
-
-}
-
-sub _items_payments {
- my $self = shift;
-
- my @b;
- #get & print payments
- foreach ( $self->cust_bill_pay ) {
-
- #something more elaborate if $_->amount ne ->cust_pay->paid ?
-
- push @b, {
- 'description' => "Payment received ".
- time2str($date_format,$_->cust_pay->_date ),
- 'amount' => sprintf("%.2f", $_->amount )
- };
- }
-
- @b;
-
-}
-
-=item call_details [ OPTION => VALUE ... ]
-
-Returns an array of CSV strings representing the call details for this invoice
-The only option available is the boolean prepend_billed_number
-
-=cut
-
-sub call_details {
- my ($self, %opt) = @_;
-
- my $format_function = sub { shift };
-
- if ($opt{prepend_billed_number}) {
- $format_function = sub {
- my $detail = shift;
- my $row = shift;
-
- $row->amount ? $row->phonenum. ",". $detail : '"Billed number",'. $detail;
-
- };
- }
-
- my @details = map { $_->details( 'format_function' => $format_function,
- 'escape_function' => sub{ return() },
- )
- }
- grep { $_->pkgnum }
- $self->cust_bill_pkg;
- my $header = $details[0];
- ( $header, grep { $_ ne $header } @details );
-}
-
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item process_reprint
-
-=cut
-
-sub process_reprint {
- process_re_X('print', @_);
-}
-
-=item process_reemail
-
-=cut
-
-sub process_reemail {
- process_re_X('email', @_);
-}
-
-=item process_refax
-
-=cut
-
-sub process_refax {
- process_re_X('fax', @_);
-}
-
-=item process_reftp
-
-=cut
-
-sub process_reftp {
- process_re_X('ftp', @_);
-}
-
-=item respool
-
-=cut
-
-sub process_respool {
- process_re_X('spool', @_);
-}
-
-use Storable qw(thaw);
-use Data::Dumper;
-use MIME::Base64;
-sub process_re_X {
- my( $method, $job ) = ( shift, shift );
- warn "$me process_re_X $method for job $job\n" if $DEBUG;
-
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- re_X(
- $method,
- $job,
- %$param,
- );
-
-}
-
-sub re_X {
- my($method, $job, %param ) = @_;
- if ( $DEBUG ) {
- warn "re_X $method for job $job with param:\n".
- join( '', map { " $_ => ". $param{$_}. "\n" } keys %param );
- }
-
- #some false laziness w/search/cust_bill.html
- my $distinct = '';
- my $orderby = 'ORDER BY cust_bill._date';
-
- my $extra_sql = ' WHERE '. FS::cust_bill->search_sql_where(\%param);
-
- my $addl_from = 'LEFT JOIN cust_main USING ( custnum )';
-
- my @cust_bill = qsearch( {
- #'select' => "cust_bill.*",
- 'table' => 'cust_bill',
- 'addl_from' => $addl_from,
- 'hashref' => {},
- 'extra_sql' => $extra_sql,
- 'order_by' => $orderby,
- 'debug' => 1,
- } );
-
- $method .= '_invoice' unless $method eq 'email' || $method eq 'print';
-
- warn " $me re_X $method: ". scalar(@cust_bill). " invoices found\n"
- if $DEBUG;
-
- my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
- foreach my $cust_bill ( @cust_bill ) {
- $cust_bill->$method();
-
- if ( $job ) { #progressbar foo
- $num++;
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $num / scalar(@cust_bill) )
- );
- die $error if $error;
- $last = time;
- }
- }
-
- }
-
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item owed_sql
-
-Returns an SQL fragment to retreive the amount owed (charged minus credited and paid).
-
-=cut
-
-sub owed_sql {
- my ($class, $start, $end) = @_;
- 'charged - '.
- $class->paid_sql($start, $end). ' - '.
- $class->credited_sql($start, $end);
-}
-
-=item net_sql
-
-Returns an SQL fragment to retreive the net amount (charged minus credited).
-
-=cut
-
-sub net_sql {
- my ($class, $start, $end) = @_;
- 'charged - '. $class->credited_sql($start, $end);
-}
-
-=item paid_sql
-
-Returns an SQL fragment to retreive the amount paid against this invoice.
-
-=cut
-
-sub paid_sql {
- my ($class, $start, $end) = @_;
- $start &&= "AND cust_bill_pay._date <= $start";
- $end &&= "AND cust_bill_pay._date > $end";
- $start = '' unless defined($start);
- $end = '' unless defined($end);
- "( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
- WHERE cust_bill.invnum = cust_bill_pay.invnum $start $end )";
-}
-
-=item credited_sql
-
-Returns an SQL fragment to retreive the amount credited against this invoice.
-
-=cut
-
-sub credited_sql {
- my ($class, $start, $end) = @_;
- $start &&= "AND cust_credit_bill._date <= $start";
- $end &&= "AND cust_credit_bill._date > $end";
- $start = '' unless defined($start);
- $end = '' unless defined($end);
- "( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
- WHERE cust_bill.invnum = cust_credit_bill.invnum $start $end )";
-}
-
-=item due_date_sql
-
-Returns an SQL fragment to retrieve the due date of an invoice.
-Currently only supported on PostgreSQL.
-
-=cut
-
-sub due_date_sql {
-'COALESCE(
- SUBSTRING(
- COALESCE(
- cust_bill.invoice_terms,
- cust_main.invoice_terms,
- \''.($conf->config('invoice_default_terms') || '').'\'
- ), E\'Net (\\\\d+)\'
- )::INTEGER, 0
-) * 86400 + cust_bill._date'
-}
-
-=item search_sql_where HASHREF
-
-Class method which returns an SQL WHERE fragment to search for parameters
-specified in HASHREF. Valid parameters are
-
-=over 4
-
-=item _date
-
-List reference of start date, end date, as UNIX timestamps.
-
-=item invnum_min
-
-=item invnum_max
-
-=item agentnum
-
-=item charged
-
-List reference of charged limits (exclusive).
-
-=item owed
-
-List reference of charged limits (exclusive).
-
-=item open
-
-flag, return open invoices only
-
-=item net
-
-flag, return net invoices only
-
-=item days
-
-=item newest_percust
-
-=back
-
-Note: validates all passed-in data; i.e. safe to use with unchecked CGI params.
-
-=cut
-
-sub search_sql_where {
- my($class, $param) = @_;
- if ( $DEBUG ) {
- warn "$me search_sql_where called with params: \n".
- join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
- }
-
- my @search = ();
-
- #agentnum
- if ( $param->{'agentnum'} =~ /^(\d+)$/ ) {
- push @search, "cust_main.agentnum = $1";
- }
-
- #_date
- if ( $param->{_date} ) {
- my($beginning, $ending) = @{$param->{_date}};
-
- push @search, "cust_bill._date >= $beginning",
- "cust_bill._date < $ending";
- }
-
- #invnum
- if ( $param->{'invnum_min'} =~ /^(\d+)$/ ) {
- push @search, "cust_bill.invnum >= $1";
- }
- if ( $param->{'invnum_max'} =~ /^(\d+)$/ ) {
- push @search, "cust_bill.invnum <= $1";
- }
-
- #charged
- if ( $param->{charged} ) {
- my @charged = ref($param->{charged})
- ? @{ $param->{charged} }
- : ($param->{charged});
-
- push @search, map { s/^charged/cust_bill.charged/; $_; }
- @charged;
- }
-
- my $owed_sql = FS::cust_bill->owed_sql;
-
- #owed
- if ( $param->{owed} ) {
- my @owed = ref($param->{owed})
- ? @{ $param->{owed} }
- : ($param->{owed});
- push @search, map { s/^owed/$owed_sql/; $_; }
- @owed;
- }
-
- #open/net flags
- push @search, "0 != $owed_sql"
- if $param->{'open'};
- push @search, '0 != '. FS::cust_bill->net_sql
- if $param->{'net'};
-
- #days
- push @search, "cust_bill._date < ". (time-86400*$param->{'days'})
- if $param->{'days'};
-
- #newest_percust
- if ( $param->{'newest_percust'} ) {
-
- #$distinct = 'DISTINCT ON ( cust_bill.custnum )';
- #$orderby = 'ORDER BY cust_bill.custnum ASC, cust_bill._date DESC';
-
- my @newest_where = map { my $x = $_;
- $x =~ s/\bcust_bill\./newest_cust_bill./g;
- $x;
- }
- grep ! /^cust_main./, @search;
- my $newest_where = scalar(@newest_where)
- ? ' AND '. join(' AND ', @newest_where)
- : '';
-
-
- push @search, "cust_bill._date = (
- SELECT(MAX(newest_cust_bill._date)) FROM cust_bill AS newest_cust_bill
- WHERE newest_cust_bill.custnum = cust_bill.custnum
- $newest_where
- )";
-
- }
-
- #agent virtualization
- my $curuser = $FS::CurrentUser::CurrentUser;
- if ( $curuser->username eq 'fs_queue'
- && $param->{'CurrentUser'} =~ /^(\w+)$/ ) {
- my $username = $1;
- my $newuser = qsearchs('access_user', {
- 'username' => $username,
- 'disabled' => '',
- } );
- if ( $newuser ) {
- $curuser = $newuser;
- } else {
- warn "$me WARNING: (fs_queue) can't find CurrentUser $username\n";
- }
- }
- push @search, $curuser->agentnums_sql;
-
- join(' AND ', @search );
-
-}
-
-=back
-
-=head1 BUGS
-
-The delete method.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill_pay>, L<FS::cust_pay>,
-L<FS::cust_bill_pkg>, L<FS::cust_bill_credit>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm
deleted file mode 100644
index afb90f4..0000000
--- a/FS/FS/cust_bill_ApplicationCommon.pm
+++ /dev/null
@@ -1,518 +0,0 @@
-package FS::cust_bill_ApplicationCommon;
-
-use strict;
-use vars qw( @ISA $DEBUG $me $skip_apply_to_lineitems_hack );
-use List::Util qw(min);
-use FS::Schema qw( dbdef );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::cust_pkg;
-use FS::cust_svc;
-use FS::cust_bill_pkg;
-use FS::part_svc;
-use FS::part_export;
-
-@ISA = qw( FS::Record );
-
-$DEBUG = 0;
-$me = '[FS::cust_bill_ApplicationCommon]';
-
-$skip_apply_to_lineitems_hack = 0;
-
-=head1 NAME
-
-FS::cust_bill_ApplicationCommon - Base class for bill application classes
-
-=head1 SYNOPSIS
-
-use FS::cust_bill_ApplicationCommon;
-
-@ISA = qw( FS::cust_bill_ApplicationCommon );
-
-sub _app_source_name { 'payment'; }
-sub _app_source_table { 'cust_pay'; }
-sub _app_lineitem_breakdown_table { 'cust_bill_pay_pkg'; }
-
-=head1 DESCRIPTION
-
-FS::cust_bill_ApplicationCommon is intended as a base class for classes which
-represent application of things to invoices, currently payments
-(see L<FS::cust_bill_pay>) or credits (see L<FS::cust_credit_bill>).
-
-=head1 METHODS
-
-=over 4
-
-=item insert
-
-=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->apply_to_lineitems(@_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item delete
-
-=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 $app ( $self->lineitem_applications ) {
- my $error = $app->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 apply_to_lineitems
-
-Auto-applies this invoice application to specific line items, if possible.
-
-=cut
-
-sub calculate_applications {
- my( $self, %options ) = @_;
-
- return '' if $skip_apply_to_lineitems_hack;
-
- my @apply = ();
-
- my $conf = new FS::Conf;
-
- my @open = $self->cust_bill->open_cust_bill_pkg; #FOR UPDATE...?
-
- if ( exists($options{subitems}) ) {
- my $i = 0;
- my %open = ();
- $open{$_->billpkgnum} = $i++ foreach @open;
-
- foreach my $listref ( @{$options{subitems}} ) {
- my ($billpkgnum, $itemamount, $taxlocationnum) = @$listref;
- return "Can't apply a ". $self->_app_source_name. ' of $'. $listref->[1].
- " to line item $billpkgnum which is not open"
- unless exists($open{$billpkgnum});
- my $itemindex = $open{$billpkgnum};
- my %taxhash = ();
- if ($taxlocationnum) {
- %taxhash = map { ($_->primary_key => $_->get($_->primary_key)) }
- grep { $_->get($_->primary_key) == $taxlocationnum }
- $open[$itemindex]->cust_bill_pkg_tax_Xlocation;
-
- return "No tax line item with a key value of $taxlocationnum exists"
- unless scalar(%taxhash);
- }
- push @apply, [ $open[$itemindex], $itemamount, { %taxhash } ];
- }
- return \@apply;
- }
-
- @open = grep { $_->pkgnum == $self->pkgnum } @open
- if $conf->exists('pkg-balances') && $self->pkgnum;
- warn "$me ". scalar(@open). " open line items for invoice ".
- $self->cust_bill->invnum. ": ". join(', ', @open). "\n"
- if $DEBUG;
- my $total = 0;
- foreach (@open) {
- $total += $_->owed_setup if $_->setup;
- $total += $_->owed_recur if $_->recur;
- }
- $total = sprintf('%.2f', $total);
-
- if ( $self->amount > $total ) {
- return "Can't apply a ". $self->_app_source_name. ' of $'. $self->amount.
- " greater than the remaining owed on line items (\$$total)";
- }
-
- #easy cases:
- # - one lineitem (a simple special case of:)
- # - amount is for whole invoice (well, all of remaining lineitem links)
- if ( $self->amount == $total ) {
-
- warn "$me application amount covers remaining balance of invoice in full;".
- "applying to those lineitems\n"
- if $DEBUG;
-
- #@apply = map { [ $_, $_->amount ]; } @open;
- #@apply = map { [ $_, $_->owed_setup + 0 || $_->owed_recur + 0 ]; } @open;
- @apply = map { [ $_, $_->setup ? $_->owed_setup : $_->owed_recur ]; } @open;
-
- } else {
-
- #slightly magic case:
- # - amount exactly and uniquely matches a single open lineitem
- # (you must be trying to pay or credit that item, then)
-
- my @same = grep { ( $_->setup && $_->owed_setup == $self->amount )
- || ( $_->recur && $_->owed_recur == $self->amount )
- }
- @open;
- if ( scalar(@same) == 1 ) {
- warn "$me application amount exactly and uniquely matches one lineitem;".
- " applying to that lineitem\n"
- if $DEBUG;
- @apply = map { [ $_, $self->amount ]; } @same
- }
-
- }
-
- unless ( @apply ) {
-
- warn "$me applying amount based on package weights\n"
- if $DEBUG;
-
- #and the rest:
- # - apply based on weights...
-
- my $weight_col = $self->_app_part_pkg_weight_column;
- my @openweight = map {
- my $open = $_;
- my $cust_pkg = $open->cust_pkg;
- my $weight =
- $cust_pkg
- ? ( $cust_pkg->part_pkg->$weight_col() || 0 )
- : -1; #default or per-tax weight?
- [ $open, $weight ]
- }
- @open;
-
- my %saw = ();
- my @weights = sort { $b <=> $a } # highest weight first
- grep { ! $saw{$_}++ } # want a list of unique weights
- map { $_->[1] }
- @openweight;
-
- my $remaining_amount = $self->amount;
- foreach my $weight ( @weights ) {
-
- #i hate it when my schwartz gets tangled
- my @items = map { $_->[0] } grep { $weight == $_->[1] } @openweight;
-
- my $itemtotal = 0;
- foreach my $item (@items) {
- $itemtotal += $item->owed_setup if $item->setup;
- $itemtotal += $item->owed_recur if $item->recur;
- }
- my $applytotal = min( $itemtotal, $remaining_amount );
- $remaining_amount -= $applytotal;
-
- warn "$me applying $applytotal ($remaining_amount remaining)".
- " to ". scalar(@items). " lineitems with weight $weight\n"
- if $DEBUG;
-
- #if some items are less than applytotal/num_items, then apply then in full
- my $lessflag;
- do {
- $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
- my $applyeach = int( 100 * $applytotal / scalar(@items) ) / 100;
-
- my @newitems = ();
- foreach my $item ( @items ) {
- my $itemamount = $item->setup ? $item->owed_setup : $item->owed_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;
- $lessflag=1;
- } 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
- 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 ) ) {
- 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;
-
- }
-
- }
-
- # break down lineitem amounts for tax lines
- # could expand @open above, instead, for a slightly different magic effect
- my @result = ();
- foreach my $apply ( @apply ) {
- my @sub_lines = $apply->[0]->cust_bill_pkg_tax_Xlocation;
- my $amount = $apply->[1];
- warn "applying ". $apply->[1]. " to ". $apply->[0]->desc
- if $DEBUG;
-
- foreach my $subline ( @sub_lines ) {
- my $owed = $subline->owed;
- push @result, [ $apply->[0],
- sprintf('%.2f', min($amount, $owed) ),
- { $subline->primary_key => $subline->get($subline->primary_key) },
- ];
- $amount -= $owed;
- $amount = 0 if $amount < 0;
- last unless $amount;
- }
- if ( $amount > 0 ) {
- push @result, [ $apply->[0], sprintf('%.2f', $amount), {} ];
- }
- }
-
- \@result;
-
-}
-
-sub apply_to_lineitems {
- #my $self = shift;
- my( $self, %options ) = @_;
-
- return '' if $skip_apply_to_lineitems_hack;
-
- my $conf = new FS::Conf;
-
- 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 $listref_or_error = $self->calculate_applications(%options);
- unless (ref($listref_or_error)) {
- $dbh->rollback if $oldAutoCommit;
- return $listref_or_error;
- }
-
- my @apply = @$listref_or_error;
-
- # do the applicaiton(s)
- my $table = $self->lineitem_breakdown_table;
- my $source_key = dbdef->table($self->table)->primary_key;
- my $applied = 0;
- foreach my $apply ( @apply ) {
- my ( $cust_bill_pkg, $amount, $taxcreditref ) = @$apply;
- $applied += $amount;
- my $application = "FS::$table"->new( {
- $source_key => $self->$source_key(),
- 'billpkgnum' => $cust_bill_pkg->billpkgnum,
- 'amount' => sprintf('%.2f', $amount),
- 'setuprecur' => ( $cust_bill_pkg->setup > 0 ? 'setup' : 'recur' ),
- 'sdate' => $cust_bill_pkg->sdate,
- 'edate' => $cust_bill_pkg->edate,
- %$taxcreditref,
- });
- my $error = $application->insert(%options);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- # trigger export_insert_on_payment
- if ( $conf->exists('trigger_export_insert_on_payment')
- && $cust_bill_pkg->pkgnum > 0 )
- {
- if ( my $cust_pkg = $cust_bill_pkg->cust_pkg ) {
-
- foreach my $cust_svc ( $cust_pkg->cust_svc ) {
- my $svc_x = $cust_svc->svc_x;
- my @part_export = grep { $_->can('_export_insert_on_payment') }
- $cust_svc->part_svc->part_export;
-
- foreach my $part_export ( @part_export ) {
- $error = $part_export->_export_insert_on_payment($svc_x);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
- }
- }
- # done trigger export_insert_on_payment
-
- }
-
- #everything should always be applied to line items in full now... sanity check
- $applied = sprintf('%.2f', $applied);
- unless ( $applied == $self->amount ) {
- $dbh->rollback if $oldAutoCommit;
- return 'Error applying '. $self->_app_source_name. ' of $'. $self->amount.
- ' to line items - only $'. $applied. ' was applied.';
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item lineitem_applications
-
-Returns all the specific line item applications for this invoice application.
-
-=cut
-
-sub lineitem_applications {
- my $self = shift;
- my $primary_key = dbdef->table($self->table)->primary_key;
- qsearch({
- 'table' => $self->lineitem_breakdown_table,
- 'hashref' => { $primary_key => $self->$primary_key() },
- });
-
-}
-
-=item cust_bill
-
-Returns the invoice (see L<FS::cust_bill>)
-
-=cut
-
-sub cust_bill {
- my $self = shift;
- qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
-}
-
-=item applied_to_invoice
-
-Returns a string representing the invoice (see L<FS::cust_bill>), for example:
-"applied to Invoice #54 (3/20/2008)"
-
-=cut
-
-sub applied_to_invoice {
- my $self = shift;
- 'applied to '. $self->cust_bill->invnum_date_pretty;
-}
-
-=item lineitem_breakdown_table
-
-=cut
-
-sub lineitem_breakdown_table {
- my $self = shift;
- $self->_load_table($self->_app_lineitem_breakdown_table);
-}
-
-sub _load_table {
- my( $self, $table ) = @_;
- eval "use FS::$table";
- die $@ if $@;
- $table;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_bill_pay> and L<FS::cust_bill_pay_pkg>,
-L<FS::cust_credit_bill> and L<FS::cust_credit_bill_pkg>
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_batch.pm b/FS/FS/cust_bill_batch.pm
deleted file mode 100644
index 4569e6b..0000000
--- a/FS/FS/cust_bill_batch.pm
+++ /dev/null
@@ -1,70 +0,0 @@
-package FS::cust_bill_batch;
-
-use strict;
-use vars qw( @ISA $me $DEBUG );
-use FS::Record qw( qsearch qsearchs dbh );
-
-@ISA = qw( FS::option_Common );
-$me = '[ FS::cust_bill_batch ]';
-$DEBUG=0;
-
-sub table { 'cust_bill_batch' }
-
-=head1 NAME
-
-FS::cust_bill_batch - Object methods for cust_bill_batch records
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_batch object represents the inclusion of an invoice in a
-processing batch. FS::cust_bill_batch inherits from FS::option_Common. The
-following fields are currently supported:
-
-=over 4
-
-=item billbatchnum - primary key
-
-=item invnum - invoice number (see C<FS::cust_bill>)
-
-=item batchnum - batchn number (see C<FS::bill_batch>)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item bill_batch
-
-Returns the C<FS::bill_batch> object.
-
-=cut
-
-sub bill_batch {
- my $self = shift;
- FS::bill_batch->by_key($self->batchnum);
-}
-
-=item cust_bill
-
-Returns the C<FS::cust_bill> object.
-
-=cut
-
-sub cust_bill {
- my $self = shift;
- FS::cust_bill->by_key($self->invnum);
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_batch_option.pm b/FS/FS/cust_bill_batch_option.pm
deleted file mode 100644
index 9bba830..0000000
--- a/FS/FS/cust_bill_batch_option.pm
+++ /dev/null
@@ -1,126 +0,0 @@
-package FS::cust_bill_batch_option;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cust_bill_batch_option - Object methods for cust_bill_batch_option records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_batch_option;
-
- $record = new FS::cust_bill_batch_option \%hash;
- $record = new FS::cust_bill_batch_option { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_batch_option object represents an option key and value for
-an invoice batch entry. FS::cust_bill_batch_option inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item optionnum - primary key
-
-=item billbatchnum -
-
-=item optionname -
-
-=item optionvalue -
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new option. To add the option 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 { 'cust_bill_batch_option'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid option. 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('optionnum')
- || $self->ut_foreign_key('billbatchnum', 'cust_bill_batch', 'billbatchnum')
- || $self->ut_text('optionname')
- || $self->ut_textn('optionvalue')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm
deleted file mode 100644
index 36afed0..0000000
--- a/FS/FS/cust_bill_event.pm
+++ /dev/null
@@ -1,380 +0,0 @@
-package FS::cust_bill_event;
-
-use strict;
-use vars qw( @ISA $DEBUG );
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_main_Mixin;
-use FS::cust_bill;
-use FS::part_bill_event;
-
-@ISA = qw(FS::cust_main_Mixin FS::Record);
-
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::cust_bill_event - Object methods for cust_bill_event records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_event;
-
- $record = new FS::cust_bill_event \%hash;
- $record = new FS::cust_bill_event { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_event object represents an complete invoice event.
-FS::cust_bill_event inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item eventnum
-
-Primary key
-
-=item invnum
-
-Invoice (see L<FS::cust_bill>)
-
-=item eventpart
-
-Event definition (see L<FS::part_bill_event>)
-
-=item _date
-
-Specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item status
-
-Event status: B<done> or B<failed>
-
-=item statustext
-
-Additional status detail (i.e. error message)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new completed invoice event. To add the compelted invoice event 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 { 'cust_bill_event'; }
-
-sub cust_linked { $_[0]->cust_main_custnum; }
-sub cust_unlinked_msg {
- my $self = shift;
- "WARNING: can't find cust_main.custnum ". $self->custnum.
- ' (cust_bill.invnum '. $self->invnum. ')';
-}
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid completed invoice event. 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('eventnum')
- || $self->ut_number('invnum')
- || $self->ut_number('eventpart')
- || $self->ut_number('_date')
- || $self->ut_enum('status', [qw( done failed )])
- || $self->ut_anything('statustext')
- ;
-
- return "Unknown eventpart ". $self->eventpart
- unless my $part_bill_event =
- qsearchs( 'part_bill_event' ,{ 'eventpart' => $self->eventpart } );
-
- return "Unknown invnum ". $self->invnum
- unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
-
- $self->SUPER::check;
-}
-
-=item part_bill_event
-
-Returns the invoice event definition (see L<FS::part_bill_event>) for this
-completed invoice event.
-
-=cut
-
-sub part_bill_event {
- my $self = shift;
- qsearchs( 'part_bill_event', { 'eventpart' => $self->eventpart } );
-}
-
-=item cust_bill
-
-Returns the invoice (see L<FS::cust_bill>) for this completed invoice event.
-
-=cut
-
-sub cust_bill {
- my $self = shift;
- qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
-}
-
-=item retry
-
-Changes the status of this event from B<done> to B<failed>, allowing it to be
-retried.
-
-=cut
-
-sub retry {
- my $self = shift;
- return '' unless $self->status eq 'done';
- my $old = ref($self)->new( { $self->hash } );
- $self->status('failed');
- $self->replace($old);
-}
-
-=item retryable
-
-Changes the statustext of this event to B<retriable>, rendering it
-retriable (should retry be called).
-
-=cut
-
-sub retriable {
- my $self = shift;
- return '' unless $self->status eq 'done';
- my $old = ref($self)->new( { $self->hash } );
- $self->statustext('retriable');
- $self->replace($old);
-}
-
-=item search_sql_where HASHREF
-
-Class method which returns an SQL WHERE fragment to search for parameters
-specified in HASHREF. Valid parameters are
-
-=over 4
-
-=item agentnum
-
-=item beginning
-
-An epoch date setting a lower bound for _date values
-
-=item ending
-
-An epoch date setting a upper bound for _date values
-
-=item failed
-
-Limits the search to failed events if true
-
-=item payby
-
-Requires that the search be JOIN'd to part_bill_event # Bug?
-
-=item invnum
-
-=item currentuser
-
-Specifies the user for agent virtualization
-
-=back
-
-=cut
-
-sub search_sql_where {
- my ($class, $params) = @_;
- my @search = ();
-
- push @search, "agentnum = ". $params->{agentnum} if $params->{agentnum};
-
- push @search, "cust_bill_event._date >= ". $params->{beginning}
- if $params->{beginning};
- push @search, "cust_bill_event._date <= ". $params->{ending}
- if $params->{ending};
-
- push @search, "statustext != ''",
- "statustext IS NOT NULL",
- "statustext != 'N/A'"
- if $params->{failed};
-
- push @search, "part_bill_event.payby = '". $params->{payby}. "'"
- if $params->{payby};
-
- push @search, "cust_bill_event.invnum = '". $params->{invnum}. "'"
- if $params->{invnum};
-
- my $currentuser = $params->{currentuser} || $params->{CurrentUser};
- if ($currentuser) {
- my $access_user = qsearchs('access_user', { username => $currentuser });
- if ($access_user) {
- push @search, $access_user->agentnums_sql;
- }else{
- push @search, "1=0";
- }
- }else{
- push @search, $FS::CurrentUser::CurrentUser->agentnums_sql;
- }
-
- join(' AND ', @search );
-
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item reprint
-
-=cut
-
-sub process_reprint {
- process_re_X('print', @_);
-}
-
-=item reemail
-
-=cut
-
-sub process_reemail {
- process_re_X('email', @_);
-}
-
-=item refax
-
-=cut
-
-sub process_refax {
- process_re_X('fax', @_);
-}
-
-use Storable qw(thaw);
-use Data::Dumper;
-use MIME::Base64;
-sub process_re_X {
- my( $method, $job ) = ( shift, shift );
-
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- re_X(
- $method,
- $param,
- $job,
- );
-
-}
-
-sub re_X {
- my($method, $param, $job) = @_;
-
- my $where = FS::cust_bill_event->search_sql_where($param);
- $where = " WHERE plan LIKE 'send%'". ( $where ? " AND $where" : "" );
-
- my $from = 'LEFT JOIN part_bill_event USING ( eventpart )'.
- 'LEFT JOIN cust_bill USING ( invnum )'.
- 'LEFT JOIN cust_main USING ( custnum )';
-
- my @cust_bill_event = qsearch( 'cust_bill_event', {}, '', $where, '', $from );
-
- my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
- foreach my $cust_bill_event ( @cust_bill_event ) {
-
- $cust_bill_event->cust_bill->$method(
- $cust_bill_event->part_bill_event->templatename
- );
-
- if ( $job ) { #progressbar foo
- $num++;
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $num / scalar(@cust_bill_event) )
- );
- die $error if $error;
- $last = time;
- }
- }
-
- }
-
- #this doesn't work, but it would be nice
- #if ( $job ) { #progressbar foo
- # my $error = $job->update_statustext(
- # scalar(@cust_bill_event). " invoices re-${method}ed"
- # );
- # die $error if $error;
- #}
-
-}
-
-=back
-
-=head1 BUGS
-
-Far too early in the morning.
-
-=head1 SEE ALSO
-
-L<FS::part_bill_event>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_pay.pm b/FS/FS/cust_bill_pay.pm
deleted file mode 100644
index 831d7f2..0000000
--- a/FS/FS/cust_bill_pay.pm
+++ /dev/null
@@ -1,186 +0,0 @@
-package FS::cust_bill_pay;
-
-use strict;
-use vars qw( @ISA $conf );
-use FS::Record qw( qsearchs );
-use FS::cust_main_Mixin;
-use FS::cust_bill_ApplicationCommon;
-use FS::cust_bill;
-use FS::cust_pay;
-use FS::cust_pkg;
-
-@ISA = qw( FS::cust_main_Mixin FS::cust_bill_ApplicationCommon );
-
-#ask FS::UID to run this stuff for us later
-FS::UID->install_callback( sub {
- $conf = new FS::Conf;
-} );
-
-=head1 NAME
-
-FS::cust_bill_pay - Object methods for cust_bill_pay records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pay;
-
- $record = new FS::cust_bill_pay \%hash;
- $record = new FS::cust_bill_pay { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pay object represents the application of a payment to a
-specific invoice. FS::cust_bill_pay inherits from
-FS::cust_bill_ApplicationCommon and FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item billpaynum - primary key (assigned automatically)
-
-=item invnum - Invoice (see L<FS::cust_bill>)
-
-=item paynum - Payment (see L<FS::cust_pay>)
-
-=item amount - Amount of the payment to apply to the specific invoice.
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new record. To add the record to the database, see L<"insert">.
-
-=cut
-
-sub table { 'cust_bill_pay'; }
-
-sub _app_source_name { 'payment'; }
-sub _app_source_table { 'cust_pay'; }
-sub _app_lineitem_breakdown_table { 'cust_bill_pay_pkg'; }
-sub _app_part_pkg_weight_column { 'pay_weight'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this payment application, unless the closed flag for the parent payment
-(see L<FS::cust_pay>) is set.
-
-=cut
-
-sub delete {
- my $self = shift;
- return "Can't delete application for closed payment"
- if $self->cust_pay->closed =~ /^Y/i;
- return "Can't delete application for closed invoice"
- if $self->cust_bill->closed =~ /^Y/i;
- $self->SUPER::delete(@_);
-}
-
-=item replace OLD_RECORD
-
-Currently unimplemented (accounting reasons).
-
-=cut
-
-sub replace {
- return "Can't modify application of payment!";
-}
-
-=item check
-
-Checks all fields to make sure this is a valid payment application. If there
-is an error, returns the error, otherwise returns false. Called by the insert
-method.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('billpaynum')
- || $self->ut_foreign_key('paynum', 'cust_pay', 'paynum' )
- || $self->ut_foreign_key('invnum', 'cust_bill', 'invnum' )
- || $self->ut_numbern('_date')
- || $self->ut_money('amount')
- || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
- ;
- return $error if $error;
-
- return "amount must be > 0" if $self->amount <= 0;
-
- $self->_date(time) unless $self->_date;
-
- return "Cannot apply more than remaining value of invoice"
- unless $self->amount <= $self->cust_bill->owed;
-
- return "Cannot apply more than remaining value of payment"
- unless $self->amount <= $self->cust_pay->unapplied;
-
- $self->SUPER::check;
-}
-
-=item cust_pay
-
-Returns the payment (see L<FS::cust_pay>)
-
-=cut
-
-sub cust_pay {
- my $self = shift;
- qsearchs( 'cust_pay', { 'paynum' => $self->paynum } );
-}
-
-=item send_receipt HASHREF | OPTION => VALUE ...
-
-
-Sends a payment receipt for the associated payment, against this specific
-invoice. If there is an error, returns the error, otherwise returns false.
-
-See L<FS::cust_pay/send_receipt>.
-
-=cut
-
-sub send_receipt {
- my $self = shift;
- my $opt = ref($_[0]) ? shift : { @_ };
- $self->cust_pay->send_receipt(
- 'cust_bill' => $self->cust_bill,
- %$opt,
- );
-}
-
-=back
-
-=head1 BUGS
-
-Delete and replace methods.
-
-=head1 SEE ALSO
-
-L<FS::cust_pay>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_pay_batch.pm b/FS/FS/cust_bill_pay_batch.pm
deleted file mode 100644
index 30fb744..0000000
--- a/FS/FS/cust_bill_pay_batch.pm
+++ /dev/null
@@ -1,120 +0,0 @@
-package FS::cust_bill_pay_batch;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cust_bill_pay_batch - Object methods for cust_bill_pay_batch records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pay_batch;
-
- $record = new FS::cust_bill_pay_batch \%hash;
- $record = new FS::cust_bill_pay_batch { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pay_batch object represents a relationship between a
-customer's bill and a batch. FS::cust_bill_pay_batch inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item billpaynum - primary key
-
-=item invnum - customer's bill (invoice)
-
-=item paybatchnum - entry in cust_pay_batch table
-
-=item amount -
-
-=item _date -
-
-
-=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
-
-sub table { 'cust_bill_pay_batch'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('billpaynum')
- || $self->ut_number('invnum')
- || $self->ut_number('paybatchnum')
- || $self->ut_money('amount')
- || $self->ut_numbern('_date')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-Just hangs there.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_pay_pkg.pm b/FS/FS/cust_bill_pay_pkg.pm
deleted file mode 100644
index eb2e80c..0000000
--- a/FS/FS/cust_bill_pay_pkg.pm
+++ /dev/null
@@ -1,224 +0,0 @@
-package FS::cust_bill_pay_pkg;
-
-use strict;
-use vars qw( @ISA );
-use FS::Conf;
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_bill_pay;
-use FS::cust_bill_pkg;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cust_bill_pay_pkg - Object methods for cust_bill_pay_pkg records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pay_pkg;
-
- $record = new FS::cust_bill_pay_pkg \%hash;
- $record = new FS::cust_bill_pay_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pay_pkg object represents application of a payment (see
-L<FS::cust_bill_pay>) to a specific line item within an invoice (see
-L<FS::cust_bill_pkg>). FS::cust_bill_pay_pkg inherits from FS::Record. The
-following fields are currently supported:
-
-=over 4
-
-=item billpaypkgnum - primary key
-
-=item billpaynum - Payment application to the overall invoice (see L<FS::cust_bill_pay>)
-
-=item billpkgnum - Line item to which payment is applied (see L<FS::cust_bill_pkg>)
-
-=item amount - Amount of the payment applied to this line item.
-
-=item setuprecur - 'setup' or 'recur', designates whether the payment was applied to the setup or recurring portion of the line item.
-
-=item sdate - starting date of recurring fee
-
-=item edate - ending date of recurring fee
-
-=back
-
-sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">. Also
-see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=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 { 'cust_bill_pay_pkg'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self, %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;
-
- my $error = $self->SUPER::insert;
- if ( $error ) {
- #$dbh->rollback if $oldAutoCommit;
- return "error inserting $self: $error";
- }
-
- #payment receipt
- my $conf = new FS::Conf;
- my $trigger = $conf->config('payment_receipt-trigger') || 'cust_pay';
- if ( $trigger eq 'cust_bill_pay_pkg' ) {
- my $error = $self->send_receipt(
- 'manual' => $options{'manual'},
- );
- warn "can't send payment receipt/statement: $error" if $error;
- }
-
- '';
-
-}
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid payment application. 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('billpaypkgnum')
- || $self->ut_foreign_key('billpaynum', 'cust_bill_pay', 'billpaynum' )
- || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' )
- || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
- || $self->ut_foreign_keyn('billpkgtaxlocationnum',
- 'cust_bill_pkg_tax_location',
- 'billpkgtaxlocationnum')
- || $self->ut_foreign_keyn('billpkgtaxratelocationnum',
- 'cust_bill_pkg_tax_rate_location',
- 'billpkgtaxratelocationnum')
- || $self->ut_money('amount')
- || $self->ut_enum('setuprecur', [ 'setup', 'recur' ] )
- || $self->ut_numbern('sdate')
- || $self->ut_numbern('edate')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item cust_bill_pay
-
-Returns the FS::cust_bill_pay object (payment application to the overall
-invoice).
-
-=cut
-
-sub cust_bill_pay {
- my $self = shift;
- qsearchs('cust_bill_pay', { 'billpaynum' => $self->billpaynum } );
-}
-
-=item cust_bill_pkg
-
-Returns the FS::cust_bill_pkg object (line item to which payment is applied).
-
-=cut
-
-sub cust_bill_pkg {
- my $self = shift;
- qsearchs('cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } );
-}
-
-=item send_receipt
-
-Sends a payment receipt for the associated payment, against this specific
-invoice and packages. If there is an error, returns the error, otherwise
-returns false.
-
-=cut
-
-sub send_receipt {
- my $self = shift;
- my $opt = ref($_[0]) ? shift : { @_ };
- $self->cust_bill_pay->send_receipt(
- 'cust_pkg' => scalar($self->cust_bill_pkg->cust_pkg),
- %$opt,
- );
-}
-
-
-=back
-
-=head1 BUGS
-
-B<setuprecur> field is a kludge to compensate for cust_bill_pkg having separate
-setup and recur fields. It should be removed once that's fixed.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm
deleted file mode 100644
index d396f82..0000000
--- a/FS/FS/cust_bill_pkg.pm
+++ /dev/null
@@ -1,902 +0,0 @@
-package FS::cust_bill_pkg;
-
-use strict;
-use vars qw( @ISA $DEBUG $me );
-use Carp;
-use FS::Record qw( qsearch qsearchs dbdef dbh );
-use FS::cust_main_Mixin;
-use FS::cust_pkg;
-use FS::part_pkg;
-use FS::cust_bill;
-use FS::cust_bill_pkg_detail;
-use FS::cust_bill_pkg_display;
-use FS::cust_bill_pay_pkg;
-use FS::cust_credit_bill_pkg;
-use FS::cust_tax_exempt_pkg;
-use FS::cust_bill_pkg_tax_location;
-use FS::cust_bill_pkg_tax_rate_location;
-use FS::cust_tax_adjustment;
-
-@ISA = qw( FS::cust_main_Mixin FS::Record );
-
-$DEBUG = 0;
-$me = '[FS::cust_bill_pkg]';
-
-=head1 NAME
-
-FS::cust_bill_pkg - Object methods for cust_bill_pkg records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pkg;
-
- $record = new FS::cust_bill_pkg \%hash;
- $record = new FS::cust_bill_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pkg object represents an invoice line item.
-FS::cust_bill_pkg inherits from FS::Record. The following fields are currently
-supported:
-
-=over 4
-
-=item billpkgnum
-
-primary key
-
-=item invnum
-
-invoice (see L<FS::cust_bill>)
-
-=item pkgnum
-
-package (see L<FS::cust_pkg>) or 0 for the special virtual sales tax package, or -1 for the virtual line item (itemdesc is used for the line)
-
-=item pkgpart_override
-
-optional package definition (see L<FS::part_pkg>) override
-
-=item setup
-
-setup fee
-
-=item recur
-
-recurring fee
-
-=item sdate
-
-starting date of recurring fee
-
-=item edate
-
-ending date of recurring fee
-
-=item itemdesc
-
-Line item description (overrides normal package description)
-
-=item quantity
-
-If not set, defaults to 1
-
-=item unitsetup
-
-If not set, defaults to setup
-
-=item unitrecur
-
-If not set, defaults to recur
-
-=item hidden
-
-If set to Y, indicates data should not appear as separate line item on invoice
-
-=back
-
-sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">. Also
-see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new line item. To add the line item to the database, see
-L<"insert">. Line items are normally created by calling the bill method of a
-customer object (see L<FS::cust_main>).
-
-=cut
-
-sub table { 'cust_bill_pkg'; }
-
-=item insert
-
-Adds this line item 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;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $self->get('details') ) {
- foreach my $detail ( @{$self->get('details')} ) {
- my $cust_bill_pkg_detail = new FS::cust_bill_pkg_detail {
- 'billpkgnum' => $self->billpkgnum,
- 'format' => (ref($detail) ? $detail->[0] : '' ),
- 'detail' => (ref($detail) ? $detail->[1] : $detail ),
- 'amount' => (ref($detail) ? $detail->[2] : '' ),
- 'classnum' => (ref($detail) ? $detail->[3] : '' ),
- 'phonenum' => (ref($detail) ? $detail->[4] : '' ),
- 'duration' => (ref($detail) ? $detail->[5] : '' ),
- 'regionname' => (ref($detail) ? $detail->[6] : '' ),
- };
- $error = $cust_bill_pkg_detail->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_bill_pkg_detail: $error";
- }
- }
- }
-
- if ( $self->get('display') ) {
- foreach my $cust_bill_pkg_display ( @{ $self->get('display') } ) {
- $cust_bill_pkg_display->billpkgnum($self->billpkgnum);
- $error = $cust_bill_pkg_display->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_bill_pkg_display: $error";
- }
- }
- }
-
- if ( $self->get('discounts') ) {
- foreach my $cust_bill_pkg_discount ( @{$self->get('discounts')} ) {
- $cust_bill_pkg_discount->billpkgnum($self->billpkgnum);
- $error = $cust_bill_pkg_discount->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_bill_pkg_discount: $error";
- }
- }
- }
-
- if ( $self->_cust_tax_exempt_pkg ) {
- foreach my $cust_tax_exempt_pkg ( @{$self->_cust_tax_exempt_pkg} ) {
- $cust_tax_exempt_pkg->billpkgnum($self->billpkgnum);
- $error = $cust_tax_exempt_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_tax_exempt_pkg: $error";
- }
- }
- }
-
- my $tax_location = $self->get('cust_bill_pkg_tax_location');
- if ( $tax_location ) {
- foreach my $cust_bill_pkg_tax_location ( @$tax_location ) {
- $cust_bill_pkg_tax_location->billpkgnum($self->billpkgnum);
- $error = $cust_bill_pkg_tax_location->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_bill_pkg_tax_location: $error";
- }
- }
- }
-
- my $tax_rate_location = $self->get('cust_bill_pkg_tax_rate_location');
- if ( $tax_rate_location ) {
- foreach my $cust_bill_pkg_tax_rate_location ( @$tax_rate_location ) {
- $cust_bill_pkg_tax_rate_location->billpkgnum($self->billpkgnum);
- $error = $cust_bill_pkg_tax_rate_location->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_bill_pkg_tax_rate_location: $error";
- }
- }
- }
-
- my $cust_tax_adjustment = $self->get('cust_tax_adjustment');
- if ( $cust_tax_adjustment ) {
- $cust_tax_adjustment->billpkgnum($self->billpkgnum);
- $error = $cust_tax_adjustment->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error replacing cust_tax_adjustment: $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item delete
-
-Not recommended.
-
-=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 $table (qw(
- cust_bill_pkg_detail
- cust_bill_pkg_display
- cust_bill_pkg_tax_location
- cust_bill_pkg_tax_rate_location
- cust_tax_exempt_pkg
- cust_bill_pay_pkg
- cust_credit_bill_pkg
- )) {
-
- foreach my $linked ( qsearch($table, { billpkgnum=>$self->billpkgnum }) ) {
- my $error = $linked->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- }
-
- foreach my $cust_tax_adjustment (
- qsearch('cust_tax_adjustment', { billpkgnum=>$self->billpkgnum })
- ) {
- $cust_tax_adjustment->billpkgnum(''); #NULL
- my $error = $cust_tax_adjustment->replace;
- 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;
-
- '';
-
-}
-
-#alas, bin/follow-tax-rename
-#
-#=item replace OLD_RECORD
-#
-#Currently unimplemented. This would be even more of an accounting nightmare
-#than deleteing the items. Just don't do it.
-#
-#=cut
-#
-#sub replace {
-# return "Can't modify cust_bill_pkg records!";
-#}
-
-=item check
-
-Checks all fields to make sure this is a valid line item. If there is an
-error, returns the error, otherwise returns false. Called by the insert
-method.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('billpkgnum')
- || $self->ut_snumber('pkgnum')
- || $self->ut_number('invnum')
- || $self->ut_money('setup')
- || $self->ut_money('recur')
- || $self->ut_numbern('sdate')
- || $self->ut_numbern('edate')
- || $self->ut_textn('itemdesc')
- || $self->ut_textn('itemcomment')
- || $self->ut_enum('hidden', [ '', 'Y' ])
- ;
- return $error if $error;
-
- #if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?)
- if ( $self->pkgnum > 0 ) { #allow -1 for non-pkg line items and 0 for tax (add to part_pkg?)
- return "Unknown pkgnum ". $self->pkgnum
- unless qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
- }
-
- return "Unknown invnum"
- unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
-
- $self->SUPER::check;
-}
-
-=item cust_pkg
-
-Returns the package (see L<FS::cust_pkg>) for this invoice line item.
-
-=cut
-
-sub cust_pkg {
- my $self = shift;
- carp "$me $self -> cust_pkg" if $DEBUG;
- qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
-}
-
-=item part_pkg
-
-Returns the package definition for this invoice line item.
-
-=cut
-
-sub part_pkg {
- my $self = shift;
- if ( $self->pkgpart_override ) {
- qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart_override } );
- } else {
- my $part_pkg;
- my $cust_pkg = $self->cust_pkg;
- $part_pkg = $cust_pkg->part_pkg if $cust_pkg;
- $part_pkg;
- }
-}
-
-=item cust_bill
-
-Returns the invoice (see L<FS::cust_bill>) for this invoice line item.
-
-=cut
-
-sub cust_bill {
- my $self = shift;
- qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
-}
-
-=item previous_cust_bill_pkg
-
-Returns the previous cust_bill_pkg for this package, if any.
-
-=cut
-
-sub previous_cust_bill_pkg {
- my $self = shift;
- return unless $self->sdate;
- qsearchs({
- 'table' => 'cust_bill_pkg',
- 'hashref' => { 'pkgnum' => $self->pkgnum,
- 'sdate' => { op=>'<', value=>$self->sdate },
- },
- 'order_by' => 'ORDER BY sdate DESC LIMIT 1',
- });
-}
-
-=item details [ OPTION => VALUE ... ]
-
-Returns an array of detail information for the invoice line item.
-
-Currently available options are: I<format> I<escape_function>
-
-If I<format> is set to html or latex then the array members are improved
-for tabular appearance in those environments if possible.
-
-If I<escape_function> is set then the array members are processed by this
-function before being returned.
-
-=cut
-
-sub details {
- my ( $self, %opt ) = @_;
- my $format = $opt{format} || '';
- my $escape_function = $opt{escape_function} || sub { shift };
- return () unless defined dbdef->table('cust_bill_pkg_detail');
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
- my $csv = new Text::CSV_XS;
-
- my $format_sub = sub { my $detail = shift;
- $csv->parse($detail) or return "can't parse $detail";
- join(' - ', map { &$escape_function($_) }
- $csv->fields
- );
- };
-
- $format_sub = sub { my $detail = shift;
- $csv->parse($detail) or return "can't parse $detail";
- join('</TD><TD>', map { &$escape_function($_) }
- $csv->fields
- );
- }
- if $format eq 'html';
-
- $format_sub = sub { my $detail = shift;
- $csv->parse($detail) or return "can't parse $detail";
- #join(' & ', map { '\small{'. &$escape_function($_). '}' }
- # $csv->fields );
- my $result = '';
- my $column = 1;
- foreach ($csv->fields) {
- $result .= ' & ' if $column > 1;
- if ($column > 6) { # KLUDGE ALERT!
- $result .= '\multicolumn{1}{l}{\scriptsize{'.
- &$escape_function($_). '}}';
- }else{
- $result .= '\scriptsize{'. &$escape_function($_). '}';
- }
- $column++;
- }
- $result;
- }
- if $format eq 'latex';
-
- $format_sub = $opt{format_function} if $opt{format_function};
-
- map { ( $_->format eq 'C'
- ? &{$format_sub}( $_->detail, $_ )
- : &{$escape_function}( $_->detail )
- )
- }
- qsearch ({ 'table' => 'cust_bill_pkg_detail',
- 'hashref' => { 'billpkgnum' => $self->billpkgnum },
- 'order_by' => 'ORDER BY detailnum',
- });
- #qsearch ( 'cust_bill_pkg_detail', { 'lineitemnum' => $self->lineitemnum });
-}
-
-=item details_header [ OPTION => VALUE ... ]
-
-Returns a list representing an invoice line item detail header, if any.
-This relies on the behavior of voip_cdr in that it expects the header
-to be the first CSV formatted detail (as is expected by invoice generation
-routines). Returns the empty list otherwise.
-
-=cut
-
-sub details_header {
- my $self = shift;
- return '' unless defined dbdef->table('cust_bill_pkg_detail');
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
- my $csv = new Text::CSV_XS;
-
- my @detail =
- qsearch ({ 'table' => 'cust_bill_pkg_detail',
- 'hashref' => { 'billpkgnum' => $self->billpkgnum,
- 'format' => 'C',
- },
- 'order_by' => 'ORDER BY detailnum LIMIT 1',
- });
- return() unless scalar(@detail);
- $csv->parse($detail[0]->detail) or return ();
- $csv->fields;
-}
-
-=item desc
-
-Returns a description for this line item. For typical line items, this is the
-I<pkg> field of the corresponding B<FS::part_pkg> object (see L<FS::part_pkg>).
-For one-shot line items and named taxes, it is the I<itemdesc> field of this
-line item, and for generic taxes, simply returns "Tax".
-
-=cut
-
-sub desc {
- my $self = shift;
-
- if ( $self->pkgnum > 0 ) {
- $self->itemdesc || $self->part_pkg->pkg;
- } else {
- my $desc = $self->itemdesc || 'Tax';
- $desc .= ' '. $self->itemcomment if $self->itemcomment =~ /\S/;
- $desc;
- }
-}
-
-=item owed_setup
-
-Returns the amount owed (still outstanding) on this line item's setup fee,
-which is the amount of the line item minus all payment applications (see
-L<FS::cust_bill_pay_pkg> and credit applications (see
-L<FS::cust_credit_bill_pkg>).
-
-=cut
-
-sub owed_setup {
- my $self = shift;
- $self->owed('setup', @_);
-}
-
-=item owed_recur
-
-Returns the amount owed (still outstanding) on this line item's recurring fee,
-which is the amount of the line item minus all payment applications (see
-L<FS::cust_bill_pay_pkg> and credit applications (see
-L<FS::cust_credit_bill_pkg>).
-
-=cut
-
-sub owed_recur {
- my $self = shift;
- $self->owed('recur', @_);
-}
-
-# modeled after cust_bill::owed...
-sub owed {
- my( $self, $field ) = @_;
- my $balance = $self->$field();
- $balance -= $_->amount foreach ( $self->cust_bill_pay_pkg($field) );
- $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg($field) );
- $balance = sprintf( '%.2f', $balance );
- $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
- $balance;
-}
-
-#modeled after owed
-sub payable {
- my( $self, $field ) = @_;
- my $balance = $self->$field();
- $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg($field) );
- $balance = sprintf( '%.2f', $balance );
- $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
- $balance;
-}
-
-sub cust_bill_pay_pkg {
- my( $self, $field ) = @_;
- qsearch( 'cust_bill_pay_pkg', { 'billpkgnum' => $self->billpkgnum,
- 'setuprecur' => $field,
- }
- );
-}
-
-sub cust_credit_bill_pkg {
- my( $self, $field ) = @_;
- qsearch( 'cust_credit_bill_pkg', { 'billpkgnum' => $self->billpkgnum,
- 'setuprecur' => $field,
- }
- );
-}
-
-=item units
-
-Returns the number of billing units (for tax purposes) represented by this,
-line item.
-
-=cut
-
-sub units {
- my $self = shift;
- $self->pkgnum ? $self->part_pkg->calc_units($self->cust_pkg) : 0; # 1?
-}
-
-=item quantity
-
-=cut
-
-sub quantity {
- my( $self, $value ) = @_;
- if ( defined($value) ) {
- $self->setfield('quantity', $value);
- }
- $self->getfield('quantity') || 1;
-}
-
-=item unitsetup
-
-=cut
-
-sub unitsetup {
- my( $self, $value ) = @_;
- if ( defined($value) ) {
- $self->setfield('unitsetup', $value);
- }
- $self->getfield('unitsetup') eq ''
- ? $self->getfield('setup')
- : $self->getfield('unitsetup');
-}
-
-=item unitrecur
-
-=cut
-
-sub unitrecur {
- my( $self, $value ) = @_;
- if ( defined($value) ) {
- $self->setfield('unitrecur', $value);
- }
- $self->getfield('unitrecur') eq ''
- ? $self->getfield('recur')
- : $self->getfield('unitrecur');
-}
-
-=item disintegrate
-
-Returns a list of cust_bill_pkg objects each with no more than a single class
-(including setup or recur) of charge.
-
-=cut
-
-sub disintegrate {
- my $self = shift;
- # XXX this goes away with cust_bill_pkg refactor
-
- my $cust_bill_pkg = new FS::cust_bill_pkg { $self->hash };
- my %cust_bill_pkg = ();
-
- $cust_bill_pkg{setup} = $cust_bill_pkg if $cust_bill_pkg->setup;
- $cust_bill_pkg{recur} = $cust_bill_pkg if $cust_bill_pkg->recur;
-
-
- #split setup and recur
- if ($cust_bill_pkg->setup && $cust_bill_pkg->recur) {
- my $cust_bill_pkg_recur = new FS::cust_bill_pkg { $cust_bill_pkg->hash };
- $cust_bill_pkg->set('details', []);
- $cust_bill_pkg->recur(0);
- $cust_bill_pkg->unitrecur(0);
- $cust_bill_pkg->type('');
- $cust_bill_pkg_recur->setup(0);
- $cust_bill_pkg_recur->unitsetup(0);
- $cust_bill_pkg{recur} = $cust_bill_pkg_recur;
-
- }
-
- #split usage from recur
- my $usage = sprintf( "%.2f", $cust_bill_pkg{recur}->usage )
- if exists($cust_bill_pkg{recur});
- warn "usage is $usage\n" if $DEBUG > 1;
- if ($usage) {
- my $cust_bill_pkg_usage =
- new FS::cust_bill_pkg { $cust_bill_pkg{recur}->hash };
- $cust_bill_pkg_usage->recur( $usage );
- $cust_bill_pkg_usage->type( 'U' );
- my $recur = sprintf( "%.2f", $cust_bill_pkg{recur}->recur - $usage );
- $cust_bill_pkg{recur}->recur( $recur );
- $cust_bill_pkg{recur}->type( '' );
- $cust_bill_pkg{recur}->set('details', []);
- $cust_bill_pkg{''} = $cust_bill_pkg_usage;
- }
-
- #subdivide usage by usage_class
- if (exists($cust_bill_pkg{''})) {
- foreach my $class (grep { $_ } $self->usage_classes) {
- my $usage = sprintf( "%.2f", $cust_bill_pkg{''}->usage($class) );
- my $cust_bill_pkg_usage =
- new FS::cust_bill_pkg { $cust_bill_pkg{''}->hash };
- $cust_bill_pkg_usage->recur( $usage );
- $cust_bill_pkg_usage->set('details', []);
- my $classless = sprintf( "%.2f", $cust_bill_pkg{''}->recur - $usage );
- $cust_bill_pkg{''}->recur( $classless );
- $cust_bill_pkg{$class} = $cust_bill_pkg_usage;
- }
- warn "Unexpected classless usage value: ". $cust_bill_pkg{''}->recur
- if ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur < 0);
- delete $cust_bill_pkg{''}
- unless ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur > 0);
- }
-
-# # sort setup,recur,'', and the rest numeric && return
-# my @result = map { $cust_bill_pkg{$_} }
-# sort { my $ad = ($a=~/^\d+$/); my $bd = ($b=~/^\d+$/);
-# ( $ad cmp $bd ) || ( $ad ? $a<=>$b : $b cmp $a )
-# }
-# keys %cust_bill_pkg;
-#
-# return (@result);
-
- %cust_bill_pkg;
-}
-
-=item usage CLASSNUM
-
-Returns the amount of the charge associated with usage class CLASSNUM if
-CLASSNUM is defined. Otherwise returns the total charge associated with
-usage.
-
-=cut
-
-sub usage {
- my( $self, $classnum ) = @_;
- my $sum = 0;
- my @values = ();
-
- if ( $self->get('details') ) {
-
- @values =
- map { $_->[2] }
- grep { ref($_) && ( defined($classnum) ? $_->[3] eq $classnum : 1 ) }
- @{ $self->get('details') };
-
- }else{
-
- my $hashref = { 'billpkgnum' => $self->billpkgnum };
- $hashref->{ 'classnum' } = $classnum if defined($classnum);
- @values = map { $_->amount } qsearch('cust_bill_pkg_detail', $hashref);
-
- }
-
- foreach ( @values ) {
- $sum += $_ if $_;
- }
- $sum;
-}
-
-=item usage_classes
-
-Returns a list of usage classnums associated with this invoice line's
-details.
-
-=cut
-
-sub usage_classes {
- my( $self ) = @_;
-
- if ( $self->get('details') ) {
-
- my %seen = ();
- foreach my $detail ( grep { ref($_) } @{$self->get('details')} ) {
- $seen{ $detail->[3] } = 1;
- }
- keys %seen;
-
- }else{
-
- map { $_->classnum }
- qsearch({ table => 'cust_bill_pkg_detail',
- hashref => { billpkgnum => $self->billpkgnum },
- select => 'DISTINCT classnum',
- });
-
- }
-
-}
-
-=item cust_bill_pkg_display [ type => TYPE ]
-
-Returns an array of display information for the invoice line item optionally
-limited to 'TYPE'.
-
-=cut
-
-sub cust_bill_pkg_display {
- my ( $self, %opt ) = @_;
-
- my $default =
- new FS::cust_bill_pkg_display { billpkgnum =>$self->billpkgnum };
-
- return ( $default ) unless defined dbdef->table('cust_bill_pkg_display');#hmmm
-
- my $type = $opt{type} if exists $opt{type};
- my @result;
-
- if ( $self->get('display') ) {
- @result = grep { defined($type) ? ($type eq $_->type) : 1 }
- @{ $self->get('display') };
- } else {
- my $hashref = { 'billpkgnum' => $self->billpkgnum };
- $hashref->{type} = $type if defined($type);
-
- @result = qsearch ({ 'table' => 'cust_bill_pkg_display',
- 'hashref' => { 'billpkgnum' => $self->billpkgnum },
- 'order_by' => 'ORDER BY billpkgdisplaynum',
- });
- }
-
- push @result, $default unless ( scalar(@result) || $type );
-
- @result;
-
-}
-
-# reserving this name for my friends FS::{tax_rate|cust_main_county}::taxline
-# and FS::cust_main::bill
-
-sub _cust_tax_exempt_pkg {
- my ( $self ) = @_;
-
- $self->{Hash}->{_cust_tax_exempt_pkg} or
- $self->{Hash}->{_cust_tax_exempt_pkg} = [];
-
-}
-
-=item cust_bill_pkg_tax_Xlocation
-
-Returns the list of associated cust_bill_pkg_tax_location and/or
-cust_bill_pkg_tax_rate_location objects
-
-=cut
-
-sub cust_bill_pkg_tax_Xlocation {
- my $self = shift;
-
- my %hash = ( 'billpkgnum' => $self->billpkgnum );
-
- (
- qsearch ( 'cust_bill_pkg_tax_location', { %hash } ),
- qsearch ( 'cust_bill_pkg_tax_rate_location', { %hash } )
- );
-
-}
-
-=item cust_bill_pkg_detail [ CLASSNUM ]
-
-Returns the list of associated cust_bill_pkg_detail objects
-The optional CLASSNUM argument will limit the details to the specified usage
-class.
-
-=cut
-
-sub cust_bill_pkg_detail {
- my $self = shift;
- my $classnum = shift || '';
-
- my %hash = ( 'billpkgnum' => $self->billpkgnum );
- $hash{classnum} = $classnum if $classnum;
-
- qsearch ( 'cust_bill_pkg_detail', { %hash } ),
-
-}
-
-=back
-
-=head1 BUGS
-
-setup and recur shouldn't be separate fields. There should be one "amount"
-field and a flag to tell you if it is a setup/one-time fee or a recurring fee.
-
-A line item with both should really be two separate records (preserving
-sdate and edate for setup fees for recurring packages - that information may
-be valuable later). Invoice generation (cust_main::bill), invoice printing
-(cust_bill), tax reports (report_tax.cgi) and line item reports
-(cust_bill_pkg.cgi) would need to be updated.
-
-owed_setup and owed_recur could then be repaced by just owed, and
-cust_bill::open_cust_bill_pkg and
-cust_bill_ApplicationCommon::apply_to_lineitems could be simplified.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
-from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_pkg_detail.pm b/FS/FS/cust_bill_pkg_detail.pm
deleted file mode 100644
index 7badaa3..0000000
--- a/FS/FS/cust_bill_pkg_detail.pm
+++ /dev/null
@@ -1,376 +0,0 @@
-package FS::cust_bill_pkg_detail;
-
-use strict;
-use vars qw( @ISA $me $DEBUG %GetInfoType );
-use HTML::Entities;
-use FS::Record qw( qsearch qsearchs dbdef dbh );
-use FS::cust_bill_pkg;
-use FS::usage_class;
-use FS::Conf;
-
-@ISA = qw(FS::Record);
-$me = '[ FS::cust_bill_pkg_detail ]';
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::cust_bill_pkg_detail - Object methods for cust_bill_pkg_detail records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pkg_detail;
-
- $record = new FS::cust_bill_pkg_detail \%hash;
- $record = new FS::cust_bill_pkg_detail { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pkg_detail object represents additional detail information for
-an invoice line item (see L<FS::cust_bill_pkg>). FS::cust_bill_pkg_detail
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item detailnum - primary key
-
-=item billpkgnum - link to cust_bill_pkg
-
-=item amount - price of this line item detail
-
-=item format - '' for straight text and 'C' for CSV in detail
-
-=item classnum - link to usage_class
-
-=item duration - granularized number of seconds for this call
-
-=item regionname -
-
-=item phonenum -
-
-=item detail - detail description
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new line item detail. To add the line item detail 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 { 'cust_bill_pkg_detail'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid line item detail. 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 $conf = new FS::Conf;
-
- my $phonenum = $self->phonenum;
- my $phonenum_check_method;
- if ( $conf->exists('svc_phone-allow_alpha_phonenum') ) {
- $phonenum =~ s/\W//g;
- $phonenum_check_method = 'ut_alphan';
- } else {
- $phonenum =~ s/\D//g;
- $phonenum_check_method = 'ut_numbern';
- }
- $self->phonenum($phonenum);
-
- $self->ut_numbern('detailnum')
- || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum')
- #|| $self->ut_moneyn('amount')
- || $self->ut_floatn('amount')
- || $self->ut_enum('format', [ '', 'C' ] )
- || $self->ut_numbern('duration')
- || $self->ut_textn('regionname')
- || $self->ut_text('detail')
- || $self->ut_foreign_keyn('classnum', 'usage_class', 'classnum')
- || $self->$phonenum_check_method('phonenum')
- || $self->SUPER::check
- ;
-
-}
-
-=item formatted [ OPTION => VALUE ... ]
-
-Returns detail information for the invoice line item detail formatted for
-display.
-
-Currently available options are: I<format> I<escape_function>
-
-If I<format> is set to html or latex then the format is improved
-for tabular appearance in those environments if possible.
-
-If I<escape_function> is set then the format is processed by this
-function before being returned.
-
-If I<format_function> is set then the detail is handed to this callback
-for processing.
-
-=cut
-
-sub formatted {
- my ( $self, %opt ) = @_;
- my $format = $opt{format} || '';
- return () unless defined dbdef->table('cust_bill_pkg_detail');
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
- my $csv = new Text::CSV_XS;
-
- my $escape_function = sub { shift };
-
- $escape_function = \&encode_entities
- if $format eq 'html';
-
- $escape_function =
- sub {
- my $value = shift;
- $value =~ s/([#\$%&~_\^{}])( )?/"\\$1". ( ( defined($2) && length($2) ) ? "\\$2" : '' )/ge;
- $value =~ s/([<>])/\$$1\$/g;
- $value;
- }
- if $format eq 'latex';
-
- $escape_function = $opt{escape_function} if $opt{escape_function};
-
- my $format_sub = sub { my $detail = shift;
- $csv->parse($detail) or return "can't parse $detail";
- join(' - ', map { &$escape_function($_) }
- $csv->fields
- );
- };
-
- $format_sub = sub { my $detail = shift;
- $csv->parse($detail) or return "can't parse $detail";
- join('</TD><TD>', map { &$escape_function($_) }
- $csv->fields
- );
- }
- if $format eq 'html';
-
- $format_sub = sub { my $detail = shift;
- $csv->parse($detail) or return "can't parse $detail";
- #join(' & ', map { '\small{'. &$escape_function($_). '}' } # $csv->fields );
- my $result = '';
- my $column = 1;
- foreach ($csv->fields) {
- $result .= ' & ' if $column > 1;
- if ($column > 6) { # KLUDGE ALERT!
- $result .= '\multicolumn{1}{l}{\scriptsize{'.
- &$escape_function($_). '}}';
- }else{
- $result .= '\scriptsize{'. &$escape_function($_). '}';
- }
- $column++;
- }
- $result;
- }
- if $format eq 'latex';
-
- $format_sub = $opt{format_function} if $opt{format_function};
-
- $self->format eq 'C'
- ? &{$format_sub}( $self->detail, $self )
- : &{$escape_function}( $self->detail )
- ;
-}
-
-
-# Used by FS::Upgrade to migrate to a new database schema
-sub _upgrade_schema { # class method
-
- my ($class, %opts) = @_;
-
- warn "$me upgrading $class\n" if $DEBUG;
-
- my $classnum = dbdef->table($class->table)->column('classnum')
- or return;
-
- my $type = $classnum->type;
- unless ( $type =~ /^int/i || $type =~ /int$/i ) {
-
- my $dbh = dbh;
- 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 $table ( qw( cust_bill_pkg_detail h_cust_bill_pkg_detail ) ){
-
- warn "updating $table column classnum to integer\n" if $DEBUG;
- my $sql = "ALTER TABLE $table ALTER classnum TYPE int USING ".
- "int4(classnum)";
- my $sth = $dbh->prepare($sql) or die $dbh->errstr;
- $sth->execute or die $sth->errstr;
-
- }
-
- } elsif ( $dbh->{pg_server_version} =~ /^704/ ) { # earlier?
-
- # ideally this would be supported in DBIx-DBSchema and friends
-
- # XXX_FIXME better locking
-
- foreach my $table ( qw( cust_bill_pkg_detail h_cust_bill_pkg_detail ) ){
-
- warn "updating $table column classnum to integer\n" if $DEBUG;
-
- my $sql = "ALTER TABLE $table RENAME classnum TO old_classnum";
- my $sth = $dbh->prepare($sql) or die $dbh->errstr;
- $sth->execute or die $sth->errstr;
-
- my $def = dbdef->table($table)->column('classnum');
- $def->type('integer');
- $def->length('');
- $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 classnum = int4( text( old_classnum ) )";
- $sth = $dbh->prepare($sql) or die $dbh->errstr;
- $sth->execute or die $sth->errstr;
-
- $sql = "ALTER TABLE $table DROP old_classnum";
- $sth = $dbh->prepare($sql) or die $dbh->errstr;
- $sth->execute or die $sth->errstr;
-
- }
-
- } else {
-
- die "cust_bill_pkg_detail classnum upgrade unsupported for this Pg version\n";
-
- }
-
- } else {
-
- die "cust_bill_pkg_detail classnum upgrade only supported for Pg 8+\n";
-
- }
-
- }
-
-}
-
-# Used by FS::Upgrade to migrate to a new database
-sub _upgrade_data { # class method
-
- my ($class, %opts) = @_;
-
- warn "$me Checking for unmigrated invoice line item details\n" if $DEBUG;
-
- my @cbpd = qsearch({ 'table' => $class->table,
- 'hashref' => {},
- 'extra_sql' => 'WHERE invnum IS NOT NULL AND '.
- 'pkgnum IS NOT NULL',
- });
-
- if (scalar(@cbpd)) {
- warn "$me Found unmigrated invoice line item details\n" if $DEBUG;
-
- foreach my $cbpd ( @cbpd ) {
- my $detailnum = $cbpd->detailnum;
- warn "$me Contemplating detail $detailnum\n" if $DEBUG > 1;
- my $cust_bill_pkg =
- qsearchs({ 'table' => 'cust_bill_pkg',
- 'hashref' => { 'invnum' => $cbpd->invnum,
- 'pkgnum' => $cbpd->pkgnum,
- },
- 'order_by' => 'ORDER BY billpkgnum LIMIT 1',
- });
- if ($cust_bill_pkg) {
- $cbpd->billpkgnum($cust_bill_pkg->billpkgnum);
- $cbpd->invnum('');
- $cbpd->pkgnum('');
- my $error = $cbpd->replace;
-
- warn "*** WARNING: error replacing line item detail ".
- "(cust_bill_pkg_detail) $detailnum: $error ***\n"
- if $error;
- } else {
- warn "Found orphaned line item detail $detailnum during upgrade.\n";
- }
-
- } # foreach $cbpd
-
- } # if @cbpd
-
- '';
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_bill_pkg>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_pkg_discount.pm b/FS/FS/cust_bill_pkg_discount.pm
deleted file mode 100644
index e7dd5f2..0000000
--- a/FS/FS/cust_bill_pkg_discount.pm
+++ /dev/null
@@ -1,158 +0,0 @@
-package FS::cust_bill_pkg_discount;
-
-use strict;
-use base qw( FS::cust_main_Mixin FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_bill_pkg;
-use FS::cust_pkg_discount;
-
-=head1 NAME
-
-FS::cust_bill_pkg_discount - Object methods for cust_bill_pkg_discount records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pkg_discount;
-
- $record = new FS::cust_bill_pkg_discount \%hash;
- $record = new FS::cust_bill_pkg_discount { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pkg_discount object represents the slice of a customer
-applied to a line item. FS::cust_bill_pkg_discount inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item billpkgdiscountnum
-
-primary key
-
-=item billpkgnum
-
-Line item (see L<FS::cust_bill_pkg>)
-
-=item pkgdiscountnum
-
-Customer discount (see L<FS::cust_pkg_discount>)
-
-=item amount
-
-Amount discounted from the line itme.
-
-=item months
-
-Number of months of discount this represents.
-
-=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 { 'cust_bill_pkg_discount'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('billpkgdiscountnum')
- || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' )
- || $self->ut_foreign_key('pkgdiscountnum', 'cust_pkg_discount', 'pkgdiscountnum' )
- || $self->ut_money('amount')
- || $self->ut_float('months')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item cust_bill_pkg
-
-Returns the associated line item (see L<FS::cust_bill_pkg>).
-
-=cut
-
-sub cust_bill_pkg {
- my $self = shift;
- qsearchs( 'cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } ) ;
-}
-
-=item cust_pkg_discount
-
-Returns the associated customer discount (see L<FS::cust_pkg_discount>).
-
-=cut
-
-sub cust_pkg_discount {
- my $self = shift;
- qsearchs( 'cust_pkg_discount', { 'pkgdiscountnum' => $self->pkgdiscountnum });
-}
-
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_pkg_display.pm b/FS/FS/cust_bill_pkg_display.pm
deleted file mode 100644
index a864ec1..0000000
--- a/FS/FS/cust_bill_pkg_display.pm
+++ /dev/null
@@ -1,166 +0,0 @@
-package FS::cust_bill_pkg_display;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cust_bill_pkg_display - Object methods for cust_bill_pkg_display records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pkg_display;
-
- $record = new FS::cust_bill_pkg_display \%hash;
- $record = new FS::cust_bill_pkg_display { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pkg_display object represents line item display information.
-FS::cust_bill_pkg_display inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item billpkgdisplaynum
-
-primary key
-
-=item billpkgnum
-
-billpkgnum
-
-=item section
-
-section
-
-=cut
-
-sub section {
- my ( $self, $value ) = @_;
- if ( defined($value) ) {
- $self->setfield('section', $value);
- } else {
- my $section = $self->getfield('section');
- unless ($section) {
- my $cust_bill_pkg = $self->cust_bill_pkg;
- if ( $cust_bill_pkg->pkgnum > 0 && !$cust_bill_pkg->hidden ) {
- my $part_pkg = $cust_bill_pkg->part_pkg;
- $section = $part_pkg->categoryname if $part_pkg;
- }
- }
- $section;
- }
-}
-
-=item post_total
-
-post_total
-
-=item type
-
-type
-
-=item summary
-
-summary
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new line item display object. 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
-
-sub table { 'cust_bill_pkg_display'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid line item display object.
-If there is an error, returns the error, otherwise returns false. Called by
-the insert and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('billpkgdisplaynum')
- || $self->ut_number('billpkgnum')
- || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum')
- || $self->ut_textn('section')
- || $self->ut_enum('post_total', [ '', 'Y' ])
- || $self->ut_enum('type', [ '', 'S', 'R', 'U' ])
- || $self->ut_enum('summary', [ '', 'Y' ])
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item cust_bill_pkg
-
-Returns the associated cust_bill_pkg (see L<FS::cust_bill_pkg>) for this
-line item display object.
-
-=cut
-
-sub cust_bill_pkg {
- my $self = shift;
- qsearchs( 'cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } ) ;
-}
-
-=back
-
-=head1 BUGS
-
-
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_bill_pkg>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_pkg_tax_location.pm b/FS/FS/cust_bill_pkg_tax_location.pm
deleted file mode 100644
index 44dd6e3..0000000
--- a/FS/FS/cust_bill_pkg_tax_location.pm
+++ /dev/null
@@ -1,225 +0,0 @@
-package FS::cust_bill_pkg_tax_location;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_bill_pkg;
-use FS::cust_pkg;
-use FS::cust_location;
-use FS::cust_bill_pay_pkg;
-use FS::cust_credit_bill_pkg;
-use FS::cust_main_county;
-
-=head1 NAME
-
-FS::cust_bill_pkg_tax_location - Object methods for cust_bill_pkg_tax_location records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pkg_tax_location;
-
- $record = new FS::cust_bill_pkg_tax_location \%hash;
- $record = new FS::cust_bill_pkg_tax_location { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pkg_tax_location object represents an record of taxation
-based on package location. FS::cust_bill_pkg_tax_location inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item billpkgtaxlocationnum
-
-billpkgtaxlocationnum
-
-=item billpkgnum
-
-billpkgnum
-
-=item taxnum
-
-taxnum
-
-=item taxtype
-
-taxtype
-
-=item pkgnum
-
-pkgnum
-
-=item locationnum
-
-locationnum
-
-=item amount
-
-amount
-
-
-=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
-
-sub table { 'cust_bill_pkg_tax_location'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Delete this record from the database.
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid 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('billpkgtaxlocationnum')
- || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' )
- || $self->ut_number('taxnum') #cust_bill_pkg/tax_rate key, based on taxtype
- || $self->ut_enum('taxtype', [ qw( FS::cust_main_county FS::tax_rate ) ] )
- || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum' )
- || $self->ut_foreign_key('locationnum', 'cust_location', 'locationnum' )
- || $self->ut_money('amount')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item cust_bill_pkg
-
-Returns the associated cust_bill_pkg object
-
-=cut
-
-sub cust_bill_pkg {
- my $self = shift;
- qsearchs( 'cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } );
-}
-
-=item cust_location
-
-Returns the associated cust_location object
-
-=cut
-
-sub cust_location {
- my $self = shift;
- qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
-}
-
-=item desc
-
-Returns a description for this tax line item constituent. Currently this
-is the desc of the associated line item followed by the state/county/city
-for the location in parentheses.
-
-=cut
-
-sub desc {
- my $self = shift;
- my $cust_location = $self->cust_location;
- my $location = join('/', grep { $_ } # leave in?
- map { $cust_location->$_ }
- qw( state county city ) # country?
- );
- my $cust_bill_pkg_desc = $self->billpkgnum
- ? $self->cust_bill_pkg->desc
- : $self->cust_bill_pkg_desc;
- "$cust_bill_pkg_desc ($location)";
-}
-
-=item owed
-
-Returns the amount owed (still outstanding) on this tax line item which is
-the amount of this record minus all payment applications and credit
-applications.
-
-=cut
-
-sub owed {
- my $self = shift;
- my $balance = $self->amount;
- $balance -= $_->amount foreach ( $self->cust_bill_pay_pkg('setup') );
- $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg('setup') );
- $balance = sprintf( '%.2f', $balance );
- $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
- $balance;
-}
-
-sub cust_bill_pay_pkg {
- my $self = shift;
- qsearch( 'cust_bill_pay_pkg',
- { map { $_ => $self->$_ } qw( billpkgtaxlocationnum billpkgnum ) }
- );
-}
-
-sub cust_credit_bill_pkg {
- my $self = shift;
- qsearch( 'cust_credit_bill_pkg',
- { map { $_ => $self->$_ } qw( billpkgtaxlocationnum billpkgnum ) }
- );
-}
-
-sub cust_main_county {
- my $self = shift;
- my $result;
- if ( $self->taxtype eq 'FS::cust_main_county' ) {
- $result = qsearchs( 'cust_main_county', { 'taxnum' => $self->taxnum } );
- }
-}
-
-=back
-
-=head1 BUGS
-
-The presense of FS::cust_main_county::delete makes the cust_main_county method
-unreliable
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_bill_pkg_tax_rate_location.pm b/FS/FS/cust_bill_pkg_tax_rate_location.pm
deleted file mode 100644
index 39b2bb9..0000000
--- a/FS/FS/cust_bill_pkg_tax_rate_location.pm
+++ /dev/null
@@ -1,221 +0,0 @@
-package FS::cust_bill_pkg_tax_rate_location;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_bill_pkg;
-use FS::cust_pkg;
-use FS::tax_rate_location;
-use FS::cust_bill_pay_pkg;
-use FS::cust_credit_bill_pkg;
-
-=head1 NAME
-
-FS::cust_bill_pkg_tax_rate_location - Object methods for cust_bill_pkg_tax_rate_location records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pkg_tax_rate_location;
-
- $record = new FS::cust_bill_pkg_tax_rate_location \%hash;
- $record = new FS::cust_bill_pkg_tax_rate_location { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pkg_tax_rate_location object represents an record of taxation
-based on package location. FS::cust_bill_pkg_tax_rate_location inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item billpkgtaxratelocationnum
-
-billpkgtaxratelocationnum
-
-=item billpkgnum
-
-billpkgnum
-
-=item taxnum
-
-taxnum
-
-=item taxtype
-
-taxtype
-
-=item locationtaxid
-
-locationtaxid
-
-=item taxratelocationnum
-
-taxratelocationnum
-
-=item amount
-
-amount
-
-
-=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
-
-sub table { 'cust_bill_pkg_tax_rate_location'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Delete this record from the database.
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid 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('billpkgtaxratelocationnum')
- || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' )
- || $self->ut_number('taxnum') #cust_bill_pkg/tax_rate key, based on taxtype
- || $self->ut_enum('taxtype', [ qw( FS::cust_main_county FS::tax_rate ) ] )
- || $self->ut_textn('locationtaxid')
- || $self->ut_foreign_key('taxratelocationnum', 'tax_rate_location', 'taxratelocationnum' )
- || $self->ut_money('amount')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item cust_bill_pkg
-
-Returns the associated cust_bill_pkg object
-
-=cut
-
-sub cust_bill_pkg {
- my $self = shift;
- qsearchs( 'cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } );
-}
-
-=item tax_rate_location
-
-Returns the associated tax_rate_location object
-
-=cut
-
-sub tax_rate_location {
- my $self = shift;
- qsearchs( 'tax_rate_location',
- { 'taxratelocationnum' => $self->taxratelocationnum }
- );
-}
-
-=item desc
-
-Returns a description for this tax line item constituent. Currently this
-is the desc of the associated line item followed by the
-state,county,city,locationtaxid for the location in parentheses.
-
-=cut
-
-sub desc {
- my $self = shift;
- my $tax_rate_location = $self->tax_rate_location;
- my $location = join(', ', grep { $_ }
- map { $tax_rate_location->$_ }
- qw( state county city )
- );
- $location .= ( $location && $self->locationtaxid ) ? ', ' : '';
- $location .= $self->locationtaxid;
- my $cust_bill_pkg_desc = $self->billpkgnum
- ? $self->cust_bill_pkg->desc
- : $self->cust_bill_pkg_desc;
- "$cust_bill_pkg_desc ($location)";
-
-}
-
-
-=item owed
-
-Returns the amount owed (still outstanding) on this tax line item which is
-the amount of this record minus all payment applications and credit
-applications.
-
-=cut
-
-sub owed {
- my $self = shift;
- my $balance = $self->amount;
- $balance -= $_->amount foreach ( $self->cust_bill_pay_pkg('setup') );
- $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg('setup') );
- $balance = sprintf( '%.2f', $balance );
- $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
- $balance;
-}
-
-sub cust_bill_pay_pkg {
- my $self = shift;
- qsearch( 'cust_bill_pay_pkg', { map { $_ => $self->$_ }
- qw( billpkgtaxratelocationnum billpkgnum )
- }
- );
-}
-
-sub cust_credit_bill_pkg {
- my $self = shift;
- qsearch( 'cust_credit_bill_pkg', { map { $_ => $self->$_ }
- qw( billpkgtaxratelocationnum billpkgnum )
- }
- );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_category.pm b/FS/FS/cust_category.pm
deleted file mode 100644
index 636b1d3..0000000
--- a/FS/FS/cust_category.pm
+++ /dev/null
@@ -1,97 +0,0 @@
-package FS::cust_category;
-
-use strict;
-use base qw( FS::category_Common );
-use FS::cust_class;
-
-=head1 NAME
-
-FS::cust_category - Object methods for cust_category records
-
-=head1 SYNOPSIS
-
- use FS::cust_category;
-
- $record = new FS::cust_category \%hash;
- $record = new FS::cust_category { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_category object represents a customer category. Every customer
-class (see L<FS::cust_class>) has, optionally, a customer category.
-FS::cust_category inherits from FS::Record. The following fields are currently
-supported:
-
-=over 4
-
-=item categorynum
-
-primary key
-
-=item categoryname
-
-Text name of this package category
-
-=item weight
-
-Weight
-
-=item disabled
-
-Disabled flag, empty or 'Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new customer category. To add the customer category to the database,
-see L<"insert">.
-
-=cut
-
-sub table { 'cust_category'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Delete this record from the database.
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_class>, L<FS::Record>
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_class.pm b/FS/FS/cust_class.pm
deleted file mode 100644
index a811be7..0000000
--- a/FS/FS/cust_class.pm
+++ /dev/null
@@ -1,120 +0,0 @@
-package FS::cust_class;
-
-use strict;
-use base qw( FS::class_Common );
-use FS::cust_main;
-use FS::cust_category;
-
-=head1 NAME
-
-FS::cust_class - Object methods for cust_class records
-
-=head1 SYNOPSIS
-
- use FS::cust_class;
-
- $record = new FS::cust_class \%hash;
- $record = new FS::cust_class { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::pkg_class object represents an customer class. Every customer (see
-L<FS::cust_main>) has, optionally, a customer class. FS::cust_class inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item classnum
-
-primary key
-
-=item classname
-
-Text name of this customer class
-
-=item categorynum
-
-Number of associated cust_category (see L<FS::cust_category>)
-
-=item disabled
-
-Disabled flag, empty or 'Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new customer class. To add the customer class to the database, see
-L<"insert">.
-
-=cut
-
-sub table { 'cust_class'; }
-sub _target_table { 'cust_main'; }
-
-=item insert
-
-Adds this customer class to the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item delete
-
-Delete this customer class from the database. Only customer classes with no
-associated customers can be deleted. If there is an error, returns
-the error, otherwise returns false.
-
-=item replace [ OLD_RECORD ]
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid customer class. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=item cust_category
-
-=item category
-
-Returns the cust_category record associated with this class, or false if there
-is none.
-
-=cut
-
-sub cust_category {
- my $self = shift;
- $self->category;
-}
-
-=item categoryname
-
-Returns the category name associated with this class, or false if there
-is none.
-
-=cut
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, L<FS::Record>
-
-=cut
-
-1;
diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
deleted file mode 100644
index 6185fc4..0000000
--- a/FS/FS/cust_credit.pm
+++ /dev/null
@@ -1,639 +0,0 @@
-package FS::cust_credit;
-
-use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record );
-use vars qw( $conf $unsuspendauto $me $DEBUG
- $otaker_upgrade_kludge $ignore_empty_reasonnum
- );
-use Date::Format;
-use FS::UID qw( dbh getotaker );
-use FS::Misc qw(send_email);
-use FS::Record qw( qsearch qsearchs dbdef );
-use FS::CurrentUser;
-use FS::cust_main;
-use FS::cust_pkg;
-use FS::cust_refund;
-use FS::cust_credit_bill;
-use FS::part_pkg;
-use FS::reason_type;
-use FS::reason;
-use FS::cust_event;
-
-$me = '[ FS::cust_credit ]';
-$DEBUG = 0;
-
-$otaker_upgrade_kludge = 0;
-$ignore_empty_reasonnum = 0;
-
-#ask FS::UID to run this stuff for us later
-$FS::UID::callback{'FS::cust_credit'} = sub {
-
- $conf = new FS::Conf;
- $unsuspendauto = $conf->exists('unsuspendauto');
-
-};
-
-our %reasontype_map = ( 'referral_credit_type' => 'Referral Credit',
- 'cancel_credit_type' => 'Cancellation Credit',
- 'signup_credit_type' => 'Self-Service Credit',
- );
-
-=head1 NAME
-
-FS::cust_credit - Object methods for cust_credit records
-
-=head1 SYNOPSIS
-
- use FS::cust_credit;
-
- $record = new FS::cust_credit \%hash;
- $record = new FS::cust_credit { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_credit object represents a credit; the equivalent of a negative
-B<cust_bill> record (see L<FS::cust_bill>). FS::cust_credit inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item crednum
-
-Primary key (assigned automatically for new credits)
-
-=item custnum
-
-Customer (see L<FS::cust_main>)
-
-=item amount
-
-Amount of the credit
-
-=item _date
-
-Specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item usernum
-
-Order taker (see L<FS::access_user>)
-
-=item reason
-
-Text ( deprecated )
-
-=item reasonnum
-
-Reason (see L<FS::reason>)
-
-=item addlinfo
-
-Text
-
-=item closed
-
-Books closed flag, empty or `Y'
-
-=item pkgnum
-
-Desired pkgnum when using experimental package balances.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new credit. To add the credit to the database, see L<"insert">.
-
-=cut
-
-sub table { 'cust_credit'; }
-sub cust_linked { $_[0]->cust_main_custnum; }
-sub cust_unlinked_msg {
- my $self = shift;
- "WARNING: can't find cust_main.custnum ". $self->custnum.
- ' (cust_credit.crednum '. $self->crednum. ')';
-}
-
-=item insert
-
-Adds this credit to the database ("Posts" the credit). If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub insert {
- my ($self, %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;
-
- my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
- my $old_balance = $cust_main->balance;
-
- unless ($self->reasonnum) {
- my $result = $self->reason( $self->getfield('reason'),
- exists($options{ 'reason_type' })
- ? ('reason_type' => $options{ 'reason_type' })
- : (),
- );
- unless($result) {
- $dbh->rollback if $oldAutoCommit;
- return "failed to set reason for $me"; #: ". $dbh->errstr;
- }
- }
-
- $self->setfield('reason', '');
-
- my $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting $self: $error";
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- #false laziness w/ cust_credit::insert
- if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
- my @errors = $cust_main->unsuspend;
- #return
- # side-fx with nested transactions? upstack rolls back?
- warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
- join(' / ', @errors)
- if @errors;
- }
- #eslaf
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item delete
-
-Unless the closed flag is set, deletes this credit and all associated
-applications (see L<FS::cust_credit_bill>). In most cases, you want to use
-the void method instead to leave a record of the deleted credit.
-
-=cut
-
-# very similar to FS::cust_pay::delete
-sub delete {
- my $self = shift;
- return "Can't delete closed credit" if $self->closed =~ /^Y/i;
-
- 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 $cust_credit_bill ( $self->cust_credit_bill ) {
- my $error = $cust_credit_bill->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- foreach my $cust_credit_refund ( $self->cust_credit_refund ) {
- my $error = $cust_credit_refund->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my $error = $self->SUPER::delete(@_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $conf->config('deletecredits') ne '' ) {
-
- my $cust_main = $self->cust_main;
-
- my $error = send_email(
- 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
- #invoice_from??? well as good as any
- 'to' => $conf->config('deletecredits'),
- 'subject' => 'FREESIDE NOTIFICATION: Credit deleted',
- 'body' => [
- "This is an automatic message from your Freeside installation\n",
- "informing you that the following credit has been deleted:\n",
- "\n",
- 'crednum: '. $self->crednum. "\n",
- 'custnum: '. $self->custnum.
- " (". $cust_main->last. ", ". $cust_main->first. ")\n",
- 'amount: $'. sprintf("%.2f", $self->amount). "\n",
- 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
- 'reason: '. $self->reason. "\n",
- ],
- );
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't send credit deletion notification: $error";
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item replace [ OLD_RECORD ]
-
-You can, but probably shouldn't modify credits...
-
-Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
-supplied, replaces this record. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub replace {
- my $self = shift;
- return "Can't modify closed credit" if $self->closed =~ /^Y/i;
- $self->SUPER::replace(@_);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid credit. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
-
- my $error =
- $self->ut_numbern('crednum')
- || $self->ut_number('custnum')
- || $self->ut_numbern('_date')
- || $self->ut_money('amount')
- || $self->ut_alphan('otaker')
- || $self->ut_textn('reason')
- || $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;
-
- my $method = $ignore_empty_reasonnum ? 'ut_foreign_keyn' : 'ut_foreign_key';
- $error = $self->$method('reasonnum', 'reason', 'reasonnum');
- return $error if $error;
-
- return "amount must be > 0 " if $self->amount <= 0;
-
- return "amount must be greater or equal to amount applied"
- if $self->unapplied < 0 && ! $otaker_upgrade_kludge;
-
- return "Unknown customer"
- unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-
- $self->_date(time) unless $self->_date;
-
- $self->SUPER::check;
-}
-
-=item cust_credit_refund
-
-Returns all refund applications (see L<FS::cust_credit_refund>) for this credit.
-
-=cut
-
-sub cust_credit_refund {
- my $self = shift;
- map { $_ } #return $self->num_cust_credit_refund unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_credit_refund', { 'crednum' => $self->crednum } )
- ;
-}
-
-=item cust_credit_bill
-
-Returns all application to invoices (see L<FS::cust_credit_bill>) for this
-credit.
-
-=cut
-
-sub cust_credit_bill {
- my $self = shift;
- map { $_ } #return $self->num_cust_credit_bill unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_credit_bill', { 'crednum' => $self->crednum } )
- ;
-}
-
-=item unapplied
-
-Returns the amount of this credit that is still unapplied/outstanding;
-amount minus all refund applications (see L<FS::cust_credit_refund>) and
-applications to invoices (see L<FS::cust_credit_bill>).
-
-=cut
-
-sub unapplied {
- my $self = shift;
- my $amount = $self->amount;
- $amount -= $_->amount foreach ( $self->cust_credit_refund );
- $amount -= $_->amount foreach ( $self->cust_credit_bill );
- sprintf( "%.2f", $amount );
-}
-
-=item credited
-
-Deprecated name for the unapplied method.
-
-=cut
-
-sub credited {
- my $self = shift;
- #carp "cust_credit->credited deprecated; use ->unapplied";
- $self->unapplied(@_);
-}
-
-=item cust_main
-
-Returns the customer (see L<FS::cust_main>) for this credit.
-
-=cut
-
-sub cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
-
-=item reason
-
-Returns the text of the associated reason (see L<FS::reason>) for this credit.
-
-=cut
-
-sub reason {
- my ($self, $value, %options) = @_;
- my $dbh = dbh;
- my $reason;
- my $typenum = $options{'reason_type'};
-
- my $oldAutoCommit = $FS::UID::AutoCommit; # this should already be in
- local $FS::UID::AutoCommit = 0; # a transaction if it matters
-
- if ( defined( $value ) ) {
- my $hashref = { 'reason' => $value };
- $hashref->{'reason_type'} = $typenum if $typenum;
- my $addl_from = "LEFT JOIN reason_type ON ( reason_type = typenum ) ";
- my $extra_sql = " AND reason_type.class='R'";
-
- $reason = qsearchs( { 'table' => 'reason',
- 'hashref' => $hashref,
- 'addl_from' => $addl_from,
- 'extra_sql' => $extra_sql,
- } );
-
- if (!$reason && $typenum) {
- $reason = new FS::reason( { 'reason_type' => $typenum,
- 'reason' => $value,
- 'disabled' => 'Y',
- } );
- my $error = $reason->insert;
- if ( $error ) {
- warn "error inserting reason: $error\n";
- $reason = undef;
- }
- }
-
- $self->reasonnum($reason ? $reason->reasonnum : '') ;
- warn "$me reason used in set mode with non-existant reason -- clearing"
- unless $reason;
- }
- $reason = qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ( $reason ? $reason->reason : '' ).
- ( $self->addlinfo ? ' '.$self->addlinfo : '' );
-}
-
-# _upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
-
- warn "$me upgrading $class\n" if $DEBUG;
-
- if (defined dbdef->table($class->table)->column('reason')) {
-
- warn "$me Checking for unmigrated reasons\n" if $DEBUG;
-
- my @cust_credits = qsearch({ 'table' => $class->table,
- 'hashref' => {},
- 'extra_sql' => 'WHERE reason IS NOT NULL',
- });
-
- if (scalar(grep { $_->getfield('reason') =~ /\S/ } @cust_credits)) {
- warn "$me Found unmigrated reasons\n" if $DEBUG;
- my $hashref = { 'class' => 'R', 'type' => 'Legacy' };
- my $reason_type = qsearchs( 'reason_type', $hashref );
- unless ($reason_type) {
- $reason_type = new FS::reason_type( $hashref );
- my $error = $reason_type->insert();
- die "$class had error inserting FS::reason_type into database: $error\n"
- if $error;
- }
-
- $hashref = { 'reason_type' => $reason_type->typenum,
- 'reason' => '(none)'
- };
- my $noreason = qsearchs( 'reason', $hashref );
- unless ($noreason) {
- $hashref->{'disabled'} = 'Y';
- $noreason = new FS::reason( $hashref );
- my $error = $noreason->insert();
- die "can't insert legacy reason '(none)' into database: $error\n"
- if $error;
- }
-
- foreach my $cust_credit ( @cust_credits ) {
- my $reason = $cust_credit->getfield('reason');
- warn "Contemplating reason $reason\n" if $DEBUG > 1;
- if ($reason =~ /\S/) {
- $cust_credit->reason($reason, 'reason_type' => $reason_type->typenum)
- or die "can't insert legacy reason $reason into database\n";
- }else{
- $cust_credit->reasonnum($noreason->reasonnum);
- }
-
- $cust_credit->setfield('reason', '');
- my $error = $cust_credit->replace;
-
- warn "*** WARNING: error replacing reason in $class ".
- $cust_credit->crednum. ": $error ***\n"
- if $error;
- }
- }
-
- warn "$me Ensuring existance of auto reasons\n" if $DEBUG;
-
- foreach ( keys %reasontype_map ) {
- unless ($conf->config($_)) { # hmmmm
-# warn "$me Found $_ reason type lacking\n" if $DEBUG;
-# my $hashref = { 'class' => 'R', 'type' => $reasontype_map{$_} };
- my $hashref = { 'class' => 'R', 'type' => 'Legacy' };
- my $reason_type = qsearchs( 'reason_type', $hashref );
- unless ($reason_type) {
- $reason_type = new FS::reason_type( $hashref );
- my $error = $reason_type->insert();
- die "$class had error inserting FS::reason_type into database: $error\n"
- if $error;
- }
- $conf->set($_, $reason_type->typenum);
- }
- }
-
- warn "$me Ensuring commission packages have a reason type\n" if $DEBUG;
-
- my $hashref = { 'class' => 'R', 'type' => 'Legacy' };
- my $reason_type = qsearchs( 'reason_type', $hashref );
- unless ($reason_type) {
- $reason_type = new FS::reason_type( $hashref );
- my $error = $reason_type->insert();
- die "$class had error inserting FS::reason_type into database: $error\n"
- if $error;
- }
-
- my @plans = qw( flat_comission flat_comission_cust flat_comission_pkg );
- foreach my $plan ( @plans ) {
- foreach my $pkg ( qsearch('part_pkg', { 'plan' => $plan } ) ) {
- unless ($pkg->option('reason_type', 1) ) {
- my $plandata = $pkg->plandata.
- "reason_type=". $reason_type->typenum. "\n";
- $pkg->plandata($plandata);
- my $error =
- $pkg->replace( undef,
- 'pkg_svc' => { map { $_->svcpart => $_->quantity }
- $pkg->pkg_svc
- },
- 'primary_svc' => $pkg->svcpart,
- );
- die "failed setting reason_type option: $error"
- if $error;
- }
- }
- }
- }
-
- local($otaker_upgrade_kludge) = 1;
- local($ignore_empty_reasonnum) = 1;
- $class->_upgrade_otaker(%opts);
-
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item unapplied_sql
-
-Returns an SQL fragment to retreive the unapplied amount.
-
-=cut
-
-sub unapplied_sql {
- my ($class, $start, $end) = @_;
-
- my $bill_start = $start ? "AND cust_credit_bill._date <= $start" : '';
- my $bill_end = $end ? "AND cust_credit_bill._date > $end" : '';
- my $refund_start = $start ? "AND cust_credit_refund._date <= $start" : '';
- my $refund_end = $end ? "AND cust_credit_refund._date > $end" : '';
-
- "amount
- - COALESCE(
- ( SELECT SUM(amount) FROM cust_credit_refund
- WHERE cust_credit.crednum = cust_credit_refund.crednum
- $refund_start $refund_end )
- ,0
- )
- - COALESCE(
- ( SELECT SUM(amount) FROM cust_credit_bill
- WHERE cust_credit.crednum = cust_credit_bill.crednum
- $bill_start $bill_end )
- ,0
- )
- ";
-
-}
-
-=item credited_sql
-
-Deprecated name for the unapplied_sql method.
-
-=cut
-
-sub credited_sql {
- #my $class = shift;
-
- #carp "cust_credit->credited_sql deprecated; use ->unapplied_sql";
-
- #$class->unapplied_sql(@_);
- unapplied_sql();
-}
-
-=back
-
-=head1 BUGS
-
-The delete method. The replace method.
-
-B<credited> and B<credited_sql> are now called B<unapplied> and
-B<unapplied_sql>. The old method names should start to give warnings.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_credit_refund>, L<FS::cust_refund>,
-L<FS::cust_credit_bill> L<FS::cust_bill>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_credit_bill.pm b/FS/FS/cust_credit_bill.pm
deleted file mode 100644
index 900a5c0..0000000
--- a/FS/FS/cust_credit_bill.pm
+++ /dev/null
@@ -1,170 +0,0 @@
-package FS::cust_credit_bill;
-
-use strict;
-use vars qw( @ISA $conf );
-use FS::UID qw( getotaker );
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_main_Mixin;
-use FS::cust_bill_ApplicationCommon;
-use FS::cust_bill;
-use FS::cust_credit;
-use FS::cust_pkg;
-
-@ISA = qw( FS::cust_main_Mixin FS::cust_bill_ApplicationCommon );
-
-#ask FS::UID to run this stuff for us later
-FS::UID->install_callback( sub {
- $conf = new FS::Conf;
-} );
-
-=head1 NAME
-
-FS::cust_credit_bill - Object methods for cust_credit_bill records
-
-=head1 SYNOPSIS
-
- use FS::cust_credit_bill;
-
- $record = new FS::cust_credit_bill \%hash;
- $record = new FS::cust_credit_bill { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_credit_bill object represents application of a credit (see
-L<FS::cust_credit>) to an invoice (see L<FS::cust_bill>). FS::cust_credit_bill
-inherits from FS::cust_bill_ApplicationCommon and FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item creditbillnum - primary key
-
-=item crednum - credit being applied
-
-=item invnum - invoice to which credit is applied (see L<FS::cust_bill>)
-
-=item amount - amount of the credit applied
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new cust_credit_bill. To add the cust_credit_bill to the database,
-see L<"insert">.
-
-=cut
-
-sub table { 'cust_credit_bill'; }
-
-sub _app_source_name { 'credit'; }
-sub _app_source_table { 'cust_credit'; }
-sub _app_lineitem_breakdown_table { 'cust_credit_bill_pkg'; }
-sub _app_part_pkg_weight_column { 'credit_weight'; }
-
-=item insert
-
-Adds this cust_credit_bill to the database ("Posts" all or part of a credit).
-If there is an error, returns the error, otherwise returns false.
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- my $self = shift;
- return "Can't delete application for closed credit"
- if $self->cust_credit->closed =~ /^Y/i;
- return "Can't delete application for closed invoice"
- if $self->cust_bill->closed =~ /^Y/i;
- $self->SUPER::delete(@_);
-}
-
-=item replace OLD_RECORD
-
-Application of credits may not be modified.
-
-=cut
-
-sub replace {
- return "Can't modify application of credit!"
-}
-
-=item check
-
-Checks all fields to make sure this is a valid credit application. If there
-is an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('creditbillnum')
- || $self->ut_foreign_key('crednum', 'cust_credit', 'crednum')
- || $self->ut_foreign_key('invnum', 'cust_bill', 'invnum' )
- || $self->ut_numbern('_date')
- || $self->ut_money('amount')
- || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
- ;
- return $error if $error;
-
- return "amount must be > 0" if $self->amount <= 0;
-
- $self->_date(time) unless $self->_date;
-
- return "Cannot apply more than remaining value of credit"
- unless $self->amount <= $self->cust_credit->credited;
-
- return "Cannot apply more than remaining value of invoice"
- unless $self->amount <= $self->cust_bill->owed;
-
- $self->SUPER::check;
-}
-
-=item sub cust_credit
-
-Returns the credit (see L<FS::cust_credit>)
-
-=cut
-
-sub cust_credit {
- my $self = shift;
- qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
-}
-
-=back
-
-=head1 BUGS
-
-The delete method.
-
-This probably should have been called cust_bill_credit.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_bill>, L<FS::cust_credit>,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_credit_bill_pkg.pm b/FS/FS/cust_credit_bill_pkg.pm
deleted file mode 100644
index 64f1f29..0000000
--- a/FS/FS/cust_credit_bill_pkg.pm
+++ /dev/null
@@ -1,355 +0,0 @@
-package FS::cust_credit_bill_pkg;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::cust_main_Mixin;
-use FS::cust_credit_bill;
-use FS::cust_bill_pkg;
-use FS::cust_bill_pkg_tax_location;
-use FS::cust_bill_pkg_tax_rate_location;
-use FS::cust_tax_exempt_pkg;
-
-@ISA = qw( FS::cust_main_Mixin FS::Record );
-
-=head1 NAME
-
-FS::cust_credit_bill_pkg - Object methods for cust_credit_bill_pkg records
-
-=head1 SYNOPSIS
-
- use FS::cust_credit_bill_pkg;
-
- $record = new FS::cust_credit_bill_pkg \%hash;
- $record = new FS::cust_credit_bill_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_credit_bill_pkg object represents application of a credit (see
-L<FS::cust_credit_bill>) to a specific line item within an invoice
-(see L<FS::cust_bill_pkg>). FS::cust_credit_bill_pkg inherits from FS::Record.
-The following fields are currently supported:
-
-=over 4
-
-=item creditbillpkgnum - primary key
-
-=item creditbillnum - Credit application to the overall invoice (see L<FS::cust_credit::bill>)
-
-=item billpkgnum - Line item to which credit is applied (see L<FS::cust_bill_pkg>)
-
-=item amount - Amount of the credit applied to this line item.
-
-=item setuprecur - 'setup' or 'recur', designates whether the payment was applied to the setup or recurring portion of the line item.
-
-=item sdate - starting date of recurring fee
-
-=item edate - ending date of recurring fee
-
-=back
-
-sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">. Also
-see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new example. To add the example 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 { 'cust_credit_bill_pkg'; }
-
-=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;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- my $payable = $self->cust_bill_pkg->payable($self->setuprecur);
- my $taxable = $self->_is_taxable ? $payable : 0;
- my $part_pkg = $self->cust_bill_pkg->part_pkg;
- my $freq = $self->cust_bill_pkg->freq;
- unless ($freq) {
- $freq = $part_pkg ? ($part_pkg->freq || 1) : 1;#fallback.. assumes unchanged
- }
- my $taxable_per_month = sprintf("%.2f", $taxable / $freq );
- my $credit_per_month = sprintf("%.2f", $self->amount / $freq ); #pennies?
-
- if ($taxable_per_month >= 0) { #panic if its subzero?
- my $groupby = 'taxnum,year,month';
- my $sum = 'SUM(amount)';
- my @exemptions = qsearch(
- {
- 'select' => "$groupby, $sum AS amount",
- 'table' => 'cust_tax_exempt_pkg',
- 'hashref' => { billpkgnum => $self->billpkgnum },
- 'extra_sql' => "GROUP BY $groupby HAVING $sum > 0",
- }
- );
- foreach my $exemption ( @exemptions ) {
- next if $taxable_per_month >= $exemption->amount;
- my $amount = $exemption->amount - $taxable_per_month;
- if ($amount > $credit_per_month) {
- "cust_bill_pkg ". $self->billpkgnum. " Reducing.\n";
- $amount = $credit_per_month;
- }
- my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg {
- 'billpkgnum' => $self->billpkgnum,
- 'creditbillpkgnum' => $self->creditbillpkgnum,
- 'amount' => sprintf('%.2f', 0-$amount),
- map { $_ => $exemption->$_ } split(',', $groupby)
- };
- my $error = $cust_tax_exempt_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_tax_exempt_pkg: $error";
- }
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-#helper functions for above
-sub _is_taxable {
- my $self = shift;
- my $part_pkg = $self->cust_bill_pkg->part_pkg;
-
- return 0 unless $part_pkg; #XXX fails for tax on tax
-
- my $method = $self->setuprecur. 'tax';
- return 0 if $part_pkg->$method =~ /^Y$/i;
-
- if ($self->billpkgtaxlocationnum) {
- my $location_object = $self->cust_bill_pkg_tax_Xlocation;
- my $tax_object = $location_object->cust_main_county;
- return 0 if $tax_object && $self->tax_object->$method =~ /^Y$/i;
- } #elsif ($self->billpkgtaxratelocationnum) { ... }
-
- 1;
-}
-
-=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 $original_cust_bill_pkg = $self->cust_bill_pkg;
- my $cust_bill = $original_cust_bill_pkg->cust_bill;
-
- my %hash = $original_cust_bill_pkg->hash;
- delete $hash{$_} for qw( billpkgnum setup recur );
- $hash{$self->setuprecur} = $self->amount;
- my $cust_bill_pkg = new FS::cust_bill_pkg { %hash };
-
- use Data::Dumper;
- my @exemptions = qsearch( 'cust_tax_exempt_pkg',
- { creditbillpkgnum => $self->creditbillpkgnum }
- );
- my %seen = ();
- my @generated_exemptions = ();
- my @unseen_exemptions = ();
- foreach my $exemption ( @exemptions ) {
- my $error = $exemption->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error deleting cust_tax_exempt_pkg: $error";
- }
-
- next if $seen{$exemption->taxnum};
- $seen{$exemption->taxnum} = 1;
- push @unseen_exemptions, $exemption;
- }
-
- foreach my $exemption ( @unseen_exemptions ) {
- my $tax_object = $exemption->cust_main_county;
- unless ($tax_object) {
- $dbh->rollback if $oldAutoCommit;
- return "can't find exempted tax";
- }
-
- my $hashref_or_error =
- $tax_object->taxline( [ $cust_bill_pkg ],
- 'custnum' => $cust_bill->custnum,
- 'invoice_time' => $cust_bill->_date,
- );
- unless (ref($hashref_or_error)) {
- $dbh->rollback if $oldAutoCommit;
- return "error calculating taxes: $hashref_or_error";
- }
-
- push @generated_exemptions, @{ $cust_bill_pkg->_cust_tax_exempt_pkg || [] };
- }
-
- foreach my $taxnum ( keys %seen ) {
- my $sum = 0;
- $sum += $_->amount for grep {$_->taxnum == $taxnum} @exemptions;
- $sum -= $_->amount for grep {$_->taxnum == $taxnum} @generated_exemptions;
- $sum = sprintf("%.2f", $sum);
- unless ($sum eq '0.00' || $sum eq '-0.00') {
- $dbh->rollback if $oldAutoCommit;
- return "Can't unapply credit without charging tax";
- }
- }
-
- 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 credit applicaiton. 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('creditbillpkgnum')
- || $self->ut_foreign_key('creditbillnum', 'cust_credit_bill', 'creditbillnum')
- || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' )
- || $self->ut_foreign_keyn('billpkgtaxlocationnum',
- 'cust_bill_pkg_tax_location',
- 'billpkgtaxlocationnum')
- || $self->ut_foreign_keyn('billpkgtaxratelocationnum',
- 'cust_bill_pkg_tax_rate_location',
- 'billpkgtaxratelocationnum')
- || $self->ut_money('amount')
- || $self->ut_enum('setuprecur', [ 'setup', 'recur' ] )
- || $self->ut_numbern('sdate')
- || $self->ut_numbern('edate')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-sub cust_credit_bill {
- my $self = shift;
- qsearchs('cust_credit_bill', { 'creditbillnum' => $self->creditbillnum } );
-}
-
-sub cust_bill_pkg {
- my $self = shift;
- qsearchs('cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } );
-}
-
-sub cust_bill_pkg_tax_Xlocation {
- my $self = shift;
- if ($self->billpkg_tax_locationnum) {
- return qsearchs(
- 'cust_bill_pkg_tax_location',
- { 'billpkgtaxlocationnum' => $self->billpkgtaxlocationnum },
- );
-
- } elsif ($self->billpkg_tax_rate_locationnum) {
- return qsearchs(
- 'cust_bill_pkg_tax_rate_location',
- { 'billpkgtaxratelocationnum' => $self->billpkgtaxratelocationnum },
- );
- } else {
- return undef;
- }
-}
-
-=back
-
-=head1 BUGS
-
-B<setuprecur> field is a kludge to compensate for cust_bill_pkg having separate
-setup and recur fields. It should be removed once that's fixed.
-
-B<insert> method used to assume that the frequency of the package associated
-with the associated line item remained unchanged during the lifetime of the
-system. That is still used as a fallback. It may get the tax exemption
-adjustments wrong if package definitions change frequency. The presense of
-delete methods in FS::cust_main_county and FS::tax_rate makes crediting of
-old "texas tax" unreliable in the presense of changing taxes. Explicit tax
-credit requests? Carry 'taxable' onto line items?
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_credit_refund.pm b/FS/FS/cust_credit_refund.pm
deleted file mode 100644
index 9fc03f2..0000000
--- a/FS/FS/cust_credit_refund.pm
+++ /dev/null
@@ -1,186 +0,0 @@
-package FS::cust_credit_refund;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::cust_main_Mixin;
-use FS::cust_credit;
-use FS::cust_refund;
-
-@ISA = qw( FS::cust_main_Mixin FS::Record );
-
-=head1 NAME
-
-FS::cust_credit_refund - Object methods for cust_bill_pay records
-
-=head1 SYNOPSIS
-
- use FS::cust_credit_refund;
-
- $record = new FS::cust_credit_refund \%hash;
- $record = new FS::cust_credit_refund { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_credit_refund represents the application of a refund to a specific
-credit. FS::cust_credit_refund inherits from FS::Record. The following fields
-are currently supported:
-
-=over 4
-
-=item creditrefundnum - primary key (assigned automatically)
-
-=item crednum - Credit (see L<FS::cust_credit>)
-
-=item refundnum - Refund (see L<FS::cust_refund>)
-
-=item amount - Amount of the refund to apply to the specific credit.
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new record. To add the record to the database, see L<"insert">.
-
-=cut
-
-sub table { 'cust_credit_refund'; }
-
-=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;
- return "Can't apply refund to closed credit"
- if $self->cust_credit->closed =~ /^Y/i;
- return "Can't apply credit to closed refund"
- if $self->cust_refund->closed =~ /^Y/i;
- $self->SUPER::insert(@_);
-}
-
-=item delete
-
-Remove this cust_credit_refund from the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub delete {
- my $self = shift;
- return "Can't remove refund from closed credit"
- if $self->cust_credit->closed =~ /^Y/i;
- return "Can't remove credit from closed refund"
- if $self->cust_refund->closed =~ /^Y/i;
- $self->SUPER::delete(@_);
-}
-
-=item replace OLD_RECORD
-
-Currently unimplemented (accounting reasons).
-
-=cut
-
-sub replace {
- return "Can't (yet?) modify cust_credit_refund records!";
-}
-
-=item check
-
-Checks all fields to make sure this is a valid refund application. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-method.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('creditrefundnum')
- || $self->ut_number('crednum')
- || $self->ut_number('refundnum')
- || $self->ut_money('amount')
- || $self->ut_numbern('_date')
- ;
- return $error if $error;
-
- return "amount must be > 0" if $self->amount <= 0;
-
- return "unknown cust_credit.crednum: ". $self->crednum
- unless my $cust_credit =
- qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
-
- return "Unknown refund"
- unless my $cust_refund =
- qsearchs( 'cust_refund', { 'refundnum' => $self->refundnum } );
-
- $self->_date(time) unless $self->_date;
-
- return "Cannot apply more than remaining value of credit"
- unless $self->amount <= $cust_credit->credited;
-
- return "Cannot apply more than remaining value of refund"
- unless $self->amount <= $cust_refund->unapplied;
-
- $self->SUPER::check;
-}
-
-=item cust_refund
-
-Returns the refund (see L<FS::cust_refund>)
-
-=cut
-
-sub cust_refund {
- my $self = shift;
- qsearchs( 'cust_refund', { 'refundnum' => $self->refundnum } );
-}
-
-=item cust_credit
-
-Returns the credit (see L<FS::cust_credit>)
-
-=cut
-
-sub cust_credit {
- my $self = shift;
- qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
-}
-
-=back
-
-=head1 BUGS
-
-Delete and replace methods.
-
-the checks for over-applied refunds could be better done like the ones in
-cust_bill_credit
-
-=head1 SEE ALSO
-
-L<FS::cust_credit>, L<FS::cust_refund>, L<FS::Record>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_event.pm b/FS/FS/cust_event.pm
deleted file mode 100644
index 1407f43..0000000
--- a/FS/FS/cust_event.pm
+++ /dev/null
@@ -1,508 +0,0 @@
-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::part_event;
-#for cust_X
-use FS::cust_main;
-use FS::cust_pkg;
-use FS::cust_bill;
-
-$DEBUG = 0;
-$me = '[FS::cust_event]';
-
-=head1 NAME
-
-FS::cust_event - Object methods for cust_event records
-
-=head1 SYNOPSIS
-
- use FS::cust_event;
-
- $record = new FS::cust_event \%hash;
- $record = new FS::cust_event { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_event object represents an completed event. FS::cust_event
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item eventnum - primary key
-
-=item eventpart - event definition (see L<FS::part_event>)
-
-=item tablenum - customer, package or invoice, depending on the value of part_event.eventtable (see L<FS::cust_main>, L<FS::cust_pkg>, and L<FS::cust_bill>)
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item status - event status: B<new>, B<locked>, B<done> or B<failed>. Note: B<done> indicates the event is complete and should not be retried (statustext may still be set to an optional message), while B<failed> indicates the event failed and should be retried.
-
-=item statustext - additional status detail (i.e. error or progress message)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new completed invoice event. To add the compelted invoice event 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 { 'cust_event'; }
-
-sub cust_linked { $_[0]->cust_main_custnum; }
-sub cust_unlinked_msg {
- my $self = shift;
- "WARNING: can't find cust_main.custnum ". $self->custnum;
- #' (cust_bill.invnum '. $self->invnum. ')';
-}
-sub custnum {
- my $self = shift;
- $self->cust_main_custnum(@_) || $self->SUPER::custnum(@_);
-}
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid completed invoice event. 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('eventnum')
- || $self->ut_foreign_key('eventpart', 'part_event', 'eventpart')
- ;
- return $error if $error;
-
- my $eventtable = $self->part_event->eventtable;
- my $dbdef_eventtable = dbdef->table( $eventtable );
-
- $error =
- $self->ut_foreign_key( 'tablenum',
- $eventtable,
- $dbdef_eventtable->primary_key
- )
- || $self->ut_number('_date')
- || $self->ut_enum('status', [qw( new locked done failed )])
- || $self->ut_anything('statustext')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item part_event
-
-Returns the event definition (see L<FS::part_event>) for this completed event.
-
-=cut
-
-sub part_event {
- my $self = shift;
- qsearchs( 'part_event', { 'eventpart' => $self->eventpart } );
-}
-
-=item cust_X
-
-Returns the customer, package, invoice or batched payment (see
-L<FS::cust_main>, L<FS::cust_pkg>, L<FS::cust_bill> or L<FS::cust_pay_batch>)
-for this completed invoice event.
-
-=cut
-
-sub cust_bill {
- croak "FS::cust_event::cust_bill called";
-}
-
-sub cust_X {
- my $self = shift;
- my $eventtable = $self->part_event->eventtable;
- my $dbdef_table = dbdef->table( $eventtable );
- my $primary_key = $dbdef_table->primary_key;
- qsearchs( $eventtable, { $primary_key => $self->tablenum } );
-}
-
-=item test_conditions [ OPTION => VALUE ... ]
-
-Tests conditions for this event, returns true if all conditions are satisfied,
-false otherwise.
-
-=cut
-
-sub test_conditions {
- my( $self, %opt ) = @_;
- my $part_event = $self->part_event;
- my $object = $self->cust_X;
- my @conditions = $part_event->part_event_condition;
- $opt{'cust_event'} = $self;
-
- #no unsatisfied conditions
- #! grep ! $_->condition( $object, %opt ), @conditions;
- my @unsatisfied = grep ! $_->condition( $object, %opt ), @conditions;
-
- if ( $opt{'stats_hashref'} ) {
- foreach my $unsat (@unsatisfied) {
- $opt{'stats_hashref'}->{$unsat->conditionname}++;
- }
- }
-
- ! @unsatisfied;
-}
-
-=item do_event
-
-Runs the event action.
-
-=cut
-
-sub do_event {
- my $self = shift;
-
- my $part_event = $self->part_event;
-
- my $object = $self->cust_X;
- my $obj_pkey = $object->primary_key;
- my $for = "for ". $object->table. " ". $object->$obj_pkey();
- warn "running cust_event ". $self->eventnum.
- " (". $part_event->action. ") $for\n"
- if $DEBUG;
-
- my $error;
- {
- local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
- $error = eval { $part_event->do_action($object, $self); };
- }
-
- my $status = '';
- my $statustext = '';
- if ( $@ ) {
- $status = 'failed';
- #$statustext = $@;
- $statustext = "Error running ". $part_event->action. " action: $@";
- } elsif ( $error ) {
- $status = 'done';
- $statustext = $error;
- } else {
- $status = 'done';
- }
-
- #replace or add myself
- $self->_date(time);
- $self->status($status);
- $self->statustext($statustext);
-
- $error = $self->eventnum ? $self->replace : $self->insert;
- if ( $error ) {
- #this is why we need that locked state...
- my $e = 'WARNING: Event run but database not updated - '.
- 'error replacing or inserting cust_event '. $self->eventnum.
- " $for: $error\n";
- warn $e;
- return $e;
- }
-
- '';
-
-}
-
-=item retry
-
-Changes the status of this event from B<done> to B<failed>, allowing it to be
-retried.
-
-=cut
-
-sub retry {
- my $self = shift;
- return '' unless $self->status eq 'done';
- my $old = ref($self)->new( { $self->hash } );
- $self->status('failed');
- $self->replace($old);
-}
-
-#=item retryable
-#
-#Changes the statustext of this event to B<retriable>, rendering it
-#retriable (should retry be called).
-#
-#=cut
-
-sub retriable {
- confess "cust_event->retriable called";
- my $self = shift;
- return '' unless $self->status eq 'done';
- my $old = ref($self)->new( { $self->hash } );
- $self->statustext('retriable');
- $self->replace($old);
-}
-
-=item join_cust_sql
-
-=cut
-
-sub join_sql {
- #my $class = shift;
-
- "
- JOIN part_event USING ( eventpart )
- LEFT JOIN cust_bill ON ( eventtable = 'cust_bill' AND tablenum = invnum )
- LEFT JOIN cust_pkg ON ( eventtable = 'cust_pkg' AND tablenum = pkgnum )
- LEFT JOIN cust_main ON ( ( eventtable = 'cust_main' AND tablenum = cust_main.custnum )
- OR ( eventtable = 'cust_bill' AND cust_bill.custnum = cust_main.custnum )
- OR ( eventtable = 'cust_pkg' AND cust_pkg.custnum = cust_main.custnum )
- )
- ";
-
-}
-
-=item search_sql_where HASHREF
-
-Class method which returns an SQL WHERE fragment to search for parameters
-specified in HASHREF. Valid parameters are
-
-=over 4
-
-=item agentnum
-
-=item custnum
-
-=item invnum
-
-=item pkgnum
-
-=item failed
-
-=item beginning
-
-=item ending
-
-=item payby
-
-=item
-
-=back
-
-=cut
-
-#Note: validates all passed-in data; i.e. safe to use with unchecked CGI params.
-#sub
-
-sub search_sql_where {
- my($class, $param) = @_;
- if ( $DEBUG ) {
- warn "$me search_sql_where called with params: \n".
- join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
- }
-
- my @search = $class->cust_search_sql($param);
-
- #eventpart
- my @eventpart = ref($param->{'eventpart'})
- ? @{ $param->{'eventpart'} }
- : split(',', $param->{'eventpart'});
- @eventpart = grep /^(\d+)$/, @eventpart;
- if ( @eventpart ) {
- push @search, 'eventpart IN ('. join(',', @eventpart). ')';
- }
-
- if ( $param->{'beginning'} =~ /^(\d+)$/ ) {
- push @search, "cust_event._date >= $1";
- }
- if ( $param->{'ending'} =~ /^(\d+)$/ ) {
- push @search, "cust_event._date <= $1";
- }
-
- if ( $param->{'failed'} ) {
- push @search, "statustext != ''",
- "statustext IS NOT NULL",
- "statustext != 'N/A'";
- }
-
- if ( $param->{'custnum'} =~ /^(\d+)$/ ) {
- push @search, "cust_main.custnum = '$1'";
- }
-
- if ( $param->{'invnum'} =~ /^(\d+)$/ ) {
- push @search, "part_event.eventtable = 'cust_bill'",
- "tablenum = '$1'";
- }
-
- if ( $param->{'pkgnum'} =~ /^(\d+)$/ ) {
- push @search, "part_event.eventtable = 'cust_pkg'",
- "tablenum = '$1'";
- }
-
- my $where = 'WHERE '. join(' AND ', @search );
-
- join(' AND ', @search );
-
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item reprint
-
-=cut
-
-sub process_reprint {
- process_re_X('print', @_);
-}
-
-=item reemail
-
-=cut
-
-sub process_reemail {
- process_re_X('email', @_);
-}
-
-=item refax
-
-=cut
-
-sub process_refax {
- process_re_X('fax', @_);
-}
-
-use Storable qw(thaw);
-use Data::Dumper;
-use MIME::Base64;
-sub process_re_X {
- my( $method, $job ) = ( shift, shift );
-
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- re_X(
- $method,
- $param,
- $job,
- );
-
-}
-
-sub re_X {
- my($method, $param, $job) = @_;
-
- my $search_sql = FS::cust_event->search_sql_where($param);
-
- #maybe not...? we do want the "re-" action to match the search more closely
- # # yuck! hardcoded *AND* sequential scans!
- #my $where = " WHERE action LIKE 'cust_bill_send%' ".
- # ( $search_sql ? " AND $search_sql" : "" );
-
- my $where = ( $search_sql ? " WHERE $search_sql" : "" );
-
- my @cust_event = qsearch({
- 'table' => 'cust_event',
- 'addl_from' => FS::cust_event->join_sql(),
- 'hashref' => {},
- 'extra_sql' => $where,
- });
-
- warn "$me re_X found ". scalar(@cust_event). " events\n"
- if $DEBUG;
-
- my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
- foreach my $cust_event ( @cust_event ) {
-
- my $cust_X = $cust_event->cust_X; # cust_bill
- next unless $cust_X->can($method);
-
- $cust_X->$method( $cust_event->part_event->templatename
- || $cust_X->agent_template
- );
-
- if ( $job ) { #progressbar foo
- $num++;
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $num / scalar(@cust_event) )
- );
- die $error if $error;
- $last = time;
- }
- }
-
- }
-
- #this doesn't work, but it would be nice
- #if ( $job ) { #progressbar foo
- # my $error = $job->update_statustext(
- # scalar(@cust_event). " invoices re-${method}ed"
- # );
- # die $error if $error;
- #}
-
-}
-
-=back
-
-=head1 SEE ALSO
-
-L<FS::part_event>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_location.pm b/FS/FS/cust_location.pm
deleted file mode 100644
index 60c0181..0000000
--- a/FS/FS/cust_location.pm
+++ /dev/null
@@ -1,278 +0,0 @@
-package FS::cust_location;
-
-use strict;
-use base qw( FS::geocode_Mixin FS::Record );
-use Locale::Country;
-use FS::UID qw( dbh );
-use FS::Record qw( qsearch ); #qsearchs );
-use FS::prospect_main;
-use FS::cust_main;
-use FS::cust_main_county;
-
-=head1 NAME
-
-FS::cust_location - Object methods for cust_location records
-
-=head1 SYNOPSIS
-
- use FS::cust_location;
-
- $record = new FS::cust_location \%hash;
- $record = new FS::cust_location { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_location object represents a customer location. FS::cust_location
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item locationnum
-
-primary key
-
-=item custnum
-
-custnum
-
-=item address1
-
-Address line one (required)
-
-=item address2
-
-Address line two (optional)
-
-=item city
-
-City
-
-=item county
-
-County (optional, see L<FS::cust_main_county>)
-
-=item state
-
-State (see L<FS::cust_main_county>)
-
-=item zip
-
-Zip
-
-=item country
-
-Country (see L<FS::cust_main_county>)
-
-=item geocode
-
-Geocode
-
-=item disabled
-
-Disabled flag; set to 'Y' to disable the location.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new location. To add the location 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 { 'cust_location'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Delete this record from the database.
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid location. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-#some false laziness w/cust_main, but since it should eventually lose these
-#fields anyway...
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('locationnum')
- || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
- || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum')
- || $self->ut_text('address1')
- || $self->ut_textn('address2')
- || $self->ut_text('city')
- || $self->ut_textn('county')
- || $self->ut_textn('state')
- || $self->ut_country('country')
- || $self->ut_zip('zip', $self->country)
- || $self->ut_alphan('geocode')
- ;
- return $error if $error;
-
- return "No prospect or customer!" unless $self->prospectnum || $self->custnum;
- return "Prospect and customer!" if $self->prospectnum && $self->custnum;
-
- unless ( qsearch('cust_main_county', {
- 'country' => $self->country,
- 'state' => '',
- } ) ) {
- return "Unknown state/county/country: ".
- $self->state. "/". $self->county. "/". $self->country
- unless qsearch('cust_main_county',{
- 'state' => $self->state,
- 'county' => $self->county,
- 'country' => $self->country,
- } );
- }
-
- $self->SUPER::check;
-}
-
-=item country_full
-
-Returns this locations's full country name
-
-=cut
-
-sub country_full {
- my $self = shift;
- code2country($self->country);
-}
-
-=item line
-
-Synonym for location_label
-
-=cut
-
-sub line {
- my $self = shift;
- $self->location_label;
-}
-
-=item has_ship_address
-
-Returns false since cust_location objects do not have a separate shipping
-address.
-
-=cut
-
-sub has_ship_address {
- '';
-}
-
-=item location_hash
-
-Returns a list of key/value pairs, with the following keys: address1, address2,
-city, county, state, zip, country, geocode.
-
-=cut
-
-=item move_to HASHREF
-
-Takes a hashref with one or more cust_location fields. Creates a duplicate
-of the existing location with all fields set to the values in the hashref.
-Moves all packages that use the existing location to the new one, then sets
-the "disabled" flag on the old location. Returns nothing on success, an
-error message on error.
-
-=cut
-
-sub move_to {
- my $old = shift;
- my $hashref = 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 = '';
-
- my $new = FS::cust_location->new({
- $old->location_hash,
- 'custnum' => $old->custnum,
- 'prospectnum' => $old->prospectnum,
- %$hashref
- });
- $error = $new->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error creating location: $error";
- }
-
- my @pkgs = qsearch('cust_pkg', {
- 'locationnum' => $old->locationnum,
- 'cancel' => ''
- });
- foreach my $cust_pkg (@pkgs) {
- $error = $cust_pkg->change(
- 'locationnum' => $new->locationnum,
- 'keep_dates' => 1
- );
- if ( $error and not ref($error) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error moving pkgnum ".$cust_pkg->pkgnum.": $error";
- }
- }
-
- $old->disabled('Y');
- $error = $old->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error disabling old location: $error";
- }
-
- $dbh->commit if $oldAutoCommit;
- return;
-}
-
-=back
-
-=head1 BUGS
-
-Not yet used for cust_main billing and shipping addresses.
-
-=head1 SEE ALSO
-
-L<FS::cust_main_county>, L<FS::cust_pkg>, L<FS::Record>,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
deleted file mode 100644
index 03154ad..0000000
--- a/FS/FS/cust_main.pm
+++ /dev/null
@@ -1,4830 +0,0 @@
-package FS::cust_main;
-
-require 5.006;
-use strict;
- #FS::cust_main:_Marketgear when they're ready to move to 2.1
-use base qw( FS::cust_main::Packages
- FS::cust_main::Billing FS::cust_main::Billing_Realtime
- FS::cust_main::Billing_Discount
- FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
- FS::geocode_Mixin
- FS::Record
- );
-use vars qw( $DEBUG $me $conf
- @encrypted_fields
- $import
- $ignore_expired_card $ignore_illegal_zip $ignore_banned_card
- $skip_fuzzyfiles @fuzzyfields
- @paytypes
- );
-use Carp;
-use Scalar::Util qw( blessed );
-use Time::Local qw(timelocal);
-use Storable qw(thaw);
-use MIME::Base64;
-use Data::Dumper;
-use Tie::IxHash;
-use Digest::MD5 qw(md5_base64);
-use Date::Format;
-#use Date::Manip;
-use File::Temp; #qw( tempfile );
-use Business::CreditCard 0.28;
-use Locale::Country;
-use FS::UID qw( getotaker dbh driver_name );
-use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
-use FS::Misc qw( generate_email send_email generate_ps do_print );
-use FS::Msgcat qw(gettext);
-use FS::CurrentUser;
-use FS::payby;
-use FS::cust_pkg;
-use FS::cust_svc;
-use FS::cust_bill;
-use FS::cust_pay;
-use FS::cust_pay_pending;
-use FS::cust_pay_void;
-use FS::cust_pay_batch;
-use FS::cust_credit;
-use FS::cust_refund;
-use FS::part_referral;
-use FS::cust_main_county;
-use FS::cust_location;
-use FS::cust_class;
-use FS::cust_main_exemption;
-use FS::cust_tax_adjustment;
-use FS::cust_tax_location;
-use FS::agent;
-use FS::cust_main_invoice;
-use FS::cust_tag;
-use FS::prepay_credit;
-use FS::queue;
-use FS::part_pkg;
-use FS::part_export;
-#use FS::cust_event;
-use FS::type_pkgs;
-use FS::payment_gateway;
-use FS::agent_payment_gateway;
-use FS::banned_pay;
-use FS::TicketSystem;
-
-# 1 is mostly method/subroutine entry and options
-# 2 traces progress of some operations
-# 3 is even more information including possibly sensitive data
-$DEBUG = 0;
-$me = '[FS::cust_main]';
-
-$import = 0;
-$ignore_expired_card = 0;
-$ignore_illegal_zip = 0;
-$ignore_banned_card = 0;
-
-$skip_fuzzyfiles = 0;
-@fuzzyfields = ( 'first', 'last', 'company', 'address1' );
-
-@encrypted_fields = ('payinfo', 'paycvv');
-sub nohistory_fields { ('payinfo', 'paycvv'); }
-
-@paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
-
-#ask FS::UID to run this stuff for us later
-#$FS::UID::callback{'FS::cust_main'} = sub {
-install_callback FS::UID sub {
- $conf = new FS::Conf;
- #yes, need it for stuff below (prolly should be cached)
-};
-
-sub _cache {
- my $self = shift;
- my ( $hashref, $cache ) = @_;
- if ( exists $hashref->{'pkgnum'} ) {
- #@{ $self->{'_pkgnum'} } = ();
- my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
- $self->{'_pkgnum'} = $subcache;
- #push @{ $self->{'_pkgnum'} },
- FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
- }
-}
-
-=head1 NAME
-
-FS::cust_main - Object methods for cust_main records
-
-=head1 SYNOPSIS
-
- use FS::cust_main;
-
- $record = new FS::cust_main \%hash;
- $record = new FS::cust_main { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- @cust_pkg = $record->all_pkgs;
-
- @cust_pkg = $record->ncancelled_pkgs;
-
- @cust_pkg = $record->suspended_pkgs;
-
- $error = $record->bill;
- $error = $record->bill %options;
- $error = $record->bill 'time' => $time;
-
- $error = $record->collect;
- $error = $record->collect %options;
- $error = $record->collect 'invoice_time' => $time,
- ;
-
-=head1 DESCRIPTION
-
-An FS::cust_main object represents a customer. FS::cust_main inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item custnum
-
-Primary key (assigned automatically for new customers)
-
-=item agentnum
-
-Agent (see L<FS::agent>)
-
-=item refnum
-
-Advertising source (see L<FS::part_referral>)
-
-=item first
-
-First name
-
-=item last
-
-Last name
-
-=item ss
-
-Cocial security number (optional)
-
-=item company
-
-(optional)
-
-=item address1
-
-=item address2
-
-(optional)
-
-=item city
-
-=item county
-
-(optional, see L<FS::cust_main_county>)
-
-=item state
-
-(see L<FS::cust_main_county>)
-
-=item zip
-
-=item country
-
-(see L<FS::cust_main_county>)
-
-=item daytime
-
-phone (optional)
-
-=item night
-
-phone (optional)
-
-=item fax
-
-phone (optional)
-
-=item ship_first
-
-Shipping first name
-
-=item ship_last
-
-Shipping last name
-
-=item ship_company
-
-(optional)
-
-=item ship_address1
-
-=item ship_address2
-
-(optional)
-
-=item ship_city
-
-=item ship_county
-
-(optional, see L<FS::cust_main_county>)
-
-=item ship_state
-
-(see L<FS::cust_main_county>)
-
-=item ship_zip
-
-=item ship_country
-
-(see L<FS::cust_main_county>)
-
-=item ship_daytime
-
-phone (optional)
-
-=item ship_night
-
-phone (optional)
-
-=item ship_fax
-
-phone (optional)
-
-=item payby
-
-Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
-
-=item payinfo
-
-Payment Information (See L<FS::payinfo_Mixin> for data format)
-
-=item paymask
-
-Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
-
-=item paycvv
-
-Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
-
-=item paydate
-
-Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
-
-=item paystart_month
-
-Start date month (maestro/solo cards only)
-
-=item paystart_year
-
-Start date year (maestro/solo cards only)
-
-=item payissue
-
-Issue number (maestro/solo cards only)
-
-=item payname
-
-Name on card or billing name
-
-=item payip
-
-IP address from which payment information was received
-
-=item tax
-
-Tax exempt, empty or `Y'
-
-=item usernum
-
-Order taker (see L<FS::access_user>)
-
-=item comments
-
-Comments (optional)
-
-=item referral_custnum
-
-Referring customer number
-
-=item spool_cdr
-
-Enable individual CDR spooling, empty or `Y'
-
-=item dundate
-
-A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
-
-=item squelch_cdr
-
-Discourage individual CDR printing, empty or `Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new customer. To add the customer 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 { 'cust_main'; }
-
-=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
-
-Adds this customer to the database. If there is an error, returns the error,
-otherwise returns false.
-
-CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
-method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
-are inserted atomicly, or the transaction is rolled back. Passing an empty
-hash reference is equivalent to not supplying this parameter. There should be
-a better explanation of this, but until then, here's an example:
-
- use Tie::RefHash;
- tie %hash, 'Tie::RefHash'; #this part is important
- %hash = (
- $cust_pkg => [ $svc_acct ],
- ...
- );
- $cust_main->insert( \%hash );
-
-INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
-be set as the invoicing list (see L<"invoicing_list">). Errors return as
-expected and rollback the entire transaction; it is not necessary to call
-check_invoicing_list first. The invoicing_list is set after the records in the
-CUST_PKG_HASHREF above are inserted, so it is now possible to set an
-invoicing_list destination to the newly-created svc_acct. Here's an example:
-
- $cust_main->insert( {}, [ $email, 'POST' ] );
-
-Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
-
-If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
-on the supplied jobnum (they will not run until the specific job completes).
-This can be used to defer provisioning until some action completes (such
-as running the customer's credit card successfully).
-
-The I<noexport> option is deprecated. If I<noexport> is set true, no
-provisioning jobs (exports) are scheduled. (You can schedule them later with
-the B<reexport> method.)
-
-The I<tax_exemption> option can be set to an arrayref of tax names.
-FS::cust_main_exemption records will be created and inserted.
-
-=cut
-
-sub insert {
- my $self = shift;
- my $cust_pkgs = @_ ? shift : {};
- my $invoicing_list = @_ ? shift : '';
- my %options = @_;
- warn "$me insert called with options ".
- join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
- if $DEBUG;
-
- 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 $prepay_identifier = '';
- my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
- my $payby = '';
- if ( $self->payby eq 'PREPAY' ) {
-
- $self->payby('BILL');
- $prepay_identifier = $self->payinfo;
- $self->payinfo('');
-
- warn " looking up prepaid card $prepay_identifier\n"
- if $DEBUG > 1;
-
- my $error = $self->get_prepay( $prepay_identifier,
- 'amount_ref' => \$amount,
- 'seconds_ref' => \$seconds,
- 'upbytes_ref' => \$upbytes,
- 'downbytes_ref' => \$downbytes,
- 'totalbytes_ref' => \$totalbytes,
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- #return "error applying prepaid card (transaction rolled back): $error";
- return $error;
- }
-
- $payby = 'PREP' if $amount;
-
- } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
-
- $payby = $1;
- $self->payby('BILL');
- $amount = $self->paid;
-
- }
-
- warn " inserting $self\n"
- if $DEBUG > 1;
-
- $self->signupdate(time) unless $self->signupdate;
-
- $self->auto_agent_custid()
- if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
-
- my $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- #return "inserting cust_main record (transaction rolled back): $error";
- return $error;
- }
-
- warn " setting invoicing list\n"
- if $DEBUG > 1;
-
- if ( $invoicing_list ) {
- $error = $self->check_invoicing_list( $invoicing_list );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- #return "checking invoicing_list (transaction rolled back): $error";
- return $error;
- }
- $self->invoicing_list( $invoicing_list );
- }
-
- warn " setting customer tags\n"
- if $DEBUG > 1;
-
- foreach my $tagnum ( @{ $self->tagnum || [] } ) {
- my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
- 'custnum' => $self->custnum };
- my $error = $cust_tag->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- if ( $invoicing_list ) {
- $error = $self->check_invoicing_list( $invoicing_list );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- #return "checking invoicing_list (transaction rolled back): $error";
- return $error;
- }
- $self->invoicing_list( $invoicing_list );
- }
-
-
- warn " setting cust_main_exemption\n"
- if $DEBUG > 1;
-
- my $tax_exemption = delete $options{'tax_exemption'};
- if ( $tax_exemption ) {
- foreach my $taxname ( @$tax_exemption ) {
- my $cust_main_exemption = new FS::cust_main_exemption {
- 'custnum' => $self->custnum,
- 'taxname' => $taxname,
- };
- my $error = $cust_main_exemption->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting cust_main_exemption (transaction rolled back): $error";
- }
- }
- }
-
- if ( $self->can('start_copy_skel') ) {
- my $error = $self->start_copy_skel;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- warn " ordering packages\n"
- if $DEBUG > 1;
-
- $error = $self->order_pkgs( $cust_pkgs,
- %options,
- 'seconds_ref' => \$seconds,
- 'upbytes_ref' => \$upbytes,
- 'downbytes_ref' => \$downbytes,
- 'totalbytes_ref' => \$totalbytes,
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $seconds ) {
- $dbh->rollback if $oldAutoCommit;
- return "No svc_acct record to apply pre-paid time";
- }
- if ( $upbytes || $downbytes || $totalbytes ) {
- $dbh->rollback if $oldAutoCommit;
- return "No svc_acct record to apply pre-paid data";
- }
-
- if ( $amount ) {
- warn " inserting initial $payby payment of $amount\n"
- if $DEBUG > 1;
- $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting payment (transaction rolled back): $error";
- }
- }
-
- unless ( $import || $skip_fuzzyfiles ) {
- warn " queueing fuzzyfiles update\n"
- if $DEBUG > 1;
- $error = $self->queue_fuzzyfiles_update;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "updating fuzzy search cache: $error";
- }
- }
-
- # cust_main exports!
- warn " exporting\n" if $DEBUG > 1;
-
- my $export_args = $options{'export_args'} || [];
-
- my @part_export =
- map qsearch( 'part_export', {exportnum=>$_} ),
- $conf->config('cust_main-exports'); #, $agentnum
-
- foreach my $part_export ( @part_export ) {
- my $error = $part_export->export_insert($self, @$export_args);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "exporting to ". $part_export->exporttype.
- " (transaction rolled back): $error";
- }
- }
-
- #foreach my $depend_jobnum ( @$depend_jobnums ) {
- # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
- # if $DEBUG;
- # foreach my $jobnum ( @jobnums ) {
- # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
- # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
- # if $DEBUG;
- # my $error = $queue->depend_insert($depend_jobnum);
- # if ( $error ) {
- # $dbh->rollback if $oldAutoCommit;
- # return "error queuing job dependancy: $error";
- # }
- # }
- # }
- #
- #}
- #
- #if ( exists $options{'jobnums'} ) {
- # push @{ $options{'jobnums'} }, @jobnums;
- #}
-
- warn " insert complete; committing transaction\n"
- if $DEBUG > 1;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-use File::CounterFile;
-sub auto_agent_custid {
- my $self = shift;
-
- my $format = $conf->config('cust_main-auto_agent_custid');
- my $agent_custid;
- if ( $format eq '1YMMXXXXXXXX' ) {
-
- my $counter = new File::CounterFile 'cust_main.agent_custid';
- $counter->lock;
-
- my $ym = 100000000000 + time2str('%y%m00000000', time);
- if ( $ym > $counter->value ) {
- $counter->{'value'} = $agent_custid = $ym;
- $counter->{'updated'} = 1;
- } else {
- $agent_custid = $counter->inc;
- }
-
- $counter->unlock;
-
- } else {
- die "Unknown cust_main-auto_agent_custid format: $format";
- }
-
- $self->agent_custid($agent_custid);
-
-}
-
-=item PACKAGE METHODS
-
-Documentation on customer package methods has been moved to
-L<FS::cust_main::Packages>.
-
-=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
-
-Recharges this (existing) customer with the specified prepaid card (see
-L<FS::prepay_credit>), specified either by I<identifier> or as an
-FS::prepay_credit object. If there is an error, returns the error, otherwise
-returns false.
-
-Optionally, five scalar references can be passed as well. They will have their
-values filled in with the amount, number of seconds, and number of upload,
-download, and total bytes applied by this prepaid card.
-
-=cut
-
-#the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
-#the only place that uses these args
-sub recharge_prepay {
- my( $self, $prepay_credit, $amountref, $secondsref,
- $upbytesref, $downbytesref, $totalbytesref ) = @_;
-
- 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( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
-
- my $error = $self->get_prepay( $prepay_credit,
- 'amount_ref' => \$amount,
- 'seconds_ref' => \$seconds,
- 'upbytes_ref' => \$upbytes,
- 'downbytes_ref' => \$downbytes,
- 'totalbytes_ref' => \$totalbytes,
- )
- || $self->increment_seconds($seconds)
- || $self->increment_upbytes($upbytes)
- || $self->increment_downbytes($downbytes)
- || $self->increment_totalbytes($totalbytes)
- || $self->insert_cust_pay_prepay( $amount,
- ref($prepay_credit)
- ? $prepay_credit->identifier
- : $prepay_credit
- );
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( defined($amountref) ) { $$amountref = $amount; }
- if ( defined($secondsref) ) { $$secondsref = $seconds; }
- if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
- if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
- if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
-
-Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
-specified either by I<identifier> or as an FS::prepay_credit object.
-
-Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>. The scalars (provided by references) will be
-incremented by the values of the prepaid card.
-
-If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
-check or set this customer's I<agentnum>.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-
-sub get_prepay {
- my( $self, $prepay_credit, %opt ) = @_;
-
- 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;
-
- unless ( ref($prepay_credit) ) {
-
- my $identifier = $prepay_credit;
-
- $prepay_credit = qsearchs(
- 'prepay_credit',
- { 'identifier' => $prepay_credit },
- '',
- 'FOR UPDATE'
- );
-
- unless ( $prepay_credit ) {
- $dbh->rollback if $oldAutoCommit;
- return "Invalid prepaid card: ". $identifier;
- }
-
- }
-
- if ( $prepay_credit->agentnum ) {
- if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
- $dbh->rollback if $oldAutoCommit;
- return "prepaid card not valid for agent ". $self->agentnum;
- }
- $self->agentnum($prepay_credit->agentnum);
- }
-
- my $error = $prepay_credit->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "removing prepay_credit (transaction rolled back): $error";
- }
-
- ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
- for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item increment_upbytes SECONDS
-
-Updates this customer's single or primary account (see L<FS::svc_acct>) by
-the specified number of upbytes. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub increment_upbytes {
- _increment_column( shift, 'upbytes', @_);
-}
-
-=item increment_downbytes SECONDS
-
-Updates this customer's single or primary account (see L<FS::svc_acct>) by
-the specified number of downbytes. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub increment_downbytes {
- _increment_column( shift, 'downbytes', @_);
-}
-
-=item increment_totalbytes SECONDS
-
-Updates this customer's single or primary account (see L<FS::svc_acct>) by
-the specified number of totalbytes. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub increment_totalbytes {
- _increment_column( shift, 'totalbytes', @_);
-}
-
-=item increment_seconds SECONDS
-
-Updates this customer's single or primary account (see L<FS::svc_acct>) by
-the specified number of seconds. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub increment_seconds {
- _increment_column( shift, 'seconds', @_);
-}
-
-=item _increment_column AMOUNT
-
-Updates this customer's single or primary account (see L<FS::svc_acct>) by
-the specified number of seconds or bytes. If there is an error, returns
-the error, otherwise returns false.
-
-=cut
-
-sub _increment_column {
- my( $self, $column, $amount ) = @_;
- warn "$me increment_column called: $column, $amount\n"
- if $DEBUG;
-
- return '' unless $amount;
-
- my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
- $self->ncancelled_pkgs;
-
- if ( ! @cust_pkg ) {
- return 'No packages with primary or single services found'.
- ' to apply pre-paid time';
- } elsif ( scalar(@cust_pkg) > 1 ) {
- #maybe have a way to specify the package/account?
- return 'Multiple packages found to apply pre-paid time';
- }
-
- my $cust_pkg = $cust_pkg[0];
- warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
- if $DEBUG > 1;
-
- my @cust_svc =
- $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
-
- if ( ! @cust_svc ) {
- return 'No account found to apply pre-paid time';
- } elsif ( scalar(@cust_svc) > 1 ) {
- return 'Multiple accounts found to apply pre-paid time';
- }
-
- my $svc_acct = $cust_svc[0]->svc_x;
- warn " found service svcnum ". $svc_acct->pkgnum.
- ' ('. $svc_acct->email. ")\n"
- if $DEBUG > 1;
-
- $column = "increment_$column";
- $svc_acct->$column($amount);
-
-}
-
-=item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
-
-Inserts a prepayment in the specified amount for this customer. An optional
-second argument can specify the prepayment identifier for tracking purposes.
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub insert_cust_pay_prepay {
- shift->insert_cust_pay('PREP', @_);
-}
-
-=item insert_cust_pay_cash AMOUNT [ PAYINFO ]
-
-Inserts a cash payment in the specified amount for this customer. An optional
-second argument can specify the payment identifier for tracking purposes.
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub insert_cust_pay_cash {
- shift->insert_cust_pay('CASH', @_);
-}
-
-=item insert_cust_pay_west AMOUNT [ PAYINFO ]
-
-Inserts a Western Union payment in the specified amount for this customer. An
-optional second argument can specify the prepayment identifier for tracking
-purposes. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub insert_cust_pay_west {
- shift->insert_cust_pay('WEST', @_);
-}
-
-sub insert_cust_pay {
- my( $self, $payby, $amount ) = splice(@_, 0, 3);
- my $payinfo = scalar(@_) ? shift : '';
-
- my $cust_pay = new FS::cust_pay {
- 'custnum' => $self->custnum,
- 'paid' => sprintf('%.2f', $amount),
- #'_date' => #date the prepaid card was purchased???
- 'payby' => $payby,
- 'payinfo' => $payinfo,
- };
- $cust_pay->insert;
-
-}
-
-=item reexport
-
-This method is deprecated. See the I<depend_jobnum> option to the insert and
-order_pkgs methods for a better way to defer provisioning.
-
-Re-schedules all exports by calling the B<reexport> method of all associated
-packages (see L<FS::cust_pkg>). If there is an error, returns the error;
-otherwise returns false.
-
-=cut
-
-sub reexport {
- my $self = shift;
-
- carp "WARNING: FS::cust_main::reexport is deprectated; ".
- "use the depend_jobnum option to insert or order_pkgs to delay export";
-
- 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 $cust_pkg ( $self->ncancelled_pkgs ) {
- my $error = $cust_pkg->reexport;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item delete [ OPTION => VALUE ... ]
-
-This deletes the customer. If there is an error, returns the error, otherwise
-returns false.
-
-This will completely remove all traces of the customer record. This is not
-what you want when a customer cancels service; for that, cancel all of the
-customer's packages (see L</cancel>).
-
-If the customer has any uncancelled packages, you need to pass a new (valid)
-customer number for those packages to be transferred to, as the "new_customer"
-option. Cancelled packages will be deleted. Did I mention that this is NOT
-what you want when a customer cancels service and that you really should be
-looking at L<FS::cust_pkg/cancel>?
-
-You can't delete a customer with invoices (see L<FS::cust_bill>),
-statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
-payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
-set the "delete_financials" option to a true value.
-
-=cut
-
-sub delete {
- my( $self, %opt ) = @_;
-
- 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 ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't delete a master agent customer";
- }
-
- #use FS::access_user
- if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't delete a master employee customer";
- }
-
- tie my %financial_tables, 'Tie::IxHash',
- 'cust_bill' => 'invoices',
- 'cust_statement' => 'statements',
- 'cust_credit' => 'credits',
- 'cust_pay' => 'payments',
- 'cust_refund' => 'refunds',
- ;
-
- foreach my $table ( keys %financial_tables ) {
-
- my @records = $self->$table();
-
- if ( @records && ! $opt{'delete_financials'} ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't delete a customer with ". $financial_tables{$table};
- }
-
- foreach my $record ( @records ) {
- my $error = $record->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error deleting ". $financial_tables{$table}. ": $error\n";
- }
- }
-
- }
-
- my @cust_pkg = $self->ncancelled_pkgs;
- if ( @cust_pkg ) {
- my $new_custnum = $opt{'new_custnum'};
- unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Invalid new customer number: $new_custnum";
- }
- foreach my $cust_pkg ( @cust_pkg ) {
- my %hash = $cust_pkg->hash;
- $hash{'custnum'} = $new_custnum;
- my $new_cust_pkg = new FS::cust_pkg ( \%hash );
- my $error = $new_cust_pkg->replace($cust_pkg,
- options => { $cust_pkg->options },
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
- my @cancelled_cust_pkg = $self->all_pkgs;
- foreach my $cust_pkg ( @cancelled_cust_pkg ) {
- my $error = $cust_pkg->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- #cust_tax_adjustment in financials?
- #cust_pay_pending? ouch
- #cust_recon?
- foreach my $table (qw(
- cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
- cust_location cust_main_note cust_tax_adjustment
- cust_pay_void cust_pay_batch queue cust_tax_exempt
- )) {
- foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
- my $error = $record->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- my $sth = $dbh->prepare(
- 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
- ) or do {
- my $errstr = $dbh->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
- $sth->execute($self->custnum) or do {
- my $errstr = $sth->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
-
- #tickets
-
- my $ticket_dbh = '';
- if ($conf->config('ticket_system') eq 'RT_Internal') {
- $ticket_dbh = $dbh;
- } elsif ($conf->config('ticket_system') eq 'RT_External') {
- my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
- $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
- #or die "RT_External DBI->connect error: $DBI::errstr\n";
- }
-
- if ( $ticket_dbh ) {
-
- my $ticket_sth = $ticket_dbh->prepare(
- 'DELETE FROM Links WHERE Target = ?'
- ) or do {
- my $errstr = $ticket_dbh->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
- $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
- or do {
- my $errstr = $ticket_sth->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
-
- #check and see if the customer is the only link on the ticket, and
- #if so, set the ticket to deleted status in RT?
- #maybe someday, for now this will at least fix tickets not displaying
-
- }
-
- #delete the customer record
-
- my $error = $self->SUPER::delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- # cust_main exports!
-
- #my $export_args = $options{'export_args'} || [];
-
- my @part_export =
- map qsearch( 'part_export', {exportnum=>$_} ),
- $conf->config('cust_main-exports'); #, $agentnum
-
- foreach my $part_export ( @part_export ) {
- my $error = $part_export->export_delete( $self ); #, @$export_args);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "exporting to ". $part_export->exporttype.
- " (transaction rolled back): $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
-
-This merges this customer into the provided new custnum, and then deletes the
-customer. If there is an error, returns the error, otherwise returns false.
-
-The source customer's name, company name, phone numbers, agent,
-referring customer, customer class, advertising source, order taker, and
-billing information (except balance) are discarded.
-
-All packages are moved to the target customer. Packages with package locations
-are preserved. Packages without package locations are moved to a new package
-location with the source customer's service/shipping address.
-
-All invoices, statements, payments, credits and refunds are moved to the target
-customer. The source customer's balance is added to the target customer.
-
-All notes, attachments, tickets and customer tags are moved to the target
-customer.
-
-Change history is not currently moved.
-
-=cut
-
-sub merge {
- my( $self, $new_custnum, %opt ) = @_;
-
- return "Can't merge a customer into self" if $self->custnum == $new_custnum;
-
- unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
- return "Invalid new customer number: $new_custnum";
- }
-
- 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 ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't merge a master agent customer";
- }
-
- #use FS::access_user
- if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't merge a master employee customer";
- }
-
- if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
- 'status' => { op=>'!=', value=>'done' },
- }
- )
- ) {
- $dbh->rollback if $oldAutoCommit;
- return "Can't merge a customer with pending payments";
- }
-
- tie my %financial_tables, 'Tie::IxHash',
- 'cust_bill' => 'invoices',
- 'cust_statement' => 'statements',
- 'cust_credit' => 'credits',
- 'cust_pay' => 'payments',
- 'cust_pay_void' => 'voided payments',
- 'cust_refund' => 'refunds',
- ;
-
- foreach my $table ( keys %financial_tables ) {
-
- my @records = $self->$table();
-
- foreach my $record ( @records ) {
- $record->custnum($new_custnum);
- my $error = $record->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error merging ". $financial_tables{$table}. ": $error\n";
- }
- }
-
- }
-
- my $name = $self->ship_name;
-
- my $locationnum = '';
- foreach my $cust_pkg ( $self->all_pkgs ) {
- $cust_pkg->custnum($new_custnum);
-
- unless ( $cust_pkg->locationnum ) {
- unless ( $locationnum ) {
- my $cust_location = new FS::cust_location {
- $self->location_hash,
- 'custnum' => $new_custnum,
- };
- my $error = $cust_location->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $locationnum = $cust_location->locationnum;
- }
- $cust_pkg->locationnum($locationnum);
- }
-
- my $error = $cust_pkg->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- # add customer (ship) name to svc_phone.phone_name if blank
- my @cust_svc = $cust_pkg->cust_svc;
- foreach my $cust_svc (@cust_svc) {
- my($label, $value, $svcdb) = $cust_svc->label;
- next unless $svcdb eq 'svc_phone';
- my $svc_phone = $cust_svc->svc_x;
- next if $svc_phone->phone_name;
- $svc_phone->phone_name($name);
- my $error = $svc_phone->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- }
-
- #not considered:
- # cust_tax_exempt (texas tax exemptions)
- # cust_recon (some sort of not-well understood thing for OnPac)
-
- #these are moved over
- foreach my $table (qw(
- cust_tag cust_location contact cust_attachment cust_main_note
- cust_tax_adjustment cust_pay_batch queue
- )) {
- foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
- $record->custnum($new_custnum);
- my $error = $record->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- #these aren't preserved
- foreach my $table (qw(
- cust_main_exemption cust_main_invoice
- )) {
- foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
- my $error = $record->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
-
- my $sth = $dbh->prepare(
- 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
- ) or do {
- my $errstr = $dbh->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
- $sth->execute($new_custnum, $self->custnum) or do {
- my $errstr = $sth->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
-
- #tickets
-
- my $ticket_dbh = '';
- if ($conf->config('ticket_system') eq 'RT_Internal') {
- $ticket_dbh = $dbh;
- } elsif ($conf->config('ticket_system') eq 'RT_External') {
- my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
- $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
- #or die "RT_External DBI->connect error: $DBI::errstr\n";
- }
-
- if ( $ticket_dbh ) {
-
- my $ticket_sth = $ticket_dbh->prepare(
- 'UPDATE Links SET Target = ? WHERE Target = ?'
- ) or do {
- my $errstr = $ticket_dbh->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
- $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
- 'freeside://freeside/cust_main/'.$self->custnum)
- or do {
- my $errstr = $ticket_sth->errstr;
- $dbh->rollback if $oldAutoCommit;
- return $errstr;
- };
-
- }
-
- #delete the customer record
-
- my $error = $self->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
-
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
-be set as the invoicing list (see L<"invoicing_list">). Errors return as
-expected and rollback the entire transaction; it is not necessary to call
-check_invoicing_list first. Here's an example:
-
- $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
-
-Currently available options are: I<tax_exemption>.
-
-The I<tax_exemption> option can be set to an arrayref of tax names.
-FS::cust_main_exemption records will be deleted and inserted as appropriate.
-
-=cut
-
-sub replace {
- my $self = shift;
-
- my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
- ? shift
- : $self->replace_old;
-
- my @param = @_;
-
- warn "$me replace called\n"
- if $DEBUG;
-
- my $curuser = $FS::CurrentUser::CurrentUser;
- if ( $self->payby eq 'COMP'
- && $self->payby ne $old->payby
- && ! $curuser->access_right('Complimentary customer')
- )
- {
- return "You are not permitted to create complimentary accounts.";
- }
-
- if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode')
- && $conf->exists('enable_taxproducts')
- )
- {
- my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip)
- ? 'ship_' : '';
- $self->set('geocode', '')
- if $old->get($pre.'zip') ne $self->get($pre.'zip')
- && length($self->get($pre.'zip')) >= 10;
- }
-
- local($ignore_expired_card) = 1
- if $old->payby =~ /^(CARD|DCRD)$/
- && $self->payby =~ /^(CARD|DCRD)$/
- && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
-
- 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::replace($old);
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
- my $invoicing_list = shift @param;
- $error = $self->check_invoicing_list( $invoicing_list );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $self->invoicing_list( $invoicing_list );
- }
-
- if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
-
- #this could be more efficient than deleting and re-inserting, if it matters
- foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
- my $error = $cust_tag->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- foreach my $tagnum ( @{ $self->tagnum || [] } ) {
- my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
- 'custnum' => $self->custnum };
- my $error = $cust_tag->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- }
-
- my %options = @param;
-
- my $tax_exemption = delete $options{'tax_exemption'};
- if ( $tax_exemption ) {
-
- my %cust_main_exemption =
- map { $_->taxname => $_ }
- qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
-
- foreach my $taxname ( @$tax_exemption ) {
-
- next if delete $cust_main_exemption{$taxname};
-
- my $cust_main_exemption = new FS::cust_main_exemption {
- 'custnum' => $self->custnum,
- 'taxname' => $taxname,
- };
- my $error = $cust_main_exemption->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting cust_main_exemption (transaction rolled back): $error";
- }
- }
-
- foreach my $cust_main_exemption ( values %cust_main_exemption ) {
- my $error = $cust_main_exemption->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "deleting cust_main_exemption (transaction rolled back): $error";
- }
- }
-
- }
-
- if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
- && ( ( $self->get('payinfo') ne $old->get('payinfo')
- && $self->get('payinfo') !~ /^99\d{14}$/
- )
- || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
- )
- )
- {
-
- # card/check/lec info has changed, want to retry realtime_ invoice events
- my $error = $self->retry_realtime;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- unless ( $import || $skip_fuzzyfiles ) {
- $error = $self->queue_fuzzyfiles_update;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "updating fuzzy search cache: $error";
- }
- }
-
- # cust_main exports!
-
- my $export_args = $options{'export_args'} || [];
-
- my @part_export =
- map qsearch( 'part_export', {exportnum=>$_} ),
- $conf->config('cust_main-exports'); #, $agentnum
-
- foreach my $part_export ( @part_export ) {
- my $error = $part_export->export_replace( $self, $old, @$export_args);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "exporting to ". $part_export->exporttype.
- " (transaction rolled back): $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item queue_fuzzyfiles_update
-
-Used by insert & replace to update the fuzzy search cache
-
-=cut
-
-sub queue_fuzzyfiles_update {
- 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 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
- my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "queueing job (transaction rolled back): $error";
- }
-
- if ( $self->ship_last ) {
- $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
- $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "queueing job (transaction rolled back): $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item check
-
-Checks all fields to make sure this is a valid customer record. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- warn "$me check BEFORE: \n". $self->_dump
- if $DEBUG > 2;
-
- my $error =
- $self->ut_numbern('custnum')
- || $self->ut_number('agentnum')
- || $self->ut_textn('agent_custid')
- || $self->ut_number('refnum')
- || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
- || $self->ut_textn('custbatch')
- || $self->ut_name('last')
- || $self->ut_name('first')
- || $self->ut_snumbern('birthdate')
- || $self->ut_snumbern('signupdate')
- || $self->ut_textn('company')
- || $self->ut_text('address1')
- || $self->ut_textn('address2')
- || $self->ut_text('city')
- || $self->ut_textn('county')
- || $self->ut_textn('state')
- || $self->ut_country('country')
- || $self->ut_anything('comments')
- || $self->ut_numbern('referral_custnum')
- || $self->ut_textn('stateid')
- || $self->ut_textn('stateid_state')
- || $self->ut_textn('invoice_terms')
- || $self->ut_alphan('geocode')
- || $self->ut_floatn('cdr_termination_percentage')
- || $self->ut_floatn('credit_limit')
- ;
-
- #barf. need message catalogs. i18n. etc.
- $error .= "Please select an advertising source."
- if $error =~ /^Illegal or empty \(numeric\) refnum: /;
- return $error if $error;
-
- return "Unknown agent"
- unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
-
- return "Unknown refnum"
- unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
-
- return "Unknown referring custnum: ". $self->referral_custnum
- unless ! $self->referral_custnum
- || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
-
- if ( $self->censustract ne '' ) {
- $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
- or return "Illegal census tract: ". $self->censustract;
-
- $self->censustract("$1.$2");
- }
-
- if ( $self->ss eq '' ) {
- $self->ss('');
- } else {
- my $ss = $self->ss;
- $ss =~ s/\D//g;
- $ss =~ /^(\d{3})(\d{2})(\d{4})$/
- or return "Illegal social security number: ". $self->ss;
- $self->ss("$1-$2-$3");
- }
-
-
-# bad idea to disable, causes billing to fail because of no tax rates later
-# except we don't fail any more
- unless ( $import ) {
- unless ( qsearch('cust_main_county', {
- 'country' => $self->country,
- 'state' => '',
- } ) ) {
- return "Unknown state/county/country: ".
- $self->state. "/". $self->county. "/". $self->country
- unless qsearch('cust_main_county',{
- 'state' => $self->state,
- 'county' => $self->county,
- 'country' => $self->country,
- } );
- }
- }
-
- $error =
- $self->ut_phonen('daytime', $self->country)
- || $self->ut_phonen('night', $self->country)
- || $self->ut_phonen('fax', $self->country)
- ;
- return $error if $error;
-
- unless ( $ignore_illegal_zip ) {
- $error = $self->ut_zip('zip', $self->country);
- return $error if $error;
- }
-
- if ( $conf->exists('cust_main-require_phone')
- && ! length($self->daytime) && ! length($self->night)
- ) {
-
- my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
- ? 'Day Phone'
- : FS::Msgcat::_gettext('daytime');
- my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
- ? 'Night Phone'
- : FS::Msgcat::_gettext('night');
-
- return "$daytime_label or $night_label is required"
-
- }
-
- if ( $self->has_ship_address
- && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
- $self->addr_fields )
- )
- {
- my $error =
- $self->ut_name('ship_last')
- || $self->ut_name('ship_first')
- || $self->ut_textn('ship_company')
- || $self->ut_text('ship_address1')
- || $self->ut_textn('ship_address2')
- || $self->ut_text('ship_city')
- || $self->ut_textn('ship_county')
- || $self->ut_textn('ship_state')
- || $self->ut_country('ship_country')
- ;
- return $error if $error;
-
- #false laziness with above
- unless ( qsearchs('cust_main_county', {
- 'country' => $self->ship_country,
- 'state' => '',
- } ) ) {
- return "Unknown ship_state/ship_county/ship_country: ".
- $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
- unless qsearch('cust_main_county',{
- 'state' => $self->ship_state,
- 'county' => $self->ship_county,
- 'country' => $self->ship_country,
- } );
- }
- #eofalse
-
- $error =
- $self->ut_phonen('ship_daytime', $self->ship_country)
- || $self->ut_phonen('ship_night', $self->ship_country)
- || $self->ut_phonen('ship_fax', $self->ship_country)
- ;
- return $error if $error;
-
- unless ( $ignore_illegal_zip ) {
- $error = $self->ut_zip('ship_zip', $self->ship_country);
- return $error if $error;
- }
- return "Unit # is required."
- if $self->ship_address2 =~ /^\s*$/
- && $conf->exists('cust_main-require_address2');
-
- } else { # ship_ info eq billing info, so don't store dup info in database
-
- $self->setfield("ship_$_", '')
- foreach $self->addr_fields;
-
- return "Unit # is required."
- if $self->address2 =~ /^\s*$/
- && $conf->exists('cust_main-require_address2');
-
- }
-
- #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
- # or return "Illegal payby: ". $self->payby;
- #$self->payby($1);
- FS::payby->can_payby($self->table, $self->payby)
- or return "Illegal payby: ". $self->payby;
-
- $error = $self->ut_numbern('paystart_month')
- || $self->ut_numbern('paystart_year')
- || $self->ut_numbern('payissue')
- || $self->ut_textn('paytype')
- ;
- return $error if $error;
-
- if ( $self->payip eq '' ) {
- $self->payip('');
- } else {
- $error = $self->ut_ip('payip');
- return $error if $error;
- }
-
- # If it is encrypted and the private key is not availaible then we can't
- # check the credit card.
- my $check_payinfo = ! $self->is_encrypted($self->payinfo);
-
- if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
-
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\D//g;
- $payinfo =~ /^(\d{13,16})$/
- or return gettext('invalid_card'); # . ": ". $self->payinfo;
- $payinfo = $1;
- $self->payinfo($payinfo);
- validate($payinfo)
- or return gettext('invalid_card'); # . ": ". $self->payinfo;
-
- return gettext('unknown_card_type')
- if $self->payinfo !~ /^99\d{14}$/ #token
- && cardtype($self->payinfo) eq "Unknown";
-
- unless ( $ignore_banned_card ) {
- my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
- if ( $ban ) {
- return 'Banned credit card: banned on '.
- time2str('%a %h %o at %r', $ban->_date).
- ' by '. $ban->otaker.
- ' (ban# '. $ban->bannum. ')';
- }
- }
-
- if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
- if ( cardtype($self->payinfo) eq 'American Express card' ) {
- $self->paycvv =~ /^(\d{4})$/
- or return "CVV2 (CID) for American Express cards is four digits.";
- $self->paycvv($1);
- } else {
- $self->paycvv =~ /^(\d{3})$/
- or return "CVV2 (CVC2/CID) is three digits.";
- $self->paycvv($1);
- }
- } else {
- $self->paycvv('');
- }
-
- my $cardtype = cardtype($payinfo);
- if ( $cardtype =~ /^(Switch|Solo)$/i ) {
-
- return "Start date or issue number is required for $cardtype cards"
- unless $self->paystart_month && $self->paystart_year or $self->payissue;
-
- return "Start month must be between 1 and 12"
- if $self->paystart_month
- and $self->paystart_month < 1 || $self->paystart_month > 12;
-
- return "Start year must be 1990 or later"
- if $self->paystart_year
- and $self->paystart_year < 1990;
-
- return "Issue number must be beween 1 and 99"
- if $self->payissue
- and $self->payissue < 1 || $self->payissue > 99;
-
- } else {
- $self->paystart_month('');
- $self->paystart_year('');
- $self->payissue('');
- }
-
- } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
-
- my $payinfo = $self->payinfo;
- $payinfo =~ s/[^\d\@]//g;
- if ( $conf->exists('echeck-nonus') ) {
- $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
- $payinfo = "$1\@$2";
- } else {
- $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
- $payinfo = "$1\@$2";
- }
- $self->payinfo($payinfo);
- $self->paycvv('');
-
- unless ( $ignore_banned_card ) {
- my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
- if ( $ban ) {
- return 'Banned ACH account: banned on '.
- time2str('%a %h %o at %r', $ban->_date).
- ' by '. $ban->otaker.
- ' (ban# '. $ban->bannum. ')';
- }
- }
-
- } elsif ( $self->payby eq 'LECB' ) {
-
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\D//g;
- $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
- $payinfo = $1;
- $self->payinfo($payinfo);
- $self->paycvv('');
-
- } elsif ( $self->payby eq 'BILL' ) {
-
- $error = $self->ut_textn('payinfo');
- return "Illegal P.O. number: ". $self->payinfo if $error;
- $self->paycvv('');
-
- } elsif ( $self->payby eq 'COMP' ) {
-
- my $curuser = $FS::CurrentUser::CurrentUser;
- if ( ! $self->custnum
- && ! $curuser->access_right('Complimentary customer')
- )
- {
- return "You are not permitted to create complimentary accounts."
- }
-
- $error = $self->ut_textn('payinfo');
- return "Illegal comp account issuer: ". $self->payinfo if $error;
- $self->paycvv('');
-
- } elsif ( $self->payby eq 'PREPAY' ) {
-
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\W//g; #anything else would just confuse things
- $self->payinfo($payinfo);
- $error = $self->ut_alpha('payinfo');
- return "Illegal prepayment identifier: ". $self->payinfo if $error;
- return "Unknown prepayment identifier"
- unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
- $self->paycvv('');
-
- }
-
- if ( $self->paydate eq '' || $self->paydate eq '-' ) {
- return "Expiration date required"
- unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
- $self->paydate('');
- } else {
- my( $m, $y );
- if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
- ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
- } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
- ( $m, $y ) = ( $2, "19$1" );
- } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
- ( $m, $y ) = ( $3, "20$2" );
- } else {
- return "Illegal expiration date: ". $self->paydate;
- }
- $m = sprintf('%02d',$m);
- $self->paydate("$y-$m-01");
- my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
- return gettext('expired_card')
- if !$import
- && !$ignore_expired_card
- && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
- }
-
- if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
- ( ! $conf->exists('require_cardname')
- || $self->payby !~ /^(CARD|DCRD)$/ )
- ) {
- $self->payname( $self->first. " ". $self->getfield('last') );
- } else {
- $self->payname =~ /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \,\.\-\'\&]+)$/
- or return gettext('illegal_name'). " payname: ". $self->payname;
- $self->payname($1);
- }
-
- foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
- $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
- $self->$flag($1);
- }
-
- $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
-
- warn "$me check AFTER: \n". $self->_dump
- if $DEBUG > 2;
-
- $self->SUPER::check;
-}
-
-=item addr_fields
-
-Returns a list of fields which have ship_ duplicates.
-
-=cut
-
-sub addr_fields {
- qw( last first company
- address1 address2 city county state zip country
- daytime night fax
- );
-}
-
-=item has_ship_address
-
-Returns true if this customer record has a separate shipping address.
-
-=cut
-
-sub has_ship_address {
- my $self = shift;
- 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, and geocode. The shipping address is used if present.
-
-=cut
-
-=item cust_location
-
-Returns all locations (see L<FS::cust_location>) for this customer.
-
-=cut
-
-sub cust_location {
- my $self = shift;
- qsearch('cust_location', { 'custnum' => $self->custnum } );
-}
-
-=item unsuspend
-
-Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
-and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
-on success or a list of errors.
-
-=cut
-
-sub unsuspend {
- my $self = shift;
- grep { $_->unsuspend } $self->suspended_pkgs;
-}
-
-=item suspend
-
-Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
-
-Returns a list: an empty list on success or a list of errors.
-
-=cut
-
-sub suspend {
- my $self = shift;
- grep { $_->suspend(@_) } $self->unsuspended_pkgs;
-}
-
-=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
-
-Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
-PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
-of a list of pkgparts; the hashref has the following keys:
-
-=over 4
-
-=item pkgparts - listref of pkgparts
-
-=item (other options are passed to the suspend method)
-
-=back
-
-
-Returns a list: an empty list on success or a list of errors.
-
-=cut
-
-sub suspend_if_pkgpart {
- my $self = shift;
- my (@pkgparts, %opt);
- if (ref($_[0]) eq 'HASH'){
- @pkgparts = @{$_[0]{pkgparts}};
- %opt = %{$_[0]};
- }else{
- @pkgparts = @_;
- }
- grep { $_->suspend(%opt) }
- grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
- $self->unsuspended_pkgs;
-}
-
-=item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
-
-Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
-given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
-instead of a list of pkgparts; the hashref has the following keys:
-
-=over 4
-
-=item pkgparts - listref of pkgparts
-
-=item (other options are passed to the suspend method)
-
-=back
-
-Returns a list: an empty list on success or a list of errors.
-
-=cut
-
-sub suspend_unless_pkgpart {
- my $self = shift;
- my (@pkgparts, %opt);
- if (ref($_[0]) eq 'HASH'){
- @pkgparts = @{$_[0]{pkgparts}};
- %opt = %{$_[0]};
- }else{
- @pkgparts = @_;
- }
- grep { $_->suspend(%opt) }
- grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
- $self->unsuspended_pkgs;
-}
-
-=item cancel [ OPTION => VALUE ... ]
-
-Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
-
-Available options are:
-
-=over 4
-
-=item quiet - can be set true to supress email cancellation notices.
-
-=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
-
-=item ban - can be set true to ban this customer's credit card or ACH information, if present.
-
-=item nobill - can be set true to skip billing if it might otherwise be done.
-
-=back
-
-Always returns a list: an empty list on success or a list of errors.
-
-=cut
-
-# nb that dates are not specified as valid options to this method
-
-sub cancel {
- my( $self, %opt ) = @_;
-
- warn "$me cancel called on customer ". $self->custnum. " with options ".
- join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
- if $DEBUG;
-
- return ( 'access denied' )
- unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
-
- if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
-
- #should try decryption (we might have the private key)
- # and if not maybe queue a job for the server that does?
- return ( "Can't (yet) ban encrypted credit cards" )
- if $self->is_encrypted($self->payinfo);
-
- my $ban = new FS::banned_pay $self->_banned_pay_hashref;
- my $error = $ban->insert;
- return ( $error ) if $error;
-
- }
-
- my @pkgs = $self->ncancelled_pkgs;
-
- if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
- $opt{nobill} = 1;
- my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
- warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
- if $error;
- }
-
- warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
- scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
- if $DEBUG;
-
- grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
-}
-
-sub _banned_pay_hashref {
- my $self = shift;
-
- my %payby2ban = (
- 'CARD' => 'CARD',
- 'DCRD' => 'CARD',
- 'CHEK' => 'CHEK',
- 'DCHK' => 'CHEK'
- );
-
- {
- 'payby' => $payby2ban{$self->payby},
- 'payinfo' => md5_base64($self->payinfo),
- #don't ever *search* on reason! #'reason' =>
- };
-}
-
-=item notes
-
-Returns all notes (see L<FS::cust_main_note>) for this customer.
-
-=cut
-
-sub notes {
- my($self,$orderby_classnum) = (shift,shift);
- my $orderby = "_DATE DESC";
- $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
- qsearch( 'cust_main_note',
- { 'custnum' => $self->custnum },
- '',
- "ORDER BY $orderby",
- );
-}
-
-=item agent
-
-Returns the agent (see L<FS::agent>) for this customer.
-
-=cut
-
-sub agent {
- my $self = shift;
- qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
-}
-
-=item agent_name
-
-Returns the agent name (see L<FS::agent>) for this customer.
-
-=cut
-
-sub agent_name {
- my $self = shift;
- $self->agent->agent;
-}
-
-=item cust_tag
-
-Returns any tags associated with this customer, as FS::cust_tag objects,
-or an empty list if there are no tags.
-
-=cut
-
-sub cust_tag {
- my $self = shift;
- qsearch('cust_tag', { 'custnum' => $self->custnum } );
-}
-
-=item part_tag
-
-Returns any tags associated with this customer, as FS::part_tag objects,
-or an empty list if there are no tags.
-
-=cut
-
-sub part_tag {
- my $self = shift;
- map $_->part_tag, $self->cust_tag;
-}
-
-
-=item cust_class
-
-Returns the customer class, as an FS::cust_class object, or the empty string
-if there is no customer class.
-
-=cut
-
-sub cust_class {
- my $self = shift;
- if ( $self->classnum ) {
- qsearchs('cust_class', { 'classnum' => $self->classnum } );
- } else {
- return '';
- }
-}
-
-=item categoryname
-
-Returns the customer category name, or the empty string if there is no customer
-category.
-
-=cut
-
-sub categoryname {
- my $self = shift;
- my $cust_class = $self->cust_class;
- $cust_class
- ? $cust_class->categoryname
- : '';
-}
-
-=item classname
-
-Returns the customer class name, or the empty string if there is no customer
-class.
-
-=cut
-
-sub classname {
- my $self = shift;
- my $cust_class = $self->cust_class;
- $cust_class
- ? $cust_class->classname
- : '';
-}
-
-=item BILLING METHODS
-
-Documentation on billing methods has been moved to
-L<FS::cust_main::Billing>.
-
-=item REALTIME BILLING METHODS
-
-Documentation on realtime billing methods has been moved to
-L<FS::cust_main::Billing_Realtime>.
-
-=item remove_cvv
-
-Removes the I<paycvv> field from the database directly.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub remove_cvv {
- my $self = shift;
- my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
- or return dbh->errstr;
- $sth->execute($self->custnum)
- or return $sth->errstr;
- $self->paycvv('');
- '';
-}
-
-=item batch_card OPTION => VALUE...
-
-Adds a payment for this invoice to the pending credit card batch (see
-L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
-runs the payment using a realtime gateway.
-
-=cut
-
-sub batch_card {
- my ($self, %options) = @_;
-
- my $amount;
- if (exists($options{amount})) {
- $amount = $options{amount};
- }else{
- $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
- }
- return '' unless $amount > 0;
-
- my $invnum = delete $options{invnum};
- my $payby = $options{payby} || $self->payby; #still dubious
-
- if ($options{'realtime'}) {
- return $self->realtime_bop( FS::payby->payby2bop($self->payby),
- $amount,
- %options,
- );
- }
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- #this needs to handle mysql as well as Pg, like svc_acct.pm
- #(make it into a common function if folks need to do batching with mysql)
- $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
- or return "Cannot lock pay_batch: " . $dbh->errstr;
-
- my %pay_batch = (
- 'status' => 'O',
- 'payby' => FS::payby->payby2payment($payby),
- );
-
- my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
-
- unless ( $pay_batch ) {
- $pay_batch = new FS::pay_batch \%pay_batch;
- my $error = $pay_batch->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die "error creating new batch: $error\n";
- }
- }
-
- my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
- 'batchnum' => $pay_batch->batchnum,
- 'custnum' => $self->custnum,
- } );
-
- foreach (qw( address1 address2 city state zip country payby payinfo paydate
- payname )) {
- $options{$_} = '' unless exists($options{$_});
- }
-
- my $cust_pay_batch = new FS::cust_pay_batch ( {
- 'batchnum' => $pay_batch->batchnum,
- 'invnum' => $invnum || 0, # is there a better value?
- # this field should be
- # removed...
- # cust_bill_pay_batch now
- 'custnum' => $self->custnum,
- 'last' => $self->getfield('last'),
- 'first' => $self->getfield('first'),
- 'address1' => $options{address1} || $self->address1,
- 'address2' => $options{address2} || $self->address2,
- 'city' => $options{city} || $self->city,
- 'state' => $options{state} || $self->state,
- 'zip' => $options{zip} || $self->zip,
- 'country' => $options{country} || $self->country,
- 'payby' => $options{payby} || $self->payby,
- 'payinfo' => $options{payinfo} || $self->payinfo,
- 'exp' => $options{paydate} || $self->paydate,
- 'payname' => $options{payname} || $self->payname,
- 'amount' => $amount, # consolidating
- } );
-
- $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
- if $old_cust_pay_batch;
-
- my $error;
- if ($old_cust_pay_batch) {
- $error = $cust_pay_batch->replace($old_cust_pay_batch)
- } else {
- $error = $cust_pay_batch->insert;
- }
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die $error;
- }
-
- my $unapplied = $self->total_unapplied_credits
- + $self->total_unapplied_payments
- + $self->in_transit_payments;
- foreach my $cust_bill ($self->open_cust_bill) {
- #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
- my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
- 'invnum' => $cust_bill->invnum,
- 'paybatchnum' => $cust_pay_batch->paybatchnum,
- 'amount' => $cust_bill->owed,
- '_date' => time,
- };
- if ($unapplied >= $cust_bill_pay_batch->amount){
- $unapplied -= $cust_bill_pay_batch->amount;
- next;
- }else{
- $cust_bill_pay_batch->amount(sprintf ( "%.2f",
- $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
- }
- $error = $cust_bill_pay_batch->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
-=item total_owed
-
-Returns the total owed for this customer on all invoices
-(see L<FS::cust_bill/owed>).
-
-=cut
-
-sub total_owed {
- my $self = shift;
- $self->total_owed_date(2145859200); #12/31/2037
-}
-
-=item total_owed_date TIME
-
-Returns the total owed for this customer on all invoices with date earlier than
-TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
-see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=cut
-
-sub total_owed_date {
- my $self = shift;
- my $time = shift;
-
- my $custnum = $self->custnum;
-
- my $owed_sql = FS::cust_bill->owed_sql;
-
- my $sql = "
- SELECT SUM($owed_sql) FROM cust_bill
- WHERE custnum = $custnum
- AND _date <= $time
- ";
-
- sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
-
-}
-
-=item total_owed_pkgnum PKGNUM
-
-Returns the total owed on all invoices for this customer's specific package
-when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
-
-=cut
-
-sub total_owed_pkgnum {
- my( $self, $pkgnum ) = @_;
- $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
-}
-
-=item total_owed_date_pkgnum TIME PKGNUM
-
-Returns the total owed for this customer's specific package when using
-experimental package balances on all invoices with date earlier than
-TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
-see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=cut
-
-sub total_owed_date_pkgnum {
- my( $self, $time, $pkgnum ) = @_;
-
- my $total_bill = 0;
- foreach my $cust_bill (
- grep { $_->_date <= $time }
- qsearch('cust_bill', { 'custnum' => $self->custnum, } )
- ) {
- $total_bill += $cust_bill->owed_pkgnum($pkgnum);
- }
- sprintf( "%.2f", $total_bill );
-
-}
-
-=item total_paid
-
-Returns the total amount of all payments.
-
-=cut
-
-sub total_paid {
- my $self = shift;
- my $total = 0;
- $total += $_->paid foreach $self->cust_pay;
- sprintf( "%.2f", $total );
-}
-
-=item total_unapplied_credits
-
-Returns the total outstanding credit (see L<FS::cust_credit>) for this
-customer. See L<FS::cust_credit/credited>.
-
-=item total_credited
-
-Old name for total_unapplied_credits. Don't use.
-
-=cut
-
-sub total_credited {
- #carp "total_credited deprecated, use total_unapplied_credits";
- shift->total_unapplied_credits(@_);
-}
-
-sub total_unapplied_credits {
- my $self = shift;
-
- my $custnum = $self->custnum;
-
- my $unapplied_sql = FS::cust_credit->unapplied_sql;
-
- my $sql = "
- SELECT SUM($unapplied_sql) FROM cust_credit
- WHERE custnum = $custnum
- ";
-
- sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
-
-}
-
-=item total_unapplied_credits_pkgnum PKGNUM
-
-Returns the total outstanding credit (see L<FS::cust_credit>) for this
-customer. See L<FS::cust_credit/credited>.
-
-=cut
-
-sub total_unapplied_credits_pkgnum {
- my( $self, $pkgnum ) = @_;
- my $total_credit = 0;
- $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
- sprintf( "%.2f", $total_credit );
-}
-
-
-=item total_unapplied_payments
-
-Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
-See L<FS::cust_pay/unapplied>.
-
-=cut
-
-sub total_unapplied_payments {
- my $self = shift;
-
- my $custnum = $self->custnum;
-
- my $unapplied_sql = FS::cust_pay->unapplied_sql;
-
- my $sql = "
- SELECT SUM($unapplied_sql) FROM cust_pay
- WHERE custnum = $custnum
- ";
-
- sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
-
-}
-
-=item total_unapplied_payments_pkgnum PKGNUM
-
-Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
-specific package when using experimental package balances. See
-L<FS::cust_pay/unapplied>.
-
-=cut
-
-sub total_unapplied_payments_pkgnum {
- my( $self, $pkgnum ) = @_;
- my $total_unapplied = 0;
- $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
- sprintf( "%.2f", $total_unapplied );
-}
-
-
-=item total_unapplied_refunds
-
-Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
-customer. See L<FS::cust_refund/unapplied>.
-
-=cut
-
-sub total_unapplied_refunds {
- my $self = shift;
- my $custnum = $self->custnum;
-
- my $unapplied_sql = FS::cust_refund->unapplied_sql;
-
- my $sql = "
- SELECT SUM($unapplied_sql) FROM cust_refund
- WHERE custnum = $custnum
- ";
-
- sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
-
-}
-
-=item balance
-
-Returns the balance for this customer (total_owed plus total_unrefunded, minus
-total_unapplied_credits minus total_unapplied_payments).
-
-=cut
-
-sub balance {
- my $self = shift;
- $self->balance_date_range;
-}
-
-=item balance_date TIME
-
-Returns the balance for this customer, only considering invoices with date
-earlier than TIME (total_owed_date minus total_credited minus
-total_unapplied_payments). TIME is specified as a UNIX timestamp; see
-L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-=cut
-
-sub balance_date {
- my $self = shift;
- $self->balance_date_range(shift);
-}
-
-=item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
-
-Returns the balance for this customer, optionally considering invoices with
-date earlier than START_TIME, and not later than END_TIME
-(total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
-
-Times are specified as SQL fragments or numeric
-UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
-L<Date::Parse> for conversion functions. The empty string can be passed
-to disable that time constraint completely.
-
-Available options are:
-
-=over 4
-
-=item unapplied_date
-
-set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
-
-=back
-
-=cut
-
-sub balance_date_range {
- my $self = shift;
- my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
- ') FROM cust_main WHERE custnum='. $self->custnum;
- sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
-}
-
-=item balance_pkgnum PKGNUM
-
-Returns the balance for this customer's specific package when using
-experimental package balances (total_owed plus total_unrefunded, minus
-total_unapplied_credits minus total_unapplied_payments)
-
-=cut
-
-sub balance_pkgnum {
- my( $self, $pkgnum ) = @_;
-
- sprintf( "%.2f",
- $self->total_owed_pkgnum($pkgnum)
-# n/a - refunds aren't part of pkg-balances since they don't apply to invoices
-# + $self->total_unapplied_refunds_pkgnum($pkgnum)
- - $self->total_unapplied_credits_pkgnum($pkgnum)
- - $self->total_unapplied_payments_pkgnum($pkgnum)
- );
-}
-
-=item in_transit_payments
-
-Returns the total of requests for payments for this customer pending in
-batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
-
-=cut
-
-sub in_transit_payments {
- my $self = shift;
- my $in_transit_payments = 0;
- foreach my $pay_batch ( qsearch('pay_batch', {
- 'status' => 'I',
- } ) ) {
- foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
- 'batchnum' => $pay_batch->batchnum,
- 'custnum' => $self->custnum,
- } ) ) {
- $in_transit_payments += $cust_pay_batch->amount;
- }
- }
- sprintf( "%.2f", $in_transit_payments );
-}
-
-=item payment_info
-
-Returns a hash of useful information for making a payment.
-
-=over 4
-
-=item balance
-
-Current balance.
-
-=item payby
-
-'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
-'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
-'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
-
-=back
-
-For credit card transactions:
-
-=over 4
-
-=item card_type 1
-
-=item payname
-
-Exact name on card
-
-=back
-
-For electronic check transactions:
-
-=over 4
-
-=item stateid_state
-
-=back
-
-=cut
-
-sub payment_info {
- my $self = shift;
-
- my %return = ();
-
- $return{balance} = $self->balance;
-
- $return{payname} = $self->payname
- || ( $self->first. ' '. $self->get('last') );
-
- $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
-
- $return{payby} = $self->payby;
- $return{stateid_state} = $self->stateid_state;
-
- if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
- $return{card_type} = cardtype($self->payinfo);
- $return{payinfo} = $self->paymask;
-
- @return{'month', 'year'} = $self->paydate_monthyear;
-
- }
-
- if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
- my ($payinfo1, $payinfo2) = split '@', $self->paymask;
- $return{payinfo1} = $payinfo1;
- $return{payinfo2} = $payinfo2;
- $return{paytype} = $self->paytype;
- $return{paystate} = $self->paystate;
-
- }
-
- #doubleclick protection
- my $_date = time;
- $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
-
- %return;
-
-}
-
-=item paydate_monthyear
-
-Returns a two-element list consisting of the month and year of this customer's
-paydate (credit card expiration date for CARD customers)
-
-=cut
-
-sub paydate_monthyear {
- my $self = shift;
- if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
- ( $2, $1 );
- } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
- ( $1, $3 );
- } else {
- ('', '');
- }
-}
-
-=item tax_exemption TAXNAME
-
-=cut
-
-sub tax_exemption {
- my( $self, $taxname ) = @_;
-
- qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
- 'taxname' => $taxname,
- },
- );
-}
-
-=item cust_main_exemption
-
-=cut
-
-sub cust_main_exemption {
- my $self = shift;
- qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
-}
-
-=item invoicing_list [ ARRAYREF ]
-
-If an arguement is given, sets these email addresses as invoice recipients
-(see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
-(except as warnings), so use check_invoicing_list first.
-
-Returns a list of email addresses (with svcnum entries expanded).
-
-Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
-check it without disturbing anything by passing nothing.
-
-This interface may change in the future.
-
-=cut
-
-sub invoicing_list {
- my( $self, $arrayref ) = @_;
-
- if ( $arrayref ) {
- my @cust_main_invoice;
- if ( $self->custnum ) {
- @cust_main_invoice =
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- @cust_main_invoice = ();
- }
- foreach my $cust_main_invoice ( @cust_main_invoice ) {
- #warn $cust_main_invoice->destnum;
- unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
- #warn $cust_main_invoice->destnum;
- my $error = $cust_main_invoice->delete;
- warn $error if $error;
- }
- }
- if ( $self->custnum ) {
- @cust_main_invoice =
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- @cust_main_invoice = ();
- }
- my %seen = map { $_->address => 1 } @cust_main_invoice;
- foreach my $address ( @{$arrayref} ) {
- next if exists $seen{$address} && $seen{$address};
- $seen{$address} = 1;
- my $cust_main_invoice = new FS::cust_main_invoice ( {
- 'custnum' => $self->custnum,
- 'dest' => $address,
- } );
- my $error = $cust_main_invoice->insert;
- warn $error if $error;
- }
- }
-
- if ( $self->custnum ) {
- map { $_->address }
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- ();
- }
-
-}
-
-=item check_invoicing_list ARRAYREF
-
-Checks these arguements as valid input for the invoicing_list method. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub check_invoicing_list {
- my( $self, $arrayref ) = @_;
-
- foreach my $address ( @$arrayref ) {
-
- if ($address eq 'FAX' and $self->getfield('fax') eq '') {
- return 'Can\'t add FAX invoice destination with a blank FAX number.';
- }
-
- my $cust_main_invoice = new FS::cust_main_invoice ( {
- 'custnum' => $self->custnum,
- 'dest' => $address,
- } );
- my $error = $self->custnum
- ? $cust_main_invoice->check
- : $cust_main_invoice->checkdest
- ;
- return $error if $error;
-
- }
-
- return "Email address required"
- if $conf->exists('cust_main-require_invoicing_list_email')
- && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
-
- '';
-}
-
-=item set_default_invoicing_list
-
-Sets the invoicing list to all accounts associated with this customer,
-overwriting any previous invoicing list.
-
-=cut
-
-sub set_default_invoicing_list {
- my $self = shift;
- $self->invoicing_list($self->all_emails);
-}
-
-=item all_emails
-
-Returns the email addresses of all accounts provisioned for this customer.
-
-=cut
-
-sub all_emails {
- my $self = shift;
- my %list;
- foreach my $cust_pkg ( $self->all_pkgs ) {
- my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
- my @svc_acct =
- map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
- grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
- @cust_svc;
- $list{$_}=1 foreach map { $_->email } @svc_acct;
- }
- keys %list;
-}
-
-=item invoicing_list_addpost
-
-Adds postal invoicing to this customer. If this customer is already configured
-to receive postal invoices, does nothing.
-
-=cut
-
-sub invoicing_list_addpost {
- my $self = shift;
- return if grep { $_ eq 'POST' } $self->invoicing_list;
- my @invoicing_list = $self->invoicing_list;
- push @invoicing_list, 'POST';
- $self->invoicing_list(\@invoicing_list);
-}
-
-=item invoicing_list_emailonly
-
-Returns the list of email invoice recipients (invoicing_list without non-email
-destinations such as POST and FAX).
-
-=cut
-
-sub invoicing_list_emailonly {
- my $self = shift;
- warn "$me invoicing_list_emailonly called"
- if $DEBUG;
- grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
-}
-
-=item invoicing_list_emailonly_scalar
-
-Returns the list of email invoice recipients (invoicing_list without non-email
-destinations such as POST and FAX) as a comma-separated scalar.
-
-=cut
-
-sub invoicing_list_emailonly_scalar {
- my $self = shift;
- warn "$me invoicing_list_emailonly_scalar called"
- if $DEBUG;
- join(', ', $self->invoicing_list_emailonly);
-}
-
-=item referral_custnum_cust_main
-
-Returns the customer who referred this customer (or the empty string, if
-this customer was not referred).
-
-Note the difference with referral_cust_main method: This method,
-referral_custnum_cust_main returns the single customer (if any) who referred
-this customer, while referral_cust_main returns an array of customers referred
-BY this customer.
-
-=cut
-
-sub referral_custnum_cust_main {
- my $self = shift;
- return '' unless $self->referral_custnum;
- qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
-}
-
-=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
-
-Returns an array of customers referred by this customer (referral_custnum set
-to this custnum). If DEPTH is given, recurses up to the given depth, returning
-customers referred by customers referred by this customer and so on, inclusive.
-The default behavior is DEPTH 1 (no recursion).
-
-Note the difference with referral_custnum_cust_main method: This method,
-referral_cust_main, returns an array of customers referred BY this customer,
-while referral_custnum_cust_main returns the single customer (if any) who
-referred this customer.
-
-=cut
-
-sub referral_cust_main {
- my $self = shift;
- my $depth = @_ ? shift : 1;
- my $exclude = @_ ? shift : {};
-
- my @cust_main =
- map { $exclude->{$_->custnum}++; $_; }
- grep { ! $exclude->{ $_->custnum } }
- qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
-
- if ( $depth > 1 ) {
- push @cust_main,
- map { $_->referral_cust_main($depth-1, $exclude) }
- @cust_main;
- }
-
- @cust_main;
-}
-
-=item referral_cust_main_ncancelled
-
-Same as referral_cust_main, except only returns customers with uncancelled
-packages.
-
-=cut
-
-sub referral_cust_main_ncancelled {
- my $self = shift;
- grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
-}
-
-=item referral_cust_pkg [ DEPTH ]
-
-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 commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
-
-=cut
-
-sub referral_cust_pkg {
- my $self = shift;
- my $depth = @_ ? shift : 1;
-
- map { $_->unsuspended_pkgs }
- grep { $_->unsuspended_pkgs }
- $self->referral_cust_main($depth);
-}
-
-=item referring_cust_main
-
-Returns the single cust_main record for the customer who referred this customer
-(referral_custnum), or false.
-
-=cut
-
-sub referring_cust_main {
- my $self = shift;
- return '' unless $self->referral_custnum;
- qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
-}
-
-=item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
-
-Applies a credit to this customer. If there is an error, returns the error,
-otherwise returns false.
-
-REASON can be a text string, an FS::reason object, or a scalar reference to
-a reasonnum. If a text string, it will be automatically inserted as a new
-reason, and a 'reason_type' option must be passed to indicate the
-FS::reason_type for the new reason.
-
-An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
-
-Any other options are passed to FS::cust_credit::insert.
-
-=cut
-
-sub credit {
- my( $self, $amount, $reason, %options ) = @_;
-
- my $cust_credit = new FS::cust_credit {
- 'custnum' => $self->custnum,
- 'amount' => $amount,
- };
-
- if ( ref($reason) ) {
-
- if ( ref($reason) eq 'SCALAR' ) {
- $cust_credit->reasonnum( $$reason );
- } else {
- $cust_credit->reasonnum( $reason->reasonnum );
- }
-
- } else {
- $cust_credit->set('reason', $reason)
- }
-
- for (qw( addlinfo eventnum )) {
- $cust_credit->$_( delete $options{$_} )
- if exists($options{$_});
- }
-
- $cust_credit->insert(%options);
-
-}
-
-=item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
-
-Creates a one-time charge for this customer. If there is an error, returns
-the error, otherwise returns false.
-
-New-style, with a hashref of options:
-
- my $error = $cust_main->charge(
- {
- 'amount' => 54.32,
- 'quantity' => 1,
- 'start_date' => str2time('7/4/2009'),
- 'pkg' => 'Description',
- 'comment' => 'Comment',
- 'additional' => [], #extra invoice detail
- 'classnum' => 1, #pkg_class
-
- 'setuptax' => '', # or 'Y' for tax exempt
-
- #internal taxation
- 'taxclass' => 'Tax class',
-
- #vendor taxation
- 'taxproduct' => 2, #part_pkg_taxproduct
- 'override' => {}, #XXX describe
-
- #will be filled in with the new object
- 'cust_pkg_ref' => \$cust_pkg,
-
- #generate an invoice immediately
- 'bill_now' => 0,
- 'invoice_terms' => '', #with these terms
- }
- );
-
-Old-style:
-
- my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
-
-=cut
-
-sub charge {
- my $self = shift;
- my ( $amount, $quantity, $start_date, $classnum );
- my ( $pkg, $comment, $additional );
- my ( $setuptax, $taxclass ); #internal taxes
- my ( $taxproduct, $override ); #vendor (CCH) taxes
- my $no_auto = '';
- my $cust_pkg_ref = '';
- my ( $bill_now, $invoice_terms ) = ( 0, '' );
- if ( ref( $_[0] ) ) {
- $amount = $_[0]->{amount};
- $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
- $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
- $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
- $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
- $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
- : '$'. sprintf("%.2f",$amount);
- $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
- $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
- $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
- $additional = $_[0]->{additional} || [];
- $taxproduct = $_[0]->{taxproductnum};
- $override = { '' => $_[0]->{tax_override} };
- $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
- $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
- $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
- } else {
- $amount = shift;
- $quantity = 1;
- $start_date = '';
- $pkg = @_ ? shift : 'One-time charge';
- $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
- $setuptax = '';
- $taxclass = @_ ? shift : '';
- $additional = [];
- }
-
- 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 $part_pkg = new FS::part_pkg ( {
- 'pkg' => $pkg,
- 'comment' => $comment,
- 'plan' => 'flat',
- 'freq' => 0,
- 'disabled' => 'Y',
- 'classnum' => ( $classnum ? $classnum : '' ),
- 'setuptax' => $setuptax,
- 'taxclass' => $taxclass,
- 'taxproductnum' => $taxproduct,
- } );
-
- my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
- ( 0 .. @$additional - 1 )
- ),
- 'additional_count' => scalar(@$additional),
- 'setup_fee' => $amount,
- );
-
- my $error = $part_pkg->insert( options => \%options,
- tax_overrides => $override,
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- my $pkgpart = $part_pkg->pkgpart;
- my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
- unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
- my $type_pkgs = new FS::type_pkgs \%type_pkgs;
- $error = $type_pkgs->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my $cust_pkg = new FS::cust_pkg ( {
- 'custnum' => $self->custnum,
- 'pkgpart' => $pkgpart,
- 'quantity' => $quantity,
- 'start_date' => $start_date,
- 'no_auto' => $no_auto,
- } );
-
- $error = $cust_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- } elsif ( $cust_pkg_ref ) {
- ${$cust_pkg_ref} = $cust_pkg;
- }
-
- if ( $bill_now ) {
- my $error = $self->bill( 'invoice_terms' => $invoice_terms,
- 'pkg_list' => [ $cust_pkg ],
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return '';
-
-}
-
-#=item charge_postal_fee
-#
-#Applies a one time charge this customer. If there is an error,
-#returns the error, returns the cust_pkg charge object or false
-#if there was no charge.
-#
-#=cut
-#
-# This should be a customer event. For that to work requires that bill
-# also be a customer event.
-
-sub charge_postal_fee {
- my $self = shift;
-
- my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
- return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
-
- my $cust_pkg = new FS::cust_pkg ( {
- 'custnum' => $self->custnum,
- 'pkgpart' => $pkgpart,
- 'quantity' => 1,
- } );
-
- my $error = $cust_pkg->insert;
- $error ? $error : $cust_pkg;
-}
-
-=item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
-
-Returns all the invoices (see L<FS::cust_bill>) for this customer.
-
-Optionally, a list or hashref of additional arguments to the qsearch call can
-be passed.
-
-=cut
-
-sub cust_bill {
- my $self = shift;
- my $opt = ref($_[0]) ? shift : { @_ };
-
- #return $self->num_cust_bill unless wantarray || keys %$opt;
-
- $opt->{'table'} = 'cust_bill';
- $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
- $opt->{'hashref'}{'custnum'} = $self->custnum;
- $opt->{'order_by'} ||= 'ORDER BY _date ASC';
-
- map { $_ } #behavior of sort undefined in scalar context
- sort { $a->_date <=> $b->_date }
- qsearch($opt);
-}
-
-=item open_cust_bill
-
-Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
-customer.
-
-=cut
-
-sub open_cust_bill {
- my $self = shift;
-
- $self->cust_bill(
- 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
- #@_
- );
-
-}
-
-=item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
-
-Returns all the statements (see L<FS::cust_statement>) for this customer.
-
-Optionally, a list or hashref of additional arguments to the qsearch call can
-be passed.
-
-=cut
-
-sub cust_statement {
- my $self = shift;
- my $opt = ref($_[0]) ? shift : { @_ };
-
- #return $self->num_cust_statement unless wantarray || keys %$opt;
-
- $opt->{'table'} = 'cust_statement';
- $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
- $opt->{'hashref'}{'custnum'} = $self->custnum;
- $opt->{'order_by'} ||= 'ORDER BY _date ASC';
-
- map { $_ } #behavior of sort undefined in scalar context
- sort { $a->_date <=> $b->_date }
- qsearch($opt);
-}
-
-=item cust_credit
-
-Returns all the credits (see L<FS::cust_credit>) for this customer.
-
-=cut
-
-sub cust_credit {
- my $self = shift;
- map { $_ } #return $self->num_cust_credit unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
-}
-
-=item cust_credit_pkgnum
-
-Returns all the credits (see L<FS::cust_credit>) for this customer's specific
-package when using experimental package balances.
-
-=cut
-
-sub cust_credit_pkgnum {
- my( $self, $pkgnum ) = @_;
- map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_credit', { 'custnum' => $self->custnum,
- 'pkgnum' => $pkgnum,
- }
- );
-}
-
-=item cust_pay
-
-Returns all the payments (see L<FS::cust_pay>) for this customer.
-
-=cut
-
-sub cust_pay {
- my $self = shift;
- return $self->num_cust_pay unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
-}
-
-=item num_cust_pay
-
-Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
-called automatically when the cust_pay method is used in a scalar context.
-
-=cut
-
-sub num_cust_pay {
- my $self = shift;
- my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute($self->custnum) or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
-}
-
-=item cust_pay_pkgnum
-
-Returns all the payments (see L<FS::cust_pay>) for this customer's specific
-package when using experimental package balances.
-
-=cut
-
-sub cust_pay_pkgnum {
- my( $self, $pkgnum ) = @_;
- map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay', { 'custnum' => $self->custnum,
- 'pkgnum' => $pkgnum,
- }
- );
-}
-
-=item cust_pay_void
-
-Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
-
-=cut
-
-sub cust_pay_void {
- my $self = shift;
- map { $_ } #return $self->num_cust_pay_void unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
-}
-
-=item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
-
-Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
-
-Optionally, a list or hashref of additional arguments to the qsearch call can
-be passed.
-
-=cut
-
-sub cust_pay_batch {
- my $self = shift;
- my $opt = ref($_[0]) ? shift : { @_ };
-
- #return $self->num_cust_statement unless wantarray || keys %$opt;
-
- $opt->{'table'} = 'cust_pay_batch';
- $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
- $opt->{'hashref'}{'custnum'} = $self->custnum;
- $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
-
- map { $_ } #behavior of sort undefined in scalar context
- sort { $a->paybatchnum <=> $b->paybatchnum }
- qsearch($opt);
-}
-
-=item cust_pay_pending
-
-Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
-(without status "done").
-
-=cut
-
-sub cust_pay_pending {
- my $self = shift;
- return $self->num_cust_pay_pending unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay_pending', {
- 'custnum' => $self->custnum,
- 'status' => { op=>'!=', value=>'done' },
- },
- );
-}
-
-=item cust_pay_pending_attempt
-
-Returns all payment attempts / declined payments for this customer, as pending
-payments objects (see L<FS::cust_pay_pending>), with status "done" but without
-a corresponding payment (see L<FS::cust_pay>).
-
-=cut
-
-sub cust_pay_pending_attempt {
- my $self = shift;
- return $self->num_cust_pay_pending_attempt unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay_pending', {
- 'custnum' => $self->custnum,
- 'status' => 'done',
- 'paynum' => '',
- },
- );
-}
-
-=item num_cust_pay_pending
-
-Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
-customer (without status "done"). Also called automatically when the
-cust_pay_pending method is used in a scalar context.
-
-=cut
-
-sub num_cust_pay_pending {
- my $self = shift;
- $self->scalar_sql(
- " SELECT COUNT(*) FROM cust_pay_pending ".
- " WHERE custnum = ? AND status != 'done' ",
- $self->custnum
- );
-}
-
-=item num_cust_pay_pending_attempt
-
-Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
-customer, with status "done" but without a corresp. Also called automatically when the
-cust_pay_pending method is used in a scalar context.
-
-=cut
-
-sub num_cust_pay_pending_attempt {
- my $self = shift;
- $self->scalar_sql(
- " SELECT COUNT(*) FROM cust_pay_pending ".
- " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
- $self->custnum
- );
-}
-
-=item cust_refund
-
-Returns all the refunds (see L<FS::cust_refund>) for this customer.
-
-=cut
-
-sub cust_refund {
- my $self = shift;
- map { $_ } #return $self->num_cust_refund unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
-}
-
-=item display_custnum
-
-Returns the displayed customer number for this customer: agent_custid if
-cust_main-default_agent_custid is set and it has a value, custnum otherwise.
-
-=cut
-
-sub display_custnum {
- my $self = shift;
- if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
- return $self->agent_custid;
- } else {
- return $self->custnum;
- }
-}
-
-=item name
-
-Returns a name string for this customer, either "Company (Last, First)" or
-"Last, First".
-
-=cut
-
-sub name {
- my $self = shift;
- my $name = $self->contact;
- $name = $self->company. " ($name)" if $self->company;
- $name;
-}
-
-=item ship_name
-
-Returns a name string for this (service/shipping) contact, either
-"Company (Last, First)" or "Last, First".
-
-=cut
-
-sub ship_name {
- my $self = shift;
- if ( $self->get('ship_last') ) {
- my $name = $self->ship_contact;
- $name = $self->ship_company. " ($name)" if $self->ship_company;
- $name;
- } else {
- $self->name;
- }
-}
-
-=item name_short
-
-Returns a name string for this customer, either "Company" or "First Last".
-
-=cut
-
-sub name_short {
- my $self = shift;
- $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
-}
-
-=item ship_name_short
-
-Returns a name string for this (service/shipping) contact, either "Company"
-or "First Last".
-
-=cut
-
-sub ship_name_short {
- my $self = shift;
- if ( $self->get('ship_last') ) {
- $self->ship_company !~ /^\s*$/
- ? $self->ship_company
- : $self->ship_contact_firstlast;
- } else {
- $self->name_company_or_firstlast;
- }
-}
-
-=item contact
-
-Returns this customer's full (billing) contact name only, "Last, First"
-
-=cut
-
-sub contact {
- my $self = shift;
- $self->get('last'). ', '. $self->first;
-}
-
-=item ship_contact
-
-Returns this customer's full (shipping) contact name only, "Last, First"
-
-=cut
-
-sub ship_contact {
- my $self = shift;
- $self->get('ship_last')
- ? $self->get('ship_last'). ', '. $self->ship_first
- : $self->contact;
-}
-
-=item contact_firstlast
-
-Returns this customers full (billing) contact name only, "First Last".
-
-=cut
-
-sub contact_firstlast {
- my $self = shift;
- $self->first. ' '. $self->get('last');
-}
-
-=item ship_contact_firstlast
-
-Returns this customer's full (shipping) contact name only, "First Last".
-
-=cut
-
-sub ship_contact_firstlast {
- my $self = shift;
- $self->get('ship_last')
- ? $self->first. ' '. $self->get('ship_last')
- : $self->contact_firstlast;
-}
-
-=item country_full
-
-Returns this customer's full country name
-
-=cut
-
-sub country_full {
- my $self = shift;
- code2country($self->country);
-}
-
-=item geocode DATA_VENDOR
-
-Returns a value for the customer location as encoded by DATA_VENDOR.
-Currently this only makes sense for "CCH" as DATA_VENDOR.
-
-=cut
-
-=item cust_status
-
-=item status
-
-Returns a status string for this customer, currently:
-
-=over 4
-
-=item prospect - No packages have ever been ordered
-
-=item ordered - Recurring packages all are new (not yet billed).
-
-=item active - One or more recurring packages is active
-
-=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
-
-=item suspended - All non-cancelled recurring packages are suspended
-
-=item cancelled - All recurring packages are cancelled
-
-=back
-
-=cut
-
-sub status { shift->cust_status(@_); }
-
-sub cust_status {
- my $self = shift;
- for my $status ( FS::cust_main->statuses() ) {
- my $method = $status.'_sql';
- my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
- my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
- $sth->execute( ($self->custnum) x $numnum )
- or die "Error executing 'SELECT $sql': ". $sth->errstr;
- return $status if $sth->fetchrow_arrayref->[0];
- }
-}
-
-=item ucfirst_cust_status
-
-=item ucfirst_status
-
-Returns the status with the first character capitalized.
-
-=cut
-
-sub ucfirst_status { shift->ucfirst_cust_status(@_); }
-
-sub ucfirst_cust_status {
- my $self = shift;
- ucfirst($self->cust_status);
-}
-
-=item statuscolor
-
-Returns a hex triplet color string for this customer's status.
-
-=cut
-
-use vars qw(%statuscolor);
-tie %statuscolor, 'Tie::IxHash',
- 'prospect' => '7e0079', #'000000', #black? naw, purple
- 'active' => '00CC00', #green
- 'ordered' => '009999', #teal? cyan?
- 'suspended' => 'FF9900', #yellow
- 'cancelled' => 'FF0000', #red
- 'inactive' => '0000CC', #blue
-;
-
-sub statuscolor { shift->cust_statuscolor(@_); }
-
-sub cust_statuscolor {
- my $self = shift;
- $statuscolor{$self->cust_status};
-}
-
-=item tickets
-
-Returns an array of hashes representing the customer's RT tickets.
-
-=cut
-
-sub tickets {
- my $self = shift;
-
- my $num = $conf->config('cust_main-max_tickets') || 10;
- my @tickets = ();
-
- if ( $conf->config('ticket_system') ) {
- unless ( $conf->config('ticket_system-custom_priority_field') ) {
-
- @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
-
- } else {
-
- foreach my $priority (
- $conf->config('ticket_system-custom_priority_field-values'), ''
- ) {
- last if scalar(@tickets) >= $num;
- push @tickets,
- @{ FS::TicketSystem->customer_tickets( $self->custnum,
- $num - scalar(@tickets),
- $priority,
- )
- };
- }
- }
- }
- (@tickets);
-}
-
-# Return services representing svc_accts in customer support packages
-sub support_services {
- my $self = shift;
- my %packages = map { $_ => 1 } $conf->config('support_packages');
-
- grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
- grep { $_->part_svc->svcdb eq 'svc_acct' }
- map { $_->cust_svc }
- grep { exists $packages{ $_->pkgpart } }
- $self->ncancelled_pkgs;
-
-}
-
-# Return a list of latitude/longitude for one of the services (if any)
-sub service_coordinates {
- my $self = shift;
-
- my @svc_X =
- grep { $_->latitude && $_->longitude }
- map { $_->svc_x }
- map { $_->cust_svc }
- $self->ncancelled_pkgs;
-
- scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
-}
-
-=item masked FIELD
-
-Returns a masked version of the named field
-
-=cut
-
-sub masked {
-my ($self,$field) = @_;
-
-# Show last four
-
-'x'x(length($self->getfield($field))-4).
- substr($self->getfield($field), (length($self->getfield($field))-4));
-
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item statuses
-
-Class method that returns the list of possible status strings for customers
-(see L<the status method|/status>). For example:
-
- @statuses = FS::cust_main->statuses();
-
-=cut
-
-sub statuses {
- #my $self = shift; #could be class...
- keys %statuscolor;
-}
-
-=item cust_status_sql
-
-Returns an SQL fragment to determine the status of a cust_main record, as a
-string.
-
-=cut
-
-sub cust_status_sql {
- my $sql = 'CASE';
- for my $status ( FS::cust_main->statuses() ) {
- my $method = $status.'_sql';
- $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
- }
- $sql .= ' END';
- return $sql;
-}
-
-
-=item prospect_sql
-
-Returns an SQL expression identifying prospective cust_main records (customers
-with no packages ever ordered)
-
-=cut
-
-use vars qw($select_count_pkgs);
-$select_count_pkgs =
- "SELECT COUNT(*) FROM cust_pkg
- WHERE cust_pkg.custnum = cust_main.custnum";
-
-sub select_count_pkgs_sql {
- $select_count_pkgs;
-}
-
-sub prospect_sql {
- " 0 = ( $select_count_pkgs ) ";
-}
-
-=item ordered_sql
-
-Returns an SQL expression identifying ordered cust_main records (customers with
-recurring packages not yet setup).
-
-=cut
-
-sub ordered_sql {
- FS::cust_main->none_active_sql.
- " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
-}
-
-=item active_sql
-
-Returns an SQL expression identifying active cust_main records (customers with
-active recurring packages).
-
-=cut
-
-sub active_sql {
- " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
-}
-
-=item none_active_sql
-
-Returns an SQL expression identifying cust_main records with no active
-recurring packages. This includes customers of status prospect, ordered,
-inactive, and suspended.
-
-=cut
-
-sub none_active_sql {
- " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
-}
-
-=item inactive_sql
-
-Returns an SQL expression identifying inactive cust_main records (customers with
-no active recurring packages, but otherwise unsuspended/uncancelled).
-
-=cut
-
-sub inactive_sql {
- FS::cust_main->none_active_sql.
- " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
-}
-
-=item susp_sql
-=item suspended_sql
-
-Returns an SQL expression identifying suspended cust_main records.
-
-=cut
-
-
-sub suspended_sql { susp_sql(@_); }
-sub susp_sql {
- FS::cust_main->none_active_sql.
- " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
-}
-
-=item cancel_sql
-=item cancelled_sql
-
-Returns an SQL expression identifying cancelled cust_main records.
-
-=cut
-
-sub cancelled_sql { cancel_sql(@_); }
-sub cancel_sql {
-
- my $recurring_sql = FS::cust_pkg->recurring_sql;
- my $cancelled_sql = FS::cust_pkg->cancelled_sql;
-
- "
- 0 < ( $select_count_pkgs )
- AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
- AND 0 = ( $select_count_pkgs AND $recurring_sql
- AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
- )
- ";
-# AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
-
-}
-
-=item uncancel_sql
-=item uncancelled_sql
-
-Returns an SQL expression identifying un-cancelled cust_main records.
-
-=cut
-
-sub uncancelled_sql { uncancel_sql(@_); }
-sub uncancel_sql { "
- ( 0 < ( $select_count_pkgs
- AND ( cust_pkg.cancel IS NULL
- OR cust_pkg.cancel = 0
- )
- )
- OR 0 = ( $select_count_pkgs )
- )
-"; }
-
-=item balance_sql
-
-Returns an SQL fragment to retreive the balance.
-
-=cut
-
-sub balance_sql { "
- ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
- WHERE cust_bill.custnum = cust_main.custnum )
- - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
- WHERE cust_pay.custnum = cust_main.custnum )
- - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
- WHERE cust_credit.custnum = cust_main.custnum )
- + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
- WHERE cust_refund.custnum = cust_main.custnum )
-"; }
-
-=item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
-
-Returns an SQL fragment to retreive the balance for this customer, optionally
-considering invoices with date earlier than START_TIME, and not
-later than END_TIME (total_owed_date minus total_unapplied_credits minus
-total_unapplied_payments).
-
-Times are specified as SQL fragments or numeric
-UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
-L<Date::Parse> for conversion functions. The empty string can be passed
-to disable that time constraint completely.
-
-Available options are:
-
-=over 4
-
-=item unapplied_date
-
-set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
-
-=item total
-
-(unused. obsolete?)
-set to true to remove all customer comparison clauses, for totals
-
-=item where
-
-(unused. obsolete?)
-WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
-
-=item join
-
-(unused. obsolete?)
-JOIN clause (typically used with the total option)
-
-=item cutoff
-
-An absolute cutoff time. Payments, credits, and refunds I<applied> after this
-time will be ignored. Note that START_TIME and END_TIME only limit the date
-range for invoices and I<unapplied> payments, credits, and refunds.
-
-=back
-
-=cut
-
-sub balance_date_sql {
- my( $class, $start, $end, %opt ) = @_;
-
- my $cutoff = $opt{'cutoff'};
-
- my $owed = FS::cust_bill->owed_sql($cutoff);
- my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
- my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
- my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
-
- my $j = $opt{'join'} || '';
-
- my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
- my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
- my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
- my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
-
- " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
- + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
- - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
- - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
- ";
-
-}
-
-=item unapplied_payments_date_sql START_TIME [ END_TIME ]
-
-Returns an SQL fragment to retreive the total unapplied payments for this
-customer, only considering invoices with date earlier than START_TIME, and
-optionally not later than END_TIME.
-
-Times are specified as SQL fragments or numeric
-UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
-L<Date::Parse> for conversion functions. The empty string can be passed
-to disable that time constraint completely.
-
-Available options are:
-
-=cut
-
-sub unapplied_payments_date_sql {
- my( $class, $start, $end, %opt ) = @_;
-
- my $cutoff = $opt{'cutoff'};
-
- my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
-
- my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
- 'unapplied_date'=>1 );
-
- " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
-}
-
-=item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
-
-Helper method for balance_date_sql; name (and usage) subject to change
-(suggestions welcome).
-
-Returns a WHERE clause for the specified monetary TABLE (cust_bill,
-cust_refund, cust_credit or cust_pay).
-
-If TABLE is "cust_bill" or the unapplied_date option is true, only
-considers records with date earlier than START_TIME, and optionally not
-later than END_TIME .
-
-=cut
-
-sub _money_table_where {
- my( $class, $table, $start, $end, %opt ) = @_;
-
- my @where = ();
- push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
- if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
- push @where, "$table._date <= $start" if defined($start) && length($start);
- push @where, "$table._date > $end" if defined($end) && length($end);
- }
- push @where, @{$opt{'where'}} if $opt{'where'};
- my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
-
- $where;
-
-}
-
-#for dyanmic FS::$table->search in httemplate/misc/email_customers.html
-use FS::cust_main::Search;
-sub search {
- my $class = shift;
- FS::cust_main::Search->search(@_);
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
-
-=cut
-
-use FS::cust_main::Search;
-sub append_fuzzyfiles {
- #my( $first, $last, $company ) = @_;
-
- FS::cust_main::Search::check_and_rebuild_fuzzyfiles();
-
- use Fcntl qw(:flock);
-
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
-
- foreach my $field (@fuzzyfields) {
- my $value = shift;
-
- if ( $value ) {
-
- open(CACHE,">>$dir/cust_main.$field")
- or die "can't open $dir/cust_main.$field: $!";
- flock(CACHE,LOCK_EX)
- or die "can't lock $dir/cust_main.$field: $!";
-
- print CACHE "$value\n";
-
- flock(CACHE,LOCK_UN)
- or die "can't unlock $dir/cust_main.$field: $!";
- close CACHE;
- }
-
- }
-
- 1;
-}
-
-=item batch_charge
-
-=cut
-
-sub batch_charge {
- my $param = shift;
- #warn join('-',keys %$param);
- my $fh = $param->{filehandle};
- my $agentnum = $param->{agentnum};
- my $format = $param->{format};
-
- my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
-
- my @fields;
- if ( $format eq 'simple' ) {
- @fields = qw( custnum agent_custid amount pkg );
- } else {
- die "unknown format $format";
- }
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
-
- my $csv = new Text::CSV_XS;
- #warn $csv;
- #warn $fh;
-
- my $imported = 0;
- #my $columns;
-
- 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;
-
- #while ( $columns = $csv->getline($fh) ) {
- my $line;
- while ( defined($line=<$fh>) ) {
-
- $csv->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $csv->error_input();
- };
-
- my @columns = $csv->fields();
- #warn join('-',@columns);
-
- my %row = ();
- foreach my $field ( @fields ) {
- $row{$field} = shift @columns;
- }
-
- if ( $row{custnum} && $row{agent_custid} ) {
- dbh->rollback if $oldAutoCommit;
- return "can't specify custnum with agent_custid $row{agent_custid}";
- }
-
- my %hash = ();
- if ( $row{agent_custid} && $agentnum ) {
- %hash = ( 'agent_custid' => $row{agent_custid},
- 'agentnum' => $agentnum,
- );
- }
-
- if ( $row{custnum} ) {
- %hash = ( 'custnum' => $row{custnum} );
- }
-
- unless ( scalar(keys %hash) ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't find customer without custnum or agent_custid and agentnum";
- }
-
- my $cust_main = qsearchs('cust_main', { %hash } );
- unless ( $cust_main ) {
- $dbh->rollback if $oldAutoCommit;
- my $custnum = $row{custnum} || $row{agent_custid};
- return "unknown custnum $custnum";
- }
-
- if ( $row{'amount'} > 0 ) {
- my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $imported++;
- } elsif ( $row{'amount'} < 0 ) {
- my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
- $row{'pkg'} );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $imported++;
- } else {
- #hmm?
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return "Empty file!" unless $imported;
-
- ''; #no error
-
-}
-
-=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
-
-Deprecated. Use event notification and message templates
-(L<FS::msg_template>) instead.
-
-Sends a templated email notification to the customer (see L<Text::Template>).
-
-OPTIONS is a hash and may include
-
-I<from> - the email sender (default is invoice_from)
-
-I<to> - comma-separated scalar or arrayref of recipients
- (default is invoicing_list)
-
-I<subject> - The subject line of the sent email notification
- (default is "Notice from company_name")
-
-I<extra_fields> - a hashref of name/value pairs which will be substituted
- into the template
-
-The following variables are vavailable in the template.
-
-I<$first> - the customer first name
-I<$last> - the customer last name
-I<$company> - the customer company
-I<$payby> - a description of the method of payment for the customer
- # would be nice to use FS::payby::shortname
-I<$payinfo> - the account information used to collect for this customer
-I<$expdate> - the expiration of the customer payment in seconds from epoch
-
-=cut
-
-sub notify {
- my ($self, $template, %options) = @_;
-
- return unless $conf->exists($template);
-
- my $from = $conf->config('invoice_from', $self->agentnum)
- if $conf->exists('invoice_from', $self->agentnum);
- $from = $options{from} if exists($options{from});
-
- my $to = join(',', $self->invoicing_list_emailonly);
- $to = $options{to} if exists($options{to});
-
- my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
- if $conf->exists('company_name', $self->agentnum);
- $subject = $options{subject} if exists($options{subject});
-
- my $notify_template = new Text::Template (TYPE => 'ARRAY',
- SOURCE => [ map "$_\n",
- $conf->config($template)]
- )
- or die "can't create new Text::Template object: Text::Template::ERROR";
- $notify_template->compile()
- or die "can't compile template: Text::Template::ERROR";
-
- $FS::notify_template::_template::company_name =
- $conf->config('company_name', $self->agentnum);
- $FS::notify_template::_template::company_address =
- join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
-
- my $paydate = $self->paydate || '2037-12-31';
- $FS::notify_template::_template::first = $self->first;
- $FS::notify_template::_template::last = $self->last;
- $FS::notify_template::_template::company = $self->company;
- $FS::notify_template::_template::payinfo = $self->mask_payinfo;
- my $payby = $self->payby;
- my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
- my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
-
- #credit cards expire at the end of the month/year of their exp date
- if ($payby eq 'CARD' || $payby eq 'DCRD') {
- $FS::notify_template::_template::payby = 'credit card';
- ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
- $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
- $expire_time--;
- }elsif ($payby eq 'COMP') {
- $FS::notify_template::_template::payby = 'complimentary account';
- }else{
- $FS::notify_template::_template::payby = 'current method';
- }
- $FS::notify_template::_template::expdate = $expire_time;
-
- for (keys %{$options{extra_fields}}){
- no strict "refs";
- ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
- }
-
- send_email(from => $from,
- to => $to,
- subject => $subject,
- body => $notify_template->fill_in( PACKAGE =>
- 'FS::notify_template::_template' ),
- );
-
-}
-
-=item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
-
-Generates a templated notification to the customer (see L<Text::Template>).
-
-OPTIONS is a hash and may include
-
-I<extra_fields> - a hashref of name/value pairs which will be substituted
- into the template. These values may override values mentioned below
- and those from the customer record.
-
-The following variables are available in the template instead of or in addition
-to the fields of the customer record.
-
-I<$payby> - a description of the method of payment for the customer
- # would be nice to use FS::payby::shortname
-I<$payinfo> - the masked account information used to collect for this customer
-I<$expdate> - the expiration of the customer payment method in seconds from epoch
-I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
-
-=cut
-
-# a lot like cust_bill::print_latex
-sub generate_letter {
- my ($self, $template, %options) = @_;
-
- return unless $conf->exists($template);
-
- my $letter_template = new Text::Template
- ( TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", $conf->config($template)],
- DELIMITERS => [ '[@--', '--@]' ],
- )
- or die "can't create new Text::Template object: Text::Template::ERROR";
-
- $letter_template->compile()
- or die "can't compile template: Text::Template::ERROR";
-
- my %letter_data = map { $_ => $self->$_ } $self->fields;
- $letter_data{payinfo} = $self->mask_payinfo;
-
- #my $paydate = $self->paydate || '2037-12-31';
- my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
-
- my $payby = $self->payby;
- my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
- my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
-
- #credit cards expire at the end of the month/year of their exp date
- if ($payby eq 'CARD' || $payby eq 'DCRD') {
- $letter_data{payby} = 'credit card';
- ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
- $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
- $expire_time--;
- }elsif ($payby eq 'COMP') {
- $letter_data{payby} = 'complimentary account';
- }else{
- $letter_data{payby} = 'current method';
- }
- $letter_data{expdate} = $expire_time;
-
- for (keys %{$options{extra_fields}}){
- $letter_data{$_} = $options{extra_fields}->{$_};
- }
-
- unless(exists($letter_data{returnaddress})){
- my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
- $self->agent_template)
- );
- if ( length($retadd) ) {
- $letter_data{returnaddress} = $retadd;
- } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
- $letter_data{returnaddress} =
- join( "\n", map { s/( {2,})/'~' x length($1)/eg;
- s/$/\\\\\*/;
- $_;
- }
- ( $conf->config('company_name', $self->agentnum),
- $conf->config('company_address', $self->agentnum),
- )
- );
- } else {
- $letter_data{returnaddress} = '~';
- }
- }
-
- $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
-
- $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
-
- my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
-
- my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
- DIR => $dir,
- SUFFIX => '.eps',
- UNLINK => 0,
- ) or die "can't open temp file: $!\n";
- print $lh $conf->config_binary('logo.eps', $self->agentnum)
- or die "can't write temp file: $!\n";
- close $lh;
- $letter_data{'logo_file'} = $lh->filename;
-
- my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
- DIR => $dir,
- SUFFIX => '.tex',
- UNLINK => 0,
- ) or die "can't open temp file: $!\n";
-
- $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
- close $fh;
- $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
- return ($1, $letter_data{'logo_file'});
-
-}
-
-=item print_ps TEMPLATE
-
-Returns an postscript letter filled in from TEMPLATE, as a scalar.
-
-=cut
-
-sub print_ps {
- my $self = shift;
- my($file, $lfile) = $self->generate_letter(@_);
- my $ps = FS::Misc::generate_ps($file);
- unlink($file.'.tex');
- unlink($lfile);
-
- $ps;
-}
-
-=item print TEMPLATE
-
-Prints the filled in template.
-
-TEMPLATE is the name of a L<Text::Template> to fill in and print.
-
-=cut
-
-sub queueable_print {
- my %opt = @_;
-
- my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
- or die "invalid customer number: " . $opt{custvnum};
-
- my $error = $self->print( $opt{template} );
- die $error if $error;
-}
-
-sub print {
- my ($self, $template) = (shift, shift);
- do_print [ $self->print_ps($template) ];
-}
-
-#these three subs should just go away once agent stuff is all config overrides
-
-sub agent_template {
- my $self = shift;
- $self->_agent_plandata('agent_templatename');
-}
-
-sub agent_invoice_from {
- my $self = shift;
- $self->_agent_plandata('agent_invoice_from');
-}
-
-sub _agent_plandata {
- my( $self, $option ) = @_;
-
- #yuck. this whole thing needs to be reconciled better with 1.9's idea of
- #agent-specific Conf
-
- use FS::part_event::Condition;
-
- my $agentnum = $self->agentnum;
-
- my $regexp = regexp_sql();
-
- my $part_event_option =
- qsearchs({
- 'select' => 'part_event_option.*',
- 'table' => 'part_event_option',
- 'addl_from' => q{
- LEFT JOIN part_event USING ( eventpart )
- LEFT JOIN part_event_option AS peo_agentnum
- ON ( part_event.eventpart = peo_agentnum.eventpart
- AND peo_agentnum.optionname = 'agentnum'
- AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
- )
- LEFT JOIN part_event_condition
- ON ( part_event.eventpart = part_event_condition.eventpart
- AND part_event_condition.conditionname = 'cust_bill_age'
- )
- LEFT JOIN part_event_condition_option
- ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
- AND part_event_condition_option.optionname = 'age'
- )
- },
- #'hashref' => { 'optionname' => $option },
- #'hashref' => { 'part_event_option.optionname' => $option },
- 'extra_sql' =>
- " WHERE part_event_option.optionname = ". dbh->quote($option).
- " AND action = 'cust_bill_send_agent' ".
- " AND ( disabled IS NULL OR disabled != 'Y' ) ".
- " AND peo_agentnum.optionname = 'agentnum' ".
- " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
- " ORDER BY
- CASE WHEN part_event_condition_option.optionname IS NULL
- THEN -1
- ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
- " END
- , part_event.weight".
- " LIMIT 1"
- });
-
- unless ( $part_event_option ) {
- return $self->agent->invoice_template || ''
- if $option eq 'agent_templatename';
- return '';
- }
-
- $part_event_option->optionvalue;
-
-}
-
-=item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
-
-Subroutine (not a method), designed to be called from the queue.
-
-Takes a list of options and values.
-
-Pulls up the customer record via the custnum option and calls bill_and_collect.
-
-=cut
-
-sub queued_bill {
- my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
-
- my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
- warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
-
- $cust_main->bill_and_collect( %args );
-}
-
-sub process_bill_and_collect {
- my $job = shift;
- my $param = thaw(decode_base64(shift));
- my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
- or die "custnum '$param->{custnum}' not found!\n";
- $param->{'job'} = $job;
- $param->{'fatal'} = 1; # runs from job queue, will be caught
- $param->{'retry'} = 1;
-
- $cust_main->bill_and_collect( %$param );
-}
-
-sub _upgrade_data { #class method
- my ($class, %opts) = @_;
-
- my @statements = (
- 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
- 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL',
- );
- # fix yyyy-m-dd formatted paydates
- if ( driver_name =~ /^mysql$/i ) {
- push @statements,
- "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
- }
- else { # the SQL standard
- push @statements,
- "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
- }
-
- foreach my $sql ( @statements ) {
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
- }
-
- local($ignore_expired_card) = 1;
- local($ignore_illegal_zip) = 1;
- local($ignore_banned_card) = 1;
- local($skip_fuzzyfiles) = 1;
- $class->_upgrade_otaker(%opts);
-
-}
-
-=back
-
-=head1 BUGS
-
-The delete method.
-
-The delete method should possibly take an FS::cust_main object reference
-instead of a scalar customer number.
-
-Bill and collect options should probably be passed as references instead of a
-list.
-
-There should probably be a configuration file with a list of allowed credit
-card types.
-
-No multiple currency support (probably a larger project than just this module).
-
-payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
-
-Birthdates rely on negative epoch values.
-
-The payby for card/check batches is broken. With mixed batching, bad
-things will happen.
-
-B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
-L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
-L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm
deleted file mode 100644
index 9fa1e41..0000000
--- a/FS/FS/cust_main/Billing.pm
+++ /dev/null
@@ -1,2111 +0,0 @@
-package FS::cust_main::Billing;
-
-use strict;
-use vars qw( $conf $DEBUG $me );
-use Carp;
-use Data::Dumper;
-use List::Util qw( min );
-use FS::UID qw( dbh );
-use FS::Record qw( qsearch qsearchs dbdef );
-use FS::cust_bill;
-use FS::cust_bill_pkg;
-use FS::cust_bill_pkg_display;
-use FS::cust_bill_pay;
-use FS::cust_credit_bill;
-use FS::cust_tax_adjustment;
-use FS::tax_rate;
-use FS::tax_rate_location;
-use FS::cust_bill_pkg_tax_location;
-use FS::cust_bill_pkg_tax_rate_location;
-use FS::part_event;
-use FS::part_event_condition;
-use FS::pkg_category;
-
-# 1 is mostly method/subroutine entry and options
-# 2 traces progress of some operations
-# 3 is even more information including possibly sensitive data
-$DEBUG = 0;
-$me = '[FS::cust_main::Billing]';
-
-install_callback FS::UID sub {
- $conf = new FS::Conf;
- #yes, need it for stuff below (prolly should be cached)
-};
-
-=head1 NAME
-
-FS::cust_main::Billing - Billing mixin for cust_main
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-These methods are available on FS::cust_main objects.
-
-=head1 METHODS
-
-=over 4
-
-=item bill_and_collect
-
-Cancels and suspends any packages due, generates bills, applies payments and
-credits, and applies collection events to run cards, send bills and notices,
-etc.
-
-By default, warns on errors and continues with the next operation (but see the
-"fatal" flag below).
-
-Options are passed as name-value pairs. Currently available options are:
-
-=over 4
-
-=item time
-
-Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example:
-
- use Date::Parse;
- ...
- $cust_main->bill( 'time' => str2time('April 20th, 2001') );
-
-=item invoice_time
-
-Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
-
-=item check_freq
-
-"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
-
-=item resetup
-
-If set true, re-charges setup fees.
-
-=item fatal
-
-If set any errors prevent subsequent operations from continusing. If set
-specifically to "return", returns the error (or false, if there is no error).
-Any other true value causes errors to die.
-
-=item debug
-
-Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
-
-=item job
-
-Optional FS::queue entry to receive status updates.
-
-=back
-
-Options are passed to the B<bill> and B<collect> methods verbatim, so all
-options of those methods are also available.
-
-=cut
-
-sub bill_and_collect {
- my( $self, %options ) = @_;
-
- my $error;
-
- #$options{actual_time} not $options{time} because freeside-daily -d is for
- #pre-printing invoices
-
- $options{'actual_time'} ||= time;
- my $job = $options{'job'};
-
- $job->update_statustext('0,cleaning expired packages') if $job;
- $error = $self->cancel_expired_pkgs( $options{actual_time} );
- if ( $error ) {
- $error = "Error expiring custnum ". $self->custnum. ": $error";
- if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
- elsif ( $options{fatal} ) { die $error; }
- else { warn $error; }
- }
-
- $error = $self->suspend_adjourned_pkgs( $options{actual_time} );
- if ( $error ) {
- $error = "Error adjourning custnum ". $self->custnum. ": $error";
- if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
- elsif ( $options{fatal} ) { die $error; }
- else { warn $error; }
- }
-
- $job->update_statustext('20,billing packages') if $job;
- $error = $self->bill( %options );
- if ( $error ) {
- $error = "Error billing custnum ". $self->custnum. ": $error";
- if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
- elsif ( $options{fatal} ) { die $error; }
- else { warn $error; }
- }
-
- $job->update_statustext('50,applying payments and credits') if $job;
- $error = $self->apply_payments_and_credits;
- if ( $error ) {
- $error = "Error applying custnum ". $self->custnum. ": $error";
- if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
- elsif ( $options{fatal} ) { die $error; }
- else { warn $error; }
- }
-
- $job->update_statustext('70,running collection events') if $job;
- unless ( $conf->exists('cancelled_cust-noevents')
- && ! $self->num_ncancelled_pkgs
- ) {
- $error = $self->collect( %options );
- if ( $error ) {
- $error = "Error collecting custnum ". $self->custnum. ": $error";
- if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
- elsif ($options{fatal} ) { die $error; }
- else { warn $error; }
- }
- }
- $job->update_statustext('100,finished') if $job;
-
- '';
-
-}
-
-sub cancel_expired_pkgs {
- my ( $self, $time, %options ) = @_;
-
- my @cancel_pkgs = $self->ncancelled_pkgs( {
- 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
- } );
-
- my @errors = ();
-
- foreach my $cust_pkg ( @cancel_pkgs ) {
- my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
- my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
- 'reason_otaker' => $cpr->otaker
- )
- : ()
- );
- push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
- }
-
- scalar(@errors) ? join(' / ', @errors) : '';
-
-}
-
-sub suspend_adjourned_pkgs {
- my ( $self, $time, %options ) = @_;
-
- my @susp_pkgs = $self->ncancelled_pkgs( {
- 'extra_sql' =>
- " AND ( susp IS NULL OR susp = 0 )
- AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
- OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
- )
- ",
- } );
-
- #only because there's no SQL test for is_prepaid :/
- @susp_pkgs =
- grep { ( $_->part_pkg->is_prepaid
- && $_->bill
- && $_->bill < $time
- )
- || ( $_->adjourn
- && $_->adjourn <= $time
- )
-
- }
- @susp_pkgs;
-
- my @errors = ();
-
- foreach my $cust_pkg ( @susp_pkgs ) {
- my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
- if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
- my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
- 'reason_otaker' => $cpr->otaker
- )
- : ()
- );
- push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
- }
-
- scalar(@errors) ? join(' / ', @errors) : '';
-
-}
-
-=item bill OPTIONS
-
-Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
-conjunction with the collect method by calling B<bill_and_collect>.
-
-If there is an error, returns the error, otherwise returns false.
-
-Options are passed as name-value pairs. Currently available options are:
-
-=over 4
-
-=item resetup
-
-If set true, re-charges setup fees.
-
-=item recurring_only
-
-If set true then only bill recurring charges, not setup, usage, one time
-charges, etc.
-
-=item freq_override
-
-If set, then override the normal frequency and look for a part_pkg_discount
-to take at that frequency.
-
-=item time
-
-Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example:
-
- use Date::Parse;
- ...
- $cust_main->bill( 'time' => str2time('April 20th, 2001') );
-
-=item pkg_list
-
-An array ref of specific packages (objects) to attempt billing, instead trying all of them.
-
- $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
-
-=item not_pkgpart
-
-A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
-
-=item invoice_time
-
-Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
-
-=item cancel
-
-This boolean value informs the us that the package is being cancelled. This
-typically might mean not charging the normal recurring fee but only usage
-fees since the last billing. Setup charges may be charged. Not all package
-plans support this feature (they tend to charge 0).
-
-=item no_usage_reset
-
-Prevent the resetting of usage limits during this call.
-
-=item no_commit
-
-Do not save the generated bill in the database. Useful with return_bill
-
-=item return_bill
-
-A list reference on which the generated bill(s) will be returned.
-
-=item invoice_terms
-
-Optional terms to be printed on this invoice. Otherwise, customer-specific
-terms or the default terms are used.
-
-=back
-
-=cut
-
-sub bill {
- my( $self, %options ) = @_;
-
- return '' if $self->payby eq 'COMP';
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- warn "$me bill customer ". $self->custnum. "\n"
- if $DEBUG;
-
- my $time = $options{'time'} || time;
- my $invoice_time = $options{'invoice_time'} || $time;
-
- $options{'not_pkgpart'} ||= {};
- $options{'not_pkgpart'} = { map { $_ => 1 }
- split(/\s*,\s*/, $options{'not_pkgpart'})
- }
- unless ref($options{'not_pkgpart'});
-
- 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;
-
- warn "$me acquiring lock on customer ". $self->custnum. "\n"
- if $DEBUG;
-
- $self->select_for_update; #mutex
-
- warn "$me running pre-bill events for customer ". $self->custnum. "\n"
- if $DEBUG;
-
- my $error = $self->do_cust_event(
- 'debug' => ( $options{'debug'} || 0 ),
- 'time' => $invoice_time,
- 'check_freq' => $options{'check_freq'},
- 'stage' => 'pre-bill',
- )
- unless $options{no_commit};
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit && !$options{no_commit};
- return $error;
- }
-
- warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
- if $DEBUG;
-
- #keep auto-charge and non-auto-charge line items separate
- my @passes = ( '', 'no_auto' );
-
- my %cust_bill_pkg = map { $_ => [] } @passes;
-
- ###
- # find the packages which are due for billing, find out how much they are
- # & generate invoice database.
- ###
-
- my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
- my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
-
- my %taxlisthash = map { $_ => {} } @passes;
-
- my @precommit_hooks = ();
-
- $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
- foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
-
- next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
-
- warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
-
- #? to avoid use of uninitialized value errors... ?
- $cust_pkg->setfield('bill', '')
- unless defined($cust_pkg->bill);
-
- #my $part_pkg = $cust_pkg->part_pkg;
-
- my $real_pkgpart = $cust_pkg->pkgpart;
- my %hash = $cust_pkg->hash;
-
- # we could implement this bit as FS::part_pkg::has_hidden, but we already
- # suffer from performance issues
- $options{has_hidden} = 0;
- my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
- $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
-
- foreach my $part_pkg ( @part_pkg ) {
-
- $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
-
- my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
-
- my $error =
- $self->_make_lines( 'part_pkg' => $part_pkg,
- 'cust_pkg' => $cust_pkg,
- 'precommit_hooks' => \@precommit_hooks,
- 'line_items' => $cust_bill_pkg{$pass},
- 'setup' => $total_setup{$pass},
- 'recur' => $total_recur{$pass},
- 'tax_matrix' => $taxlisthash{$pass},
- 'time' => $time,
- 'real_pkgpart' => $real_pkgpart,
- 'options' => \%options,
- );
- if ($error) {
- $dbh->rollback if $oldAutoCommit && !$options{no_commit};
- return $error;
- }
-
- } #foreach my $part_pkg
-
- } #foreach my $cust_pkg
-
- #if the customer isn't on an automatic payby, everything can go on a single
- #invoice anyway?
- #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
- #merge everything into one list
- #}
-
- foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
-
- my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
-
- next unless @cust_bill_pkg; #don't create an invoice w/o line items
-
- warn "$me billing pass $pass\n"
- #.Dumper(\@cust_bill_pkg)."\n"
- if $DEBUG > 2;
-
- if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
- !$conf->exists('postal_invoice-recurring_only')
- )
- {
-
- my $postal_pkg = $self->charge_postal_fee();
- if ( $postal_pkg && !ref( $postal_pkg ) ) {
-
- $dbh->rollback if $oldAutoCommit && !$options{no_commit};
- return "can't charge postal invoice fee for customer ".
- $self->custnum. ": $postal_pkg";
-
- } elsif ( $postal_pkg ) {
-
- my $real_pkgpart = $postal_pkg->pkgpart;
- # we could implement this bit as FS::part_pkg::has_hidden, but we already
- # suffer from performance issues
- $options{has_hidden} = 0;
- my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
- $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
-
- foreach my $part_pkg ( @part_pkg ) {
- my %postal_options = %options;
- delete $postal_options{cancel};
- my $error =
- $self->_make_lines( 'part_pkg' => $part_pkg,
- 'cust_pkg' => $postal_pkg,
- 'precommit_hooks' => \@precommit_hooks,
- 'line_items' => \@cust_bill_pkg,
- 'setup' => $total_setup{$pass},
- 'recur' => $total_recur{$pass},
- 'tax_matrix' => $taxlisthash{$pass},
- 'time' => $time,
- 'real_pkgpart' => $real_pkgpart,
- 'options' => \%postal_options,
- );
- if ($error) {
- $dbh->rollback if $oldAutoCommit && !$options{no_commit};
- return $error;
- }
- }
-
- # it's silly to have a zero value postal_pkg, but....
- @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
-
- }
-
- }
-
- my $listref_or_error =
- $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
-
- unless ( ref( $listref_or_error ) ) {
- $dbh->rollback if $oldAutoCommit && !$options{no_commit};
- return $listref_or_error;
- }
-
- foreach my $taxline ( @$listref_or_error ) {
- ${ $total_setup{$pass} } =
- sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
- push @cust_bill_pkg, $taxline;
- }
-
- #add tax adjustments
- warn "adding tax adjustments...\n" if $DEBUG > 2;
- foreach my $cust_tax_adjustment (
- qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
- 'billpkgnum' => '',
- }
- )
- ) {
-
- my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
-
- my $itemdesc = $cust_tax_adjustment->taxname;
- $itemdesc = '' if $itemdesc eq 'Tax';
-
- push @cust_bill_pkg, new FS::cust_bill_pkg {
- 'pkgnum' => 0,
- 'setup' => $tax,
- 'recur' => 0,
- 'sdate' => '',
- 'edate' => '',
- 'itemdesc' => $itemdesc,
- 'itemcomment' => $cust_tax_adjustment->comment,
- 'cust_tax_adjustment' => $cust_tax_adjustment,
- #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
- };
-
- }
-
- my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
-
- my @cust_bill = $self->cust_bill;
- my $balance = $self->balance;
- my $previous_balance = scalar(@cust_bill)
- ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
- : 0;
-
- $previous_balance += $cust_bill[$#cust_bill]->charged
- if scalar(@cust_bill);
- #my $balance_adjustments =
- # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
-
- warn "creating the new invoice\n" if $DEBUG;
- #create the new invoice
- my $cust_bill = new FS::cust_bill ( {
- 'custnum' => $self->custnum,
- '_date' => ( $invoice_time ),
- 'charged' => $charged,
- 'billing_balance' => $balance,
- 'previous_balance' => $previous_balance,
- 'invoice_terms' => $options{'invoice_terms'},
- 'cust_bill_pkg' => \@cust_bill_pkg,
- } );
- $error = $cust_bill->insert unless $options{no_commit};
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit && !$options{no_commit};
- return "can't create invoice for customer #". $self->custnum. ": $error";
- }
- push @{$options{return_bill}}, $cust_bill if $options{return_bill};
-
- } #foreach my $pass ( keys %cust_bill_pkg )
-
- foreach my $hook ( @precommit_hooks ) {
- eval {
- &{$hook}; #($self) ?
- } unless $options{no_commit};
- if ( $@ ) {
- $dbh->rollback if $oldAutoCommit && !$options{no_commit};
- return "$@ running precommit hook $hook\n";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
-
- ''; #no error
-}
-
-#discard bundled packages of 0 value
-sub _omit_zero_value_bundles {
-
- my @cust_bill_pkg = ();
- my @cust_bill_pkg_bundle = ();
- my $sum = 0;
-
- foreach my $cust_bill_pkg ( @_ ) {
- if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
- push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
- @cust_bill_pkg_bundle = ();
- $sum = 0;
- }
- $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
- push @cust_bill_pkg_bundle, $cust_bill_pkg;
- }
- push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
-
- (@cust_bill_pkg);
-
-}
-
-=item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
-
-This is a weird one. Perhaps it should not even be exposed.
-
-Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
-Usually used internally by bill method B<bill>.
-
-If there is an error, returns the error, otherwise returns reference to a
-list of line items suitable for insertion.
-
-=over 4
-
-=item LINEITEMREF
-
-An array ref of the line items being billed.
-
-=item TAXHASHREF
-
-A strange beast. The keys to this hash are internal identifiers consisting
-of the name of the tax object type, a space, and its unique identifier ( e.g.
- 'cust_main_county 23' ). The values of the hash are listrefs. The first
-item in the list is the tax object. The remaining items are either line
-items or floating point values (currency amounts).
-
-The taxes are calculated on this entity. Calculated exemption records are
-transferred to the LINEITEMREF items on the assumption that they are related.
-
-Read the source.
-
-=item INVOICE_TIME
-
-This specifies the date appearing on the associated invoice. Some
-jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
-
-=back
-
-=cut
-
-sub calculate_taxes {
- my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- warn "$me calculate_taxes\n"
- #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n"
- if $DEBUG > 2;
-
- my @tax_line_items = ();
-
- # keys are tax names (as printed on invoices / itemdesc )
- # values are listrefs of taxlisthash keys (internal identifiers)
- my %taxname = ();
-
- # keys are taxlisthash keys (internal identifiers)
- # values are (cumulative) amounts
- my %tax = ();
-
- # keys are taxlisthash keys (internal identifiers)
- # values are listrefs of cust_bill_pkg_tax_location hashrefs
- my %tax_location = ();
-
- # keys are taxlisthash keys (internal identifiers)
- # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
- my %tax_rate_location = ();
-
- foreach my $tax ( keys %$taxlisthash ) {
- my $tax_object = shift @{ $taxlisthash->{$tax} };
- warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
- warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
- my $hashref_or_error =
- $tax_object->taxline( $taxlisthash->{$tax},
- 'custnum' => $self->custnum,
- 'invoice_time' => $invoice_time
- );
- return $hashref_or_error unless ref($hashref_or_error);
-
- unshift @{ $taxlisthash->{$tax} }, $tax_object;
-
- my $name = $hashref_or_error->{'name'};
- my $amount = $hashref_or_error->{'amount'};
-
- #warn "adding $amount as $name\n";
- $taxname{ $name } ||= [];
- push @{ $taxname{ $name } }, $tax;
-
- $tax{ $tax } += $amount;
-
- $tax_location{ $tax } ||= [];
- if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
- push @{ $tax_location{ $tax } },
- {
- 'taxnum' => $tax_object->taxnum,
- 'taxtype' => ref($tax_object),
- 'pkgnum' => $tax_object->get('pkgnum'),
- 'locationnum' => $tax_object->get('locationnum'),
- 'amount' => sprintf('%.2f', $amount ),
- };
- }
-
- $tax_rate_location{ $tax } ||= [];
- if ( ref($tax_object) eq 'FS::tax_rate' ) {
- my $taxratelocationnum =
- $tax_object->tax_rate_location->taxratelocationnum;
- push @{ $tax_rate_location{ $tax } },
- {
- 'taxnum' => $tax_object->taxnum,
- 'taxtype' => ref($tax_object),
- 'amount' => sprintf('%.2f', $amount ),
- 'locationtaxid' => $tax_object->location,
- 'taxratelocationnum' => $taxratelocationnum,
- };
- }
-
- }
-
- #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
- my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
- foreach my $tax ( keys %$taxlisthash ) {
- foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
- next unless ref($_) eq 'FS::cust_bill_pkg';
- push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
- splice( @{ $_->_cust_tax_exempt_pkg } );
- }
- }
-
- #consolidate and create tax line items
- warn "consolidating and generating...\n" if $DEBUG > 2;
- foreach my $taxname ( keys %taxname ) {
- my $tax = 0;
- my %seen = ();
- my @cust_bill_pkg_tax_location = ();
- my @cust_bill_pkg_tax_rate_location = ();
- warn "adding $taxname\n" if $DEBUG > 1;
- foreach my $taxitem ( @{ $taxname{$taxname} } ) {
- next if $seen{$taxitem}++;
- warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
- $tax += $tax{$taxitem};
- push @cust_bill_pkg_tax_location,
- map { new FS::cust_bill_pkg_tax_location $_ }
- @{ $tax_location{ $taxitem } };
- push @cust_bill_pkg_tax_rate_location,
- map { new FS::cust_bill_pkg_tax_rate_location $_ }
- @{ $tax_rate_location{ $taxitem } };
- }
- next unless $tax;
-
- $tax = sprintf('%.2f', $tax );
-
- my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
- 'disabled' => '',
- },
- );
-
- my @display = ();
- if ( $pkg_category and
- $conf->config('invoice_latexsummary') ||
- $conf->config('invoice_htmlsummary')
- )
- {
-
- my %hash = ( 'section' => $pkg_category->categoryname );
- push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
-
- }
-
- push @tax_line_items, new FS::cust_bill_pkg {
- 'pkgnum' => 0,
- 'setup' => $tax,
- 'recur' => 0,
- 'sdate' => '',
- 'edate' => '',
- 'itemdesc' => $taxname,
- 'display' => \@display,
- 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
- 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
- };
-
- }
-
- \@tax_line_items;
-}
-
-sub _make_lines {
- my ($self, %params) = @_;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
- my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
- my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
- my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
- my $total_setup = $params{setup} or die "no setup accumulator specified";
- my $total_recur = $params{recur} or die "no recur accumulator specified";
- my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
- my $time = $params{'time'} or die "no time specified";
- my (%options) = %{$params{options}};
-
- my $dbh = dbh;
- my $real_pkgpart = $params{real_pkgpart};
- my %hash = $cust_pkg->hash;
- my $old_cust_pkg = new FS::cust_pkg \%hash;
-
- my @details = ();
- my @discounts = ();
- my $lineitems = 0;
-
- $cust_pkg->pkgpart($part_pkg->pkgpart);
-
- ###
- # bill setup
- ###
-
- my $setup = 0;
- my $unitsetup = 0;
- if ( $options{'resetup'}
- || ( ! $cust_pkg->setup
- && ( ! $cust_pkg->start_date
- || $cust_pkg->start_date <= $time
- )
- && ( ! $conf->exists('disable_setup_suspended_pkgs')
- || ( $conf->exists('disable_setup_suspended_pkgs') &&
- ! $cust_pkg->getfield('susp')
- )
- )
- )
- and !$options{recurring_only}
- )
- {
-
- warn " bill setup\n" if $DEBUG > 1;
- $lineitems++;
-
- $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
- return "$@ running calc_setup for $cust_pkg\n"
- if $@;
-
- $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
-
- $cust_pkg->setfield('setup', $time)
- unless $cust_pkg->setup;
- #do need it, but it won't get written to the db
- #|| $cust_pkg->pkgpart != $real_pkgpart;
-
- $cust_pkg->setfield('start_date', '')
- if $cust_pkg->start_date;
-
- }
-
- ###
- # bill recurring fee
- ###
-
- #XXX unit stuff here too
- my $recur = 0;
- my $unitrecur = 0;
- my $sdate;
- if ( ! $cust_pkg->start_date
- and ( ! $cust_pkg->susp || $part_pkg->option('suspend_bill', 1) )
- and
- ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $time )
- || ( $part_pkg->plan eq 'voip_cdr'
- && $part_pkg->option('bill_every_call')
- )
- || $options{cancel}
- ) {
-
- # XXX should this be a package event? probably. events are called
- # at collection time at the moment, though...
- $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
- if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
- #don't want to reset usage just cause we want a line item??
- #&& $part_pkg->pkgpart == $real_pkgpart;
-
- warn " bill recur\n" if $DEBUG > 1;
- $lineitems++;
-
- # XXX shared with $recur_prog
- $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
- || $cust_pkg->setup
- || $time;
-
- #over two params! lets at least switch to a hashref for the rest...
- my $increment_next_bill = ( $part_pkg->freq ne '0'
- && ( $cust_pkg->getfield('bill') || 0 ) <= $time
- && !$options{cancel}
- );
- my %param = ( 'precommit_hooks' => $precommit_hooks,
- 'increment_next_bill' => $increment_next_bill,
- 'discounts' => \@discounts,
- 'real_pkgpart' => $real_pkgpart,
- 'freq_override' => $options{freq_override} || '',
- );
-
- my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
-
- # There may be some part_pkg for which this is wrong. Only those
- # which can_discount are supported.
- # (the UI should prevent adding discounts to these at the moment)
-
- $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
- return "$@ running $method for $cust_pkg\n"
- if ( $@ );
-
- if ( $increment_next_bill ) {
-
- my $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
- return "unparsable frequency: ". $part_pkg->freq
- if $next_bill == -1;
-
- #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
- # only for figuring next bill date, nothing else, so, reset $sdate again
- # here
- $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
- #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
- $cust_pkg->last_bill($sdate);
-
- $cust_pkg->setfield('bill', $next_bill );
-
- }
-
- }
-
- warn "\$setup is undefined" unless defined($setup);
- warn "\$recur is undefined" unless defined($recur);
- warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
-
- ###
- # If there's line items, create em cust_bill_pkg records
- # If $cust_pkg has been modified, update it (if we're a real pkgpart)
- ###
-
- if ( $lineitems ) {
-
- if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
- # hmm.. and if just the options are modified in some weird price plan?
-
- warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
- if $DEBUG >1;
-
- my $error = $cust_pkg->replace( $old_cust_pkg,
- 'options' => { $cust_pkg->options },
- )
- unless $options{no_commit};
- return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
- if $error; #just in case
- }
-
- $setup = sprintf( "%.2f", $setup );
- $recur = sprintf( "%.2f", $recur );
- if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
- return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
- }
- if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
- return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
- }
-
- if ( $setup != 0 ||
- $recur != 0 ||
- !$part_pkg->hidden && $options{has_hidden} ) #include some $0 lines
- {
-
- warn " charges (setup=$setup, recur=$recur); adding line items\n"
- if $DEBUG > 1;
-
- my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
- if ( $DEBUG > 1 ) {
- warn " adding customer package invoice detail: $_\n"
- foreach @cust_pkg_detail;
- }
- push @details, @cust_pkg_detail;
-
- my $cust_bill_pkg = new FS::cust_bill_pkg {
- 'pkgnum' => $cust_pkg->pkgnum,
- 'setup' => $setup,
- 'unitsetup' => $unitsetup,
- 'recur' => $recur,
- 'unitrecur' => $unitrecur,
- 'quantity' => $cust_pkg->quantity,
- 'details' => \@details,
- 'discounts' => \@discounts,
- 'hidden' => $part_pkg->hidden,
- 'freq' => $part_pkg->freq,
- };
-
- if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
- $cust_bill_pkg->sdate( $hash{last_bill} );
- $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
- $cust_bill_pkg->edate( $time ) if $options{cancel};
- } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
- $cust_bill_pkg->sdate( $sdate );
- $cust_bill_pkg->edate( $cust_pkg->bill );
- #$cust_bill_pkg->edate( $time ) if $options{cancel};
- }
-
- $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
- unless $part_pkg->pkgpart == $real_pkgpart;
-
- $$total_setup += $setup;
- $$total_recur += $recur;
-
- ###
- # handle taxes
- ###
-
- my $error =
- $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
- return $error if $error;
-
- push @$cust_bill_pkgs, $cust_bill_pkg;
-
- } #if $setup != 0 || $recur != 0
-
- } #if $line_items
-
- '';
-
-}
-
-sub _handle_taxes {
- my $self = shift;
- my $part_pkg = shift;
- my $taxlisthash = shift;
- my $cust_bill_pkg = shift;
- my $cust_pkg = shift;
- my $invoice_time = shift;
- my $real_pkgpart = shift;
- my $options = shift;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- my %cust_bill_pkg = ();
- my %taxes = ();
-
- my @classes;
- #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
- push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
- push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
- push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
-
- if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
-
- if ( $conf->exists('enable_taxproducts')
- && ( scalar($part_pkg->part_pkg_taxoverride)
- || $part_pkg->has_taxproduct
- )
- )
- {
-
- foreach my $class (@classes) {
- my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg );
- return $err_or_ref unless ref($err_or_ref);
- $taxes{$class} = $err_or_ref;
- }
-
- unless (exists $taxes{''}) {
- my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg );
- return $err_or_ref unless ref($err_or_ref);
- $taxes{''} = $err_or_ref;
- }
-
- } else {
-
- my @loc_keys = qw( city county state country );
- my %taxhash;
- if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
- my $cust_location = $cust_pkg->cust_location;
- %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
- } else {
- my $prefix =
- ( $conf->exists('tax-ship_address') && length($self->ship_last) )
- ? 'ship_'
- : '';
- %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
- }
-
- $taxhash{'taxclass'} = $part_pkg->taxclass;
-
- my @taxes = ();
- my %taxhash_elim = %taxhash;
- my @elim = qw( city county state );
- do {
-
- #first try a match with taxclass
- @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
-
- if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
- #then try a match without taxclass
- my %no_taxclass = %taxhash_elim;
- $no_taxclass{ 'taxclass' } = '';
- @taxes = qsearch( 'cust_main_county', \%no_taxclass );
- }
-
- $taxhash_elim{ shift(@elim) } = '';
-
- } while ( !scalar(@taxes) && scalar(@elim) );
-
- @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
- @taxes
- if $self->cust_main_exemption; #just to be safe
-
- if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
- foreach (@taxes) {
- $_->set('pkgnum', $cust_pkg->pkgnum );
- $_->set('locationnum', $cust_pkg->locationnum );
- }
- }
-
- $taxes{''} = [ @taxes ];
- $taxes{'setup'} = [ @taxes ];
- $taxes{'recur'} = [ @taxes ];
- $taxes{$_} = [ @taxes ] foreach (@classes);
-
- # # maybe eliminate this entirely, along with all the 0% records
- # unless ( @taxes ) {
- # return
- # "fatal: can't find tax rate for state/county/country/taxclass ".
- # join('/', map $taxhash{$_}, qw(state county country taxclass) );
- # }
-
- } #if $conf->exists('enable_taxproducts') ...
-
- }
-
- my @display = ();
- my $separate = $conf->exists('separate_usage');
- my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
- my $usage_mandate = $temp_pkg->part_pkg->option('usage_mandate', 'Hush!');
- my $section = $temp_pkg->part_pkg->categoryname;
- if ( $separate || $section || $usage_mandate ) {
-
- my %hash = ( 'section' => $section );
-
- $section = $temp_pkg->part_pkg->option('usage_section', 'Hush!');
- my $summary = $temp_pkg->part_pkg->option('summarize_usage', 'Hush!');
- if ( $separate ) {
- push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
- push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
- } else {
- push @display, new FS::cust_bill_pkg_display
- { type => '',
- %hash,
- ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
- };
- }
-
- if ($separate && $section && $summary) {
- push @display, new FS::cust_bill_pkg_display { type => 'U',
- summary => 'Y',
- %hash,
- };
- }
- if ($usage_mandate || $section && $summary) {
- $hash{post_total} = 'Y';
- }
-
- if ($separate || $usage_mandate) {
- $hash{section} = $section if ($separate || $usage_mandate);
- push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
- }
-
- }
- $cust_bill_pkg->set('display', \@display);
-
- my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
- foreach my $key (keys %tax_cust_bill_pkg) {
- my @taxes = @{ $taxes{$key} || [] };
- my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
-
- my %localtaxlisthash = ();
- foreach my $tax ( @taxes ) {
-
- my $taxname = ref( $tax ). ' '. $tax->taxnum;
-# $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
-# ' locationnum'. $cust_pkg->locationnum
-# if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
-
- $taxlisthash->{ $taxname } ||= [ $tax ];
- push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
-
- $localtaxlisthash{ $taxname } ||= [ $tax ];
- push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
-
- }
-
- warn "finding taxed taxes...\n" if $DEBUG > 2;
- foreach my $tax ( keys %localtaxlisthash ) {
- my $tax_object = shift @{ $localtaxlisthash{$tax} };
- warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
- if $DEBUG > 2;
- next unless $tax_object->can('tax_on_tax');
-
- foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
- my $totname = ref( $tot ). ' '. $tot->taxnum;
-
- warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
- if $DEBUG > 2;
- next unless exists( $localtaxlisthash{ $totname } ); # only increase
- # existing taxes
- warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
- my $hashref_or_error =
- $tax_object->taxline( $localtaxlisthash{$tax},
- 'custnum' => $self->custnum,
- 'invoice_time' => $invoice_time,
- );
- return $hashref_or_error
- unless ref($hashref_or_error);
-
- $taxlisthash->{ $totname } ||= [ $tot ];
- push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
-
- }
- }
-
- }
-
- '';
-}
-
-sub _gather_taxes {
- my $self = shift;
- my $part_pkg = shift;
- my $class = shift;
- my $cust_pkg = shift;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- my $geocode;
- if ( $cust_pkg->locationnum && $conf->exists('tax-pkg_address') ) {
- $geocode = $cust_pkg->cust_location->geocode('cch');
- } else {
- $geocode = $self->geocode('cch');
- }
-
- my @taxes = ();
-
- my @taxclassnums = map { $_->taxclassnum }
- $part_pkg->part_pkg_taxoverride($class);
-
- unless (@taxclassnums) {
- @taxclassnums = map { $_->taxclassnum }
- grep { $_->taxable eq 'Y' }
- $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
- }
- warn "Found taxclassnum values of ". join(',', @taxclassnums)
- if $DEBUG;
-
- my $extra_sql =
- "AND (".
- join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
-
- @taxes = qsearch({ 'table' => 'tax_rate',
- 'hashref' => { 'geocode' => $geocode, },
- 'extra_sql' => $extra_sql,
- })
- if scalar(@taxclassnums);
-
- warn "Found taxes ".
- join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
- if $DEBUG;
-
- [ @taxes ];
-
-}
-
-=item collect [ HASHREF | OPTION => VALUE ... ]
-
-(Attempt to) collect money for this customer's outstanding invoices (see
-L<FS::cust_bill>). Usually used after the bill method.
-
-Actions are now triggered by billing events; see L<FS::part_event> and the
-billing events web interface. Old-style invoice events (see
-L<FS::part_bill_event>) have been deprecated.
-
-If there is an error, returns the error, otherwise returns false.
-
-Options are passed as name-value pairs.
-
-Currently available options are:
-
-=over 4
-
-=item invoice_time
-
-Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item retry
-
-Retry card/echeck/LEC transactions even when not scheduled by invoice events.
-
-=item check_freq
-
-"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
-
-=item quiet
-
-set true to surpress email card/ACH decline notices.
-
-=item debug
-
-Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
-
-=back
-
-# =item payby
-#
-# allows for one time override of normal customer billing method
-
-=cut
-
-sub collect {
- my( $self, %options ) = @_;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- my $invoice_time = $options{'invoice_time'} || time;
-
- #put below somehow?
- 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;
-
- $self->select_for_update; #mutex
-
- if ( $DEBUG ) {
- my $balance = $self->balance;
- warn "$me collect customer ". $self->custnum. ": balance $balance\n"
- }
-
- if ( exists($options{'retry_card'}) ) {
- carp 'retry_card option passed to collect is deprecated; use retry';
- $options{'retry'} ||= $options{'retry_card'};
- }
- if ( exists($options{'retry'}) && $options{'retry'} ) {
- my $error = $self->retry_realtime;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- #never want to roll back an event just because it returned an error
- local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
-
- $self->do_cust_event(
- 'debug' => ( $options{'debug'} || 0 ),
- 'time' => $invoice_time,
- 'check_freq' => $options{'check_freq'},
- 'stage' => 'collect',
- );
-
-}
-
-=item retry_realtime
-
-Schedules realtime / batch credit card / electronic check / LEC billing
-events for for retry. Useful if card information has changed or manual
-retry is desired. The 'collect' method must be called to actually retry
-the transaction.
-
-Implementation details: For either this customer, or for each of this
-customer's open invoices, changes the status of the first "done" (with
-statustext error) realtime processing event to "failed".
-
-=cut
-
-sub retry_realtime {
- 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;
-
- #a little false laziness w/due_cust_event (not too bad, really)
-
- my $join = FS::part_event_condition->join_conditions_sql;
- my $order = FS::part_event_condition->order_conditions_sql;
- my $mine =
- '( '
- . join ( ' OR ' , map {
- "( part_event.eventtable = " . dbh->quote($_)
- . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
- } FS::part_event->eventtables)
- . ') ';
-
- #here is the agent virtualization
- my $agent_virt = " ( part_event.agentnum IS NULL
- OR part_event.agentnum = ". $self->agentnum. ' )';
-
- #XXX this shouldn't be hardcoded, actions should declare it...
- my @realtime_events = qw(
- cust_bill_realtime_card
- cust_bill_realtime_check
- cust_bill_realtime_lec
- cust_bill_batch
- );
-
- my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
- @realtime_events
- ).
- ' ) ';
-
- my @cust_event = qsearchs({
- 'table' => 'cust_event',
- 'select' => 'cust_event.*',
- 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
- 'hashref' => { 'status' => 'done' },
- 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
- " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
- });
-
- my %seen_invnum = ();
- foreach my $cust_event (@cust_event) {
-
- #max one for the customer, one for each open invoice
- my $cust_X = $cust_event->cust_X;
- next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
- ? $cust_X->invnum
- : 0
- }++
- or $cust_event->part_event->eventtable eq 'cust_bill'
- && ! $cust_X->owed;
-
- my $error = $cust_event->retry;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error scheduling event for retry: $error";
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item do_cust_event [ HASHREF | OPTION => VALUE ... ]
-
-Runs billing events; see L<FS::part_event> and the billing events web
-interface.
-
-If there is an error, returns the error, otherwise returns false.
-
-Options are passed as name-value pairs.
-
-Currently available options are:
-
-=over 4
-
-=item time
-
-Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item check_freq
-
-"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
-
-=item stage
-
-"collect" (the default) or "pre-bill"
-
-=item quiet
-
-set true to surpress email card/ACH decline notices.
-
-=item debug
-
-Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
-
-=back
-=cut
-
-# =item payby
-#
-# allows for one time override of normal customer billing method
-
-# =item retry
-#
-# Retry card/echeck/LEC transactions even when not scheduled by invoice events.
-
-sub do_cust_event {
- my( $self, %options ) = @_;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- my $time = $options{'time'} || time;
-
- #put below somehow?
- 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;
-
- $self->select_for_update; #mutex
-
- if ( $DEBUG ) {
- my $balance = $self->balance;
- warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
- }
-
-# if ( exists($options{'retry_card'}) ) {
-# carp 'retry_card option passed to collect is deprecated; use retry';
-# $options{'retry'} ||= $options{'retry_card'};
-# }
-# if ( exists($options{'retry'}) && $options{'retry'} ) {
-# my $error = $self->retry_realtime;
-# if ( $error ) {
-# $dbh->rollback if $oldAutoCommit;
-# return $error;
-# }
-# }
-
- # false laziness w/pay_batch::import_results
-
- my $due_cust_event = $self->due_cust_event(
- 'debug' => ( $options{'debug'} || 0 ),
- 'time' => $time,
- 'check_freq' => $options{'check_freq'},
- 'stage' => ( $options{'stage'} || 'collect' ),
- );
- unless( ref($due_cust_event) ) {
- $dbh->rollback if $oldAutoCommit;
- return $due_cust_event;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- #never want to roll back an event just because it or a different one
- # returned an error
- local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
-
- foreach my $cust_event ( @$due_cust_event ) {
-
- #XXX lock event
-
- #re-eval event conditions (a previous event could have changed things)
- unless ( $cust_event->test_conditions( 'time' => $time ) ) {
- #don't leave stray "new/locked" records around
- my $error = $cust_event->delete;
- return $error if $error;
- next;
- }
-
- {
- local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
- if $options{'quiet'};
- warn " running cust_event ". $cust_event->eventnum. "\n"
- if $DEBUG > 1;
-
- #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
- if ( my $error = $cust_event->do_event() ) {
- #XXX wtf is this? figure out a proper dealio with return value
- #from do_event
- return $error;
- }
- }
-
- }
-
- '';
-
-}
-
-=item due_cust_event [ HASHREF | OPTION => VALUE ... ]
-
-Inserts database records for and returns an ordered listref of new events due
-for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
-events are due, an empty listref is returned. If there is an error, returns a
-scalar error message.
-
-To actually run the events, call each event's test_condition method, and if
-still true, call the event's do_event method.
-
-Options are passed as a hashref or as a list of name-value pairs. Available
-options are:
-
-=over 4
-
-=item check_freq
-
-Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
-
-=item stage
-
-"collect" (the default) or "pre-bill"
-
-=item time
-
-"Current time" for the events.
-
-=item debug
-
-Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
-
-=item eventtable
-
-Only return events for the specified eventtable (by default, events of all eventtables are returned)
-
-=item objects
-
-Explicitly pass the objects to be tested (typically used with eventtable).
-
-=item testonly
-
-Set to true to return the objects, but not actually insert them into the
-database.
-
-=back
-
-=cut
-
-sub due_cust_event {
- my $self = shift;
- my %opt = ref($_[0]) ? %{ $_[0] } : @_;
-
- #???
- #my $DEBUG = $opt{'debug'}
- local($DEBUG) = $opt{'debug'}
- if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
- $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- warn "$me due_cust_event called with options ".
- join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
- if $DEBUG;
-
- $opt{'time'} ||= time;
-
- 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;
-
- $self->select_for_update #mutex
- unless $opt{testonly};
-
- ###
- # find possible events (initial search)
- ###
-
- my @cust_event = ();
-
- my @eventtable = $opt{'eventtable'}
- ? ( $opt{'eventtable'} )
- : FS::part_event->eventtables_runorder;
-
- my $check_freq = $opt{'check_freq'} || '1d';
-
- foreach my $eventtable ( @eventtable ) {
-
- my @objects;
- if ( $opt{'objects'} ) {
-
- @objects = @{ $opt{'objects'} };
-
- } else {
-
- #my @objects = $self->$eventtable(); # sub cust_main { @{ [ $self ] }; }
- if ( $eventtable eq 'cust_main' ) {
- @objects = ( $self );
- } else {
-
- my $cm_join =
- "LEFT JOIN cust_main USING ( custnum )";
-
- #some false laziness w/Cron::bill bill_where
-
- my $join = FS::part_event_condition->join_conditions_sql( $eventtable);
- my $where = FS::part_event_condition->where_conditions_sql($eventtable,
- 'time'=>$opt{'time'},
- );
- $where = $where ? "AND $where" : '';
-
- my $are_part_event =
- "EXISTS ( SELECT 1 FROM part_event $join
- WHERE check_freq = '$check_freq'
- AND eventtable = '$eventtable'
- AND ( disabled = '' OR disabled IS NULL )
- $where
- )
- ";
- #eofalse
-
- @objects = $self->$eventtable(
- 'addl_from' => $cm_join,
- 'extra_sql' => " AND $are_part_event",
- );
- }
-
- }
-
- my @e_cust_event = ();
-
- my $cross = "CROSS JOIN $eventtable";
- $cross .= ' LEFT JOIN cust_main USING ( custnum )'
- unless $eventtable eq 'cust_main';
-
- foreach my $object ( @objects ) {
-
- #this first search uses the condition_sql magic for optimization.
- #the more possible events we can eliminate in this step the better
-
- my $cross_where = '';
- my $pkey = $object->primary_key;
- $cross_where = "$eventtable.$pkey = ". $object->$pkey();
-
- my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
- my $extra_sql =
- FS::part_event_condition->where_conditions_sql( $eventtable,
- 'time'=>$opt{'time'}
- );
- my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
-
- $extra_sql = "AND $extra_sql" if $extra_sql;
-
- #here is the agent virtualization
- $extra_sql .= " AND ( part_event.agentnum IS NULL
- OR part_event.agentnum = ". $self->agentnum. ' )';
-
- $extra_sql .= " $order";
-
- warn "searching for events for $eventtable ". $object->$pkey. "\n"
- if $opt{'debug'} > 2;
- my @part_event = qsearch( {
- 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
- 'select' => 'part_event.*',
- 'table' => 'part_event',
- 'addl_from' => "$cross $join",
- 'hashref' => { 'check_freq' => $check_freq,
- 'eventtable' => $eventtable,
- 'disabled' => '',
- },
- 'extra_sql' => "AND $cross_where $extra_sql",
- } );
-
- if ( $DEBUG > 2 ) {
- my $pkey = $object->primary_key;
- warn " ". scalar(@part_event).
- " possible events found for $eventtable ". $object->$pkey(). "\n";
- }
-
- push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
-
- }
-
- warn " ". scalar(@e_cust_event).
- " subtotal possible cust events found for $eventtable\n"
- if $DEBUG > 1;
-
- push @cust_event, @e_cust_event;
-
- }
-
- warn " ". scalar(@cust_event).
- " total possible cust events found in initial search\n"
- if $DEBUG; # > 1;
-
-
- ##
- # test stage
- ##
-
- $opt{stage} ||= 'collect';
- @cust_event =
- grep { my $stage = $_->part_event->event_stage;
- $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
- }
- @cust_event;
-
- ##
- # test conditions
- ##
-
- my %unsat = ();
-
- @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
- 'stats_hashref' => \%unsat ),
- @cust_event;
-
- warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
- if $DEBUG; # > 1;
-
- warn " invalid conditions not eliminated with condition_sql:\n".
- join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
- if keys %unsat && $DEBUG; # > 1;
-
- ##
- # insert
- ##
-
- unless( $opt{testonly} ) {
- foreach my $cust_event ( @cust_event ) {
-
- my $error = $cust_event->insert();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ##
- # return
- ##
-
- warn " returning events: ". Dumper(@cust_event). "\n"
- if $DEBUG > 2;
-
- \@cust_event;
-
-}
-
-=item apply_payments_and_credits [ OPTION => VALUE ... ]
-
-Applies unapplied payments and credits.
-
-In most cases, this new method should be used in place of sequential
-apply_payments and apply_credits methods.
-
-A hash of optional arguments may be passed. Currently "manual" is supported.
-If true, a payment receipt is sent instead of a statement when
-'payment_receipt_email' configuration option is set.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub apply_payments_and_credits {
- my( $self, %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;
-
- $self->select_for_update; #mutex
-
- foreach my $cust_bill ( $self->open_cust_bill ) {
- my $error = $cust_bill->apply_payments_and_credits(%options);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error applying: $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-
-}
-
-=item apply_credits OPTION => VALUE ...
-
-Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
-to outstanding invoice balances in chronological order (or reverse
-chronological order if the I<order> option is set to B<newest>) and returns the
-value of any remaining unapplied credits available for refund (see
-L<FS::cust_refund>).
-
-Dies if there is an error.
-
-=cut
-
-sub apply_credits {
- my $self = shift;
- my %opt = @_;
-
- 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;
-
- $self->select_for_update; #mutex
-
- unless ( $self->total_unapplied_credits ) {
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return 0;
- }
-
- my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
- qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
-
- my @invoices = $self->open_cust_bill;
- @invoices = sort { $b->_date <=> $a->_date } @invoices
- if defined($opt{'order'}) && $opt{'order'} eq 'newest';
-
- if ( $conf->exists('pkg-balances') ) {
- # limit @credits to those w/ a pkgnum grepped from $self
- my %pkgnums = ();
- foreach my $i (@invoices) {
- foreach my $li ( $i->cust_bill_pkg ) {
- $pkgnums{$li->pkgnum} = 1;
- }
- }
- @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
- }
-
- my $credit;
-
- foreach my $cust_bill ( @invoices ) {
-
- if ( !defined($credit) || $credit->credited == 0) {
- $credit = pop @credits or last;
- }
-
- my $owed;
- if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
- $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
- } else {
- $owed = $cust_bill->owed;
- }
- unless ( $owed > 0 ) {
- push @credits, $credit;
- next;
- }
-
- my $amount = min( $credit->credited, $owed );
-
- my $cust_credit_bill = new FS::cust_credit_bill ( {
- 'crednum' => $credit->crednum,
- 'invnum' => $cust_bill->invnum,
- 'amount' => $amount,
- } );
- $cust_credit_bill->pkgnum( $credit->pkgnum )
- if $conf->exists('pkg-balances') && $credit->pkgnum;
- my $error = $cust_credit_bill->insert;
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
-
- redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
-
- }
-
- my $total_unapplied_credits = $self->total_unapplied_credits;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return $total_unapplied_credits;
-}
-
-=item apply_payments [ OPTION => VALUE ... ]
-
-Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
-to outstanding invoice balances in chronological order.
-
- #and returns the value of any remaining unapplied payments.
-
-A hash of optional arguments may be passed. Currently "manual" is supported.
-If true, a payment receipt is sent instead of a statement when
-'payment_receipt_email' configuration option is set.
-
-Dies if there is an error.
-
-=cut
-
-sub apply_payments {
- my( $self, %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;
-
- $self->select_for_update; #mutex
-
- #return 0 unless
-
- my @payments = sort { $b->_date <=> $a->_date }
- grep { $_->unapplied > 0 }
- $self->cust_pay;
-
- my @invoices = sort { $a->_date <=> $b->_date}
- grep { $_->owed > 0 }
- $self->cust_bill;
-
- if ( $conf->exists('pkg-balances') ) {
- # limit @payments to those w/ a pkgnum grepped from $self
- my %pkgnums = ();
- foreach my $i (@invoices) {
- foreach my $li ( $i->cust_bill_pkg ) {
- $pkgnums{$li->pkgnum} = 1;
- }
- }
- @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
- }
-
- my $payment;
-
- foreach my $cust_bill ( @invoices ) {
-
- if ( !defined($payment) || $payment->unapplied == 0 ) {
- $payment = pop @payments or last;
- }
-
- my $owed;
- if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
- $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
- } else {
- $owed = $cust_bill->owed;
- }
- unless ( $owed > 0 ) {
- push @payments, $payment;
- next;
- }
-
- my $amount = min( $payment->unapplied, $owed );
-
- my $cust_bill_pay = new FS::cust_bill_pay ( {
- 'paynum' => $payment->paynum,
- 'invnum' => $cust_bill->invnum,
- 'amount' => $amount,
- } );
- $cust_bill_pay->pkgnum( $payment->pkgnum )
- if $conf->exists('pkg-balances') && $payment->pkgnum;
- my $error = $cust_bill_pay->insert(%options);
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
-
- redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
-
- }
-
- my $total_unapplied_payments = $self->total_unapplied_payments;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return $total_unapplied_payments;
-}
-
-=back
-
-=head1 FLOW
-
- bill_and_collect
-
- cancel_expired_pkgs
- suspend_adjourned_pkgs
-
- bill
- (do_cust_event pre-bill)
- _make_lines
- _handle_taxes
- (vendor-only) _gather_taxes
- _omit_zero_value_bundles
- calculate_taxes
-
- apply_payments_and_credits
- collect
- do_cust_event
- due_cust_event
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>
-
-=cut
-
-1;
diff --git a/FS/FS/cust_main/Billing_Discount.pm b/FS/FS/cust_main/Billing_Discount.pm
deleted file mode 100644
index 9dda389..0000000
--- a/FS/FS/cust_main/Billing_Discount.pm
+++ /dev/null
@@ -1,207 +0,0 @@
-package FS::cust_main::Billing_Discount;
-
-use strict;
-use vars qw( $DEBUG $me );
-use FS::Record qw( qsearch ); #qsearchs );
-use FS::cust_pkg;
-
-# 1 is mostly method/subroutine entry and options
-# 2 traces progress of some operations
-# 3 is even more information including possibly sensitive data
-$DEBUG = 0;
-$me = '[FS::cust_main::Billing_Discount]';
-
-=head1 NAME
-
-FS::cust_main::Billing_Discount - Billing discount mixin for cust_main
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-These methods are available on FS::cust_main objects.
-
-=head1 METHODS
-
-=over 4
-
-=item _discount_pkg_and_bill
-
-=cut
-
-sub _discount_pkgs_and_bill {
- my $self = shift;
-
- my @cust_bill = $self->cust_bill;
- my $cust_bill = pop @cust_bill;
- return () unless $cust_bill && $cust_bill->owed;
-
- my @where = ();
- push @where, "cust_bill_pkg.invnum = ". $cust_bill->invnum;
- push @where, "cust_bill_pkg.pkgpart_override IS NULL";
- push @where, "part_pkg.freq = '1'";
- push @where, "(cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0)";
- push @where, "(cust_pkg.susp IS NULL OR cust_pkg.susp = 0)";
- push @where, "0<(SELECT count(*) FROM part_pkg_discount
- WHERE part_pkg.pkgpart = part_pkg_discount.pkgpart)";
- push @where,
- "0=(SELECT count(*) FROM cust_bill_pkg_discount
- WHERE cust_bill_pkg.billpkgnum = cust_bill_pkg_discount.billpkgnum)";
-
- my $extra_sql = 'WHERE '. join(' AND ', @where);
-
- my @cust_pkg =
- qsearch({
- 'table' => 'cust_pkg',
- 'select' => "DISTINCT cust_pkg.*",
- 'addl_from' => 'JOIN cust_bill_pkg USING(pkgnum) '.
- 'JOIN part_pkg USING(pkgpart)',
- 'hashref' => {},
- 'extra_sql' => $extra_sql,
- });
-
- ($cust_bill, @cust_pkg);
-}
-
-=item _discountable_pkgs_at_term
-
-=cut
-
-#this isn't even a method
-sub _discountable_pkgs_at_term {
- my ($term, @pkgs) = @_;
- my $part_pkg = new FS::part_pkg { freq => $term - 1 };
- grep { ( !$_->adjourn || $_->adjourn > $part_pkg->add_freq($_->bill) ) &&
- ( !$_->expire || $_->expire > $part_pkg->add_freq($_->bill) )
- }
- @pkgs;
-}
-
-=item discount_terms
-
-Returns a list of lengths for term discounts
-
-=cut
-
-sub discount_terms {
- my $self = shift;
-
- my %terms = ();
-
- my @discount_pkgs = $self->_discount_pkgs_and_bill;
- shift @discount_pkgs; #discard bill;
-
- map { $terms{$_->months} = 1 }
- grep { $_->months && $_->months > 1 }
- map { $_->discount }
- map { $_->part_pkg->part_pkg_discount }
- @discount_pkgs;
-
- return sort { $a <=> $b } keys %terms;
-
-}
-
-=item discount_term_values MONTHS
-
-Returns a list with credit, dollar amount saved, and total bill acheived
-by prepaying the most recent invoice for MONTHS.
-
-=cut
-
-sub discount_term_values {
- my $self = shift;
- my $term = shift;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- warn "$me discount_term_values called with $term\n" if $DEBUG;
-
- my %result = ();
-
- my @packages = $self->_discount_pkgs_and_bill;
- my $cust_bill = shift(@packages);
- @packages = _discountable_pkgs_at_term( $term, @packages );
- return () unless scalar(@packages);
-
- $_->bill($_->last_bill) foreach @packages;
- my @final = map { new FS::cust_pkg { $_->hash } } @packages;
-
- my %options = (
- 'recurring_only' => 1,
- 'no_usage_reset' => 1,
- 'no_commit' => 1,
- );
-
- my %params = (
- 'return_bill' => [],
- 'pkg_list' => \@packages,
- 'time' => $cust_bill->_date,
- );
-
- my $error = $self->bill(%options, %params);
- die $error if $error; # XXX think about this a bit more
-
- my $credit = 0;
- $credit += $_->charged foreach @{$params{return_bill}};
- $credit = sprintf('%.2f', $credit);
- warn "$me discount_term_values $term credit: $credit\n" if $DEBUG;
-
- %params = (
- 'return_bill' => [],
- 'pkg_list' => \@packages,
- 'time' => $packages[0]->part_pkg->add_freq($cust_bill->_date)
- );
-
- $error = $self->bill(%options, %params);
- die $error if $error; # XXX think about this a bit more
-
- my $next = 0;
- $next += $_->charged foreach @{$params{return_bill}};
- warn "$me discount_term_values $term next: $next\n" if $DEBUG;
-
- %params = (
- 'return_bill' => [],
- 'pkg_list' => \@final,
- 'time' => $cust_bill->_date,
- 'freq_override' => $term,
- );
-
- $error = $self->bill(%options, %params);
- die $error if $error; # XXX think about this a bit more
-
- my $final = $self->balance - $credit;
- $final += $_->charged foreach @{$params{return_bill}};
- $final = sprintf('%.2f', $final);
- warn "$me discount_term_values $term final: $final\n" if $DEBUG;
-
- my $savings = sprintf('%.2f', $self->balance + ($term - 1) * $next - $final);
-
- ( $credit, $savings, $final );
-
-}
-
-sub discount_terms_hash {
- my $self = shift;
-
- my %result = ();
- my @terms = $self->discount_terms;
- foreach my $term (@terms) {
- my @result = $self->discount_term_values($term);
- $result{$term} = [ @result ] if scalar(@result);
- }
-
- return %result;
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, L<FS::cust_main::Billing>
-
-=cut
-
-1;
diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm
deleted file mode 100644
index 10b898d..0000000
--- a/FS/FS/cust_main/Billing_Realtime.pm
+++ /dev/null
@@ -1,1494 +0,0 @@
-package FS::cust_main::Billing_Realtime;
-
-use strict;
-use vars qw( $conf $DEBUG $me );
-use vars qw( $realtime_bop_decline_quiet ); #ugh
-use Data::Dumper;
-use Digest::MD5 qw(md5_base64);
-use Business::CreditCard 0.28;
-use FS::UID qw( dbh );
-use FS::Record qw( qsearch qsearchs );
-use FS::Misc qw( send_email );
-use FS::payby;
-use FS::cust_pay;
-use FS::cust_pay_pending;
-use FS::cust_refund;
-
-$realtime_bop_decline_quiet = 0;
-
-# 1 is mostly method/subroutine entry and options
-# 2 traces progress of some operations
-# 3 is even more information including possibly sensitive data
-$DEBUG = 0;
-$me = '[FS::cust_main::Billing_Realtime]';
-
-install_callback FS::UID sub {
- $conf = new FS::Conf;
- #yes, need it for stuff below (prolly should be cached)
-};
-
-=head1 NAME
-
-FS::cust_main::Billing_Realtime - Realtime billing mixin for cust_main
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-These methods are available on FS::cust_main objects.
-
-=head1 METHODS
-
-=over 4
-
-=item realtime_collect [ OPTION => VALUE ... ]
-
-Runs a realtime credit card, ACH (electronic check) or phone bill transaction
-via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
-gateway. See L<http://420.am/business-onlinepayment> and
-L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
-
-On failure returns an error message.
-
-Returns false or a hashref upon success. The hashref contains keys popup_url reference, and collectitems. The first is a URL to which a browser should be redirected for completion of collection. The second is a reference id for the transaction suitable for the end user. The collectitems is a reference to a list of name value pairs suitable for assigning to a html form and posted to popup_url.
-
-Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
-
-I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified
-then it is deduced from the customer record.
-
-If no I<amount> is specified, then the customer balance is used.
-
-The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
-I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
-if set, will override the value from the customer record.
-
-I<description> is a free-text field passed to the gateway. It defaults to
-the value defined by the business-onlinepayment-description configuration
-option, or "Internet services" if that is unset.
-
-If an I<invnum> is specified, this payment (if successful) is applied to the
-specified invoice. If you don't specify an I<invnum> you might want to
-call the B<apply_payments> method or set the I<apply> option.
-
-I<apply> can be set to true to apply a resulting payment.
-
-I<quiet> can be set true to surpress email decline notices.
-
-I<paynum_ref> can be set to a scalar reference. It will be filled in with the
-resulting paynum, if any.
-
-I<payunique> is a unique identifier for this payment.
-
-I<session_id> is a session identifier associated with this payment.
-
-I<depend_jobnum> allows payment capture to unlock export jobs
-
-=cut
-
-sub realtime_collect {
- my( $self, %options ) = @_;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- if ( $DEBUG ) {
- warn "$me realtime_collect:\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- $options{amount} = $self->balance unless exists( $options{amount} );
- $options{method} = FS::payby->payby2bop($self->payby)
- unless exists( $options{method} );
-
- return $self->realtime_bop({%options});
-
-}
-
-=item realtime_bop { [ ARG => VALUE ... ] }
-
-Runs a realtime credit card, ACH (electronic check) or phone bill transaction
-via a Business::OnlinePayment realtime gateway. See
-L<http://420.am/business-onlinepayment> for supported gateways.
-
-Required arguments in the hashref are I<method>, and I<amount>
-
-Available methods are: I<CC>, I<ECHECK> and I<LEC>
-
-Available optional arguments are: I<description>, I<invnum>, I<apply>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
-
-The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
-I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
-if set, will override the value from the customer record.
-
-I<description> is a free-text field passed to the gateway. It defaults to
-the value defined by the business-onlinepayment-description configuration
-option, or "Internet services" if that is unset.
-
-If an I<invnum> is specified, this payment (if successful) is applied to the
-specified invoice. If you don't specify an I<invnum> you might want to
-call the B<apply_payments> method or set the I<apply> option.
-
-I<apply> can be set to true to apply a resulting payment.
-
-I<quiet> can be set true to surpress email decline notices.
-
-I<paynum_ref> can be set to a scalar reference. It will be filled in with the
-resulting paynum, if any.
-
-I<payunique> is a unique identifier for this payment.
-
-I<session_id> is a session identifier associated with this payment.
-
-I<depend_jobnum> allows payment capture to unlock export jobs
-
-I<discount_term> attempts to take a discount by prepaying for discount_term
-
-(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
-
-=cut
-
-# some helper routines
-sub _bop_recurring_billing {
- my( $self, %opt ) = @_;
-
- my $method = scalar($conf->config('credit_card-recurring_billing_flag'));
-
- if ( defined($method) && $method eq 'transaction_is_recur' ) {
-
- return 1 if $opt{'trans_is_recur'};
-
- } else {
-
- my %hash = ( 'custnum' => $self->custnum,
- 'payby' => 'CARD',
- );
-
- return 1
- if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
- || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
- $opt{'payinfo'} )
- } );
-
- }
-
- return 0;
-
-}
-
-sub _payment_gateway {
- my ($self, $options) = @_;
-
- if ( $options->{'selfservice'} ) {
- my $gatewaynum = FS::Conf->new->config('selfservice-payment_gateway');
- if ( $gatewaynum ) {
- return $options->{payment_gateway} ||=
- qsearchs('payment_gateway', { gatewaynum => $gatewaynum });
- }
- }
-
- $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
- unless exists($options->{payment_gateway});
-
- $options->{payment_gateway};
-}
-
-sub _bop_auth {
- my ($self, $options) = @_;
-
- (
- 'login' => $options->{payment_gateway}->gateway_username,
- 'password' => $options->{payment_gateway}->gateway_password,
- );
-}
-
-sub _bop_options {
- my ($self, $options) = @_;
-
- $options->{payment_gateway}->gatewaynum
- ? $options->{payment_gateway}->options
- : @{ $options->{payment_gateway}->get('options') };
-
-}
-
-sub _bop_defaults {
- my ($self, $options) = @_;
-
- unless ( $options->{'description'} ) {
- if ( $conf->exists('business-onlinepayment-description') ) {
- my $dtempl = $conf->config('business-onlinepayment-description');
-
- my $agent = $self->agent->agent;
- #$pkgs... not here
- $options->{'description'} = eval qq("$dtempl");
- } else {
- $options->{'description'} = 'Internet services';
- }
- }
-
- $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
- $options->{invnum} ||= '';
- $options->{payname} = $self->payname unless exists( $options->{payname} );
-}
-
-sub _bop_content {
- my ($self, $options) = @_;
- my %content = ();
-
- my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
- $content{customer_ip} = $payip if length($payip);
-
- $content{invoice_number} = $options->{'invnum'}
- if exists($options->{'invnum'}) && length($options->{'invnum'});
-
- $content{email_customer} =
- ( $conf->exists('business-onlinepayment-email_customer')
- || $conf->exists('business-onlinepayment-email-override') );
-
- my ($payname, $payfirst, $paylast);
- if ( $options->{payname} && $options->{method} ne 'ECHECK' ) {
- ($payname = $options->{payname}) =~
- /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
- or return "Illegal payname $payname";
- ($payfirst, $paylast) = ($1, $2);
- } else {
- $payfirst = $self->getfield('first');
- $paylast = $self->getfield('last');
- $payname = "$payfirst $paylast";
- }
-
- $content{last_name} = $paylast;
- $content{first_name} = $payfirst;
-
- $content{name} = $payname;
-
- $content{address} = exists($options->{'address1'})
- ? $options->{'address1'}
- : $self->address1;
- my $address2 = exists($options->{'address2'})
- ? $options->{'address2'}
- : $self->address2;
- $content{address} .= ", ". $address2 if length($address2);
-
- $content{city} = exists($options->{city})
- ? $options->{city}
- : $self->city;
- $content{state} = exists($options->{state})
- ? $options->{state}
- : $self->state;
- $content{zip} = exists($options->{zip})
- ? $options->{'zip'}
- : $self->zip;
- $content{country} = exists($options->{country})
- ? $options->{country}
- : $self->country;
-
- $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
- $content{phone} = $self->daytime || $self->night;
-
- \%content;
-}
-
-my %bop_method2payby = (
- 'CC' => 'CARD',
- 'ECHECK' => 'CHEK',
- 'LEC' => 'LECB',
-);
-
-sub realtime_bop {
- my $self = shift;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- my %options = ();
- if (ref($_[0]) eq 'HASH') {
- %options = %{$_[0]};
- } else {
- my ( $method, $amount ) = ( shift, shift );
- %options = @_;
- $options{method} = $method;
- $options{amount} = $amount;
- }
-
- if ( $DEBUG ) {
- warn "$me realtime_bop (new): $options{method} $options{amount}\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- return $self->fake_bop(%options) if $options{'fake'};
-
- $self->_bop_defaults(\%options);
-
- ###
- # set trans_is_recur based on invnum if there is one
- ###
-
- my $trans_is_recur = 0;
- if ( $options{'invnum'} ) {
-
- my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
- die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
-
- my @part_pkg =
- map { $_->part_pkg }
- grep { $_ }
- map { $_->cust_pkg }
- $cust_bill->cust_bill_pkg;
-
- $trans_is_recur = 1
- if grep { $_->freq ne '0' } @part_pkg;
-
- }
-
- ###
- # select a gateway
- ###
-
- my $payment_gateway = $self->_payment_gateway( \%options );
- my $namespace = $payment_gateway->gateway_namespace;
-
- eval "use $namespace";
- die $@ if $@;
-
- ###
- # check for banned credit card/ACH
- ###
-
- my $ban = qsearchs('banned_pay', {
- 'payby' => $bop_method2payby{$options{method}},
- 'payinfo' => md5_base64($options{payinfo}),
- } );
- return "Banned credit card" if $ban;
-
- ###
- # massage data
- ###
-
- my $bop_content = $self->_bop_content(\%options);
- return $bop_content unless ref($bop_content);
-
- my @invoicing_list = $self->invoicing_list_emailonly;
- if ( $conf->exists('emailinvoiceautoalways')
- || $conf->exists('emailinvoiceauto') && ! @invoicing_list
- || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
- push @invoicing_list, $self->all_emails;
- }
-
- my $email = ($conf->exists('business-onlinepayment-email-override'))
- ? $conf->config('business-onlinepayment-email-override')
- : $invoicing_list[0];
-
- my $paydate = '';
- my %content = ();
- if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
-
- $content{card_number} = $options{payinfo};
- $paydate = exists($options{'paydate'})
- ? $options{'paydate'}
- : $self->paydate;
- $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
- $content{expiration} = "$2/$1";
-
- my $paycvv = exists($options{'paycvv'})
- ? $options{'paycvv'}
- : $self->paycvv;
- $content{cvv2} = $paycvv
- if length($paycvv);
-
- my $paystart_month = exists($options{'paystart_month'})
- ? $options{'paystart_month'}
- : $self->paystart_month;
-
- my $paystart_year = exists($options{'paystart_year'})
- ? $options{'paystart_year'}
- : $self->paystart_year;
-
- $content{card_start} = "$paystart_month/$paystart_year"
- if $paystart_month && $paystart_year;
-
- my $payissue = exists($options{'payissue'})
- ? $options{'payissue'}
- : $self->payissue;
- $content{issue_number} = $payissue if $payissue;
-
- if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'},
- 'trans_is_recur' => $trans_is_recur,
- )
- )
- {
- $content{recurring_billing} = 'YES';
- $content{acct_code} = 'rebill'
- if $conf->exists('credit_card-recurring_billing_acct_code');
- }
-
- } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
- ( $content{account_number}, $content{routing_code} ) =
- split('@', $options{payinfo});
- $content{bank_name} = $options{payname};
- $content{bank_state} = exists($options{'paystate'})
- ? $options{'paystate'}
- : $self->getfield('paystate');
- $content{account_type} = exists($options{'paytype'})
- ? uc($options{'paytype'}) || 'CHECKING'
- : uc($self->getfield('paytype')) || 'CHECKING';
- $content{account_name} = $self->getfield('first'). ' '.
- $self->getfield('last');
-
- $content{customer_org} = $self->company ? 'B' : 'I';
- $content{state_id} = exists($options{'stateid'})
- ? $options{'stateid'}
- : $self->getfield('stateid');
- $content{state_id_state} = exists($options{'stateid_state'})
- ? $options{'stateid_state'}
- : $self->getfield('stateid_state');
- $content{customer_ssn} = exists($options{'ss'})
- ? $options{'ss'}
- : $self->ss;
- } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
- $content{phone} = $options{payinfo};
- } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
- #move along
- } else {
- #die an evil death
- }
-
- ###
- # run transaction(s)
- ###
-
- my $balance = exists( $options{'balance'} )
- ? $options{'balance'}
- : $self->balance;
-
- $self->select_for_update; #mutex ... just until we get our pending record in
-
- #the checks here are intended to catch concurrent payments
- #double-form-submission prevention is taken care of in cust_pay_pending::check
-
- #check the balance
- return "The customer's balance has changed; $options{method} transaction aborted."
- if $self->balance < $balance;
- #&& $self->balance < $options{amount}; #might as well anyway?
-
- #also check and make sure there aren't *other* pending payments for this cust
-
- my @pending = qsearch('cust_pay_pending', {
- 'custnum' => $self->custnum,
- 'status' => { op=>'!=', value=>'done' }
- });
- # This is a problem. A self-service third party payment that fails somehow
- # can't be retried, EVER, until someone manually clears it. Totally
- # arbitrary fix: if the existing payment is more than two minutes old,
- # kill it. This doesn't limit how long it can take the pending payment
- # to complete, only how long it will obstruct new payments.
- my @still_pending;
- foreach (@pending) {
- if ( time - $_->_date > 120 ) {
- my $error = $_->delete;
- warn "error deleting stale pending payment ".$_->paypendingnum.": $error"
- if $error; # not fatal, it will fail anyway
- }
- else {
- push @still_pending, $_;
- }
- }
- @pending = @still_pending;
-
- return "A payment is already being processed for this customer (".
- join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
- "); $options{method} transaction aborted."
- if scalar(@pending);
-
- #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
-
- my $cust_pay_pending = new FS::cust_pay_pending {
- 'custnum' => $self->custnum,
- #'invnum' => $options{'invnum'},
- 'paid' => $options{amount},
- '_date' => '',
- 'payby' => $bop_method2payby{$options{method}},
- 'payinfo' => $options{payinfo},
- 'paydate' => $paydate,
- 'recurring_billing' => $content{recurring_billing},
- 'pkgnum' => $options{'pkgnum'},
- 'status' => 'new',
- 'gatewaynum' => $payment_gateway->gatewaynum || '',
- 'session_id' => $options{session_id} || '',
- 'jobnum' => $options{depend_jobnum} || '',
- };
- $cust_pay_pending->payunique( $options{payunique} )
- if defined($options{payunique}) && length($options{payunique});
- my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
- return $cpp_new_err if $cpp_new_err;
-
- my( $action1, $action2 ) =
- split( /\s*\,\s*/, $payment_gateway->gateway_action );
-
- my $transaction = new $namespace( $payment_gateway->gateway_module,
- $self->_bop_options(\%options),
- );
-
- $transaction->content(
- 'type' => $options{method},
- $self->_bop_auth(\%options),
- 'action' => $action1,
- 'description' => $options{'description'},
- 'amount' => $options{amount},
- #'invoice_number' => $options{'invnum'},
- 'customer_id' => $self->custnum,
- %$bop_content,
- 'reference' => $cust_pay_pending->paypendingnum, #for now
- 'callback_url' => $payment_gateway->gateway_callback_url,
- 'email' => $email,
- %content, #after
- );
-
- $cust_pay_pending->status('pending');
- my $cpp_pending_err = $cust_pay_pending->replace;
- return $cpp_pending_err if $cpp_pending_err;
-
- #config?
- my $BOP_TESTING = 0;
- my $BOP_TESTING_SUCCESS = 1;
-
- unless ( $BOP_TESTING ) {
- $transaction->test_transaction(1)
- if $conf->exists('business-onlinepayment-test_transaction');
- $transaction->submit();
- } else {
- if ( $BOP_TESTING_SUCCESS ) {
- $transaction->is_success(1);
- $transaction->authorization('fake auth');
- } else {
- $transaction->is_success(0);
- $transaction->error_message('fake failure');
- }
- }
-
- if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
-
- return { reference => $cust_pay_pending->paypendingnum,
- map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
-
- } elsif ( $transaction->is_success() && $action2 ) {
-
- $cust_pay_pending->status('authorized');
- my $cpp_authorized_err = $cust_pay_pending->replace;
- return $cpp_authorized_err if $cpp_authorized_err;
-
- my $auth = $transaction->authorization;
- my $ordernum = $transaction->can('order_number')
- ? $transaction->order_number
- : '';
-
- my $capture =
- new Business::OnlinePayment( $payment_gateway->gateway_module,
- $self->_bop_options(\%options),
- );
-
- my %capture = (
- %content,
- type => $options{method},
- action => $action2,
- $self->_bop_auth(\%options),
- order_number => $ordernum,
- amount => $options{amount},
- authorization => $auth,
- description => $options{'description'},
- );
-
- foreach my $field (qw( authorization_source_code returned_ACI
- transaction_identifier validation_code
- transaction_sequence_num local_transaction_date
- local_transaction_time AVS_result_code )) {
- $capture{$field} = $transaction->$field() if $transaction->can($field);
- }
-
- $capture->content( %capture );
-
- $capture->test_transaction(1)
- if $conf->exists('business-onlinepayment-test_transaction');
- $capture->submit();
-
- unless ( $capture->is_success ) {
- my $e = "Authorization successful but capture failed, custnum #".
- $self->custnum. ': '. $capture->result_code.
- ": ". $capture->error_message;
- warn $e;
- return $e;
- }
-
- }
-
- ###
- # remove paycvv after initial transaction
- ###
-
- #false laziness w/misc/process/payment.cgi - check both to make sure working
- # correctly
- if ( length($self->paycvv)
- && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
- ) {
- my $error = $self->remove_cvv;
- if ( $error ) {
- warn "WARNING: error removing cvv: $error\n";
- }
- }
-
- ###
- # Tokenize
- ###
-
-
- if ( $transaction->can('card_token') && $transaction->card_token ) {
-
- $self->card_token($transaction->card_token);
-
- if ( $options{'payinfo'} eq $self->payinfo ) {
- $self->payinfo($transaction->card_token);
- my $error = $self->replace;
- if ( $error ) {
- warn "WARNING: error storing token: $error, but proceeding anyway\n";
- }
- }
-
- }
-
- ###
- # result handling
- ###
-
- $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
-
-}
-
-=item fake_bop
-
-=cut
-
-sub fake_bop {
- my $self = shift;
-
- my %options = ();
- if (ref($_[0]) eq 'HASH') {
- %options = %{$_[0]};
- } else {
- my ( $method, $amount ) = ( shift, shift );
- %options = @_;
- $options{method} = $method;
- $options{amount} = $amount;
- }
-
- if ( $options{'fake_failure'} ) {
- return "Error: No error; test failure requested with fake_failure";
- }
-
- #my $paybatch = '';
- #if ( $payment_gateway->gatewaynum ) { # agent override
- # $paybatch = $payment_gateway->gatewaynum. '-';
- #}
- #
- #$paybatch .= "$processor:". $transaction->authorization;
- #
- #$paybatch .= ':'. $transaction->order_number
- # if $transaction->can('order_number')
- # && length($transaction->order_number);
-
- my $paybatch = 'FakeProcessor:54:32';
-
- my $cust_pay = new FS::cust_pay ( {
- 'custnum' => $self->custnum,
- 'invnum' => $options{'invnum'},
- 'paid' => $options{amount},
- '_date' => '',
- 'payby' => $bop_method2payby{$options{method}},
- #'payinfo' => $payinfo,
- 'payinfo' => '4111111111111111',
- 'paybatch' => $paybatch,
- #'paydate' => $paydate,
- 'paydate' => '2012-05-01',
- } );
- $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
-
- my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
-
- if ( $error ) {
- $cust_pay->invnum(''); #try again with no specific invnum
- my $error2 = $cust_pay->insert( $options{'manual'} ?
- ( 'manual' => 1 ) : ()
- );
- if ( $error2 ) {
- # gah, even with transactions.
- my $e = 'WARNING: Card/ACH debited but database not updated - '.
- "error inserting (fake!) payment: $error2".
- " (previously tried insert with invnum #$options{'invnum'}" .
- ": $error )";
- warn $e;
- return $e;
- }
- }
-
- if ( $options{'paynum_ref'} ) {
- ${ $options{'paynum_ref'} } = $cust_pay->paynum;
- }
-
- return ''; #no error
-
-}
-
-
-# item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
-#
-# Wraps up processing of a realtime credit card, ACH (electronic check) or
-# phone bill transaction.
-
-sub _realtime_bop_result {
- my( $self, $cust_pay_pending, $transaction, %options ) = @_;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- if ( $DEBUG ) {
- warn "$me _realtime_bop_result: pending transaction ".
- $cust_pay_pending->paypendingnum. "\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- my $payment_gateway = $options{payment_gateway}
- or return "no payment gateway in arguments to _realtime_bop_result";
-
- $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
- my $cpp_captured_err = $cust_pay_pending->replace;
- return $cpp_captured_err if $cpp_captured_err;
-
- if ( $transaction->is_success() ) {
-
- my $paybatch = '';
- if ( $payment_gateway->gatewaynum ) { # agent override
- $paybatch = $payment_gateway->gatewaynum. '-';
- }
-
- $paybatch .= $payment_gateway->gateway_module. ":".
- $transaction->authorization;
-
- $paybatch .= ':'. $transaction->order_number
- if $transaction->can('order_number')
- && length($transaction->order_number);
-
- my $cust_pay = new FS::cust_pay ( {
- 'custnum' => $self->custnum,
- 'invnum' => $options{'invnum'},
- 'paid' => $cust_pay_pending->paid,
- '_date' => '',
- 'payby' => $cust_pay_pending->payby,
- 'payinfo' => $options{'payinfo'},
- 'paybatch' => $paybatch,
- 'paydate' => $cust_pay_pending->paydate,
- 'pkgnum' => $cust_pay_pending->pkgnum,
- 'discount_term' => $options{'discount_term'},
- } );
- #doesn't hurt to know, even though the dup check is in cust_pay_pending now
- $cust_pay->payunique( $options{payunique} )
- if defined($options{payunique}) && length($options{payunique});
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
-
- my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
-
- if ( $error ) {
- $cust_pay->invnum(''); #try again with no specific invnum
- my $error2 = $cust_pay->insert( $options{'manual'} ?
- ( 'manual' => 1 ) : ()
- );
- if ( $error2 ) {
- # gah. but at least we have a record of the state we had to abort in
- # from cust_pay_pending now.
- my $e = "WARNING: $options{method} captured but payment not recorded -".
- " error inserting payment (". $payment_gateway->gateway_module.
- "): $error2".
- " (previously tried insert with invnum #$options{'invnum'}" .
- ": $error ) - pending payment saved as paypendingnum ".
- $cust_pay_pending->paypendingnum. "\n";
- warn $e;
- return $e;
- }
- }
-
- my $jobnum = $cust_pay_pending->jobnum;
- if ( $jobnum ) {
- my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
-
- unless ( $placeholder ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- my $e = "WARNING: $options{method} captured but job $jobnum not ".
- "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
- warn $e;
- return $e;
- }
-
- $error = $placeholder->delete;
-
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- my $e = "WARNING: $options{method} captured but could not delete ".
- "job $jobnum for paypendingnum ".
- $cust_pay_pending->paypendingnum. ": $error\n";
- warn $e;
- return $e;
- }
-
- }
-
- if ( $options{'paynum_ref'} ) {
- ${ $options{'paynum_ref'} } = $cust_pay->paynum;
- }
-
- $cust_pay_pending->status('done');
- $cust_pay_pending->statustext('captured');
- $cust_pay_pending->paynum($cust_pay->paynum);
- my $cpp_done_err = $cust_pay_pending->replace;
-
- if ( $cpp_done_err ) {
-
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- my $e = "WARNING: $options{method} captured but payment not recorded - ".
- "error updating status for paypendingnum ".
- $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
- warn $e;
- return $e;
-
- } else {
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- if ( $options{'apply'} ) {
- my $apply_error = $self->apply_payments_and_credits;
- if ( $apply_error ) {
- warn "WARNING: error applying payment: $apply_error\n";
- #but we still should return no error cause the payment otherwise went
- #through...
- }
- }
-
- return ''; #no error
-
- }
-
- } else {
-
- my $perror = $payment_gateway->gateway_module. " error: ".
- $transaction->error_message;
-
- my $jobnum = $cust_pay_pending->jobnum;
- if ( $jobnum ) {
- my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
-
- if ( $placeholder ) {
- my $error = $placeholder->depended_delete;
- $error ||= $placeholder->delete;
- warn "error removing provisioning jobs after declined paypendingnum ".
- $cust_pay_pending->paypendingnum. "\n";
- } else {
- my $e = "error finding job $jobnum for declined paypendingnum ".
- $cust_pay_pending->paypendingnum. "\n";
- warn $e;
- }
-
- }
-
- unless ( $transaction->error_message ) {
-
- my $t_response;
- if ( $transaction->can('response_page') ) {
- $t_response = {
- 'page' => ( $transaction->can('response_page')
- ? $transaction->response_page
- : ''
- ),
- 'code' => ( $transaction->can('response_code')
- ? $transaction->response_code
- : ''
- ),
- 'headers' => ( $transaction->can('response_headers')
- ? $transaction->response_headers
- : ''
- ),
- };
- } else {
- $t_response .=
- "No additional debugging information available for ".
- $payment_gateway->gateway_module;
- }
-
- $perror .= "No error_message returned from ".
- $payment_gateway->gateway_module. " -- ".
- ( ref($t_response) ? Dumper($t_response) : $t_response );
-
- }
-
- if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
- && $conf->exists('emaildecline', $self->agentnum)
- && grep { $_ ne 'POST' } $self->invoicing_list
- && ! grep { $transaction->error_message =~ /$_/ }
- $conf->config('emaildecline-exclude', $self->agentnum)
- ) {
-
- # Send a decline alert to the customer.
- my $msgnum = $conf->config('decline_msgnum', $self->agentnum);
- my $error = '';
- if ( $msgnum ) {
- # include the raw error message in the transaction state
- $cust_pay_pending->setfield('error', $transaction->error_message);
- my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
- $error = $msg_template->send( 'cust_main' => $self,
- 'object' => $cust_pay_pending );
- }
- else { #!$msgnum
-
- my @templ = $conf->config('declinetemplate');
- my $template = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", @templ ],
- ) or return "($perror) can't create template: $Text::Template::ERROR";
- $template->compile()
- or return "($perror) can't compile template: $Text::Template::ERROR";
-
- my $templ_hash = {
- 'company_name' =>
- scalar( $conf->config('company_name', $self->agentnum ) ),
- 'company_address' =>
- join("\n", $conf->config('company_address', $self->agentnum ) ),
- 'error' => $transaction->error_message,
- };
-
- my $error = send_email(
- 'from' => $conf->config('invoice_from', $self->agentnum ),
- 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ],
- 'subject' => 'Your payment could not be processed',
- 'body' => [ $template->fill_in(HASH => $templ_hash) ],
- );
- }
-
- $perror .= " (also received error sending decline notification: $error)"
- if $error;
-
- }
-
- $cust_pay_pending->status('done');
- $cust_pay_pending->statustext("declined: $perror");
- my $cpp_done_err = $cust_pay_pending->replace;
- if ( $cpp_done_err ) {
- my $e = "WARNING: $options{method} declined but pending payment not ".
- "resolved - error updating status for paypendingnum ".
- $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
- warn $e;
- $perror = "$e ($perror)";
- }
-
- return $perror;
- }
-
-}
-
-=item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
-
-Verifies successful third party processing of a realtime credit card,
-ACH (electronic check) or phone bill transaction via a
-Business::OnlineThirdPartyPayment realtime gateway. See
-L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
-
-Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
-
-The additional options I<payname>, I<city>, I<state>,
-I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
-if set, will override the value from the customer record.
-
-I<description> is a free-text field passed to the gateway. It defaults to
-"Internet services".
-
-If an I<invnum> is specified, this payment (if successful) is applied to the
-specified invoice. If you don't specify an I<invnum> you might want to
-call the B<apply_payments> method.
-
-I<quiet> can be set true to surpress email decline notices.
-
-I<paynum_ref> can be set to a scalar reference. It will be filled in with the
-resulting paynum, if any.
-
-I<payunique> is a unique identifier for this payment.
-
-Returns a hashref containing elements bill_error (which will be undefined
-upon success) and session_id of any associated session.
-
-=cut
-
-sub realtime_botpp_capture {
- my( $self, $cust_pay_pending, %options ) = @_;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- if ( $DEBUG ) {
- warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- eval "use Business::OnlineThirdPartyPayment";
- die $@ if $@;
-
- ###
- # select the gateway
- ###
-
- my $method = FS::payby->payby2bop($cust_pay_pending->payby);
-
- my $payment_gateway;
- my $gatewaynum = $cust_pay_pending->getfield('gatewaynum');
- $payment_gateway = $gatewaynum ? qsearchs( 'payment_gateway',
- { gatewaynum => $gatewaynum }
- )
- : $self->agent->payment_gateway( 'method' => $method,
- # 'invnum' => $cust_pay_pending->invnum,
- # 'payinfo' => $cust_pay_pending->payinfo,
- );
-
- $options{payment_gateway} = $payment_gateway; # for the helper subs
-
- ###
- # massage data
- ###
-
- my @invoicing_list = $self->invoicing_list_emailonly;
- if ( $conf->exists('emailinvoiceautoalways')
- || $conf->exists('emailinvoiceauto') && ! @invoicing_list
- || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
- push @invoicing_list, $self->all_emails;
- }
-
- my $email = ($conf->exists('business-onlinepayment-email-override'))
- ? $conf->config('business-onlinepayment-email-override')
- : $invoicing_list[0];
-
- my %content = ();
-
- $content{email_customer} =
- ( $conf->exists('business-onlinepayment-email_customer')
- || $conf->exists('business-onlinepayment-email-override') );
-
- ###
- # run transaction(s)
- ###
-
- my $transaction =
- new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
- $self->_bop_options(\%options),
- );
-
- $transaction->reference({ %options });
-
- $transaction->content(
- 'type' => $method,
- $self->_bop_auth(\%options),
- 'action' => 'Post Authorization',
- 'description' => $options{'description'},
- 'amount' => $cust_pay_pending->paid,
- #'invoice_number' => $options{'invnum'},
- 'customer_id' => $self->custnum,
- 'referer' => 'http://cleanwhisker.420.am/',
- 'reference' => $cust_pay_pending->paypendingnum,
- 'email' => $email,
- 'phone' => $self->daytime || $self->night,
- %content, #after
- # plus whatever is required for bogus capture avoidance
- );
-
- $transaction->submit();
-
- my $error =
- $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
-
- if ( $options{'apply'} ) {
- my $apply_error = $self->apply_payments_and_credits;
- if ( $apply_error ) {
- warn "WARNING: error applying payment: $apply_error\n";
- }
- }
-
- return {
- bill_error => $error,
- session_id => $cust_pay_pending->session_id,
- }
-
-}
-
-=item default_payment_gateway
-
-DEPRECATED -- use agent->payment_gateway
-
-=cut
-
-sub default_payment_gateway {
- my( $self, $method ) = @_;
-
- die "Real-time processing not enabled\n"
- unless $conf->exists('business-onlinepayment');
-
- #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
-
- #load up config
- my $bop_config = 'business-onlinepayment';
- $bop_config .= '-ach'
- if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
- my ( $processor, $login, $password, $action, @bop_options ) =
- $conf->config($bop_config);
- $action ||= 'normal authorization';
- pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
- die "No real-time processor is enabled - ".
- "did you set the business-onlinepayment configuration value?\n"
- unless $processor;
-
- ( $processor, $login, $password, $action, @bop_options )
-}
-
-=item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
-
-Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
-via a Business::OnlinePayment realtime gateway. See
-L<http://420.am/business-onlinepayment> for supported gateways.
-
-Available methods are: I<CC>, I<ECHECK> and I<LEC>
-
-Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
-
-Most gateways require a reference to an original payment transaction to refund,
-so you probably need to specify a I<paynum>.
-
-I<amount> defaults to the original amount of the payment if not specified.
-
-I<reason> specifies a reason for the refund.
-
-I<paydate> specifies the expiration date for a credit card overriding the
-value from the customer record or the payment record. Specified as yyyy-mm-dd
-
-Implementation note: If I<amount> is unspecified or equal to the amount of the
-orignal payment, first an attempt is made to "void" the transaction via
-the gateway (to cancel a not-yet settled transaction) and then if that fails,
-the normal attempt is made to "refund" ("credit") the transaction via the
-gateway is attempted.
-
-#The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
-#I<zip>, I<payinfo> and I<paydate> are also available. Any of these options,
-#if set, will override the value from the customer record.
-
-#If an I<invnum> is specified, this payment (if successful) is applied to the
-#specified invoice. If you don't specify an I<invnum> you might want to
-#call the B<apply_payments> method.
-
-=cut
-
-#some false laziness w/realtime_bop, not enough to make it worth merging
-#but some useful small subs should be pulled out
-sub realtime_refund_bop {
- my $self = shift;
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- my %options = ();
- if (ref($_[0]) eq 'HASH') {
- %options = %{$_[0]};
- } else {
- my $method = shift;
- %options = @_;
- $options{method} = $method;
- }
-
- if ( $DEBUG ) {
- warn "$me realtime_refund_bop (new): $options{method} refund\n";
- warn " $_ => $options{$_}\n" foreach keys %options;
- }
-
- ###
- # look up the original payment and optionally a gateway for that payment
- ###
-
- my $cust_pay = '';
- my $amount = $options{'amount'};
-
- my( $processor, $login, $password, @bop_options, $namespace ) ;
- my( $auth, $order_number ) = ( '', '', '' );
-
- if ( $options{'paynum'} ) {
-
- warn " paynum: $options{paynum}\n" if $DEBUG > 1;
- $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
- or return "Unknown paynum $options{'paynum'}";
- $amount ||= $cust_pay->paid;
-
- $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
- or return "Can't parse paybatch for paynum $options{'paynum'}: ".
- $cust_pay->paybatch;
- my $gatewaynum = '';
- ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
-
- if ( $gatewaynum ) { #gateway for the payment to be refunded
-
- my $payment_gateway =
- qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
- die "payment gateway $gatewaynum not found"
- unless $payment_gateway;
-
- $processor = $payment_gateway->gateway_module;
- $login = $payment_gateway->gateway_username;
- $password = $payment_gateway->gateway_password;
- $namespace = $payment_gateway->gateway_namespace;
- @bop_options = $payment_gateway->options;
-
- } else { #try the default gateway
-
- my $conf_processor;
- my $payment_gateway =
- $self->agent->payment_gateway('method' => $options{method});
-
- ( $conf_processor, $login, $password, $namespace ) =
- map { my $method = "gateway_$_"; $payment_gateway->$method }
- qw( module username password namespace );
-
- @bop_options = $payment_gateway->gatewaynum
- ? $payment_gateway->options
- : @{ $payment_gateway->get('options') };
-
- return "processor of payment $options{'paynum'} $processor does not".
- " match default processor $conf_processor"
- unless $processor eq $conf_processor;
-
- }
-
-
- } else { # didn't specify a paynum, so look for agent gateway overrides
- # like a normal transaction
-
- my $payment_gateway =
- $self->agent->payment_gateway( 'method' => $options{method},
- #'payinfo' => $payinfo,
- );
- my( $processor, $login, $password, $namespace ) =
- map { my $method = "gateway_$_"; $payment_gateway->$method }
- qw( module username password namespace );
-
- my @bop_options = $payment_gateway->gatewaynum
- ? $payment_gateway->options
- : @{ $payment_gateway->get('options') };
-
- }
- return "neither amount nor paynum specified" unless $amount;
-
- eval "use $namespace";
- die $@ if $@;
-
- my %content = (
- 'type' => $options{method},
- 'login' => $login,
- 'password' => $password,
- 'order_number' => $order_number,
- 'amount' => $amount,
- 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/
- );
- $content{authorization} = $auth
- if length($auth); #echeck/ACH transactions have an order # but no auth
- #(at least with authorize.net)
-
- my $disable_void_after;
- if ($conf->exists('disable_void_after')
- && $conf->config('disable_void_after') =~ /^(\d+)$/) {
- $disable_void_after = $1;
- }
-
- #first try void if applicable
- if ( $cust_pay && $cust_pay->paid == $amount
- && (
- ( not defined($disable_void_after) )
- || ( time < ($cust_pay->_date + $disable_void_after ) )
- )
- ) {
- warn " attempting void\n" if $DEBUG > 1;
- my $void = new Business::OnlinePayment( $processor, @bop_options );
- 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->test_transaction(1)
- if $conf->exists('business-onlinepayment-test_transaction');
- $void->submit();
- if ( $void->is_success ) {
- my $error = $cust_pay->void($options{'reason'});
- if ( $error ) {
- # gah, even with transactions.
- my $e = 'WARNING: Card/ACH voided but database not updated - '.
- "error voiding payment: $error";
- warn $e;
- return $e;
- }
- warn " void successful\n" if $DEBUG > 1;
- return '';
- }
- }
-
- warn " void unsuccessful, trying refund\n"
- if $DEBUG > 1;
-
- #massage data
- my $address = $self->address1;
- $address .= ", ". $self->address2 if $self->address2;
-
- my($payname, $payfirst, $paylast);
- if ( $self->payname && $options{method} ne 'ECHECK' ) {
- $payname = $self->payname;
- $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
- or return "Illegal payname $payname";
- ($payfirst, $paylast) = ($1, $2);
- } else {
- $payfirst = $self->getfield('first');
- $paylast = $self->getfield('last');
- $payname = "$payfirst $paylast";
- }
-
- my @invoicing_list = $self->invoicing_list_emailonly;
- if ( $conf->exists('emailinvoiceautoalways')
- || $conf->exists('emailinvoiceauto') && ! @invoicing_list
- || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
- push @invoicing_list, $self->all_emails;
- }
-
- my $email = ($conf->exists('business-onlinepayment-email-override'))
- ? $conf->config('business-onlinepayment-email-override')
- : $invoicing_list[0];
-
- my $payip = exists($options{'payip'})
- ? $options{'payip'}
- : $self->payip;
- $content{customer_ip} = $payip
- if length($payip);
-
- my $payinfo = '';
- if ( $options{method} eq 'CC' ) {
-
- if ( $cust_pay ) {
- $content{card_number} = $payinfo = $cust_pay->payinfo;
- (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
- =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
- ($content{expiration} = "$2/$1"); # where available
- } else {
- $content{card_number} = $payinfo = $self->payinfo;
- (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
- =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
- $content{expiration} = "$2/$1";
- }
-
- } elsif ( $options{method} eq 'ECHECK' ) {
-
- if ( $cust_pay ) {
- $payinfo = $cust_pay->payinfo;
- } else {
- $payinfo = $self->payinfo;
- }
- ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
- $content{bank_name} = $self->payname;
- $content{account_type} = 'CHECKING';
- $content{account_name} = $payname;
- $content{customer_org} = $self->company ? 'B' : 'I';
- $content{customer_ssn} = $self->ss;
- } elsif ( $options{method} eq 'LEC' ) {
- $content{phone} = $payinfo = $self->payinfo;
- }
-
- #then try refund
- my $refund = new Business::OnlinePayment( $processor, @bop_options );
- my %sub_content = $refund->content(
- 'action' => 'credit',
- 'customer_id' => $self->custnum,
- 'last_name' => $paylast,
- 'first_name' => $payfirst,
- 'name' => $payname,
- 'address' => $address,
- 'city' => $self->city,
- 'state' => $self->state,
- 'zip' => $self->zip,
- 'country' => $self->country,
- 'email' => $email,
- 'phone' => $self->daytime || $self->night,
- %content, #after
- );
- warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content )
- if $DEBUG > 1;
- $refund->test_transaction(1)
- if $conf->exists('business-onlinepayment-test_transaction');
- $refund->submit();
-
- return "$processor error: ". $refund->error_message
- unless $refund->is_success();
-
- my $paybatch = "$processor:". $refund->authorization;
- $paybatch .= ':'. $refund->order_number
- if $refund->can('order_number') && $refund->order_number;
-
- while ( $cust_pay && $cust_pay->unapplied < $amount ) {
- my @cust_bill_pay = $cust_pay->cust_bill_pay;
- last unless @cust_bill_pay;
- my $cust_bill_pay = pop @cust_bill_pay;
- my $error = $cust_bill_pay->delete;
- last if $error;
- }
-
- my $cust_refund = new FS::cust_refund ( {
- 'custnum' => $self->custnum,
- 'paynum' => $options{'paynum'},
- 'refund' => $amount,
- '_date' => '',
- 'payby' => $bop_method2payby{$options{method}},
- 'payinfo' => $payinfo,
- 'paybatch' => $paybatch,
- 'reason' => $options{'reason'} || 'card or ACH refund',
- } );
- my $error = $cust_refund->insert;
- if ( $error ) {
- $cust_refund->paynum(''); #try again with no specific paynum
- my $error2 = $cust_refund->insert;
- if ( $error2 ) {
- # gah, even with transactions.
- my $e = 'WARNING: Card/ACH refunded but database not updated - '.
- "error inserting refund ($processor): $error2".
- " (previously tried insert with paynum #$options{'paynum'}" .
- ": $error )";
- warn $e;
- return $e;
- }
- }
-
- ''; #no error
-
-}
-
-=back
-
-=head1 BUGS
-
-Not autoloaded.
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, L<FS::cust_main::Billing>
-
-=cut
-
-1;
diff --git a/FS/FS/cust_main/Import.pm b/FS/FS/cust_main/Import.pm
deleted file mode 100644
index 7f5a3f0..0000000
--- a/FS/FS/cust_main/Import.pm
+++ /dev/null
@@ -1,472 +0,0 @@
-package FS::cust_main::Import;
-
-use strict;
-use vars qw( $DEBUG $conf );
-use Storable qw(thaw);
-use Data::Dumper;
-use MIME::Base64;
-use File::Slurp qw( slurp );
-use FS::Misc::DateTime qw( parse_datetime );
-use FS::UID qw( dbh );
-use FS::Record qw( qsearchs );
-use FS::cust_main;
-use FS::svc_acct;
-use FS::svc_external;
-use FS::svc_phone;
-use FS::part_referral;
-
-$DEBUG = 0;
-
-install_callback FS::UID sub {
- $conf = new FS::Conf;
-};
-
-=head1 NAME
-
-FS::cust_main::Import - Batch customer importing
-
-=head1 SYNOPSIS
-
- use FS::cust_main::Import;
-
- #import
- FS::cust_main::Import::batch_import( {
- file => $file, #filename
- type => $type, #csv or xls
- format => $format, #extended, extended-plus_company, svc_external,
- #extended-plus_company_and_options
- #extended-plus_options, or svc_external_svc_phone
- agentnum => $agentnum,
- refnum => $refnum,
- pkgpart => $pkgpart,
- job => $job, #optional job queue job, for progressbar updates
- custbatch => $custbatch, #optional batch unique identifier
- } );
- die $error if $error;
-
- #ajax helper
- use FS::UI::Web::JSRPC;
- my $server =
- new FS::UI::Web::JSRPC 'FS::cust_main::Import::process_batch_import', $cgi;
- print $server->process;
-
-=head1 DESCRIPTION
-
-Batch customer importing.
-
-=head1 SUBROUTINES
-
-=item process_batch_import
-
-Load a batch import as a queued JSRPC job
-
-=cut
-
-sub process_batch_import {
- my $job = shift;
-
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- my $files = $param->{'uploaded_files'}
- or die "No files provided.\n";
-
- my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
-
- my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
- my $file = $dir. $files{'file'};
-
- my $type;
- if ( $file =~ /\.(\w+)$/i ) {
- $type = lc($1);
- } else {
- #or error out???
- warn "can't parse file type from filename $file; defaulting to CSV";
- $type = 'csv';
- }
-
- my $error =
- FS::cust_main::Import::batch_import( {
- job => $job,
- file => $file,
- type => $type,
- custbatch => $param->{custbatch},
- agentnum => $param->{'agentnum'},
- refnum => $param->{'refnum'},
- pkgpart => $param->{'pkgpart'},
- #'fields' => [qw( cust_pkg.setup dayphone first last address1 address2
- # city state zip comments )],
- 'format' => $param->{'format'},
- } );
-
- unlink $file;
-
- die "$error\n" if $error;
-
-}
-
-=item batch_import
-
-=cut
-
-
-#some false laziness w/cdr.pm now
-sub batch_import {
- my $param = shift;
-
- my $job = $param->{job};
-
- my $filename = $param->{file};
- my $type = $param->{type} || 'csv';
-
- my $custbatch = $param->{custbatch};
-
- my $agentnum = $param->{agentnum};
- my $refnum = $param->{refnum};
- my $pkgpart = $param->{pkgpart};
-
- my $format = $param->{'format'};
-
- my @fields;
- my $payby;
- if ( $format eq 'simple' ) {
- @fields = qw( cust_pkg.setup dayphone first last
- address1 address2 city state zip comments );
- $payby = 'BILL';
- } elsif ( $format eq 'extended' ) {
- @fields = qw( agent_custid refnum
- last first address1 address2 city state zip country
- daytime night
- ship_last ship_first ship_address1 ship_address2
- ship_city ship_state ship_zip ship_country
- payinfo paycvv paydate
- invoicing_list
- cust_pkg.pkgpart
- svc_acct.username svc_acct._password
- );
- $payby = 'BILL';
- } elsif ( $format eq 'extended-plus_options' ) {
- @fields = qw( agent_custid refnum
- last first address1 address2 city state zip country
- daytime night
- ship_last ship_first ship_company ship_address1 ship_address2
- ship_city ship_state ship_zip ship_country
- payinfo paycvv paydate
- invoicing_list
- cust_pkg.pkgpart
- svc_acct.username svc_acct._password
- customer_options
- );
- $payby = 'BILL';
- } elsif ( $format eq 'extended-plus_company' ) {
- @fields = qw( agent_custid refnum
- last first company address1 address2 city state zip country
- daytime night
- ship_last ship_first ship_company ship_address1 ship_address2
- ship_city ship_state ship_zip ship_country
- payinfo paycvv paydate
- invoicing_list
- cust_pkg.pkgpart
- svc_acct.username svc_acct._password
- );
- $payby = 'BILL';
- } elsif ( $format eq 'extended-plus_company_and_options' ) {
- @fields = qw( agent_custid refnum
- last first company address1 address2 city state zip country
- daytime night
- ship_last ship_first ship_company ship_address1 ship_address2
- ship_city ship_state ship_zip ship_country
- payinfo paycvv paydate
- invoicing_list
- cust_pkg.pkgpart
- svc_acct.username svc_acct._password
- customer_options
- );
- $payby = 'BILL';
- } elsif ( $format =~ /^svc_external/ ) {
- @fields = qw( agent_custid refnum
- last first company address1 address2 city state zip country
- daytime night
- ship_last ship_first ship_company ship_address1 ship_address2
- ship_city ship_state ship_zip ship_country
- payinfo paycvv paydate
- invoicing_list
- cust_pkg.pkgpart cust_pkg.bill
- svc_external.id svc_external.title
- );
- push @fields, map "svc_phone.$_", qw( countrycode phonenum sip_password pin)
- if $format eq 'svc_external_svc_phone';
- $payby = 'BILL';
- } else {
- die "unknown format $format";
- }
-
- my $count;
- my $parser;
- my @buffer = ();
- if ( $type eq 'csv' ) {
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
-
- $parser = new Text::CSV_XS;
-
- @buffer = split(/\r?\n/, slurp($filename) );
- $count = scalar(@buffer);
-
- } elsif ( $type eq 'xls' ) {
-
- eval "use Spreadsheet::ParseExcel;";
- die $@ if $@;
-
- my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($filename);
- $parser = $excel->{Worksheet}[0]; #first sheet
-
- $count = $parser->{MaxRow} || $parser->{MinRow};
- $count++;
-
- } else {
- die "Unknown file type $type\n";
- }
-
- #my $columns;
-
- 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;
-
- #implies ignore_expired_card
- local($FS::cust_main::import) = 1;
- local($FS::cust_main::import) = 1;
-
- my $line;
- my $row = 0;
- my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
- while (1) {
-
- my @columns = ();
- if ( $type eq 'csv' ) {
-
- last unless scalar(@buffer);
- $line = shift(@buffer);
-
- $parser->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $parser->error_input();
- };
- @columns = $parser->fields();
-
- } elsif ( $type eq 'xls' ) {
-
- last if $row > ($parser->{MaxRow} || $parser->{MinRow})
- || ! $parser->{Cells}[$row];
-
- my @row = @{ $parser->{Cells}[$row] };
- @columns = map $_->{Val}, @row;
-
- #my $z = 'A';
- #warn $z++. ": $_\n" for @columns;
-
- } else {
- die "Unknown file type $type\n";
- }
-
- #warn join('-',@columns);
-
- my %cust_main = (
- custbatch => $custbatch,
- agentnum => $agentnum,
- refnum => $refnum,
- country => $conf->config('countrydefault') || 'US',
- payby => $payby, #default
- paydate => '12/2037', #default
- );
- my $billtime = time;
- my %cust_pkg = ( pkgpart => $pkgpart );
- my %svc_x = ();
- foreach my $field ( @fields ) {
-
- if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
-
- #$cust_pkg{$1} = parse_datetime( shift @$columns );
- if ( $1 eq 'pkgpart' ) {
- $cust_pkg{$1} = shift @columns;
- } elsif ( $1 eq 'setup' ) {
- $billtime = parse_datetime(shift @columns);
- } else {
- $cust_pkg{$1} = parse_datetime( shift @columns );
- }
-
- } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
-
- $svc_x{$1} = shift @columns;
-
- } elsif ( $field =~ /^svc_external\.(id|title)$/ ) {
-
- $svc_x{$1} = shift @columns;
-
- } elsif ( $field =~ /^svc_phone\.(countrycode|phonenum|sip_password|pin)$/ ) {
- $svc_x{$1} = shift @columns;
-
- } else {
-
- #refnum interception
- if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
-
- my $referral = $columns[0];
- my %hash = ( 'referral' => $referral,
- 'agentnum' => $agentnum,
- 'disabled' => '',
- );
-
- my $part_referral = qsearchs('part_referral', \%hash )
- || new FS::part_referral \%hash;
-
- unless ( $part_referral->refnum ) {
- my $error = $part_referral->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't auto-insert advertising source: $referral: $error";
- }
- }
-
- $columns[0] = $part_referral->refnum;
- }
-
- my $value = shift @columns;
- $cust_main{$field} = $value if length($value);
- }
- }
-
- if ( defined $cust_main{'payinfo'} && length $cust_main{'payinfo'} ) {
- $cust_main{'payby'} = 'CARD';
- if ($cust_main{'payinfo'} =~ /\s*([AD]?)(.*)\s*$/) {
- $cust_main{'payby'} = 'DCRD' if $1 eq 'D';
- $cust_main{'payinfo'} = $2;
- }
- }
-
- my $invoicing_list = $cust_main{'invoicing_list'}
- ? [ delete $cust_main{'invoicing_list'} ]
- : [];
-
- my $customer_options = delete $cust_main{customer_options};
- $cust_main{tax} = 'Y' if $customer_options =~ /taxexempt/i;
- push @$invoicing_list, 'POST' if $customer_options =~ /postalinvoice/i;
-
- my $cust_main = new FS::cust_main ( \%cust_main );
-
- use Tie::RefHash;
- tie my %hash, 'Tie::RefHash'; #this part is important
-
- if ( $cust_pkg{'pkgpart'} ) {
-
- unless ( $cust_pkg{'pkgpart'} =~ /^\d+$/ ) {
- $dbh->rollback if $oldAutoCommit;
- return 'illegal pkgpart: '. $cust_pkg{'pkgpart'};
- }
-
- my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
-
- my @svc_x = ();
- my $svcdb = '';
- if ( $svc_x{'username'} ) {
- $svcdb = 'svc_acct';
- } elsif ( $svc_x{'id'} || $svc_x{'title'} ) {
- $svcdb = 'svc_external';
- }
-
- my $svc_phone = '';
- if ( $svc_x{'countrycode'} || $svc_x{'phonenum'} ) {
- $svc_phone = FS::svc_phone->new( {
- map { $_ => delete($svc_x{$_}) }
- qw( countrycode phonenum sip_password pin)
- } );
- }
-
- if ( $svcdb || $svc_phone ) {
- my $part_pkg = $cust_pkg->part_pkg;
- unless ( $part_pkg ) {
- $dbh->rollback if $oldAutoCommit;
- return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
- }
- if ( $svcdb ) {
- $svc_x{svcpart} = $part_pkg->svcpart_unique_svcdb( $svcdb );
- my $class = "FS::$svcdb";
- push @svc_x, $class->new( \%svc_x );
- }
- if ( $svc_phone ) {
- $svc_phone->svcpart( $part_pkg->svcpart_unique_svcdb('svc_phone') );
- push @svc_x, $svc_phone;
- }
- }
-
- $hash{$cust_pkg} = \@svc_x;
- }
-
- my $error = $cust_main->insert( \%hash, $invoicing_list );
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert customer". ( $line ? " for $line" : '' ). ": $error";
- }
-
- if ( $format eq 'simple' ) {
-
- #false laziness w/bill.cgi
- $error = $cust_main->bill( 'time' => $billtime );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't bill customer for $line: $error";
- }
-
- $error = $cust_main->apply_payments_and_credits;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't bill customer for $line: $error";
- }
-
- $error = $cust_main->collect();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't collect customer for $line: $error";
- }
-
- }
-
- $row++;
-
- if ( $job && time - $min_sec > $last ) { #progress bar
- $job->update_statustext( int(100 * $row / $count) );
- $last = time;
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
-
- return "Empty file!" unless $row;
-
- ''; #no error
-
-}
-
-=head1 BUGS
-
-Not enough documentation.
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, L<FS::cust_pkg>,
-L<FS::svc_acct>, L<FS::svc_external>, L<FS::svc_phone>
-
-=cut
-
-1;
diff --git a/FS/FS/cust_main/Packages.pm b/FS/FS/cust_main/Packages.pm
deleted file mode 100644
index ab7bde3..0000000
--- a/FS/FS/cust_main/Packages.pm
+++ /dev/null
@@ -1,452 +0,0 @@
-package FS::cust_main::Packages;
-
-use strict;
-use vars qw( $DEBUG $me );
-use List::Util qw( min );
-use FS::UID qw( dbh );
-use FS::Record qw( qsearch );
-use FS::cust_pkg;
-use FS::cust_svc;
-
-$DEBUG = 0;
-$me = '[FS::cust_main::Packages]';
-
-=head1 NAME
-
-FS::cust_main::Packages - Packages mixin for cust_main
-
-=head1 SYNOPSIS
-
-=head1 DESRIPTION
-
-These methods are available on FS::cust_main objects;
-
-=head1 METHODS
-
-=over 4
-
-=item order_pkg HASHREF | OPTION => VALUE ...
-
-Orders a single package.
-
-Options may be passed as a list of key/value pairs or as a hash reference.
-Options are:
-
-=over 4
-
-=item cust_pkg
-
-FS::cust_pkg object
-
-=item cust_location
-
-Optional FS::cust_location object
-
-=item svcs
-
-Optional arryaref of FS::svc_* service objects.
-
-=item depend_jobnum
-
-If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
-jobs will have a dependancy on the supplied job (they will not run until the
-specific job completes). This can be used to defer provisioning until some
-action completes (such as running the customer's credit card successfully).
-
-=item ticket_subject
-
-Optional subject for a ticket created and attached to this customer
-
-=item ticket_subject
-
-Optional queue name for ticket additions
-
-=back
-
-=cut
-
-sub order_pkg {
- my $self = shift;
- my $opt = ref($_[0]) ? shift : { @_ };
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- warn "$me order_pkg called with options ".
- join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
- if $DEBUG;
-
- my $cust_pkg = $opt->{'cust_pkg'};
- my $svcs = $opt->{'svcs'} || [];
-
- my %svc_options = ();
- $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
- if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
-
- my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
- qw( ticket_subject ticket_queue );
-
- 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 ( $opt->{'cust_location'} &&
- ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
- my $error = $opt->{'cust_location'}->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting cust_location (transaction rolled back): $error";
- }
- $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
- }
-
- $cust_pkg->custnum( $self->custnum );
-
- my $error = $cust_pkg->insert( %insert_params );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting cust_pkg (transaction rolled back): $error";
- }
-
- foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
- if ( $svc_something->svcnum ) {
- my $old_cust_svc = $svc_something->cust_svc;
- my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
- $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
- $error = $new_cust_svc->replace($old_cust_svc);
- } else {
- $svc_something->pkgnum( $cust_pkg->pkgnum );
- if ( $svc_something->isa('FS::svc_acct') ) {
- foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
- qw( seconds upbytes downbytes totalbytes ) ) {
- $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
- ${ $opt->{$_.'_ref'} } = 0;
- }
- }
- $error = $svc_something->insert(%svc_options);
- }
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting svc_ (transaction rolled back): $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-
-}
-
-#deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
-=item order_pkgs HASHREF [ , OPTION => VALUE ... ]
-
-Like the insert method on an existing record, this method orders multiple
-packages and included services atomicaly. Pass a Tie::RefHash data structure
-to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
-There should be a better explanation of this, but until then, here's an
-example:
-
- use Tie::RefHash;
- tie %hash, 'Tie::RefHash'; #this part is important
- %hash = (
- $cust_pkg => [ $svc_acct ],
- ...
- );
- $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
-
-Services can be new, in which case they are inserted, or existing unaudited
-services, in which case they are linked to the newly-created package.
-
-Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
-I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
-
-If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
-on the supplied jobnum (they will not run until the specific job completes).
-This can be used to defer provisioning until some action completes (such
-as running the customer's credit card successfully).
-
-The I<noexport> option is deprecated. If I<noexport> is set true, no
-provisioning jobs (exports) are scheduled. (You can schedule them later with
-the B<reexport> method for each cust_pkg object. Using the B<reexport> method
-on the cust_main object is not recommended, as existing services will also be
-reexported.)
-
-If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
-provided, the scalars (provided by references) will be incremented by the
-values of the prepaid card.`
-
-=cut
-
-sub order_pkgs {
- my $self = shift;
- my $cust_pkgs = shift;
- my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
- my %options = @_;
- $seconds_ref ||= $options{'seconds_ref'};
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- warn "$me order_pkgs called with options ".
- join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
- if $DEBUG;
-
- 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;
-
- local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
-
- foreach my $cust_pkg ( keys %$cust_pkgs ) {
-
- my $error = $self->order_pkg(
- 'cust_pkg' => $cust_pkg,
- 'svcs' => $cust_pkgs->{$cust_pkg},
- 'seconds_ref' => $seconds_ref,
- map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
- depend_jobnum
- )
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-}
-
-=item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
-
-Returns all packages (see L<FS::cust_pkg>) for this customer.
-
-=cut
-
-sub all_pkgs {
- my $self = shift;
- my $extra_qsearch = ref($_[0]) ? shift : { @_ };
-
- return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
-
- my @cust_pkg = ();
- if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
- @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
- } else {
- @cust_pkg = $self->_cust_pkg($extra_qsearch);
- }
-
- map { $_ } sort sort_packages @cust_pkg;
-}
-
-=item cust_pkg
-
-Synonym for B<all_pkgs>.
-
-=cut
-
-sub cust_pkg {
- shift->all_pkgs(@_);
-}
-
-=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
-
-Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
-
-=cut
-
-sub ncancelled_pkgs {
- my $self = shift;
- my $extra_qsearch = ref($_[0]) ? shift : {};
-
- local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
-
- return $self->num_ncancelled_pkgs unless wantarray;
-
- my @cust_pkg = ();
- if ( $self->{'_pkgnum'} ) {
-
- warn "$me ncancelled_pkgs: returning cached objects"
- if $DEBUG > 1;
-
- @cust_pkg = grep { ! $_->getfield('cancel') }
- values %{ $self->{'_pkgnum'}->cache };
-
- } else {
-
- warn "$me ncancelled_pkgs: searching for packages with custnum ".
- $self->custnum. "\n"
- if $DEBUG > 1;
-
- $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
-
- @cust_pkg = $self->_cust_pkg($extra_qsearch);
-
- }
-
- sort sort_packages @cust_pkg;
-
-}
-
-sub _cust_pkg {
- my $self = shift;
- my $extra_qsearch = ref($_[0]) ? shift : {};
-
- $extra_qsearch->{'select'} ||= '*';
- $extra_qsearch->{'select'} .=
- ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
- AS _num_cust_svc';
-
- map {
- $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
- $_;
- }
- qsearch({
- %$extra_qsearch,
- 'table' => 'cust_pkg',
- 'hashref' => { 'custnum' => $self->custnum },
- });
-
-}
-
-# This should be generalized to use config options to determine order.
-sub sort_packages {
-
- my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
- return $locationsort if $locationsort;
-
- if ( $a->get('cancel') xor $b->get('cancel') ) {
- return -1 if $b->get('cancel');
- return 1 if $a->get('cancel');
- #shouldn't get here...
- return 0;
- } else {
- my $a_num_cust_svc = $a->num_cust_svc;
- my $b_num_cust_svc = $b->num_cust_svc;
- return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
- return -1 if $a_num_cust_svc && !$b_num_cust_svc;
- return 1 if !$a_num_cust_svc && $b_num_cust_svc;
- my @a_cust_svc = $a->cust_svc;
- my @b_cust_svc = $b->cust_svc;
- return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
- return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
- return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
- $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
- }
-
-}
-
-=item suspended_pkgs
-
-Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
-
-=cut
-
-sub suspended_pkgs {
- my $self = shift;
- grep { $_->susp } $self->ncancelled_pkgs;
-}
-
-=item unflagged_suspended_pkgs
-
-Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
-customer (thouse packages without the `manual_flag' set).
-
-=cut
-
-sub unflagged_suspended_pkgs {
- my $self = shift;
- return $self->suspended_pkgs
- unless dbdef->table('cust_pkg')->column('manual_flag');
- grep { ! $_->manual_flag } $self->suspended_pkgs;
-}
-
-=item unsuspended_pkgs
-
-Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
-this customer.
-
-=cut
-
-sub unsuspended_pkgs {
- my $self = shift;
- grep { ! $_->susp } $self->ncancelled_pkgs;
-}
-
-=item active_pkgs
-
-Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
-this customer that are active (recurring).
-
-=cut
-
-sub active_pkgs {
- my $self = shift;
- grep { my $part_pkg = $_->part_pkg;
- $part_pkg->freq ne '' && $part_pkg->freq ne '0';
- }
- $self->unsuspended_pkgs;
-}
-
-=item next_bill_date
-
-Returns the next date this customer will be billed, as a UNIX timestamp, or
-undef if no active package has a next bill date.
-
-=cut
-
-sub next_bill_date {
- my $self = shift;
- min( map $_->get('bill'), grep $_->get('bill'), $self->active_pkgs );
-}
-
-=item num_cancelled_pkgs
-
-Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
-customer.
-
-=cut
-
-sub num_cancelled_pkgs {
- shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
-}
-
-sub num_ncancelled_pkgs {
- shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
-}
-
-sub num_pkgs {
- my( $self ) = shift;
- my $sql = scalar(@_) ? shift : '';
- $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
- my $sth = dbh->prepare(
- "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
- ) or die dbh->errstr;
- $sth->execute($self->custnum) or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, L<FS::cust_pkg>
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm
deleted file mode 100644
index ad24ff8..0000000
--- a/FS/FS/cust_main/Search.pm
+++ /dev/null
@@ -1,881 +0,0 @@
-package FS::cust_main::Search;
-
-use strict;
-use base qw( Exporter );
-use vars qw( @EXPORT_OK $DEBUG $me $conf @fuzzyfields );
-use String::Approx qw(amatch);
-use FS::UID qw( dbh );
-use FS::Record qw( qsearch );
-use FS::cust_main;
-use FS::cust_main_invoice;
-use FS::svc_acct;
-
-@EXPORT_OK = qw( smart_search );
-
-# 1 is mostly method/subroutine entry and options
-# 2 traces progress of some operations
-# 3 is even more information including possibly sensitive data
-$DEBUG = 0;
-$me = '[FS::cust_main::Search]';
-
-@fuzzyfields = @FS::cust_main::fuzzyfields;
-
-install_callback FS::UID sub {
- $conf = new FS::Conf;
- #yes, need it for stuff below (prolly should be cached)
-};
-
-=head1 NAME
-
-FS::cust_main::Search - Customer searching
-
-=head1 SYNOPSIS
-
- use FS::cust_main::Search;
-
- FS::cust_main::Search::smart_search(%options);
-
- FS::cust_main::Search::email_search(%options);
-
- FS::cust_main::Search->search( \%options );
-
- FS::cust_main::Search->fuzzy_search( \%fuzzy_hashref );
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item smart_search OPTION => VALUE ...
-
-Accepts the following options: I<search>, the string to search for. The string
-will be searched for as a customer number, phone number, name or company name,
-as an exact, or, in some cases, a substring or fuzzy match (see the source code
-for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
-skip fuzzy matching when an exact match is found.
-
-Any additional options are treated as an additional qualifier on the search
-(i.e. I<agentnum>).
-
-Returns a (possibly empty) array of FS::cust_main objects.
-
-=cut
-
-sub smart_search {
- my %options = @_;
-
- #here is the agent virtualization
- my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
-
- my @cust_main = ();
-
- my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
- my $search = delete $options{'search'};
- ( my $alphanum_search = $search ) =~ s/\W//g;
-
- if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
-
- #false laziness w/Record::ut_phone
- my $phonen = "$1-$2-$3";
- $phonen .= " x$4" if $4;
-
- push @cust_main, qsearch( {
- 'table' => 'cust_main',
- 'hashref' => { %options },
- 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
- ' ( '.
- join(' OR ', map "$_ = '$phonen'",
- qw( daytime night fax
- ship_daytime ship_night ship_fax )
- ).
- ' ) '.
- " AND $agentnums_sql", #agent virtualization
- } );
-
- unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
- #try looking for matches with extensions unless one was specified
-
- push @cust_main, qsearch( {
- 'table' => 'cust_main',
- 'hashref' => { %options },
- 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
- ' ( '.
- join(' OR ', map "$_ LIKE '$phonen\%'",
- qw( daytime night
- ship_daytime ship_night )
- ).
- ' ) '.
- " AND $agentnums_sql", #agent virtualization
- } );
-
- }
-
- # custnum search (also try agent_custid), with some tweaking options if your
- # legacy cust "numbers" have letters
- }
-
- if ( $search =~ /^\s*(\d+)\s*$/
- || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
- && $search =~ /^\s*(\w\w?\d+)\s*$/
- )
- || ( $conf->exists('address1-search' )
- && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
- )
- )
- {
-
- my $num = $1;
-
- if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
- push @cust_main, qsearch( {
- 'table' => 'cust_main',
- 'hashref' => { 'custnum' => $num, %options },
- 'extra_sql' => " AND $agentnums_sql", #agent virtualization
- } );
- }
-
- push @cust_main, qsearch( {
- 'table' => 'cust_main',
- 'hashref' => { 'agent_custid' => $num, %options },
- 'extra_sql' => " AND $agentnums_sql", #agent virtualization
- } );
-
- if ( $conf->exists('address1-search') ) {
- my $len = length($num);
- $num = lc($num);
- foreach my $prefix ( '', 'ship_' ) {
- push @cust_main, qsearch( {
- 'table' => 'cust_main',
- 'hashref' => { %options, },
- 'extra_sql' =>
- ( keys(%options) ? ' AND ' : ' WHERE ' ).
- " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
- " AND $agentnums_sql",
- } );
- }
- }
-
- } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
-
- my($company, $last, $first) = ( $1, $2, $3 );
-
- # "Company (Last, First)"
- #this is probably something a browser remembered,
- #so just do an exact search (but case-insensitive, so USPS standardization
- #doesn't throw a wrench in the works)
-
- foreach my $prefix ( '', 'ship_' ) {
- push @cust_main, qsearch( {
- 'table' => 'cust_main',
- 'hashref' => { %options },
- 'extra_sql' =>
- ( keys(%options) ? ' AND ' : ' WHERE ' ).
- join(' AND ',
- " LOWER(${prefix}first) = ". dbh->quote(lc($first)),
- " LOWER(${prefix}last) = ". dbh->quote(lc($last)),
- " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
- $agentnums_sql,
- ),
- } );
- }
-
- } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
- # try (ship_){last,company}
-
- my $value = lc($1);
-
- # # remove "(Last, First)" in "Company (Last, First)", otherwise the
- # # full strings the browser remembers won't work
- # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
-
- use Lingua::EN::NameParse;
- my $NameParse = new Lingua::EN::NameParse(
- auto_clean => 1,
- allow_reversed => 1,
- );
-
- my($last, $first) = ( '', '' );
- #maybe disable this too and just rely on NameParse?
- if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
-
- ($last, $first) = ( $1, $2 );
-
- #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
- } elsif ( ! $NameParse->parse($value) ) {
-
- my %name = $NameParse->components;
- $first = $name{'given_name_1'} || $name{'initials_1'}; #wtf NameParse, Ed?
- $last = $name{'surname_1'};
-
- }
-
- if ( $first && $last ) {
-
- my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
-
- #exact
- my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
- $sql .= "
- ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
- OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
- )";
-
- push @cust_main, qsearch( {
- 'table' => 'cust_main',
- 'hashref' => \%options,
- 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
- } );
-
- # or it just be something that was typed in... (try that in a sec)
-
- }
-
- my $q_value = dbh->quote($value);
-
- #exact
- my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
- $sql .= " ( LOWER(last) = $q_value
- OR LOWER(company) = $q_value
- OR LOWER(ship_last) = $q_value
- OR LOWER(ship_company) = $q_value
- ";
- $sql .= " OR LOWER(address1) = $q_value
- OR LOWER(ship_address1) = $q_value
- "
- if $conf->exists('address1-search');
- $sql .= " )";
-
- push @cust_main, qsearch( {
- 'table' => 'cust_main',
- 'hashref' => \%options,
- 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
- } );
-
- #no exact match, trying substring/fuzzy
- #always do substring & fuzzy (unless they're explicity config'ed off)
- #getting complaints searches are not returning enough
- unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
-
- #still some false laziness w/search (was search/cust_main.cgi)
-
- #substring
-
- my @hashrefs = (
- { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
- { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
- );
-
- if ( $first && $last ) {
-
- push @hashrefs,
- { 'first' => { op=>'ILIKE', value=>"%$first%" },
- 'last' => { op=>'ILIKE', value=>"%$last%" },
- },
- { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
- 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
- },
- ;
-
- } else {
-
- push @hashrefs,
- { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
- { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
- ;
- }
-
- if ( $conf->exists('address1-search') ) {
- push @hashrefs,
- { 'address1' => { op=>'ILIKE', value=>"%$value%" }, },
- { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
- ;
- }
-
- foreach my $hashref ( @hashrefs ) {
-
- push @cust_main, qsearch( {
- 'table' => 'cust_main',
- 'hashref' => { %$hashref,
- %options,
- },
- 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
- } );
-
- }
-
- #fuzzy
- my @fuzopts = (
- \%options, #hashref
- '', #select
- " AND $agentnums_sql", #extra_sql #agent virtualization
- );
-
- if ( $first && $last ) {
- push @cust_main, FS::cust_main::Search->fuzzy_search(
- { 'last' => $last, #fuzzy hashref
- 'first' => $first }, #
- @fuzopts
- );
- }
- foreach my $field ( 'last', 'company' ) {
- push @cust_main,
- FS::cust_main::Search->fuzzy_search( { $field => $value }, @fuzopts );
- }
- if ( $conf->exists('address1-search') ) {
- push @cust_main,
- FS::cust_main::Search->fuzzy_search( { 'address1' => $value }, @fuzopts );
- }
-
- }
-
- }
-
- #eliminate duplicates
- my %saw = ();
- @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
-
- @cust_main;
-
-}
-
-=item email_search
-
-Accepts the following options: I<email>, the email address to search for. The
-email address will be searched for as an email invoice destination and as an
-svc_acct account.
-
-#Any additional options are treated as an additional qualifier on the search
-#(i.e. I<agentnum>).
-
-Returns a (possibly empty) array of FS::cust_main objects (but usually just
-none or one).
-
-=cut
-
-sub email_search {
- my %options = @_;
-
- local($DEBUG) = 1;
-
- my $email = delete $options{'email'};
-
- #we're only being used by RT at the moment... no agent virtualization yet
- #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
-
- my @cust_main = ();
-
- if ( $email =~ /([^@]+)\@([^@]+)/ ) {
-
- my ( $user, $domain ) = ( $1, $2 );
-
- warn "$me smart_search: searching for $user in domain $domain"
- if $DEBUG;
-
- push @cust_main,
- map $_->cust_main,
- qsearch( {
- 'table' => 'cust_main_invoice',
- 'hashref' => { 'dest' => $email },
- }
- );
-
- push @cust_main,
- map $_->cust_main,
- grep $_,
- map $_->cust_svc->cust_pkg,
- qsearch( {
- 'table' => 'svc_acct',
- 'hashref' => { 'username' => $user, },
- 'extra_sql' =>
- 'AND ( SELECT domain FROM svc_domain
- WHERE svc_acct.domsvc = svc_domain.svcnum
- ) = '. dbh->quote($domain),
- }
- );
- }
-
- my %saw = ();
- @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
-
- warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
- if $DEBUG;
-
- @cust_main;
-
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item search HASHREF
-
-(Class method)
-
-Returns a qsearch hash expression to search for parameters specified in
-HASHREF. Valid parameters are
-
-=over 4
-
-=item agentnum
-
-=item status
-
-=item address
-
-=item cancelled_pkgs
-
-bool
-
-=item signupdate
-
-listref of start date, end date
-
-=item payby
-
-listref
-
-=item paydate_year
-
-=item paydate_month
-
-=item current_balance
-
-listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
-
-=item cust_fields
-
-=item flattened_pkgs
-
-bool
-
-=back
-
-=cut
-
-sub search {
- my ($class, $params) = @_;
-
- my $dbh = dbh;
-
- my @where = ();
- my $orderby;
-
- ##
- # parse agent
- ##
-
- if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
- push @where,
- "cust_main.agentnum = $1";
- }
-
- ##
- # do the same for user
- ##
-
- if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) {
- push @where,
- "cust_main.usernum = $1";
- }
-
- ##
- # parse status
- ##
-
- #prospect ordered active inactive suspended cancelled
- if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
- my $method = $params->{'status'}. '_sql';
- #push @where, $class->$method();
- push @where, FS::cust_main->$method();
- }
-
- ##
- # address
- ##
- if ( $params->{'address'} =~ /\S/ ) {
- my $address = dbh->quote('%'. lc($params->{'address'}). '%');
- push @where, '('. join(' OR ',
- map "LOWER($_) LIKE $address",
- qw(address1 address2 ship_address1 ship_address2)
- ).
- ')';
- }
-
- ##
- # parse cancelled package checkbox
- ##
-
- my $pkgwhere = "";
-
- $pkgwhere .= "AND (cancel = 0 or cancel is null)"
- unless $params->{'cancelled_pkgs'};
-
- ##
- # parse without census tract checkbox
- ##
-
- push @where, "(censustract = '' or censustract is null)"
- if $params->{'no_censustract'};
-
- ##
- # parse with hardcoded tax location checkbox
- ##
-
- push @where, "geocode is not null"
- if $params->{'with_geocode'};
-
- ##
- # dates
- ##
-
- foreach my $field (qw( signupdate )) {
-
- next unless exists($params->{$field});
-
- my($beginning, $ending, $hour) = @{$params->{$field}};
-
- push @where,
- "cust_main.$field IS NOT NULL",
- "cust_main.$field >= $beginning",
- "cust_main.$field <= $ending";
-
- if(defined $hour) {
- if ($dbh->{Driver}->{Name} =~ /Pg/i) {
- push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour";
- }
- elsif( $dbh->{Driver}->{Name} =~ /mysql/i) {
- push @where, "hour(from_unixtime(cust_main.$field)) = $hour"
- }
- else {
- warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases";
- }
- }
-
- $orderby ||= "ORDER BY cust_main.$field";
-
- }
-
- ###
- # classnum
- ###
-
- if ( $params->{'classnum'} ) {
-
- my @classnum = ref( $params->{'classnum'} )
- ? @{ $params->{'classnum'} }
- : ( $params->{'classnum'} );
-
- @classnum = grep /^(\d*)$/, @classnum;
-
- if ( @classnum ) {
- push @where, '( '. join(' OR ', map {
- $_ ? "cust_main.classnum = $_"
- : "cust_main.classnum IS NULL"
- }
- @classnum
- ).
- ' )';
- }
-
- }
-
- ###
- # payby
- ###
-
- if ( $params->{'payby'} ) {
-
- my @payby = ref( $params->{'payby'} )
- ? @{ $params->{'payby'} }
- : ( $params->{'payby'} );
-
- @payby = grep /^([A-Z]{4})$/, @payby;
-
- push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
- if @payby;
-
- }
-
- ###
- # paydate_year / paydate_month
- ###
-
- if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
- my $year = $1;
- $params->{'paydate_month'} =~ /^(\d\d?)$/
- or die "paydate_year without paydate_month?";
- my $month = $1;
-
- push @where,
- 'paydate IS NOT NULL',
- "paydate != ''",
- "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
-;
- }
-
- ###
- # invoice terms
- ###
-
- if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
- my $terms = $1;
- if ( $1 eq 'NULL' ) {
- push @where,
- "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
- } else {
- push @where,
- "cust_main.invoice_terms IS NOT NULL",
- "cust_main.invoice_terms = '$1'";
- }
- }
-
- ##
- # amounts
- ##
-
- if ( $params->{'current_balance'} ) {
-
- #my $balance_sql = $class->balance_sql();
- my $balance_sql = FS::cust_main->balance_sql();
-
- my @current_balance =
- ref( $params->{'current_balance'} )
- ? @{ $params->{'current_balance'} }
- : ( $params->{'current_balance'} );
-
- push @where, map { s/current_balance/$balance_sql/; $_ }
- @current_balance;
-
- }
-
- ##
- # custbatch
- ##
-
- if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
- push @where,
- "cust_main.custbatch = '$1'";
- }
-
- if ( $params->{'tagnum'} ) {
- my @tagnums = ref( $params->{'tagnum'} ) ? @{ $params->{'tagnum'} } : ( $params->{'tagnum'} );
-
- @tagnums = grep /^(\d+)$/, @tagnums;
-
- if ( @tagnums ) {
- my $tags_where = "0 < (select count(1) from cust_tag where "
- . " cust_tag.custnum = cust_main.custnum and tagnum in ("
- . join(',', @tagnums) . "))";
-
- push @where, $tags_where;
- }
- }
-
-
- ##
- # setup queries, subs, etc. for the search
- ##
-
- $orderby ||= 'ORDER BY custnum';
-
- # here is the agent virtualization
- push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
-
- my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
-
- my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
-
- my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
-
- my @select = (
- 'cust_main.custnum',
- FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
- );
-
- my(@extra_headers) = ();
- my(@extra_fields) = ();
-
- if ($params->{'flattened_pkgs'}) {
-
- if ($dbh->{Driver}->{Name} eq 'Pg') {
-
- push @select, "array_to_string(array(select pkg from cust_pkg left join part_pkg using ( pkgpart ) where cust_main.custnum = cust_pkg.custnum $pkgwhere),'|') as magic";
-
- }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
- push @select, "GROUP_CONCAT(pkg SEPARATOR '|') as magic";
- $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
- }else{
- warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
- "omitting packing information from report.";
- }
-
- my $header_query = "SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count FROM cust_main $addl_from $extra_sql $pkgwhere group by cust_main.custnum order by count desc limit 1";
-
- my $sth = dbh->prepare($header_query) or die dbh->errstr;
- $sth->execute() or die $sth->errstr;
- my $headerrow = $sth->fetchrow_arrayref;
- my $headercount = $headerrow ? $headerrow->[0] : 0;
- while($headercount) {
- unshift @extra_headers, "Package ". $headercount;
- unshift @extra_fields, eval q!sub {my $c = shift;
- my @a = split '\|', $c->magic;
- my $p = $a[!.--$headercount. q!];
- $p;
- };!;
- }
-
- }
-
- if ( $params->{'with_geocode'} ) {
-
- unshift @extra_headers, 'Tax location override', 'Calculated tax location';
- unshift @extra_fields, sub { my $c = shift; $c->get('geocode'); },
- sub { my $c = shift;
- $c->set('geocode', '');
- $c->geocode('cch'); #XXX only cch right now
- };
- push @select, 'geocode';
- push @select, 'zip' unless grep { $_ eq 'zip' } @select;
- push @select, 'ship_zip' unless grep { $_ eq 'ship_zip' } @select;
- }
-
- my $select = join(', ', @select);
-
- my $sql_query = {
- 'table' => 'cust_main',
- 'select' => $select,
- 'hashref' => {},
- 'extra_sql' => $extra_sql,
- 'order_by' => $orderby,
- 'count_query' => $count_query,
- 'extra_headers' => \@extra_headers,
- 'extra_fields' => \@extra_fields,
- };
-
-}
-
-=item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
-
-Performs a fuzzy (approximate) search and returns the matching FS::cust_main
-records. Currently, I<first>, I<last>, I<company> and/or I<address1> may be
-specified (the appropriate ship_ field is also searched).
-
-Additional options are the same as FS::Record::qsearch
-
-=cut
-
-sub fuzzy_search {
- my( $self, $fuzzy, $hash, @opt) = @_;
- #$self
- $hash ||= {};
- my @cust_main = ();
-
- check_and_rebuild_fuzzyfiles();
- foreach my $field ( keys %$fuzzy ) {
-
- my $all = $self->all_X($field);
- next unless scalar(@$all);
-
- my %match = ();
- $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
-
- my @fcust = ();
- foreach ( keys %match ) {
- push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
- push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
- }
- my %fsaw = ();
- push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
- }
-
- # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
- my %saw = ();
- @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
-
- @cust_main;
-
-}
-
-=back
-
-=head1 UTILITY SUBROUTINES
-
-=over 4
-
-=item check_and_rebuild_fuzzyfiles
-
-=cut
-
-sub check_and_rebuild_fuzzyfiles {
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
-}
-
-=item rebuild_fuzzyfiles
-
-=cut
-
-sub rebuild_fuzzyfiles {
-
- use Fcntl qw(:flock);
-
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- mkdir $dir, 0700 unless -d $dir;
-
- foreach my $fuzzy ( @fuzzyfields ) {
-
- open(LOCK,">>$dir/cust_main.$fuzzy")
- or die "can't open $dir/cust_main.$fuzzy: $!";
- flock(LOCK,LOCK_EX)
- or die "can't lock $dir/cust_main.$fuzzy: $!";
-
- open (CACHE,">$dir/cust_main.$fuzzy.tmp")
- or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
-
- foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
- my $sth = dbh->prepare("SELECT $field FROM cust_main".
- " WHERE $field != '' AND $field IS NOT NULL");
- $sth->execute or die $sth->errstr;
-
- while ( my $row = $sth->fetchrow_arrayref ) {
- print CACHE $row->[0]. "\n";
- }
-
- }
-
- close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
-
- rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
- close LOCK;
- }
-
-}
-
-=item all_X
-
-=cut
-
-sub all_X {
- my( $self, $field ) = @_;
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- open(CACHE,"<$dir/cust_main.$field")
- or die "can't open $dir/cust_main.$field: $!";
- my @array = map { chomp; $_; } <CACHE>;
- close CACHE;
- \@array;
-}
-
-=head1 BUGS
-
-Bed bugs
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, L<FS::Record>
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_main/_Marketgear.pm b/FS/FS/cust_main/_Marketgear.pm
deleted file mode 100644
index 2d3c927..0000000
--- a/FS/FS/cust_main/_Marketgear.pm
+++ /dev/null
@@ -1,146 +0,0 @@
-package FS::cust_main::_Marketgear;
-
-use strict;
-use vars qw( $DEBUG $me $conf );
-
-$DEBUG = 0;
-$me = '[FS::cust_main::_Marketgear]';
-
-install_callback FS::UID sub {
- $conf = new FS::Conf;
-};
-
-sub start_copy_skel {
- my $self = shift;
-
- return '' unless $conf->config('cust_main-skeleton_tables')
- && $conf->config('cust_main-skeleton_custnum');
-
- warn " inserting skeleton records\n"
- if $DEBUG > 1 || $cust_main::DEBUG > 1;
-
- #'mg_user_preference' => {},
- #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
- #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
- #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
- #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
- my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
- die $@ if $@;
-
- _copy_skel( 'cust_main', #tablename
- $conf->config('cust_main-skeleton_custnum'), #sourceid
- $self->custnum, #destid
- @tables, #child tables
- );
-}
-
-#recursive subroutine, not a method
-sub _copy_skel {
- my( $table, $sourceid, $destid, %child_tables ) = @_;
-
- my $primary_key;
- if ( $table =~ /^(\w+)\.(\w+)$/ ) {
- ( $table, $primary_key ) = ( $1, $2 );
- } else {
- my $dbdef_table = dbdef->table($table);
- $primary_key = $dbdef_table->primary_key
- or return "$table has no primary key".
- " (or do you need to run dbdef-create?)";
- }
-
- warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
- join (', ', keys %child_tables). "\n"
- if $DEBUG > 2;
-
- foreach my $child_table_def ( keys %child_tables ) {
-
- my $child_table;
- my $child_pkey = '';
- if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
- ( $child_table, $child_pkey ) = ( $1, $2 );
- } else {
- $child_table = $child_table_def;
-
- $child_pkey = dbdef->table($child_table)->primary_key;
- # or return "$table has no primary key".
- # " (or do you need to run dbdef-create?)\n";
- }
-
- my $sequence = '';
- if ( keys %{ $child_tables{$child_table_def} } ) {
-
- return "$child_table has no primary key".
- " (run dbdef-create or try specifying it?)\n"
- unless $child_pkey;
-
- #false laziness w/Record::insert and only works on Pg
- #refactor the proper last-inserted-id stuff out of Record::insert if this
- # ever gets use for anything besides a quick kludge for one customer
- my $default = dbdef->table($child_table)->column($child_pkey)->default;
- $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
- or return "can't parse $child_table.$child_pkey default value ".
- " for sequence name: $default";
- $sequence = $1;
-
- }
-
- my @sel_columns = grep { $_ ne $primary_key }
- dbdef->table($child_table)->columns;
- my $sel_columns = join(', ', @sel_columns );
-
- my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
- my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
- my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
-
- my $sel_st = "SELECT $sel_columns FROM $child_table".
- " WHERE $primary_key = $sourceid";
- warn " $sel_st\n"
- if $DEBUG > 2;
- my $sel_sth = dbh->prepare( $sel_st )
- or return dbh->errstr;
-
- $sel_sth->execute or return $sel_sth->errstr;
-
- while ( my $row = $sel_sth->fetchrow_hashref ) {
-
- warn " selected row: ".
- join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
- if $DEBUG > 2;
-
- my $statement =
- "INSERT INTO $child_table $ins_columns VALUES $placeholders";
- my $ins_sth =dbh->prepare($statement)
- or return dbh->errstr;
- my @param = ( $destid, map $row->{$_}, @ins_columns );
- warn " $statement: [ ". join(', ', @param). " ]\n"
- if $DEBUG > 2;
- $ins_sth->execute( @param )
- or return $ins_sth->errstr;
-
- #next unless keys %{ $child_tables{$child_table} };
- next unless $sequence;
-
- #another section of that laziness
- my $seq_sql = "SELECT currval('$sequence')";
- my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
- $seq_sth->execute or return $seq_sth->errstr;
- my $insertid = $seq_sth->fetchrow_arrayref->[0];
-
- # don't drink soap! recurse! recurse! okay!
- my $error =
- _copy_skel( $child_table_def,
- $row->{$child_pkey}, #sourceid
- $insertid, #destid
- %{ $child_tables{$child_table_def} },
- );
- return $error if $error;
-
- }
-
- }
-
- return '';
-
-}
-
-1;
diff --git a/FS/FS/cust_main_Mixin.pm b/FS/FS/cust_main_Mixin.pm
deleted file mode 100644
index 8c8553c..0000000
--- a/FS/FS/cust_main_Mixin.pm
+++ /dev/null
@@ -1,554 +0,0 @@
-package FS::cust_main_Mixin;
-
-use strict;
-use vars qw( $DEBUG $me );
-use Carp qw( confess );
-use FS::UID qw(dbh);
-use FS::cust_main;
-use FS::Record qw( qsearch qsearchs );
-use FS::Misc qw( send_email generate_email );
-
-$DEBUG = 0;
-$me = '[FS::cust_main_Mixin]';
-
-=head1 NAME
-
-FS::cust_main_Mixin - Mixin class for records that contain fields from cust_main
-
-=head1 SYNOPSIS
-
-package FS::some_table;
-use vars qw(@ISA);
-@ISA = qw( FS::cust_main_Mixin FS::Record );
-
-=head1 DESCRIPTION
-
-This is a mixin class for records that contain fields from the cust_main table,
-for example, from a JOINed search. See httemplate/search/ for examples.
-
-=head1 METHODS
-
-=over 4
-
-=cut
-
-sub cust_unlinked_msg { '(unlinked)'; }
-sub cust_linked { $_[0]->custnum; }
-
-sub cust_main {
- my $self = shift;
- $self->cust_linked ? qsearchs('cust_main', {custnum => $self->custnum}) : '';
-}
-
-=item display_custnum
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
-a customer.
-
-=cut
-
-sub display_custnum {
- my $self = shift;
- $self->cust_linked
- ? FS::cust_main::display_custnum($self)
- : $self->cust_unlinked_msg;
-}
-
-=item name
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
-a customer.
-
-=cut
-
-sub name {
- my $self = shift;
- $self->cust_linked
- ? FS::cust_main::name($self)
- : $self->cust_unlinked_msg;
-}
-
-=item ship_name
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<ship_name> method, or "(unlinked)" if this object is not
-linked to a customer.
-
-=cut
-
-sub ship_name {
- my $self = shift;
- $self->cust_linked
- ? FS::cust_main::ship_name($self)
- : $self->cust_unlinked_msg;
-}
-
-=item contact
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<contact> method, or "(unlinked)" if this object is not linked
-to a customer.
-
-=cut
-
-sub contact {
- my $self = shift;
- $self->cust_linked
- ? FS::cust_main::contact($self)
- : $self->cust_unlinked_msg;
-}
-
-=item ship_contact
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<ship_contact> method, or "(unlinked)" if this object is not
-linked to a customer.
-
-=cut
-
-sub ship_contact {
- my $self = shift;
- $self->cust_linked
- ? FS::cust_main::ship_contact($self)
- : $self->cust_unlinked_msg;
-}
-
-=item country_full
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<country_full> method, or "(unlinked)" if this object is not
-linked to a customer.
-
-=cut
-
-sub country_full {
- my $self = shift;
- $self->cust_linked
- ? FS::cust_main::country_full($self)
- : $self->cust_unlinked_msg;
-}
-
-=item invoicing_list_emailonly
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<invoicing_list_emailonly> method, or "(unlinked)" if this
-object is not linked to a customer.
-
-=cut
-
-sub invoicing_list_emailonly {
- my $self = shift;
- warn "invoicing_list_email only called on $self, ".
- "custnum ". $self->custnum. "\n"
- if $DEBUG;
- $self->cust_linked
- ? FS::cust_main::invoicing_list_emailonly($self)
- : $self->cust_unlinked_msg;
-}
-
-=item invoicing_list_emailonly_scalar
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<invoicing_list_emailonly_scalar> method, or "(unlinked)" if
-this object is not linked to a customer.
-
-=cut
-
-sub invoicing_list_emailonly_scalar {
- my $self = shift;
- warn "invoicing_list_emailonly called on $self, ".
- "custnum ". $self->custnum. "\n"
- if $DEBUG;
- $self->cust_linked
- ? FS::cust_main::invoicing_list_emailonly_scalar($self)
- : $self->cust_unlinked_msg;
-}
-
-=item invoicing_list
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<invoicing_list> method, or "(unlinked)" if this object is not
-linked to a customer.
-
-Note: this method is read-only.
-
-=cut
-
-#read-only
-sub invoicing_list {
- my $self = shift;
- $self->cust_linked
- ? FS::cust_main::invoicing_list($self)
- : ();
-}
-
-=item status
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<status> method, or "(unlinked)" if this object is not linked to
-a customer.
-
-=cut
-
-sub cust_status {
- my $self = shift;
- return $self->cust_unlinked_msg unless $self->cust_linked;
-
- #FS::cust_main::status($self)
- #false laziness w/actual cust_main::status
- # (make sure FS::cust_main methods are called)
- for my $status (qw( prospect active inactive suspended cancelled )) {
- my $method = $status.'_sql';
- my $sql = FS::cust_main->$method();;
- my $numnum = ( $sql =~ s/cust_main\.custnum/?/g );
- my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
- $sth->execute( ($self->custnum) x $numnum )
- or die "Error executing 'SELECT $sql': ". $sth->errstr;
- return $status if $sth->fetchrow_arrayref->[0];
- }
-}
-
-=item ucfirst_cust_status
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<ucfirst_status> method, or "(unlinked)" if this object is not
-linked to a customer.
-
-=cut
-
-sub ucfirst_cust_status {
- my $self = shift;
- $self->cust_linked
- ? ucfirst( $self->cust_status(@_) )
- : $self->cust_unlinked_msg;
-}
-
-=item cust_statuscolor
-
-Given an object that contains fields from cust_main (say, from a JOINed
-search; see httemplate/search/ for examples), returns the equivalent of the
-FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
-a customer.
-
-=cut
-
-sub cust_statuscolor {
- my $self = shift;
-
- $self->cust_linked
- ? FS::cust_main::cust_statuscolor($self)
- : '000000';
-}
-
-=item prospect_sql
-
-=item active_sql
-
-=item inactive_sql
-
-=item suspended_sql
-
-=item cancelled_sql
-
-Class methods that return SQL framents, equivalent to the corresponding
-FS::cust_main method.
-
-=cut
-
-# my \$self = shift;
-# \$self->cust_linked
-# ? FS::cust_main::${sub}_sql(\$self)
-# : '0';
-
-foreach my $sub (qw( prospect active inactive suspended cancelled )) {
- eval "
- sub ${sub}_sql {
- confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
- 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
- }
- ";
- die $@ if $@;
-}
-
-=item cust_search_sql
-
-Returns a list of SQL WHERE fragments to search for parameters specified
-in HASHREF. Valid parameters are:
-
-=over 4
-
-=item agentnum
-
-=item status
-
-=item payby
-
-=back
-
-=cut
-
-sub cust_search_sql {
- my($class, $param) = @_;
-
- if ( $DEBUG ) {
- warn "$me cust_search_sql called with params: \n".
- join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
- }
-
- my @search = ();
-
- if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
- push @search, "cust_main.agentnum = $1";
- }
-
- #status (prospect active inactive suspended cancelled)
- if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
- my $method = $param->{'status'}. '_sql';
- push @search, $class->$method();
- }
-
- #payby
- my @payby = ref($param->{'payby'})
- ? @{ $param->{'payby'} }
- : split(',', $param->{'payby'});
- @payby = grep /^([A-Z]{4})$/, @payby;
- if ( @payby ) {
- push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
- }
-
- #here is the agent virtualization
- push @search,
- $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
-
- return @search;
-
-}
-
-=item email_search_result HASHREF
-
-Emails a notice to the specified customers. Customers without
-invoice email destinations will be skipped.
-
-Parameters:
-
-=over 4
-
-=item job
-
-Queue job for status updates. Required.
-
-=item search
-
-Hashref of params to the L<search()> method. Required.
-
-=item msgnum
-
-Message template number (see L<FS::msg_template>). Overrides all
-of the following options.
-
-=item from
-
-From: address
-
-=item subject
-
-Email Subject:
-
-=item html_body
-
-HTML body
-
-=item text_body
-
-Text body
-
-=back
-
-Returns an error message, or false for success.
-
-If any messages fail to send, they will be queued as individual
-jobs which can be manually retried. If the first ten messages
-in the job fail, the entire job will abort and return an error.
-
-=cut
-
-use Storable qw(thaw);
-use MIME::Base64;
-use Data::Dumper qw(Dumper);
-
-sub email_search_result {
- my($class, $param) = @_;
-
- my $msgnum = $param->{msgnum};
- my $from = delete $param->{from};
- my $subject = delete $param->{subject};
- my $html_body = delete $param->{html_body};
- my $text_body = delete $param->{text_body};
- my $error = '';
-
- my $job = delete $param->{'job'}
- or die "email_search_result must run from the job queue.\n";
-
- my $msg_template;
- if ( $msgnum ) {
- $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
- or die "msgnum $msgnum not found\n";
- }
-
- $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
- unless ref($param->{'payby'});
-
- my $sql_query = $class->search($param->{'search'});
-
- my $count_query = delete($sql_query->{'count_query'});
- my $count_sth = dbh->prepare($count_query)
- or die "Error preparing $count_query: ". dbh->errstr;
- $count_sth->execute
- or die "Error executing $count_query: ". $count_sth->errstr;
- my $count_arrayref = $count_sth->fetchrow_arrayref;
- my $num_cust = $count_arrayref->[0];
-
- my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
- my @retry_jobs = ();
- my $dups = 0;
- my $success = 0;
- my %sent_to = ();
-
- #eventually order+limit magic to reduce memory use?
- foreach my $obj ( qsearch($sql_query) ) {
-
- #progressbar first, so that the count is right
- $num++;
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $num / $num_cust )
- );
- die $error if $error;
- $last = time;
- }
-
- my $cust_main = $obj->cust_main;
- my @message;
- if ( !$cust_main ) {
- next; # unlinked object; nothing else we can do
- }
-
- if( $sent_to{$cust_main->custnum} ) {
- # avoid duplicates
- $dups++;
- next;
- }
-
- $sent_to{$cust_main->custnum} = 1;
-
- if ( $msg_template ) {
- # XXX add support for other context objects?
- # If we do that, handling of "duplicates" will
- # have to be smarter. Currently we limit to
- # one message per custnum because they'd all
- # be identical.
- @message = $msg_template->prepare( 'cust_main' => $cust_main );
- }
- else {
- my $to = $cust_main->invoicing_list_emailonly_scalar;
- next if !$to;
-
- @message = (
- 'from' => $from,
- 'to' => $to,
- 'subject' => $subject,
- 'html_body' => $html_body,
- 'text_body' => $text_body,
- );
- } #if $msg_template
-
- $error = send_email( generate_email( @message ) );
-
- if($error) {
- # queue the sending of this message so that the user can see what we
- # tried to do, and retry if desired
- my $queue = new FS::queue {
- 'job' => 'FS::Misc::process_send_email',
- 'custnum' => $cust_main->custnum,
- 'status' => 'failed',
- 'statustext' => $error,
- };
- $queue->insert(@message);
- push @retry_jobs, $queue;
- }
- else {
- $success++;
- }
-
- if($success == 0 and
- (scalar(@retry_jobs) > 10 or $num == $num_cust)
- ) {
- # 10 is arbitrary, but if we have enough failures, that's
- # probably a configuration or network problem, and we
- # abort the batch and run away screaming.
- # We NEVER do this if anything was successfully sent.
- $_->delete foreach (@retry_jobs);
- return "multiple failures: '$error'\n";
- }
- } # foreach $obj
-
- if(@retry_jobs) {
- # fail the job, but with a status message that makes it clear
- # something was sent.
- return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
- }
-
- return '';
-}
-
-sub process_email_search_result {
- my $job = shift;
- #warn "$me process_re_X $method for job $job\n" if $DEBUG;
-
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- $param->{'job'} = $job;
-
- $param->{'search'} = thaw(decode_base64($param->{'search'}))
- or die "process_email_search_result requires search params.\n";
-
-# $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
-# unless ref($param->{'payby'});
-
- my $table = $param->{'table'}
- or die "process_email_search_result requires table.\n";
-
- eval "use FS::$table;";
- die "error loading FS::$table: $@\n" if $@;
-
- my $error = "FS::$table"->email_search_result( $param );
- die $error if $error;
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, L<FS::Record>
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm
deleted file mode 100644
index e84fa98..0000000
--- a/FS/FS/cust_main_county.pm
+++ /dev/null
@@ -1,506 +0,0 @@
-package FS::cust_main_county;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK $conf
- @cust_main_county %cust_main_county $countyflag ); # $cityflag );
-use Exporter;
-use FS::Record qw( qsearch dbh );
-use FS::cust_bill_pkg;
-use FS::cust_bill;
-use FS::cust_pkg;
-use FS::part_pkg;
-use FS::cust_tax_exempt;
-use FS::cust_tax_exempt_pkg;
-
-@ISA = qw( FS::Record );
-@EXPORT_OK = qw( regionselector );
-
-@cust_main_county = ();
-$countyflag = '';
-#$cityflag = '';
-
-#ask FS::UID to run this stuff for us later
-$FS::UID::callback{'FS::cust_main_county'} = sub {
- $conf = new FS::Conf;
-};
-
-=head1 NAME
-
-FS::cust_main_county - Object methods for cust_main_county objects
-
-=head1 SYNOPSIS
-
- use FS::cust_main_county;
-
- $record = new FS::cust_main_county \%hash;
- $record = new FS::cust_main_county { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- ($county_html, $state_html, $country_html) =
- FS::cust_main_county::regionselector( $county, $state, $country );
-
-=head1 DESCRIPTION
-
-An FS::cust_main_county object represents a tax rate, defined by locale.
-FS::cust_main_county inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item taxnum - primary key (assigned automatically for new tax rates)
-
-=item city
-
-=item county
-
-=item state
-
-=item country
-
-=item tax - percentage
-
-=item taxclass
-
-=item exempt_amount
-
-=item taxname - if defined, printed on invoices instead of "Tax"
-
-=item setuptax - if 'Y', this tax does not apply to setup fees
-
-=item recurtax - if 'Y', this tax does not apply to recurring fees
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
-
-=cut
-
-sub table { 'cust_main_county'; }
-
-=item insert
-
-Adds this tax rate to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this tax rate from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid tax rate. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->exempt_amount(0) unless $self->exempt_amount;
-
- $self->ut_numbern('taxnum')
- || $self->ut_textn('city')
- || $self->ut_textn('county')
- || $self->ut_anything('state')
- || $self->ut_text('country')
- || $self->ut_float('tax')
- || $self->ut_textn('taxclass') # ...
- || $self->ut_money('exempt_amount')
- || $self->ut_textn('taxname')
- || $self->ut_enum('setuptax', [ '', 'Y' ] )
- || $self->ut_enum('recurtax', [ '', 'Y' ] )
- || $self->SUPER::check
- ;
-
-}
-
-sub taxname {
- my $self = shift;
- if ( $self->dbdef_table->column('taxname') ) {
- return $self->setfield('taxname', $_[0]) if @_;
- return $self->getfield('taxname');
- }
- return '';
-}
-
-sub setuptax {
- my $self = shift;
- if ( $self->dbdef_table->column('setuptax') ) {
- return $self->setfield('setuptax', $_[0]) if @_;
- return $self->getfield('setuptax');
- }
- return '';
-}
-
-sub recurtax {
- my $self = shift;
- if ( $self->dbdef_table->column('recurtax') ) {
- return $self->setfield('recurtax', $_[0]) if @_;
- return $self->getfield('recurtax');
- }
- return '';
-}
-
-=item sql_taxclass_sameregion
-
-Returns an SQL WHERE fragment or the empty string to search for entries
-with different tax classes.
-
-=cut
-
-#hmm, description above could be better...
-
-sub sql_taxclass_sameregion {
- my $self = shift;
-
- my $same_query = 'SELECT taxclass FROM cust_main_county '.
- ' WHERE taxnum != ? AND country = ?';
- my @same_param = ( 'taxnum', 'country' );
- foreach my $opt_field (qw( state county )) {
- if ( $self->$opt_field() ) {
- $same_query .= " AND $opt_field = ?";
- push @same_param, $opt_field;
- } else {
- $same_query .= " AND $opt_field IS NULL";
- }
- }
-
- my @taxclasses = $self->_list_sql( \@same_param, $same_query );
-
- return '' unless scalar(@taxclasses);
-
- '( taxclass IS NULL OR ( '. #only if !$self->taxclass ??
- join(' AND ', map { 'taxclass != '.dbh->quote($_) } @taxclasses ).
- ' ) ) ';
-}
-
-sub _list_sql {
- my( $self, $param, $sql ) = @_;
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute( map $self->$_(), @$param )
- or die "Unexpected error executing statement $sql: ". $sth->errstr;
- map $_->[0], @{ $sth->fetchall_arrayref };
-}
-
-=item taxline TAXABLES_ARRAYREF, [ OPTION => VALUE ... ]
-
-Returns a listref of a name and an amount of tax calculated for the list of
-packages or amounts referenced by TAXABLES_ARRAYREF. Returns a scalar error
-message on error.
-
-Options include custnum and invoice_date and are hints to this method
-
-=cut
-
-sub taxline {
- my( $self, $taxables, %opt ) = @_;
-
- my @exemptions = ();
- push @exemptions, @{ $_->_cust_tax_exempt_pkg }
- for grep { ref($_) } @$taxables;
-
- 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 $name = $self->taxname || 'Tax';
- my $amount = 0;
-
- foreach my $cust_bill_pkg (@$taxables) {
-
- my $cust_pkg = $cust_bill_pkg->cust_pkg;
- my $cust_bill = $cust_pkg->cust_bill if $cust_pkg;
- my $custnum = $cust_pkg ? $cust_pkg->custnum : $opt{custnum};
- my $part_pkg = $cust_bill_pkg->part_pkg;
- my $invoice_date = $cust_bill ? $cust_bill->_date : $opt{invoice_date};
-
- my $taxable_charged = 0;
- $taxable_charged += $cust_bill_pkg->setup
- unless $part_pkg->setuptax =~ /^Y$/i
- || $self->setuptax =~ /^Y$/i;
- $taxable_charged += $cust_bill_pkg->recur
- unless $part_pkg->recurtax =~ /^Y$/i
- || $self->recurtax =~ /^Y$/i;
-
- next unless $taxable_charged;
-
- if ( $self->exempt_amount && $self->exempt_amount > 0 ) {
- #my ($mon,$year) = (localtime($cust_bill_pkg->sdate) )[4,5];
- my ($mon,$year) =
- (localtime( $cust_bill_pkg->sdate || $invoice_date ) )[4,5];
- $mon++;
- my $freq = $cust_bill_pkg->freq;
- unless ($freq) {
- $freq = $part_pkg->freq || 1; # less trustworthy fallback
- }
- if ( $freq !~ /(\d+)$/ ) {
- $dbh->rollback if $oldAutoCommit;
- return "daily/weekly package definitions not (yet?)".
- " compatible with monthly tax exemptions";
- }
- my $taxable_per_month =
- sprintf("%.2f", $taxable_charged / $freq );
-
- #call the whole thing off if this customer has any old
- #exemption records...
- my @cust_tax_exempt =
- qsearch( 'cust_tax_exempt' => { custnum=> $custnum } );
- if ( @cust_tax_exempt ) {
- $dbh->rollback if $oldAutoCommit;
- return
- 'this customer still has old-style tax exemption records; '.
- 'run bin/fs-migrate-cust_tax_exempt?';
- }
-
- foreach my $which_month ( 1 .. $freq ) {
-
- #maintain the new exemption table now
- my $sql = "
- SELECT SUM(amount)
- FROM cust_tax_exempt_pkg
- LEFT JOIN cust_bill_pkg USING ( billpkgnum )
- LEFT JOIN cust_bill USING ( invnum )
- WHERE custnum = ?
- AND taxnum = ?
- AND year = ?
- AND month = ?
- ";
- my $sth = dbh->prepare($sql) or do {
- $dbh->rollback if $oldAutoCommit;
- return "fatal: can't lookup exising exemption: ". dbh->errstr;
- };
- $sth->execute(
- $custnum,
- $self->taxnum,
- 1900+$year,
- $mon,
- ) or do {
- $dbh->rollback if $oldAutoCommit;
- return "fatal: can't lookup exising exemption: ". dbh->errstr;
- };
- my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
-
- foreach ( grep { $_->taxnum == $self->taxnum &&
- $_->month == $mon &&
- $_->year == 1900+$year
- } @exemptions
- )
- {
- $existing_exemption += $_->amount;
- }
-
- my $remaining_exemption =
- $self->exempt_amount - $existing_exemption;
- if ( $remaining_exemption > 0 ) {
- my $addl = $remaining_exemption > $taxable_per_month
- ? $taxable_per_month
- : $remaining_exemption;
- $taxable_charged -= $addl;
-
- my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
- 'taxnum' => $self->taxnum,
- 'year' => 1900+$year,
- 'month' => $mon,
- 'amount' => sprintf("%.2f", $addl ),
- } );
- if ($cust_bill_pkg->billpkgnum) {
- $cust_tax_exempt_pkg->billpkgnum($cust_bill_pkg->billpkgnum);
- my $error = $cust_tax_exempt_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "fatal: can't insert cust_tax_exempt_pkg: $error";
- }
- }else{
- push @exemptions, $cust_tax_exempt_pkg;
- push @{ $cust_bill_pkg->_cust_tax_exempt_pkg }, $cust_tax_exempt_pkg;
- } # if $cust_bill_pkg->billpkgnum
- } # if $remaining_exemption > 0
-
- #++
- $mon++;
- #until ( $mon < 12 ) { $mon -= 12; $year++; }
- until ( $mon < 13 ) { $mon -= 12; $year++; }
-
- } #foreach $which_month
-
- } #if $tax->exempt_amount
-
- $taxable_charged = sprintf( "%.2f", $taxable_charged);
-
- $amount += $taxable_charged * $self->tax / 100
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return {
- 'name' => $name,
- 'amount' => $amount,
- };
-
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item regionselector [ COUNTY STATE COUNTRY [ PREFIX [ ONCHANGE [ DISABLED ] ] ] ]
-
-=cut
-
-sub regionselector {
- my ( $selected_county, $selected_state, $selected_country,
- $prefix, $onchange, $disabled ) = @_;
-
- $prefix = '' unless defined $prefix;
-
- $countyflag = 0;
-
-# unless ( @cust_main_county ) { #cache
- @cust_main_county = qsearch('cust_main_county', {} );
- foreach my $c ( @cust_main_county ) {
- $countyflag=1 if $c->county;
- #push @{$cust_main_county{$c->country}{$c->state}}, $c->county;
- $cust_main_county{$c->country}{$c->state}{$c->county} = 1;
- }
-# }
- $countyflag=1 if $selected_county;
-
- my $script_html = <<END;
- <SCRIPT>
- function opt(what,value,text) {
- var optionName = new Option(text, value, false, false);
- var length = what.length;
- what.options[length] = optionName;
- }
- function ${prefix}country_changed(what) {
- country = what.options[what.selectedIndex].text;
- for ( var i = what.form.${prefix}state.length; i >= 0; i-- )
- what.form.${prefix}state.options[i] = null;
-END
- #what.form.${prefix}state.options[0] = new Option('', '', false, true);
-
- foreach my $country ( sort keys %cust_main_county ) {
- $script_html .= "\nif ( country == \"$country\" ) {\n";
- foreach my $state ( sort keys %{$cust_main_county{$country}} ) {
- ( my $dstate = $state ) =~ s/[\n\r]//g;
- my $text = $dstate || '(n/a)';
- $script_html .= qq!opt(what.form.${prefix}state, "$dstate", "$text");\n!;
- }
- $script_html .= "}\n";
- }
-
- $script_html .= <<END;
- }
- function ${prefix}state_changed(what) {
-END
-
- if ( $countyflag ) {
- $script_html .= <<END;
- state = what.options[what.selectedIndex].text;
- country = what.form.${prefix}country.options[what.form.${prefix}country.selectedIndex].text;
- for ( var i = what.form.${prefix}county.length; i >= 0; i-- )
- what.form.${prefix}county.options[i] = null;
-END
-
- foreach my $country ( sort keys %cust_main_county ) {
- $script_html .= "\nif ( country == \"$country\" ) {\n";
- foreach my $state ( sort keys %{$cust_main_county{$country}} ) {
- $script_html .= "\nif ( state == \"$state\" ) {\n";
- #foreach my $county ( sort @{$cust_main_county{$country}{$state}} ) {
- foreach my $county ( sort keys %{$cust_main_county{$country}{$state}} ) {
- my $text = $county || '(n/a)';
- $script_html .=
- qq!opt(what.form.${prefix}county, "$county", "$text");\n!;
- }
- $script_html .= "}\n";
- }
- $script_html .= "}\n";
- }
- }
-
- $script_html .= <<END;
- }
- </SCRIPT>
-END
-
- my $county_html = $script_html;
- if ( $countyflag ) {
- $county_html .= qq!<SELECT NAME="${prefix}county" onChange="$onchange" $disabled>!;
- $county_html .= '</SELECT>';
- } else {
- $county_html .=
- qq!<INPUT TYPE="hidden" NAME="${prefix}county" VALUE="$selected_county">!;
- }
-
- my $state_html = qq!<SELECT NAME="${prefix}state" !.
- qq!onChange="${prefix}state_changed(this); $onchange" $disabled>!;
- foreach my $state ( sort keys %{ $cust_main_county{$selected_country} } ) {
- my $text = $state || '(n/a)';
- my $selected = $state eq $selected_state ? 'SELECTED' : '';
- $state_html .= qq(\n<OPTION $selected VALUE="$state">$text</OPTION>);
- }
- $state_html .= '</SELECT>';
-
- $state_html .= '</SELECT>';
-
- my $country_html = qq!<SELECT NAME="${prefix}country" !.
- qq!onChange="${prefix}country_changed(this); $onchange" $disabled>!;
- my $countrydefault = $conf->config('countrydefault') || 'US';
- foreach my $country (
- sort { ($b eq $countrydefault) <=> ($a eq $countrydefault) or $a cmp $b }
- keys %cust_main_county
- ) {
- my $selected = $country eq $selected_country ? ' SELECTED' : '';
- $country_html .= qq(\n<OPTION$selected VALUE="$country">$country</OPTION>");
- }
- $country_html .= '</SELECT>';
-
- ($county_html, $state_html, $country_html);
-
-}
-
-=back
-
-=head1 BUGS
-
-regionselector? putting web ui components in here? they should probably live
-somewhere else...
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_main_exemption.pm b/FS/FS/cust_main_exemption.pm
deleted file mode 100644
index 06d22b7..0000000
--- a/FS/FS/cust_main_exemption.pm
+++ /dev/null
@@ -1,128 +0,0 @@
-package FS::cust_main_exemption;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_main;
-
-=head1 NAME
-
-FS::cust_main_exemption - Object methods for cust_main_exemption records
-
-=head1 SYNOPSIS
-
- use FS::cust_main_exemption;
-
- $record = new FS::cust_main_exemption \%hash;
- $record = new FS::cust_main_exemption { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_main_exemption object represents a customer tax exemption from a
-specific tax name (prefix). FS::cust_main_exemption inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item exemptionnum
-
-Primary key
-
-=item custnum
-
-Customer (see L<FS::cust_main>)
-
-=item taxname
-
-taxname
-
-
-=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 { 'cust_main_exemption'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('exemptionnum')
- || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
- || $self->ut_text('taxname')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm
deleted file mode 100644
index ec01842..0000000
--- a/FS/FS/cust_main_invoice.pm
+++ /dev/null
@@ -1,188 +0,0 @@
-package FS::cust_main_invoice;
-
-use strict;
-use vars qw(@ISA);
-use Exporter;
-use FS::Record qw( qsearchs );
-use FS::Conf;
-use FS::cust_main;
-use FS::svc_acct;
-use FS::Msgcat qw(gettext);
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::cust_main_invoice - Object methods for cust_main_invoice records
-
-=head1 SYNOPSIS
-
- use FS::cust_main_invoice;
-
- $record = new FS::cust_main_invoice \%hash;
- $record = new FS::cust_main_invoice { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $email_address = $record->address;
-
-=head1 DESCRIPTION
-
-An FS::cust_main_invoice object represents an invoice destination. FS::cust_main_invoice inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item destnum - primary key
-
-=item custnum - customer (see L<FS::cust_main>)
-
-=item dest - Invoice destination: If numeric, a svcnum (see L<FS::svc_acct>), if string, a literal email address, `POST' to enable mailing (the default if no cust_main_invoice records exist), or `FAX' to enable faxing via a HylaFAX server.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new invoice destination. To add the invoice destination 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 { 'cust_main_invoice'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Delete this record from the database.
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my ( $new, $old ) = ( shift, shift );
-
- return "Can't change custnum!" unless $old->custnum == $new->custnum;
-
- $new->SUPER::replace($old);
-}
-
-
-=item check
-
-Checks all fields to make sure this is a valid invoice destination. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error = $self->ut_numbern('destnum')
- || $self->ut_number('custnum')
- || $self->checkdest;
- ;
- return $error if $error;
-
- return "Unknown customer"
- unless qsearchs('cust_main',{ 'custnum' => $self->custnum });
-
- $self->SUPER::check;
-}
-
-=item checkdest
-
-Checks the dest field only.
-
-#If it finds that the account ends in the
-#same domain configured as the B<domain> configuration file, it will change the
-#invoice destination from an email address to a service number (see
-#L<FS::svc_acct>).
-
-=cut
-
-sub checkdest {
- my $self = shift;
-
- my $error = $self->ut_text('dest');
- return $error if $error;
-
- my $conf = new FS::Conf;
-
- if ( $self->dest =~ /^(POST|FAX)$/ ) {
- #contemplate our navel
- } elsif ( $self->dest =~ /^(\d+)$/ ) {
- return "Unknown local account (specified by svcnum: ". $self->dest. ")"
- unless qsearchs( 'svc_acct', { 'svcnum' => $self->dest } );
- } elsif ( $conf->exists('emailinvoice-apostrophe')
- ? $self->dest =~ /^\s*([\w\.\-\&\+\']+)\@(([\w\.\-]+\.)+\w+)\s*$/
- : $self->dest =~ /^\s*([\w\.\-\&\+]+)\@(([\w\.\-]+\.)+\w+)\s*$/ ){
- my($user, $domain) = ($1, $2);
- $self->dest("$1\@$2");
- } else {
- return gettext("illegal_email_invoice_address"). ': '. $self->dest;
- }
-
- ''; #no error
-}
-
-=item address
-
-Returns the literal email address for this record (or `POST' or `FAX').
-
-=cut
-
-sub address {
- my $self = shift;
- if ( $self->dest =~ /^(\d+)$/ ) {
- my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $1 } )
- or return undef;
- $svc_acct->email;
- } else {
- $self->dest;
- }
-}
-
-=item cust_main
-
-Returns the parent customer object (see L<FS::cust_main>).
-
-=cut
-
-sub cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_main_note.pm b/FS/FS/cust_main_note.pm
deleted file mode 100644
index 06da096..0000000
--- a/FS/FS/cust_main_note.pm
+++ /dev/null
@@ -1,193 +0,0 @@
-package FS::cust_main_note;
-
-use strict;
-use base qw( FS::otaker_Mixin FS::Record );
-use Carp;
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_note_class;
-
-=head1 NAME
-
-FS::cust_main_note - Object methods for cust_main_note records
-
-=head1 SYNOPSIS
-
- use FS::cust_main_note;
-
- $record = new FS::cust_main_note \%hash;
- $record = new FS::cust_main_note { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_main_note object represents a note attachted to a customer.
-FS::cust_main_note inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item notenum
-
-primary key
-
-=item custnum
-
-=item classnum
-
-=item _date
-
-=item usernum
-
-=item comments
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new customer note. To add the note 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 { 'cust_main_note'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('notenum')
- || $self->ut_number('custnum')
- || $self->ut_foreign_keyn('classnum', 'cust_note_class', 'classnum')
- || $self->ut_numbern('_date')
- || $self->ut_textn('otaker')
- || $self->ut_anything('comments')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item cust_note_class
-
-Returns the customer note class, as an FS::cust_note_class object, or the empty
-string if there is no note class.
-
-=cut
-
-sub cust_note_class {
- my $self = shift;
- if ( $self->classnum ) {
- qsearchs('cust_note_class', { 'classnum' => $self->classnum } );
- } else {
- return '';
- }
-}
-
-=item classname
-
-Returns the customer note class name, or the empty string if there is no
-customer note class.
-
-=cut
-
-sub classname {
- my $self = shift;
- my $cust_note_class = $self->cust_note_class;
- $cust_note_class ? $cust_note_class->classname : '';
-}
-
-
-#false laziness w/otaker_Mixin & cust_attachment
-sub otaker {
- my $self = shift;
- if ( scalar(@_) ) { #set
- my $otaker = shift;
- my($l,$f) = (split(', ', $otaker));
- my $access_user = qsearchs('access_user', { 'username'=>$otaker } )
- || qsearchs('access_user', { 'first'=>$f, 'last'=>$l } )
- or croak "can't set otaker: $otaker not found!"; #confess?
- $self->usernum( $access_user->usernum );
- $otaker; #not sure return is used anywhere, but just in case
- } else { #get
- if ( $self->usernum ) {
- $self->access_user->username;
- } elsif ( length($self->get('otaker')) ) {
- $self->get('otaker');
- } else {
- '';
- }
- }
-}
-
-# Used by FS::Upgrade to migrate to a new database.
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
- $class->_upgrade_otaker(%opts);
-}
-
-=back
-
-=head1 BUGS
-
-Lurking in the cracks.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_note_class.pm b/FS/FS/cust_note_class.pm
deleted file mode 100644
index 0cb9677..0000000
--- a/FS/FS/cust_note_class.pm
+++ /dev/null
@@ -1,105 +0,0 @@
-package FS::cust_note_class;
-
-use strict;
-use base qw( FS::class_Common );
-use FS::cust_main_note;
-
-=head1 NAME
-
-FS::cust_note_class - Object methods for cust_note_class records
-
-=head1 SYNOPSIS
-
- use FS::cust_note_class;
-
- $record = new FS::cust_note_class \%hash;
- $record = new FS::cust_note_class { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_note_class object represents a customer note class. Every customer
-note (see L<FS::cust_main_note) has, optionally, a note class. This class
-inherits from FS::class_Common. The following fields are currently supported:
-
-=over 4
-
-=item classnum
-
-primary key
-
-=item classname
-
-classname
-
-=item disabled
-
-disabled
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new customer note class. To add the note class 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 { 'cust_note_class'; }
-sub _target_table { 'cust_main_note'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid note class. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_main_note>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm
deleted file mode 100644
index 71bc707..0000000
--- a/FS/FS/cust_pay.pm
+++ /dev/null
@@ -1,1061 +0,0 @@
-package FS::cust_pay;
-
-use strict;
-use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
- FS::Record );
-use vars qw( $DEBUG $me $conf @encrypted_fields
- $unsuspendauto $ignore_noapply
- );
-use Date::Format;
-use Business::CreditCard;
-use Text::Template;
-use FS::UID qw( getotaker );
-use FS::Misc qw( send_email );
-use FS::Record qw( dbh qsearch qsearchs );
-use FS::CurrentUser;
-use FS::payby;
-use FS::cust_main_Mixin;
-use FS::payinfo_transaction_Mixin;
-use FS::cust_bill;
-use FS::cust_bill_pay;
-use FS::cust_pay_refund;
-use FS::cust_main;
-use FS::cust_pkg;
-use FS::cust_pay_void;
-
-$DEBUG = 0;
-
-$me = '[FS::cust_pay]';
-
-$ignore_noapply = 0;
-
-#ask FS::UID to run this stuff for us later
-FS::UID->install_callback( sub {
- $conf = new FS::Conf;
- $unsuspendauto = $conf->exists('unsuspendauto');
-} );
-
-@encrypted_fields = ('payinfo');
-
-=head1 NAME
-
-FS::cust_pay - Object methods for cust_pay objects
-
-=head1 SYNOPSIS
-
- use FS::cust_pay;
-
- $record = new FS::cust_pay \%hash;
- $record = new FS::cust_pay { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_pay object represents a payment; the transfer of money from a
-customer. FS::cust_pay inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item paynum
-
-primary key (assigned automatically for new payments)
-
-=item custnum
-
-customer (see L<FS::cust_main>)
-
-=item _date
-
-specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item paid
-
-Amount of this payment
-
-=item usernum
-
-order taker (see L<FS::access_user>)
-
-=item payby
-
-Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
-
-=item payinfo
-
-Payment Information (See L<FS::payinfo_Mixin> for data format)
-
-=item paymask
-
-Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
-
-=item paybatch
-
-text field for tracking card processing or other batch grouping
-
-=item payunique
-
-Optional unique identifer to prevent duplicate transactions.
-
-=item closed
-
-books closed flag, empty or `Y'
-
-=item pkgnum
-
-Desired pkgnum when using experimental package balances.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new payment. To add the payment to the databse, see L<"insert">.
-
-=cut
-
-sub table { 'cust_pay'; }
-sub cust_linked { $_[0]->cust_main_custnum; }
-sub cust_unlinked_msg {
- my $self = shift;
- "WARNING: can't find cust_main.custnum ". $self->custnum.
- ' (cust_pay.paynum '. $self->paynum. ')';
-}
-
-=item insert [ OPTION => VALUE ... ]
-
-Adds this payment to the database.
-
-For backwards-compatibility and convenience, if the additional field invnum
-is defined, an FS::cust_bill_pay record for the full amount of the payment
-will be created. In this case, custnum is optional.
-
-If the additional field discount_term is defined then a prepayment discount
-is taken for that length of time. It is an error for the customer to owe
-after this payment is made.
-
-A hash of optional arguments may be passed. Currently "manual" is supported.
-If true, a payment receipt is sent instead of a statement when
-'payment_receipt_email' configuration option is set.
-
-=cut
-
-sub insert {
- my($self, %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;
-
- my $cust_bill;
- if ( $self->invnum ) {
- $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
- or do {
- $dbh->rollback if $oldAutoCommit;
- return "Unknown cust_bill.invnum: ". $self->invnum;
- };
- $self->custnum($cust_bill->custnum );
- }
-
- my $error = $self->check;
- return $error if $error;
-
- my $cust_main = $self->cust_main;
- my $old_balance = $cust_main->balance;
-
- $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_pay: $error";
- }
-
- if ( my $credit_type = $conf->config('prepayment_discounts-credit_type') ) {
- if ( my $months = $self->discount_term ) {
- #hmmm... error handling
- my ($credit, $savings, $total) =
- $cust_main->discount_term_values($months);
- my $cust_credit = new FS::cust_credit {
- 'custnum' => $self->custnum,
- 'amount' => $credit,
- 'reason' => 'customer chose to prepay for discount',
- };
- $error = $cust_credit->insert('reason_type' => $credit_type);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_pay: $error";
- }
- my @pkgs = $cust_main->_discount_pkgs_and_bill;
- my $cust_bill = shift(@pkgs);
- @pkgs = &FS::cust_main::Billing::_discountable_pkgs_at_term($months, @pkgs);
- $_->bill($_->last_bill) foreach @pkgs;
- $error = $cust_main->bill(
- 'recurring_only' => 1,
- 'time' => $cust_bill->invoice_date,
- 'no_usage_reset' => 1,
- 'pkg_list' => \@pkgs,
- 'freq_override' => $months,
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_pay: $error";
- }
- $error = $cust_main->apply_payments_and_credits;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_pay: $error";
- }
- my $new_balance = $cust_main->balance;
- if ($new_balance > 0) {
- $dbh->rollback if $oldAutoCommit;
- return "balance after prepay discount attempt: $new_balance";
- }
-
- }
-
- }
-
- if ( $self->invnum ) {
- my $cust_bill_pay = new FS::cust_bill_pay {
- 'invnum' => $self->invnum,
- 'paynum' => $self->paynum,
- 'amount' => $self->paid,
- '_date' => $self->_date,
- };
- $error = $cust_bill_pay->insert(%options);
- if ( $error ) {
- if ( $ignore_noapply ) {
- warn "warning: error inserting cust_bill_pay: $error ".
- "(ignore_noapply flag set; inserting cust_pay record anyway)\n";
- } else {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting cust_bill_pay: $error";
- }
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- #false laziness w/ cust_credit::insert
- if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
- my @errors = $cust_main->unsuspend;
- #return
- # side-fx with nested transactions? upstack rolls back?
- warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
- join(' / ', @errors)
- if @errors;
- }
- #eslaf
-
- #bill setup fees for voip_cdr bill_every_call packages
- #some false laziness w/search in freeside-cdrd
- my $addl_from =
- 'LEFT JOIN part_pkg USING ( pkgpart ) '.
- "LEFT JOIN part_pkg_option
- ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart
- AND part_pkg_option.optionname = 'bill_every_call' )";
-
- my $extra_sql = " AND plan = 'voip_cdr' AND optionvalue = '1' ".
- " AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) ";
-
- my @cust_pkg = qsearch({
- 'table' => 'cust_pkg',
- 'addl_from' => $addl_from,
- 'hashref' => { 'custnum' => $self->custnum,
- 'susp' => '',
- 'cancel' => '',
- },
- 'extra_sql' => $extra_sql,
- });
-
- if ( @cust_pkg ) {
- warn "voip_cdr bill_every_call packages found; billing customer\n";
- my $bill_error = $self->cust_main->bill_and_collect( 'fatal' => 'return' );
- if ( $bill_error ) {
- warn "WARNING: Error billing customer: $bill_error\n";
- }
- }
- #end of billing setup fees for voip_cdr bill_every_call packages
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- #payment receipt
- my $trigger = $conf->config('payment_receipt-trigger',
- $self->cust_main->agentnum) || 'cust_pay';
- if ( $trigger eq 'cust_pay' ) {
- my $error = $self->send_receipt(
- 'manual' => $options{'manual'},
- 'cust_bill' => $cust_bill,
- 'cust_main' => $cust_main,
- );
- warn "can't send payment receipt/statement: $error" if $error;
- }
-
- '';
-
-}
-
-=item void [ REASON ]
-
-Voids this payment: deletes the payment and all associated applications and
-adds a record of the voided payment to the FS::cust_pay_void table.
-
-=cut
-
-sub void {
- 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 $cust_pay_void = new FS::cust_pay_void ( {
- map { $_ => $self->get($_) } $self->fields
- } );
- $cust_pay_void->reason(shift) if scalar(@_);
- my $error = $cust_pay_void->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $error = $self->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item delete
-
-Unless the closed flag is set, deletes this payment and all associated
-applications (see L<FS::cust_bill_pay> and L<FS::cust_pay_refund>). In most
-cases, you want to use the void method instead to leave a record of the
-deleted payment.
-
-=cut
-
-# very similar to FS::cust_credit::delete
-sub delete {
- my $self = shift;
- return "Can't delete closed payment" if $self->closed =~ /^Y/i;
-
- 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 $app ( $self->cust_bill_pay, $self->cust_pay_refund ) {
- my $error = $app->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my $error = $self->SUPER::delete(@_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $conf->exists('deletepayments')
- && $conf->config('deletepayments') ne '' ) {
-
- my $cust_main = $self->cust_main;
-
- my $error = send_email(
- 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
- #invoice_from??? well as good as any
- 'to' => $conf->config('deletepayments'),
- 'subject' => 'FREESIDE NOTIFICATION: Payment deleted',
- 'body' => [
- "This is an automatic message from your Freeside installation\n",
- "informing you that the following payment has been deleted:\n",
- "\n",
- 'paynum: '. $self->paynum. "\n",
- 'custnum: '. $self->custnum.
- " (". $cust_main->last. ", ". $cust_main->first. ")\n",
- 'paid: $'. sprintf("%.2f", $self->paid). "\n",
- 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
- 'payby: '. $self->payby. "\n",
- 'payinfo: '. $self->paymask. "\n",
- 'paybatch: '. $self->paybatch. "\n",
- ],
- );
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't send payment deletion notification: $error";
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item replace [ OLD_RECORD ]
-
-You can, but probably shouldn't modify payments...
-
-Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
-supplied, replaces this record. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub replace {
- my $self = shift;
- return "Can't modify closed payment" if $self->closed =~ /^Y/i;
- $self->SUPER::replace(@_);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid payment. If there is an error,
-returns the error, otherwise returns false. Called by the insert method.
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
-
- my $error =
- $self->ut_numbern('paynum')
- || $self->ut_numbern('custnum')
- || $self->ut_numbern('_date')
- || $self->ut_money('paid')
- || $self->ut_alphan('otaker')
- || $self->ut_textn('paybatch')
- || $self->ut_textn('payunique')
- || $self->ut_enum('closed', [ '', 'Y' ])
- || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
- || $self->payinfo_check()
- || $self->ut_numbern('discount_term')
- ;
- return $error if $error;
-
- return "paid must be > 0 " if $self->paid <= 0;
-
- return "unknown cust_main.custnum: ". $self->custnum
- unless $self->invnum
- || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-
- $self->_date(time) unless $self->_date;
-
- return "invalid discount_term"
- if ($self->discount_term && $self->discount_term < 2);
-
-#i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it
-# # UNIQUE index should catch this too, without race conditions, but this
-# # should give a better error message the other 99.9% of the time...
-# if ( length($self->payunique)
-# && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) {
-# #well, it *could* be a better error message
-# return "duplicate transaction".
-# " - a payment with unique identifer ". $self->payunique.
-# " already exists";
-# }
-
- $self->SUPER::check;
-}
-
-=item send_receipt HASHREF | OPTION => VALUE ...
-
-Sends a payment receipt for this payment..
-
-Available options:
-
-=over 4
-
-=item manual
-
-Flag indicating the payment is being made manually.
-
-=item cust_bill
-
-Invoice (FS::cust_bill) object. If not specified, the most recent invoice
-will be assumed.
-
-=item cust_main
-
-Customer (FS::cust_main) object (for efficiency).
-
-=back
-
-=cut
-
-sub send_receipt {
- my $self = shift;
- my $opt = ref($_[0]) ? shift : { @_ };
-
- my $cust_bill = $opt->{'cust_bill'};
- my $cust_main = $opt->{'cust_main'} || $self->cust_main;
-
- my $conf = new FS::Conf;
-
- return '' unless $conf->exists('payment_receipt', $cust_main->agentnum);
-
- my @invoicing_list = $cust_main->invoicing_list_emailonly;
- return '' unless @invoicing_list;
-
- $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though?
-
- my $error = '';
-
- if ( ( exists($opt->{'manual'}) && $opt->{'manual'} )
- || ! $conf->exists('invoice_html_statement')
- || ! $cust_bill
- )
- {
- my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum);
- if ( $msgnum ) {
- my $msg_template = FS::msg_template->by_key($msgnum);
- $error = $msg_template->send('cust_main'=> $cust_main, 'object'=> $self);
-
- } elsif ( $conf->exists('payment_receipt_email') ) {
-
- my $receipt_template = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ],
- ) or do {
- warn "can't create payment receipt template: $Text::Template::ERROR";
- return '';
- };
-
- my $payby = $self->payby;
- my $payinfo = $self->payinfo;
- $payby =~ s/^BILL$/Check/ if $payinfo;
- if ( $payby eq 'CARD' || $payby eq 'CHEK' ) {
- $payinfo = $self->paymask
- } else {
- $payinfo = $self->decrypt($payinfo);
- }
- $payby =~ s/^CHEK$/Electronic check/;
-
- my %fill_in = (
- 'date' => time2str("%a %B %o, %Y", $self->_date),
- 'name' => $cust_main->name,
- 'paynum' => $self->paynum,
- 'paid' => sprintf("%.2f", $self->paid),
- 'payby' => ucfirst(lc($payby)),
- 'payinfo' => $payinfo,
- 'balance' => $cust_main->balance,
- 'company_name' => $conf->config('company_name', $cust_main->agentnum),
- );
-
- if ( $opt->{'cust_pkg'} ) {
- $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg;
- #setup date, other things?
- }
-
- $error = send_email(
- 'from' => $conf->config('invoice_from', $cust_main->agentnum),
- #invoice_from??? well as good as any
- 'to' => \@invoicing_list,
- 'subject' => 'Payment receipt',
- 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ],
- );
-
- } else {
-
- warn "payment_receipt is on, but no payment_receipt_msgnum or invoice_html_statement is configured\n";
-
- }
-
- } else { #not manual
-
- my $queue = new FS::queue {
- 'paynum' => $self->paynum,
- 'job' => 'FS::cust_bill::queueable_email',
- };
-
- $error = $queue->insert(
- 'invnum' => $cust_bill->invnum,
- 'template' => 'statement',
- );
-
- }
-
- warn "send_receipt: $error\n" if $error;
-}
-
-=item cust_bill_pay
-
-Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
-payment.
-
-=cut
-
-sub cust_bill_pay {
- my $self = shift;
- map { $_ } #return $self->num_cust_bill_pay unless wantarray;
- sort { $a->_date <=> $b->_date
- || $a->invnum <=> $b->invnum }
- qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
- ;
-}
-
-=item cust_pay_refund
-
-Returns all applications of refunds (see L<FS::cust_pay_refund>) to this
-payment.
-
-=cut
-
-sub cust_pay_refund {
- my $self = shift;
- map { $_ } #return $self->num_cust_pay_refund unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay_refund', { 'paynum' => $self->paynum } )
- ;
-}
-
-
-=item unapplied
-
-Returns the amount of this payment that is still unapplied; which is
-paid minus all payment applications (see L<FS::cust_bill_pay>) and refund
-applications (see L<FS::cust_pay_refund>).
-
-=cut
-
-sub unapplied {
- my $self = shift;
- my $amount = $self->paid;
- $amount -= $_->amount foreach ( $self->cust_bill_pay );
- $amount -= $_->amount foreach ( $self->cust_pay_refund );
- sprintf("%.2f", $amount );
-}
-
-=item unrefunded
-
-Returns the amount of this payment that has not been refuned; which is
-paid minus all refund applications (see L<FS::cust_pay_refund>).
-
-=cut
-
-sub unrefunded {
- my $self = shift;
- my $amount = $self->paid;
- $amount -= $_->amount foreach ( $self->cust_pay_refund );
- sprintf("%.2f", $amount );
-}
-
-=item amount
-
-Returns the "paid" field.
-
-=cut
-
-sub amount {
- my $self = shift;
- $self->paid();
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item batch_insert CUST_PAY_OBJECT, ...
-
-Class method which inserts multiple payments. Takes a list of FS::cust_pay
-objects. Returns a list, each element representing the status of inserting the
-corresponding payment - empty. If there is an error inserting any payment, the
-entire transaction is rolled back, i.e. all payments are inserted or none are.
-
-For example:
-
- my @errors = FS::cust_pay->batch_insert(@cust_pay);
- my $num_errors = scalar(grep $_, @errors);
- if ( $num_errors == 0 ) {
- #success; all payments were inserted
- } else {
- #failure; no payments were inserted.
- }
-
-=cut
-
-sub batch_insert {
- my $self = shift; #class method
-
- 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 $errors = 0;
-
- my @errors = map {
- my $error = $_->insert( 'manual' => 1 );
- if ( $error ) {
- $errors++;
- } else {
- $_->cust_main->apply_payments;
- }
- $error;
- } @_;
-
- if ( $errors ) {
- $dbh->rollback if $oldAutoCommit;
- } else {
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- }
-
- @errors;
-
-}
-
-=item unapplied_sql
-
-Returns an SQL fragment to retreive the unapplied amount.
-
-=cut
-
-sub unapplied_sql {
- my ($class, $start, $end) = @_;
- my $bill_start = $start ? "AND cust_bill_pay._date <= $start" : '';
- my $bill_end = $end ? "AND cust_bill_pay._date > $end" : '';
- my $refund_start = $start ? "AND cust_pay_refund._date <= $start" : '';
- my $refund_end = $end ? "AND cust_pay_refund._date > $end" : '';
-
- "paid
- - COALESCE(
- ( SELECT SUM(amount) FROM cust_bill_pay
- WHERE cust_pay.paynum = cust_bill_pay.paynum
- $bill_start $bill_end )
- ,0
- )
- - COALESCE(
- ( SELECT SUM(amount) FROM cust_pay_refund
- WHERE cust_pay.paynum = cust_pay_refund.paynum
- $refund_start $refund_end )
- ,0
- )
- ";
-
-}
-
-# _upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-
-use FS::h_cust_pay;
-
-sub _upgrade_data { #class method
- my ($class, %opts) = @_;
-
- warn "$me upgrading $class\n" if $DEBUG;
-
- ##
- # otaker/ivan upgrade
- ##
-
- #not the most efficient, but hey, it only has to run once
-
- my $where = "WHERE ( otaker IS NULL OR otaker = '' OR otaker = 'ivan' ) ".
- " AND usernum IS NULL ".
- " AND 0 < ( SELECT COUNT(*) FROM cust_main ".
- " WHERE cust_main.custnum = cust_pay.custnum ) ";
-
- my $count_sql = "SELECT COUNT(*) FROM cust_pay $where";
-
- my $sth = dbh->prepare($count_sql) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
- my $total = $sth->fetchrow_arrayref->[0];
- #warn "$total cust_pay records to update\n"
- # if $DEBUG;
- local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info
-
- my $count = 0;
- my $lastprog = 0;
-
- my @cust_pay = qsearch( {
- 'table' => 'cust_pay',
- 'hashref' => {},
- 'extra_sql' => $where,
- 'order_by' => 'ORDER BY paynum',
- } );
-
- foreach my $cust_pay (@cust_pay) {
-
- my $h_cust_pay = $cust_pay->h_search('insert');
- if ( $h_cust_pay ) {
- next if $cust_pay->otaker eq $h_cust_pay->history_user;
- #$cust_pay->otaker($h_cust_pay->history_user);
- $cust_pay->set('otaker', $h_cust_pay->history_user);
- } else {
- $cust_pay->set('otaker', 'legacy');
- }
-
- delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
- my $error = $cust_pay->replace;
-
- if ( $error ) {
- warn " *** WARNING: Error updating order taker for payment paynum ".
- $cust_pay->paynun. ": $error\n";
- next;
- }
-
- $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
-
- $count++;
- if ( $DEBUG > 1 && $lastprog + 30 < time ) {
- warn "$me $count/$total (". sprintf('%.2f',100*$count/$total). '%)'. "\n";
- $lastprog = time;
- }
-
- }
-
- ###
- # payinfo N/A upgrade
- ###
-
- #XXX remove the 'N/A (tokenized)' part (or just this entire thing)
-
- my @na_cust_pay = qsearch( {
- 'table' => 'cust_pay',
- 'hashref' => {}, #could be encrypted# { 'payinfo' => 'N/A' },
- 'extra_sql' => "WHERE ( payinfo = 'N/A' OR paymask = 'N/AA' OR paymask = 'N/A (tokenized)' ) AND payby IN ( 'CARD', 'CHEK' )",
- } );
-
- foreach my $na ( @na_cust_pay ) {
-
- next unless $na->payinfo eq 'N/A';
-
- my $cust_pay_pending =
- qsearchs('cust_pay_pending', { 'paynum' => $na->paynum } );
- unless ( $cust_pay_pending ) {
- warn " *** WARNING: not-yet recoverable N/A card for payment ".
- $na->paynum. " (no cust_pay_pending)\n";
- next;
- }
- $na->$_($cust_pay_pending->$_) for qw( payinfo paymask );
- my $error = $na->replace;
- if ( $error ) {
- warn " *** WARNING: Error updating payinfo for payment paynum ".
- $na->paynun. ": $error\n";
- next;
- }
-
- }
-
- ###
- # otaker->usernum upgrade
- ###
-
- delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge
- $class->_upgrade_otaker(%opts);
- $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it
-
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item batch_import HASHREF
-
-Inserts new payments.
-
-=cut
-
-sub batch_import {
- my $param = shift;
-
- my $fh = $param->{filehandle};
- my $agentnum = $param->{agentnum};
- my $format = $param->{'format'};
- my $paybatch = $param->{'paybatch'};
-
- # here is the agent virtualization
- my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
-
- my @fields;
- my $payby;
- if ( $format eq 'simple' ) {
- @fields = qw( custnum agent_custid paid payinfo );
- $payby = 'BILL';
- } elsif ( $format eq 'extended' ) {
- die "unimplemented\n";
- @fields = qw( );
- $payby = 'BILL';
- } else {
- die "unknown format $format";
- }
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
-
- my $csv = new Text::CSV_XS;
-
- my $imported = 0;
-
- 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 $line;
- while ( defined($line=<$fh>) ) {
-
- $csv->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $csv->error_input();
- };
-
- my @columns = $csv->fields();
-
- my %cust_pay = (
- payby => $payby,
- paybatch => $paybatch,
- );
-
- my $cust_main;
- foreach my $field ( @fields ) {
-
- if ( $field eq 'agent_custid'
- && $agentnum
- && $columns[0] =~ /\S+/ )
- {
-
- my $agent_custid = $columns[0];
- my %hash = ( 'agent_custid' => $agent_custid,
- 'agentnum' => $agentnum,
- );
-
- if ( $cust_pay{'custnum'} !~ /^\s*$/ ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't specify custnum with agent_custid $agent_custid";
- }
-
- $cust_main = qsearchs({
- 'table' => 'cust_main',
- 'hashref' => \%hash,
- 'extra_sql' => $extra_sql,
- });
-
- unless ( $cust_main ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't find customer with agent_custid $agent_custid";
- }
-
- $field = 'custnum';
- $columns[0] = $cust_main->custnum;
- }
-
- $cust_pay{$field} = shift @columns;
- }
-
- my $cust_pay = new FS::cust_pay( \%cust_pay );
- my $error = $cust_pay->insert;
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert payment for $line: $error";
- }
-
- if ( $format eq 'simple' ) {
- # include agentnum for less surprise?
- $cust_main = qsearchs({
- 'table' => 'cust_main',
- 'hashref' => { 'custnum' => $cust_pay->custnum },
- 'extra_sql' => $extra_sql,
- })
- unless $cust_main;
-
- unless ( $cust_main ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't find customer to which payments apply at line: $line";
- }
-
- $error = $cust_main->apply_payments_and_credits;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't apply payments to customer for $line: $error";
- }
-
- }
-
- $imported++;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return "Empty file!" unless $imported;
-
- ''; #no error
-
-}
-
-=back
-
-=head1 BUGS
-
-Delete and replace methods.
-
-=head1 SEE ALSO
-
-L<FS::cust_pay_pending>, L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm
deleted file mode 100644
index 9fa1459..0000000
--- a/FS/FS/cust_pay_batch.pm
+++ /dev/null
@@ -1,353 +0,0 @@
-package FS::cust_pay_batch;
-
-use strict;
-use vars qw( @ISA $DEBUG );
-use Carp qw( confess );
-use Business::CreditCard 0.28;
-use FS::Record qw(dbh qsearch qsearchs);
-use FS::payinfo_Mixin;
-use FS::cust_main;
-use FS::cust_bill;
-
-@ISA = qw( FS::payinfo_Mixin FS::Record );
-
-# 1 is mostly method/subroutine entry and options
-# 2 traces progress of some operations
-# 3 is even more information including possibly sensitive data
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::cust_pay_batch - Object methods for batch cards
-
-=head1 SYNOPSIS
-
- use FS::cust_pay_batch;
-
- $record = new FS::cust_pay_batch \%hash;
- $record = new FS::cust_pay_batch { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- #deprecated# $error = $record->retriable;
-
-=head1 DESCRIPTION
-
-An FS::cust_pay_batch object represents a credit card transaction ready to be
-batched (sent to a processor). FS::cust_pay_batch inherits from FS::Record.
-Typically called by the collect method of an FS::cust_main object. The
-following fields are currently supported:
-
-=over 4
-
-=item paybatchnum - primary key (automatically assigned)
-
-=item batchnum - indentifies group in batch
-
-=item payby - CARD/CHEK/LECB/BILL/COMP
-
-=item payinfo
-
-=item exp - card expiration
-
-=item amount
-
-=item invnum - invoice
-
-=item custnum - customer
-
-=item payname - name on card
-
-=item first - name
-
-=item last - name
-
-=item address1
-
-=item address2
-
-=item city
-
-=item state
-
-=item zip
-
-=item country
-
-=item status
-
-=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
-
-sub table { 'cust_pay_batch'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Delete this record from the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid transaction. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('paybatchnum')
- || $self->ut_numbern('trancode') #deprecated
- || $self->ut_money('amount')
- || $self->ut_number('invnum')
- || $self->ut_number('custnum')
- || $self->ut_text('address1')
- || $self->ut_textn('address2')
- || $self->ut_text('city')
- || $self->ut_textn('state')
- ;
-
- return $error if $error;
-
- $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
- $self->setfield('last',$1);
-
- $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
- $self->first($1);
-
- $error = $self->payinfo_check();
- return $error if $error;
-
- if ( $self->exp eq '' ) {
- return "Expiration date required"
- unless $self->payby =~ /^(CHEK|DCHK|LECB|WEST)$/;
- $self->exp('');
- } else {
- if ( $self->exp =~ /^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})$/ ) {
- $self->exp("$1-$2-$3");
- } elsif ( $self->exp =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
- if ( length($2) == 4 ) {
- $self->exp("$2-$1-01");
- } elsif ( $2 > 98 ) { #should pry change to check for "this year"
- $self->exp("19$2-$1-01");
- } else {
- $self->exp("20$2-$1-01");
- }
- } else {
- return "Illegal expiration date";
- }
- }
-
- if ( $self->payname eq '' ) {
- $self->payname( $self->first. " ". $self->getfield('last') );
- } else {
- $self->payname =~ /^([\w \,\.\-\']+)$/
- or return "Illegal billing name";
- $self->payname($1);
- }
-
- #we have lots of old zips in there... don't hork up batch results cause of em
- $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
- or return "Illegal zip: ". $self->zip;
- $self->zip($1);
-
- $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
- $self->country($1);
-
- #$error = $self->ut_zip('zip', $self->country);
- #return $error if $error;
-
- #check invnum, custnum, ?
-
- $self->SUPER::check;
-}
-
-=item cust_main
-
-Returns the customer (see L<FS::cust_main>) for this batched credit card
-payment.
-
-=cut
-
-sub cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
-#you know what, screw this in the new world of events. we should be able to
-#get the event defs to retry (remove once.pm condition, add every.pm) without
-#mucking about with statuses of previous cust_event records. right?
-#
-#=item retriable
-#
-#Marks the corresponding event (see L<FS::cust_bill_event>) for this batched
-#credit card payment as retriable. Useful if the corresponding financial
-#institution account was declined for temporary reasons and/or a manual
-#retry is desired.
-#
-#Implementation details: For the named customer's invoice, changes the
-#statustext of the 'done' (without statustext) event to 'retriable.'
-#
-#=cut
-
-sub retriable {
-
- confess "deprecated method cust_pay_batch->retriable called; try removing ".
- "the once condition and adding an every condition?";
-
- my $self = shift;
-
- local $SIG{HUP} = 'IGNORE'; #Hmm
- 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 $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
- or return "event $self->eventnum references nonexistant invoice $self->invnum";
-
- warn "cust_pay_batch->retriable working with self of " . $self->paybatchnum . " and invnum of " . $self->invnum;
- my @cust_bill_event =
- sort { $a->part_bill_event->seconds <=> $b->part_bill_event->seconds }
- grep {
- $_->part_bill_event->eventcode =~ /\$cust_bill->batch_card/
- && $_->status eq 'done'
- && ! $_->statustext
- }
- $cust_bill->cust_bill_event;
- # complain loudly if scalar(@cust_bill_event) > 1 ?
- my $error = $cust_bill_event[0]->retriable;
- if ($error ) {
- # gah, even with transactions.
- $dbh->commit if $oldAutoCommit; #well.
- return "error marking invoice event retriable: $error";
- }
- '';
-}
-
-=item approve PAYBATCH
-
-Approve this payment. This will replace the existing record with the
-same paybatchnum, set its status to 'Approved', and generate a payment
-record (L<FS::cust_pay>). This should only be called from the batch
-import process.
-
-=cut
-
-sub approve {
- # to break up the Big Wall of Code that is import_results
- my $new = shift;
- my $paybatch = shift;
- my $paybatchnum = $new->paybatchnum;
- my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
- or return "paybatchnum $paybatchnum not found";
- return "paybatchnum $paybatchnum already resolved ('".$old->status."')"
- if $old->status;
- $new->status('Approved');
- my $error = $new->replace($old);
- if ( $error ) {
- return "error updating status of paybatchnum $paybatchnum: $error\n";
- }
- my $cust_pay = new FS::cust_pay ( {
- 'custnum' => $new->custnum,
- 'payby' => $new->payby,
- 'paybatch' => $paybatch,
- 'payinfo' => $new->payinfo || $old->payinfo,
- 'paid' => $new->paid,
- '_date' => $new->_date,
- } );
- $error = $cust_pay->insert;
- if ( $error ) {
- return "error inserting payment for paybatchnum $paybatchnum: $error\n";
- }
- $cust_pay->cust_main->apply_payments;
- return;
-}
-
-=item decline
-
-Decline this payment. This will replace the existing record with the
-same paybatchnum, set its status to 'Declined', and run collection events
-as appropriate. This should only be called from the batch import process.
-
-
-=cut
-sub decline {
- my $new = shift;
- my $paybatchnum = $new->paybatchnum;
- my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum })
- or return "paybatchnum $paybatchnum not found";
- return "paybatchnum $paybatchnum already resolved ('".$old->status."')"
- if $old->status;
- $new->status('Declined');
- my $error = $new->replace($old);
- if ( $error ) {
- return "error updating status of paybatchnum $paybatchnum: $error\n";
- }
- my $due_cust_event = $new->cust_main->due_cust_event(
- 'eventtable' => 'cust_pay_batch',
- 'objects' => [ $new ],
- );
- if ( !ref($due_cust_event) ) {
- return $due_cust_event;
- }
- # XXX breaks transaction integrity
- foreach my $cust_event (@$due_cust_event) {
- next unless $cust_event->test_conditions;
- if ( my $error = $cust_event->do_event() ) {
- return $error;
- }
- }
- return;
-}
-
-=back
-
-=head1 BUGS
-
-There should probably be a configuration file with a list of allowed credit
-card types.
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, L<FS::Record>
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_pay_pending.pm b/FS/FS/cust_pay_pending.pm
deleted file mode 100644
index e54690e..0000000
--- a/FS/FS/cust_pay_pending.pm
+++ /dev/null
@@ -1,341 +0,0 @@
-package FS::cust_pay_pending;
-
-use strict;
-use vars qw( @ISA @encrypted_fields );
-use FS::Record qw( qsearch qsearchs dbh ); #dbh for _upgrade_data
-use FS::payinfo_transaction_Mixin;
-use FS::cust_main_Mixin;
-use FS::cust_main;
-use FS::cust_pkg;
-use FS::cust_pay;
-
-@ISA = qw( FS::payinfo_transaction_Mixin FS::cust_main_Mixin FS::Record );
-
-@encrypted_fields = ('payinfo');
-
-=head1 NAME
-
-FS::cust_pay_pending - Object methods for cust_pay_pending records
-
-=head1 SYNOPSIS
-
- use FS::cust_pay_pending;
-
- $record = new FS::cust_pay_pending \%hash;
- $record = new FS::cust_pay_pending { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_pay_pending object represents an pending payment. It reflects
-local state through the multiple stages of processing a real-time transaction
-with an external gateway. FS::cust_pay_pending inherits from FS::Record. The
-following fields are currently supported:
-
-=over 4
-
-=item paypendingnum
-
-Primary key
-
-=item custnum
-
-Customer (see L<FS::cust_main>)
-
-=item paid
-
-Amount of this payment
-
-=item _date
-
-Specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item payby
-
-Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
-
-=item payinfo
-
-Payment Information (See L<FS::payinfo_Mixin> for data format)
-
-=item paymask
-
-Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
-
-=item paydate
-
-Expiration date
-
-=item payunique
-
-Unique identifer to prevent duplicate transactions.
-
-=item pkgnum
-
-Desired pkgnum when using experimental package balances.
-
-=item status
-
-Pending transaction status, one of the following:
-
-=over 4
-
-=item new
-
-Aquires basic lock on payunique
-
-=item pending
-
-Transaction is pending with the gateway
-
-=item authorized
-
-Only used for two-stage transactions that require a separate capture step
-
-=item captured
-
-Transaction completed with payment gateway (sucessfully), not yet recorded in
-the database
-
-=item declined
-
-Transaction completed with payment gateway (declined), not yet recorded in
-the database
-
-=item done
-
-Transaction recorded in database
-
-=back
-
-=item statustext
-
-Additional status information.
-
-=item gatewaynum
-
-L<FS::payment_gateway> id.
-
-=item paynum -
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new pending payment. To add the pending payment 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 { 'cust_pay_pending'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid pending payment. 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('paypendingnum')
- || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
- || $self->ut_money('paid')
- || $self->ut_numbern('_date')
- || $self->ut_textn('payunique')
- || $self->ut_text('status')
- #|| $self->ut_textn('statustext')
- || $self->ut_anything('statustext')
- #|| $self->ut_money('cust_balance')
- || $self->ut_hexn('session_id')
- || $self->ut_foreign_keyn('paynum', 'cust_pay', 'paynum' )
- || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
- || $self->payinfo_check() #payby/payinfo/paymask/paydate
- ;
- return $error if $error;
-
- $self->_date(time) unless $self->_date;
-
- # UNIQUE index should catch this too, without race conditions, but this
- # should give a better error message the other 99.9% of the time...
- if ( length($self->payunique) ) {
- my $cust_pay_pending = qsearchs('cust_pay_pending', {
- 'payunique' => $self->payunique,
- 'paypendingnum' => { op=>'!=', value=>$self->paypendingnum },
- });
- if ( $cust_pay_pending ) {
- #well, it *could* be a better error message
- return "duplicate transaction - a payment with unique identifer ".
- $self->payunique. " already exists";
- }
- }
-
- $self->SUPER::check;
-}
-
-=item cust_main
-
-Returns the associated L<FS::cust_main> record if any. Otherwise returns false.
-
-=cut
-
-sub cust_main {
- my $self = shift;
- qsearchs('cust_main', { custnum => $self->custnum } );
-}
-
-
-#these two are kind-of false laziness w/cust_main::realtime_bop
-#(currently only used when resolving pending payments manually)
-
-=item insert_cust_pay
-
-Sets the status of this pending pament to "done" (with statustext
-"captured (manual)"), and inserts a payment record (see L<FS::cust_pay>).
-
-Currently only used when resolving pending payments manually.
-
-=cut
-
-sub insert_cust_pay {
- my $self = shift;
-
- my $cust_pay = new FS::cust_pay ( {
- 'custnum' => $self->custnum,
- 'paid' => $self->paid,
- '_date' => $self->_date, #better than passing '' for now
- 'payby' => $self->payby,
- 'payinfo' => $self->payinfo,
- 'paybatch' => $self->paybatch,
- 'paydate' => $self->paydate,
- } );
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
-
- my $error = $cust_pay->insert;#($options{'manual'} ? ( 'manual' => 1 ) : () );
-
- if ( $error ) {
- # gah.
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- return $error;
- }
-
- $self->status('done');
- $self->statustext('captured (manual)');
- $self->paynum($cust_pay->paynum);
- my $cpp_done_err = $self->replace;
-
- if ( $cpp_done_err ) {
-
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- return $cpp_done_err;
-
- } else {
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return ''; #no error
-
- }
-
-}
-
-=item decline [ STATUSTEXT ]
-
-Sets the status of this pending payment to "done" (with statustext
-"declined (manual)" unless otherwise specified).
-
-Currently only used when resolving pending payments manually.
-
-=cut
-
-sub decline {
- my $self = shift;
- my $statustext = shift || "declined (manual)";
-
- #could send decline email too? doesn't seem useful in manual resolution
-
- $self->status('done');
- $self->statustext($statustext);
- $self->replace;
-}
-
-# _upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-
-sub _upgrade_data { #class method
- my ($class, %opts) = @_;
-
- my $sql =
- "DELETE FROM cust_pay_pending WHERE status = 'new' AND _date < ".(time-600);
-
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_pay_refund.pm b/FS/FS/cust_pay_refund.pm
deleted file mode 100644
index cb9dbce..0000000
--- a/FS/FS/cust_pay_refund.pm
+++ /dev/null
@@ -1,188 +0,0 @@
-package FS::cust_pay_refund;
-
-use strict;
-use vars qw( @ISA ); #$conf );
-use FS::UID qw( getotaker );
-use FS::Record qw( qsearchs ); # qsearch );
-use FS::cust_main;
-use FS::cust_pay;
-use FS::cust_refund;
-
-@ISA = qw( FS::Record );
-
-#ask FS::UID to run this stuff for us later
-#FS::UID->install_callback( sub {
-# $conf = new FS::Conf;
-#} );
-
-=head1 NAME
-
-FS::cust_pay_refund - Object methods for cust_pay_refund records
-
-=head1 SYNOPSIS
-
- use FS::cust_pay_refund;
-
- $record = new FS::cust_pay_refund \%hash;
- $record = new FS::cust_pay_refund { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_pay_refund object represents application of a refund (see
-L<FS::cust_refund>) to an payment (see L<FS::cust_pay>). FS::cust_pay_refund
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item payrefundnum - primary key
-
-=item paynum - credit being applied
-
-=item refundnum - invoice to which credit is applied (see L<FS::cust_bill>)
-
-=item amount - amount of the credit applied
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new cust_pay_refund. To add the cust_pay_refund to the database,
-see L<"insert">.
-
-=cut
-
-sub table { 'cust_pay_refund'; }
-
-=item insert
-
-Adds this cust_pay_refund to the database. If there is an error, returns the
-error, otherwise returns false.
-
-=cut
-
-sub insert {
- my $self = shift;
- return "Can't apply refund to closed payment"
- if $self->cust_pay->closed =~ /^Y/i;
- return "Can't apply payment to closed refund"
- if $self->cust_refund->closed =~ /^Y/i;
- $self->SUPER::insert(@_);
-}
-
-=item delete
-
-=cut
-
-sub delete {
- my $self = shift;
- return "Can't remove refund from closed payment"
- if $self->cust_pay->closed =~ /^Y/i;
- return "Can't remove payment from closed refund"
- if $self->cust_refund->closed =~ /^Y/i;
- $self->SUPER::delete(@_);
-}
-
-=item replace OLD_RECORD
-
-Application of refunds to payments may not be modified.
-
-=cut
-
-sub replace {
- return "Can't modify application of a refund to payment!"
-}
-
-=item check
-
-Checks all fields to make sure this is a valid refund application to a payment.
-If there is an error, returns the error, otherwise returns false. Called by
-the insert and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('payrefundnum')
- || $self->ut_number('paynum')
- || $self->ut_number('refundnum')
- || $self->ut_numbern('_date')
- || $self->ut_money('amount')
- ;
- return $error if $error;
-
- return "amount must be > 0" if $self->amount <= 0;
-
- return "Unknown payment"
- unless my $cust_pay =
- qsearchs( 'cust_pay', { 'paynum' => $self->paynum } );
-
- return "Unknown refund"
- unless my $cust_refund =
- qsearchs( 'cust_refund', { 'refundnum' => $self->refundnum } );
-
- $self->_date(time) unless $self->_date;
-
- return 'Cannot apply ($'. $self->amount. ') more than'.
- ' remaining value of refund ($'. $cust_refund->unapplied. ')'
- unless $self->amount <= $cust_refund->unapplied;
-
- return "Cannot apply more than remaining value of payment"
- unless $self->amount <= $cust_pay->unapplied;
-
- $self->SUPER::check;
-}
-
-=item sub cust_pay
-
-Returns the payment (see L<FS::cust_pay>)
-
-=cut
-
-sub cust_pay {
- my $self = shift;
- qsearchs( 'cust_pay', { 'paynum' => $self->paynum } );
-}
-
-=item cust_refund
-
-Returns the refund (see L<FS::cust_refund>)
-
-=cut
-
-sub cust_refund {
- my $self = shift;
- qsearchs( 'cust_refund', { 'refundnum' => $self->refundnum } );
-}
-
-=back
-
-=head1 BUGS
-
-The delete method.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_refund>, L<FS::cust_bill>, L<FS::cust_credit>,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_pay_void.pm b/FS/FS/cust_pay_void.pm
deleted file mode 100644
index 3a30acb..0000000
--- a/FS/FS/cust_pay_void.pm
+++ /dev/null
@@ -1,291 +0,0 @@
-package FS::cust_pay_void;
-
-use strict;
-use base qw( FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
- FS::Record );
-use vars qw( @encrypted_fields $otaker_upgrade_kludge );
-use Business::CreditCard;
-use FS::UID qw(getotaker);
-use FS::Record qw(qsearch qsearchs dbh fields);
-use FS::CurrentUser;
-use FS::access_user;
-use FS::cust_pay;
-#use FS::cust_bill;
-#use FS::cust_bill_pay;
-#use FS::cust_pay_refund;
-#use FS::cust_main;
-use FS::cust_pkg;
-
-@encrypted_fields = ('payinfo');
-$otaker_upgrade_kludge = 0;
-
-=head1 NAME
-
-FS::cust_pay_void - Object methods for cust_pay_void objects
-
-=head1 SYNOPSIS
-
- use FS::cust_pay_void;
-
- $record = new FS::cust_pay_void \%hash;
- $record = new FS::cust_pay_void { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_pay_void object represents a voided payment. The following fields
-are currently supported:
-
-=over 4
-
-=item paynum
-
-primary key (assigned automatically for new payments)
-
-=item custnum
-
-customer (see L<FS::cust_main>)
-
-=item paid
-
-Amount of this payment
-
-=item _date
-
-specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item otaker
-
-order taker (see L<FS::access_user>)
-
-=item payby
-
-`CARD' (credit cards), `CHEK' (electronic check/ACH),
-`LECB' (phone bill billing), `BILL' (billing), `CASH' (cash),
-`WEST' (Western Union), `MCRD' (Manual credit card), or `COMP' (free)
-
-=item payinfo
-
-card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively
-
-=item paybatch
-
-text field for tracking card processing
-
-=item closed
-
-books closed flag, empty or `Y'
-
-=item pkgnum
-
-Desired pkgnum when using experimental package balances.
-
-=item void_date
-
-=item reason
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new payment. To add the payment to the databse, see L<"insert">.
-
-=cut
-
-sub table { 'cust_pay_void'; }
-
-=item insert
-
-Adds this voided payment to the database.
-
-=item unvoid
-
-"Un-void"s this payment: Deletes the voided payment from the database and adds
-back a normal payment.
-
-=cut
-
-sub unvoid {
- 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 $cust_pay = new FS::cust_pay ( {
- map { $_ => $self->get($_) } fields('cust_pay')
- } );
- my $error = $cust_pay->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $error = $self->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item delete
-
-Deletes this voided payment. You probably don't want to use this directly; see
-the B<unvoid> method to add the original payment back.
-
-=item replace [ OLD_RECORD ]
-
-You can, but probably shouldn't modify voided payments...
-
-Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
-supplied, replaces this record. If there is an error, returns the error,
-otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid voided payment. If there is an
-error, returns the error, otherwise returns false. Called by the insert
-method.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('paynum')
- || $self->ut_numbern('custnum')
- || $self->ut_money('paid')
- || $self->ut_number('_date')
- || $self->ut_textn('paybatch')
- || $self->ut_enum('closed', [ '', 'Y' ])
- || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum')
- || $self->ut_numbern('void_date')
- || $self->ut_textn('reason')
- ;
- return $error if $error;
-
- return "paid must be > 0 " if $self->paid <= 0;
-
- return "unknown cust_main.custnum: ". $self->custnum
- unless $self->invnum
- || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-
- $self->void_date(time) unless $self->void_date;
-
- $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREP|CASH|WEST|MCRD)$/
- or return "Illegal payby";
- $self->payby($1);
-
- #false laziness with cust_refund::check
- if ( $self->payby eq 'CARD' ) {
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\D//g;
- $self->payinfo($payinfo);
- if ( $self->payinfo ) {
- $self->payinfo =~ /^(\d{13,16})$/
- or return "Illegal (mistyped?) credit card number (payinfo)";
- $self->payinfo($1);
- validate($self->payinfo) or return "Illegal credit card number";
- return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
- } else {
- $self->payinfo('N/A');
- }
-
- } else {
- $error = $self->ut_textn('payinfo');
- return $error if $error;
- }
-
- $self->void_usernum($FS::CurrentUser::CurrentUser->usernum)
- unless $self->void_usernum;
-
- $self->SUPER::check;
-}
-
-=item cust_main
-
-Returns the parent customer object (see L<FS::cust_main>).
-
-=cut
-
-sub cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
-=item void_access_user
-
-Returns the voiding employee object (see L<FS::access_user>).
-
-=cut
-
-sub void_access_user {
- my $self = shift;
- qsearchs('access_user', { 'usernum' => $self->void_usernum } );
-}
-
-# Used by FS::Upgrade to migrate to a new database.
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
-
- my $sql = "SELECT usernum FROM access_user WHERE username = ( SELECT history_user FROM h_cust_pay_void WHERE paynum = ? AND history_action = 'insert' ORDER BY history_date LIMIT 1 ) ";
- my $sth = dbh->prepare($sql) or die dbh->errstr;
-
- foreach my $cust_pay_void (qsearch('cust_pay_void', {'void_usernum' => ''})) {
- $sth->execute($cust_pay_void->paynum) or die $sth->errstr;
- my $usernum = $sth->fetchrow_arrayref->[0] or next;
- if ( $usernum ) {
- $cust_pay_void->void_usernum($usernum);
- my $error = $cust_pay_void->replace;
- die $error if $error;
- } else {
- warn "cust_pay_void upgrade: can't find access_user record for ". $cust_pay_void->paynum. "\n";
- }
- }
-
- local($otaker_upgrade_kludge) = 1;
- $class->_upgrade_otaker(%opts);
-
- #XXX look for the h_cust_pay delete records and when that's a different
- # usernum, set usernum
-}
-
-=back
-
-=head1 BUGS
-
-Delete and replace methods.
-
-=head1 SEE ALSO
-
-L<FS::cust_pay>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
deleted file mode 100644
index 2ed25a0..0000000
--- a/FS/FS/cust_pkg.pm
+++ /dev/null
@@ -1,3435 +0,0 @@
-package FS::cust_pkg;
-
-use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin
- FS::m2m_Common FS::option_Common );
-use vars qw($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::CurrentUser;
-use FS::cust_svc;
-use FS::part_pkg;
-use FS::cust_main;
-use FS::cust_location;
-use FS::pkg_svc;
-use FS::cust_bill_pkg;
-use FS::cust_pkg_detail;
-use FS::cust_event;
-use FS::h_cust_svc;
-use FS::reg_code;
-use FS::part_svc;
-use FS::cust_pkg_reason;
-use FS::reason;
-use FS::cust_pkg_discount;
-use FS::discount;
-use FS::UI::Web;
-
-# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
-# setup }
-# because they load configuration by setting FS::UID::callback (see TODO)
-use FS::svc_acct;
-use FS::svc_domain;
-use FS::svc_www;
-use FS::svc_forward;
-
-# for sending cancel emails in sub cancel
-use FS::Conf;
-
-$DEBUG = 0;
-$me = '[FS::cust_pkg]';
-
-$disable_agentcheck = 0;
-
-sub _cache {
- my $self = shift;
- my ( $hashref, $cache ) = @_;
- #if ( $hashref->{'pkgpart'} ) {
- if ( $hashref->{'pkg'} ) {
- # #@{ $self->{'_pkgnum'} } = ();
- # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
- # $self->{'_pkgpart'} = $subcache;
- # #push @{ $self->{'_pkgnum'} },
- # FS::part_pkg->new_or_cached($hashref, $subcache);
- $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
- }
- if ( exists $hashref->{'svcnum'} ) {
- #@{ $self->{'_pkgnum'} } = ();
- my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
- $self->{'_svcnum'} = $subcache;
- #push @{ $self->{'_pkgnum'} },
- FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
- }
-}
-
-=head1 NAME
-
-FS::cust_pkg - Object methods for cust_pkg objects
-
-=head1 SYNOPSIS
-
- use FS::cust_pkg;
-
- $record = new FS::cust_pkg \%hash;
- $record = new FS::cust_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->cancel;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $part_pkg = $record->part_pkg;
-
- @labels = $record->labels;
-
- $seconds = $record->seconds_since($timestamp);
-
- $error = FS::cust_pkg::order( $custnum, \@pkgparts );
- $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
-
-=head1 DESCRIPTION
-
-An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item pkgnum
-
-Primary key (assigned automatically for new billing items)
-
-=item custnum
-
-Customer (see L<FS::cust_main>)
-
-=item pkgpart
-
-Billing item definition (see L<FS::part_pkg>)
-
-=item locationnum
-
-Optional link to package location (see L<FS::location>)
-
-=item start_date
-
-date
-
-=item setup
-
-date
-
-=item bill
-
-date (next bill date)
-
-=item last_bill
-
-last bill date
-
-=item adjourn
-
-date
-
-=item susp
-
-date
-
-=item expire
-
-date
-
-=item contract_end
-
-date
-
-=item cancel
-
-date
-
-=item usernum
-
-order taker (see L<FS::access_user>)
-
-=item manual_flag
-
-If this field is set to 1, disables the automatic
-unsuspension of this package when using the B<unsuspendauto> config option.
-
-=item quantity
-
-If not set, defaults to 1
-
-=item change_date
-
-Date of change from previous package
-
-=item change_pkgnum
-
-Previous pkgnum
-
-=item change_pkgpart
-
-Previous pkgpart
-
-=item change_locationnum
-
-Previous locationnum
-
-=back
-
-Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
-are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Create a new billing item. To add the item to the database, see L<"insert">.
-
-=cut
-
-sub table { 'cust_pkg'; }
-sub cust_linked { $_[0]->cust_main_custnum; }
-sub cust_unlinked_msg {
- my $self = shift;
- "WARNING: can't find cust_main.custnum ". $self->custnum.
- ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
-}
-
-=item insert [ OPTION => VALUE ... ]
-
-Adds this billing item to the database ("Orders" the item). If there is an
-error, returns the error, otherwise returns false.
-
-If the additional field I<promo_code> is defined instead of I<pkgpart>, it
-will be used to look up the package definition and agent restrictions will be
-ignored.
-
-If the additional field I<refnum> is defined, an FS::pkg_referral record will
-be created and inserted. Multiple FS::pkg_referral records can be created by
-setting I<refnum> to an array reference of refnums or a hash reference with
-refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
-record will be created corresponding to cust_main.refnum.
-
-The following options are available:
-
-=over 4
-
-=item change
-
-If set true, supresses any referral credit to a referring customer.
-
-=item options
-
-cust_pkg_option records will be created
-
-=item ticket_subject
-
-a ticket will be added to this customer with this subject
-
-=item ticket_queue
-
-an optional queue name for ticket additions
-
-=back
-
-=cut
-
-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) );
- }
-
- foreach my $action ( qw(expire adjourn contract_end) ) {
- my $months = $self->part_pkg->option("${action}_months",1);
- if($months and !$self->$action) {
- my $start = $self->start_date || $self->setup || time;
- $self->$action( $self->part_pkg->add_freq($start, $months) );
- }
- }
-
- 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($options{options} ? %{$options{options}} : ());
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $self->refnum($self->cust_main->refnum) unless $self->refnum;
- $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
- $self->process_m2m( 'link_table' => 'pkg_referral',
- 'target_table' => 'part_referral',
- 'params' => $self->refnum,
- );
-
- if ( $self->discountnum ) {
- my $error = $self->insert_discount();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- #if ( $self->reg_code ) {
- # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
- # $error = $reg_code->delete;
- # if ( $error ) {
- # $dbh->rollback if $oldAutoCommit;
- # return $error;
- # }
- #}
-
- my $conf = new FS::Conf;
-
- if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
-
- #eval '
- # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
- # use RT;
- #';
- #die $@ if $@;
- #
- #RT::LoadConfig();
- #RT::Init();
- use FS::TicketSystem;
- FS::TicketSystem->init();
-
- my $q = new RT::Queue($RT::SystemUser);
- $q->Load($options{ticket_queue}) if $options{ticket_queue};
- my $t = new RT::Ticket($RT::SystemUser);
- my $mime = new MIME::Entity;
- $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
- $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
- Subject => $options{ticket_subject},
- MIMEObj => $mime,
- );
- $t->AddLink( Type => 'MemberOf',
- Target => 'freeside://freeside/cust_main/'. $self->custnum,
- );
- }
-
- if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
- my $queue = new FS::queue {
- 'job' => 'FS::cust_main::queueable_print',
- };
- $error = $queue->insert(
- 'custnum' => $self->custnum,
- 'template' => 'welcome_letter',
- );
-
- if ($error) {
- warn "can't send welcome letter: $error";
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item delete
-
-This method now works but you probably shouldn't use it.
-
-You don't want to delete billing items, because there would then be no record
-the customer ever purchased the item. Instead, see the cancel method.
-
-=cut
-
-#sub delete {
-# return "Can't delete cust_pkg records!";
-#}
-
-=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
-
-Changing pkgpart may have disasterous effects. See the order subroutine.
-
-setup and bill are normally updated by calling the bill method of a customer
-object (see L<FS::cust_main>).
-
-suspend is normally updated by the suspend and unsuspend methods.
-
-cancel is normally updated by the cancel method (and also the order subroutine
-in some cases).
-
-Available options are:
-
-=over 4
-
-=item reason
-
-can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
-
-=item reason_otaker
-
-the access_user (see L<FS::access_user>) providing the reason
-
-=item options
-
-hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
-
-=back
-
-=cut
-
-sub replace {
- my $new = shift;
-
- my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
- ? shift
- : $new->replace_old;
-
- my $options =
- ( ref($_[0]) eq 'HASH' )
- ? shift
- : { @_ };
-
- #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
- #return "Can't change otaker!" if $old->otaker ne $new->otaker;
-
- #allow this *sigh*
- #return "Can't change setup once it exists!"
- # if $old->getfield('setup') &&
- # $old->getfield('setup') != $new->getfield('setup');
-
- #some logic for bill, susp, cancel?
-
- local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
-
- 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 $method ( qw(adjourn expire) ) { # How many reasons?
- if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
- my $error = $new->insert_reason(
- 'reason' => $options->{'reason'},
- 'date' => $new->$method,
- 'action' => $method,
- 'reason_otaker' => $options->{'reason_otaker'},
- );
- if ( $error ) {
- dbh->rollback if $oldAutoCommit;
- return "Error inserting cust_pkg_reason: $error";
- }
- }
- }
-
- #save off and freeze RADIUS attributes for any associated svc_acct records
- my @svc_acct = ();
- if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
-
- #also check for specific exports?
- # to avoid spurious modify export events
- @svc_acct = map { $_->svc_x }
- grep { $_->part_svc->svcdb eq 'svc_acct' }
- $old->cust_svc;
-
- $_->snapshot foreach @svc_acct;
-
- }
-
- my $error = $new->SUPER::replace($old,
- $options->{options} ? $options->{options} : ()
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- #for prepaid packages,
- #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
- foreach my $old_svc_acct ( @svc_acct ) {
- my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
- my $s_error = $new_svc_acct->replace($old_svc_acct);
- if ( $s_error ) {
- $dbh->rollback if $oldAutoCommit;
- return $s_error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item check
-
-Checks all fields to make sure this is a valid billing item. If there is an
-error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
-
- my $error =
- $self->ut_numbern('pkgnum')
- || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
- || $self->ut_numbern('pkgpart')
- || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
- || $self->ut_numbern('start_date')
- || $self->ut_numbern('setup')
- || $self->ut_numbern('bill')
- || $self->ut_numbern('susp')
- || $self->ut_numbern('cancel')
- || $self->ut_numbern('adjourn')
- || $self->ut_numbern('expire')
- || $self->ut_enum('no_auto', [ '', 'Y' ])
- ;
- return $error if $error;
-
- if ( $self->reg_code ) {
-
- unless ( grep { $self->pkgpart == $_->pkgpart }
- map { $_->reg_code_pkg }
- qsearchs( 'reg_code', { 'code' => $self->reg_code,
- 'agentnum' => $self->cust_main->agentnum })
- ) {
- return "Unknown registration code";
- }
-
- } elsif ( $self->promo_code ) {
-
- my $promo_part_pkg =
- qsearchs('part_pkg', {
- 'pkgpart' => $self->pkgpart,
- 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
- } );
- return 'Unknown promotional code' unless $promo_part_pkg;
-
- } else {
-
- unless ( $disable_agentcheck ) {
- my $agent =
- qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
- return "agent ". $agent->agentnum. ':'. $agent->agent.
- " can't purchase pkgpart ". $self->pkgpart
- unless $agent->pkgpart_hashref->{ $self->pkgpart }
- || $agent->agentnum == $self->part_pkg->agentnum;
- }
-
- $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
- return $error if $error;
-
- }
-
- $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
-
- if ( $self->dbdef_table->column('manual_flag') ) {
- $self->manual_flag('') if $self->manual_flag eq ' ';
- $self->manual_flag =~ /^([01]?)$/
- or return "Illegal manual_flag ". $self->manual_flag;
- $self->manual_flag($1);
- }
-
- $self->SUPER::check;
-}
-
-=item cancel [ OPTION => VALUE ... ]
-
-Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
-in this package, then cancels the package itself (sets the cancel field to
-now).
-
-Available options are:
-
-=over 4
-
-=item quiet - can be set true to supress email cancellation notices.
-
-=item time - can be set to cancel the package based on a specific future or historical date. Using time ensures that the remaining amount is calculated correctly. Note however that this is an immediate cancel and just changes the date. You are PROBABLY looking to expire the account instead of using this.
-
-=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
-
-=item date - can be set to a unix style timestamp to specify when to cancel (expire)
-
-=item nobill - can be set true to skip billing if it might otherwise be done.
-
-=item unused_credit - can be set to 1 to credit the remaining time, or 0 to
-not credit it. This must be set (by change()) when changing the package
-to a different pkgpart or location, and probably shouldn't be in any other
-case. If it's not set, the 'unused_credit_cancel' part_pkg option will
-be used.
-
-=back
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub cancel {
- my( $self, %options ) = @_;
- my $error;
-
- my $conf = new FS::Conf;
-
- warn "cust_pkg::cancel called with options".
- join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
- if $DEBUG;
-
- 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 $old = $self->select_for_update;
-
- if ( $old->get('cancel') || $self->get('cancel') ) {
- dbh->rollback if $oldAutoCommit;
- return ""; # no error
- }
-
- my $date = $options{date} if $options{date}; # expire/cancel later
- $date = '' if ($date && $date <= time); # complain instead?
-
- #race condition: usage could be ongoing until unprovisioned
- #resolved by performing a change package instead (which unprovisions) and
- #later cancelling
- if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
- my $copy = $self->new({$self->hash});
- my $error =
- $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 );
- warn "Error billing during cancel, custnum ".
- #$self->cust_main->custnum. ": $error"
- ": $error"
- if $error;
- }
-
- my $cancel_time = $options{'time'} || time;
-
- if ( $options{'reason'} ) {
- $error = $self->insert_reason( 'reason' => $options{'reason'},
- 'action' => $date ? 'expire' : 'cancel',
- 'date' => $date ? $date : $cancel_time,
- 'reason_otaker' => $options{'reason_otaker'},
- );
- if ( $error ) {
- dbh->rollback if $oldAutoCommit;
- return "Error inserting cust_pkg_reason: $error";
- }
- }
-
- my %svc;
- if ( $date ) {
-# copied from below
- foreach my $cust_svc (
- #schwartz
- map { $_->[0] }
- sort { $a->[1] <=> $b->[1] }
- map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
- qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
- ) {
- my $error = $cust_svc->cancel( ('date' => $date) );
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error expiring cust_svc: $error";
- }
- }
- } else { #!date
- foreach my $cust_svc (
- #schwartz
- map { $_->[0] }
- sort { $a->[1] <=> $b->[1] }
- map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
- qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
- ) {
- my $error = $cust_svc->cancel;
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error cancelling cust_svc: $error";
- }
- }
- } #if $date
-
- # Add a credit for remaining service
- my $last_bill = $self->getfield('last_bill') || 0;
- my $next_bill = $self->getfield('bill') || 0;
- my $do_credit;
- if ( exists($options{'unused_credit'}) ) {
- $do_credit = $options{'unused_credit'};
- }
- else {
- $do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
- }
- if ( $do_credit
- and $last_bill > 0 # the package has been billed
- and $next_bill > 0 # the package has a next bill date
- and $next_bill >= $cancel_time # which is in the future
- ) {
- my $remaining_value = $self->calc_remain('time' => $cancel_time);
- if ( $remaining_value > 0 ) {
- # && !$options{'no_credit'} ) {
- # Undocumented, unused option.
- # part_pkg configuration should decide this anyway.
- my $error = $self->cust_main->credit(
- $remaining_value,
- 'Credit for unused time on '. $self->part_pkg->pkg,
- 'reason_type' => $conf->config('cancel_credit_type'),
- );
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return "Error crediting customer \$$remaining_value for unused time on".
- $self->part_pkg->pkg. ": $error";
- }
- } #if $remaining_value
- } #if $do_credit
-
- my %hash = $self->hash;
- $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
- my $new = new FS::cust_pkg ( \%hash );
- $error = $new->replace( $self, options => { $self->options } );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return '' if $date; #no errors
-
- my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
- if ( !$options{'quiet'} &&
- $conf->exists('emailcancel', $self->cust_main->agentnum) &&
- @invoicing_list ) {
- my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
- my $error = '';
- if ( $msgnum ) {
- my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
- $error = $msg_template->send( 'cust_main' => $self->cust_main,
- 'object' => $self );
- }
- else {
- $error = send_email(
- 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
- 'to' => \@invoicing_list,
- 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
- 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
- );
- }
- #should this do something on errors?
- }
-
- ''; #no errors
-
-}
-
-=item cancel_if_expired [ NOW_TIMESTAMP ]
-
-Cancels this package if its expire date has been reached.
-
-=cut
-
-sub cancel_if_expired {
- my $self = shift;
- my $time = shift || time;
- return '' unless $self->expire && $self->expire <= $time;
- my $error = $self->cancel;
- if ( $error ) {
- return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
- $self->custnum. ": $error";
- }
- '';
-}
-
-=item unexpire
-
-Cancels any pending expiration (sets the expire field to null).
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub unexpire {
- my( $self, %options ) = @_;
- my $error;
-
- 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 $old = $self->select_for_update;
-
- my $pkgnum = $old->pkgnum;
- if ( $old->get('cancel') || $self->get('cancel') ) {
- dbh->rollback if $oldAutoCommit;
- return "Can't unexpire cancelled package $pkgnum";
- # or at least it's pointless
- }
-
- unless ( $old->get('expire') && $self->get('expire') ) {
- dbh->rollback if $oldAutoCommit;
- return ""; # no error
- }
-
- my %hash = $self->hash;
- $hash{'expire'} = '';
- my $new = new FS::cust_pkg ( \%hash );
- $error = $new->replace( $self, options => { $self->options } );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ''; #no errors
-
-}
-
-=item suspend [ OPTION => VALUE ... ]
-
-Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
-package, then suspends the package itself (sets the susp field to now).
-
-Available options are:
-
-=over 4
-
-=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
-
-=item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
-
-=back
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub suspend {
- my( $self, %options ) = @_;
- my $error;
-
- 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 $old = $self->select_for_update;
-
- my $pkgnum = $old->pkgnum;
- if ( $old->get('cancel') || $self->get('cancel') ) {
- dbh->rollback if $oldAutoCommit;
- return "Can't suspend cancelled package $pkgnum";
- }
-
- if ( $old->get('susp') || $self->get('susp') ) {
- dbh->rollback if $oldAutoCommit;
- return ""; # no error # complain on adjourn?
- }
-
- my $date = $options{date} if $options{date}; # adjourn/suspend later
- $date = '' if ($date && $date <= time); # complain instead?
-
- if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
- dbh->rollback if $oldAutoCommit;
- return "Package $pkgnum expires before it would be suspended.";
- }
-
- my $suspend_time = $options{'time'} || time;
-
- if ( $options{'reason'} ) {
- $error = $self->insert_reason( 'reason' => $options{'reason'},
- 'action' => $date ? 'adjourn' : 'suspend',
- 'date' => $date ? $date : $suspend_time,
- 'reason_otaker' => $options{'reason_otaker'},
- );
- if ( $error ) {
- dbh->rollback if $oldAutoCommit;
- return "Error inserting cust_pkg_reason: $error";
- }
- }
-
- unless ( $date ) {
-
- my @labels = ();
-
- foreach my $cust_svc (
- qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
- ) {
- my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
-
- $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
- $dbh->rollback if $oldAutoCommit;
- return "Illegal svcdb value in part_svc!";
- };
- my $svcdb = $1;
- require "FS/$svcdb.pm";
-
- my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
- if ($svc) {
- $error = $svc->suspend;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- my( $label, $value ) = $cust_svc->label;
- push @labels, "$label: $value";
- }
- }
-
- my $conf = new FS::Conf;
- if ( $conf->config('suspend_email_admin') ) {
-
- my $error = send_email(
- 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
- #invoice_from ??? well as good as any
- 'to' => $conf->config('suspend_email_admin'),
- 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
- 'body' => [
- "This is an automatic message from your Freeside installation\n",
- "informing you that the following customer package has been suspended:\n",
- "\n",
- 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
- 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
- ( map { "Service : $_\n" } @labels ),
- ],
- );
-
- if ( $error ) {
- warn "WARNING: can't send suspension admin email (suspending anyway): ".
- "$error\n";
- }
-
- }
-
- }
-
- my %hash = $self->hash;
- if ( $date ) {
- $hash{'adjourn'} = $date;
- } else {
- $hash{'susp'} = $suspend_time;
- }
- my $new = new FS::cust_pkg ( \%hash );
- $error = $new->replace( $self, options => { $self->options } );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ''; #no errors
-}
-
-=item unsuspend [ OPTION => VALUE ... ]
-
-Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
-package, then unsuspends the package itself (clears the susp field and the
-adjourn field if it is in the past).
-
-Available options are:
-
-=over 4
-
-=item adjust_next_bill
-
-Can be set true to adjust the next bill date forward by
-the amount of time the account was inactive. This was set true by default
-since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
-explicitly requested. Price plans for which this makes sense (anniversary-date
-based than prorate or subscription) could have an option to enable this
-behaviour?
-
-=back
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub unsuspend {
- my( $self, %opt ) = @_;
- my $error;
-
- 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 $old = $self->select_for_update;
-
- my $pkgnum = $old->pkgnum;
- if ( $old->get('cancel') || $self->get('cancel') ) {
- dbh->rollback if $oldAutoCommit;
- return "Can't unsuspend cancelled package $pkgnum";
- }
-
- unless ( $old->get('susp') && $self->get('susp') ) {
- dbh->rollback if $oldAutoCommit;
- return ""; # no error # complain instead?
- }
-
- foreach my $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
- ) {
- my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
-
- $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
- $dbh->rollback if $oldAutoCommit;
- return "Illegal svcdb value in part_svc!";
- };
- my $svcdb = $1;
- require "FS/$svcdb.pm";
-
- my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
- if ($svc) {
- $error = $svc->unsuspend;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- }
-
- my %hash = $self->hash;
- my $inactive = time - $hash{'susp'};
-
- my $conf = new FS::Conf;
-
- if ( $inactive > 0 &&
- ( $hash{'bill'} || $hash{'setup'} ) &&
- ( $opt{'adjust_next_bill'} ||
- $conf->exists('unsuspend-always_adjust_next_bill_date') ||
- $self->part_pkg->option('unsuspend_adjust_bill', 1) )
- ) {
-
- $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
-
- }
-
- $hash{'susp'} = '';
- $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
- my $new = new FS::cust_pkg ( \%hash );
- $error = $new->replace( $self, options => { $self->options } );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ''; #no errors
-}
-
-=item unadjourn
-
-Cancels any pending suspension (sets the adjourn field to null).
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub unadjourn {
- my( $self, %options ) = @_;
- my $error;
-
- 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 $old = $self->select_for_update;
-
- my $pkgnum = $old->pkgnum;
- if ( $old->get('cancel') || $self->get('cancel') ) {
- dbh->rollback if $oldAutoCommit;
- return "Can't unadjourn cancelled package $pkgnum";
- # or at least it's pointless
- }
-
- if ( $old->get('susp') || $self->get('susp') ) {
- dbh->rollback if $oldAutoCommit;
- return "Can't unadjourn suspended package $pkgnum";
- # perhaps this is arbitrary
- }
-
- unless ( $old->get('adjourn') && $self->get('adjourn') ) {
- dbh->rollback if $oldAutoCommit;
- return ""; # no error
- }
-
- my %hash = $self->hash;
- $hash{'adjourn'} = '';
- my $new = new FS::cust_pkg ( \%hash );
- $error = $new->replace( $self, options => { $self->options } );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ''; #no errors
-
-}
-
-
-=item change HASHREF | OPTION => VALUE ...
-
-Changes this package: cancels it and creates a new one, with a different
-pkgpart or locationnum or both. All services are transferred to the new
-package (no change will be made if this is not possible).
-
-Options may be passed as a list of key/value pairs or as a hash reference.
-Options are:
-
-=over 4
-
-=item locationnum
-
-New locationnum, to change the location for this package.
-
-=item cust_location
-
-New FS::cust_location object, to create a new location and assign it
-to this package.
-
-=item pkgpart
-
-New pkgpart (see L<FS::part_pkg>).
-
-=item refnum
-
-New refnum (see L<FS::part_referral>).
-
-=item keep_dates
-
-Set to true to transfer billing dates (start_date, setup, last_bill, bill,
-susp, adjourn, cancel, expire, and contract_end) to the new package.
-
-=back
-
-At least one of locationnum, cust_location, pkgpart, refnum must be specified
-(otherwise, what's the point?)
-
-Returns either the new FS::cust_pkg object or a scalar error.
-
-For example:
-
- my $err_or_new_cust_pkg = $old_cust_pkg->change
-
-=cut
-
-#some false laziness w/order
-sub change {
- my $self = shift;
- my $opt = ref($_[0]) ? shift : { @_ };
-
-# my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
-#
-
- my $conf = new FS::Conf;
-
- # Transactionize this whole mess
- 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;
-
- my %hash = ();
-
- my $time = time;
-
- #$hash{$_} = $self->$_() foreach qw( last_bill bill );
-
- #$hash{$_} = $self->$_() foreach qw( setup );
-
- $hash{'setup'} = $time if $self->setup;
-
- $hash{'change_date'} = $time;
- $hash{"change_$_"} = $self->$_()
- foreach qw( pkgnum pkgpart locationnum );
-
- if ( $opt->{'cust_location'} &&
- ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
- $error = $opt->{'cust_location'}->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting cust_location (transaction rolled back): $error";
- }
- $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
- }
-
- my $unused_credit = 0;
- if ( $opt->{'keep_dates'} ) {
- foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
- start_date contract_end ) ) {
- $hash{$date} = $self->getfield($date);
- }
- }
- # Special case. If the pkgpart is changing, and the customer is
- # going to be credited for remaining time, don't keep setup, bill,
- # or last_bill dates, and DO pass the flag to cancel() to credit
- # the customer.
- if ( $opt->{'pkgpart'}
- and $opt->{'pkgpart'} != $self->pkgpart
- and $self->part_pkg->option('unused_credit_change', 1) ) {
- $unused_credit = 1;
- $hash{$_} = '' foreach qw(setup bill last_bill);
- }
-
- # Create the new package.
- my $cust_pkg = new FS::cust_pkg {
- custnum => $self->custnum,
- pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
- refnum => ( $opt->{'refnum'} || $self->refnum ),
- locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
- %hash,
- };
-
- $error = $cust_pkg->insert( 'change' => 1 );
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- # Transfer services and cancel old package.
-
- $error = $self->transfer($cust_pkg);
- if ($error and $error == 0) {
- # $old_pkg->transfer failed.
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
- warn "trying transfer again with change_svcpart option\n" if $DEBUG;
- $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
- if ($error and $error == 0) {
- # $old_pkg->transfer failed.
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- if ($error > 0) {
- # Transfers were successful, but we still had services left on the old
- # package. We can't change the package under this circumstances, so abort.
- $dbh->rollback if $oldAutoCommit;
- return "Unable to transfer all services from package ". $self->pkgnum;
- }
-
- #reset usage if changing pkgpart
- # AND usage rollover is off (otherwise adds twice, now and at package bill)
- if ($self->pkgpart != $cust_pkg->pkgpart) {
- my $part_pkg = $cust_pkg->part_pkg;
- $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
- ? ()
- : ( 'null' => 1 )
- )
- if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
-
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return "Error setting usage values: $error";
- }
- }
-
- #Good to go, cancel old package. Notify 'cancel' of whether to credit
- #remaining time.
- $error = $self->cancel( quiet=>1, unused_credit => $unused_credit );
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
- #$self->cust_main
- my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- $cust_pkg;
-
-}
-
-use Data::Dumper;
-use Storable 'thaw';
-use MIME::Base64;
-sub process_bulk_cust_pkg {
- my $job = shift;
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- my $old_part_pkg = qsearchs('part_pkg',
- { pkgpart => $param->{'old_pkgpart'} });
- my $new_part_pkg = qsearchs('part_pkg',
- { pkgpart => $param->{'new_pkgpart'} });
- die "Must select a new package type\n" unless $new_part_pkg;
- #my $keep_dates = $param->{'keep_dates'} || 0;
- my $keep_dates = 1; # there is no good reason to turn this off
-
- 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 @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
-
- my $i = 0;
- foreach my $old_cust_pkg ( @cust_pkgs ) {
- $i++;
- $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
- if ( $old_cust_pkg->getfield('cancel') ) {
- warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
- $old_cust_pkg->pkgnum."\n"
- if $DEBUG;
- next;
- }
- warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
- if $DEBUG;
- my $error = $old_cust_pkg->change(
- 'pkgpart' => $param->{'new_pkgpart'},
- 'keep_dates' => $keep_dates
- );
- if ( !ref($error) ) { # change returns the cust_pkg on success
- $dbh->rollback;
- die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
- }
- }
- $dbh->commit if $oldAutoCommit;
- return;
-}
-
-=item last_bill
-
-Returns the last bill date, or if there is no last bill date, the setup date.
-Useful for billing metered services.
-
-=cut
-
-sub last_bill {
- my $self = shift;
- return $self->setfield('last_bill', $_[0]) if @_;
- return $self->getfield('last_bill') if $self->getfield('last_bill');
- my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
- 'edate' => $self->bill, } );
- $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
-}
-
-=item last_cust_pkg_reason ACTION
-
-Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
-Returns false if there is no reason or the package is not currenly ACTION'd
-ACTION is one of adjourn, susp, cancel, or expire.
-
-=cut
-
-sub last_cust_pkg_reason {
- my ( $self, $action ) = ( shift, shift );
- my $date = $self->get($action);
- qsearchs( {
- 'table' => 'cust_pkg_reason',
- 'hashref' => { 'pkgnum' => $self->pkgnum,
- 'action' => substr(uc($action), 0, 1),
- 'date' => $date,
- },
- 'order_by' => 'ORDER BY num DESC LIMIT 1',
- } );
-}
-
-=item last_reason ACTION
-
-Returns the most recent ACTION FS::reason associated with the package.
-Returns false if there is no reason or the package is not currenly ACTION'd
-ACTION is one of adjourn, susp, cancel, or expire.
-
-=cut
-
-sub last_reason {
- my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
- $cust_pkg_reason->reason
- if $cust_pkg_reason;
-}
-
-=item part_pkg
-
-Returns the definition for this billing item, as an FS::part_pkg object (see
-L<FS::part_pkg>).
-
-=cut
-
-sub part_pkg {
- my $self = shift;
- return $self->{'_pkgpart'} if $self->{'_pkgpart'};
- cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
- qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
-}
-
-=item old_cust_pkg
-
-Returns the cancelled package this package was changed from, if any.
-
-=cut
-
-sub old_cust_pkg {
- my $self = shift;
- return '' unless $self->change_pkgnum;
- qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
-}
-
-=item calc_setup
-
-Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
-item.
-
-=cut
-
-sub calc_setup {
- my $self = shift;
- $self->part_pkg->calc_setup($self, @_);
-}
-
-=item calc_recur
-
-Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
-item.
-
-=cut
-
-sub calc_recur {
- my $self = shift;
- $self->part_pkg->calc_recur($self, @_);
-}
-
-=item base_recur
-
-Calls the I<base_recur> of the FS::part_pkg object associated with this billing
-item.
-
-=cut
-
-sub base_recur {
- my $self = shift;
- $self->part_pkg->base_recur($self, @_);
-}
-
-=item calc_remain
-
-Calls the I<calc_remain> of the FS::part_pkg object associated with this
-billing item.
-
-=cut
-
-sub calc_remain {
- my $self = shift;
- $self->part_pkg->calc_remain($self, @_);
-}
-
-=item calc_cancel
-
-Calls the I<calc_cancel> of the FS::part_pkg object associated with this
-billing item.
-
-=cut
-
-sub calc_cancel {
- my $self = shift;
- $self->part_pkg->calc_cancel($self, @_);
-}
-
-=item cust_bill_pkg
-
-Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
-
-=cut
-
-sub cust_bill_pkg {
- my $self = shift;
- qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
-}
-
-=item cust_pkg_detail [ DETAILTYPE ]
-
-Returns any customer package details for this package (see
-L<FS::cust_pkg_detail>).
-
-DETAILTYPE can be set to "I" for invoice details or "C" for comments.
-
-=cut
-
-sub cust_pkg_detail {
- my $self = shift;
- my %hash = ( 'pkgnum' => $self->pkgnum );
- $hash{detailtype} = shift if @_;
- qsearch({
- 'table' => 'cust_pkg_detail',
- 'hashref' => \%hash,
- 'order_by' => 'ORDER BY weight, pkgdetailnum',
- });
-}
-
-=item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
-
-Sets customer package details for this package (see L<FS::cust_pkg_detail>).
-
-DETAILTYPE can be set to "I" for invoice details or "C" for comments.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub set_cust_pkg_detail {
- my( $self, $detailtype, @details ) = @_;
-
- 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 $current ( $self->cust_pkg_detail($detailtype) ) {
- my $error = $current->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error removing old detail: $error";
- }
- }
-
- foreach my $detail ( @details ) {
- my $cust_pkg_detail = new FS::cust_pkg_detail {
- 'pkgnum' => $self->pkgnum,
- 'detailtype' => $detailtype,
- 'detail' => $detail,
- };
- my $error = $cust_pkg_detail->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error adding new detail: $error";
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item cust_event
-
-Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
-
-=cut
-
-#false laziness w/cust_bill.pm
-sub cust_event {
- my $self = shift;
- qsearch({
- 'table' => 'cust_event',
- 'addl_from' => 'JOIN part_event USING ( eventpart )',
- 'hashref' => { 'tablenum' => $self->pkgnum },
- 'extra_sql' => " AND eventtable = 'cust_pkg' ",
- });
-}
-
-=item num_cust_event
-
-Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
-
-=cut
-
-#false laziness w/cust_bill.pm
-sub num_cust_event {
- my $self = shift;
- my $sql =
- "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
- " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
- my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
- $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
- $sth->fetchrow_arrayref->[0];
-}
-
-=item cust_svc [ SVCPART ]
-
-Returns the services for this package, as FS::cust_svc objects (see
-L<FS::cust_svc>). If a svcpart is specified, return only the matching
-services.
-
-=cut
-
-sub cust_svc {
- my $self = shift;
-
- return () unless $self->num_cust_svc(@_);
-
- if ( @_ ) {
- return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
- 'svcpart' => shift, } );
- }
-
- cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
-
- #if ( $self->{'_svcnum'} ) {
- # values %{ $self->{'_svcnum'}->cache };
- #} else {
- $self->_sort_cust_svc(
- [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
- );
- #}
-
-}
-
-=item overlimit [ SVCPART ]
-
-Returns the services for this package which have exceeded their
-usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
-is specified, return only the matching services.
-
-=cut
-
-sub overlimit {
- my $self = shift;
- return () unless $self->num_cust_svc(@_);
- grep { $_->overlimit } $self->cust_svc(@_);
-}
-
-=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
-
-Returns historical services for this package created before END TIMESTAMP and
-(optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
-(see L<FS::h_cust_svc>). If MODE is 'I' (for 'invoice'), services with the
-I<pkg_svc.hidden> flag will be omitted.
-
-=cut
-
-sub h_cust_svc {
- my $self = shift;
- my ($end, $start, $mode) = @_;
- my @cust_svc = $self->_sort_cust_svc(
- [ qsearch( 'h_cust_svc',
- { 'pkgnum' => $self->pkgnum, },
- FS::h_cust_svc->sql_h_search(@_),
- ) ]
- );
- if ( $mode eq 'I' ) {
- my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
- return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
- }
- else {
- return @cust_svc;
- }
-}
-
-sub _sort_cust_svc {
- my( $self, $arrayref ) = @_;
-
- my $sort =
- sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
-
- map { $_->[0] }
- sort $sort
- map {
- my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
- 'svcpart' => $_->svcpart } );
- [ $_,
- $pkg_svc ? $pkg_svc->primary_svc : '',
- $pkg_svc ? $pkg_svc->quantity : 0,
- ];
- }
- @$arrayref;
-
-}
-
-=item num_cust_svc [ SVCPART ]
-
-Returns the number of provisioned services for this package. If a svcpart is
-specified, counts only the matching services.
-
-=cut
-
-sub num_cust_svc {
- my $self = shift;
-
- return $self->{'_num_cust_svc'}
- if !scalar(@_)
- && exists($self->{'_num_cust_svc'})
- && $self->{'_num_cust_svc'} =~ /\d/;
-
- cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
- if $DEBUG > 2;
-
- my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
- $sql .= ' AND svcpart = ?' if @_;
-
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute($self->pkgnum, @_) or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
-}
-
-=item available_part_svc
-
-Returns a list of FS::part_svc objects representing services included in this
-package but not yet provisioned. Each FS::part_svc object also has an extra
-field, I<num_avail>, which specifies the number of available services.
-
-=cut
-
-sub available_part_svc {
- my $self = shift;
- grep { $_->num_avail > 0 }
- map {
- my $part_svc = $_->part_svc;
- $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
- $_->quantity - $self->num_cust_svc($_->svcpart);
-
- # more evil encapsulation breakage
- if($part_svc->{'Hash'}{'num_avail'} > 0) {
- my @exports = $part_svc->part_export_did;
- $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
- }
-
- $part_svc;
- }
- $self->part_pkg->pkg_svc;
-}
-
-=item part_svc
-
-Returns a list of FS::part_svc objects representing provisioned and available
-services included in this package. Each FS::part_svc object also has the
-following extra fields:
-
-=over 4
-
-=item num_cust_svc (count)
-
-=item num_avail (quantity - count)
-
-=item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
-
-svcnum
-label -> ($cust_svc->label)[1]
-
-=back
-
-=cut
-
-sub part_svc {
- my $self = shift;
-
- #XXX some sort of sort order besides numeric by svcpart...
- my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
- my $pkg_svc = $_;
- my $part_svc = $pkg_svc->part_svc;
- my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
- $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
- $part_svc->{'Hash'}{'num_avail'} =
- max( 0, $pkg_svc->quantity - $num_cust_svc );
- $part_svc->{'Hash'}{'cust_pkg_svc'} =
- $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
- $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
- $part_svc;
- } $self->part_pkg->pkg_svc;
-
- #extras
- push @part_svc, map {
- my $part_svc = $_;
- my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
- $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
- $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
- $part_svc->{'Hash'}{'cust_pkg_svc'} =
- $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
- $part_svc;
- } $self->extra_part_svc;
-
- @part_svc;
-
-}
-
-=item extra_part_svc
-
-Returns a list of FS::part_svc objects corresponding to services in this
-package which are still provisioned but not (any longer) available in the
-package definition.
-
-=cut
-
-sub extra_part_svc {
- my $self = shift;
-
- my $pkgnum = $self->pkgnum;
- my $pkgpart = $self->pkgpart;
-
-# qsearch( {
-# 'table' => 'part_svc',
-# 'hashref' => {},
-# 'extra_sql' =>
-# "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
-# WHERE pkg_svc.svcpart = part_svc.svcpart
-# AND pkg_svc.pkgpart = ?
-# AND quantity > 0
-# )
-# AND 0 < ( SELECT COUNT(*) FROM cust_svc
-# LEFT JOIN cust_pkg USING ( pkgnum )
-# WHERE cust_svc.svcpart = part_svc.svcpart
-# AND pkgnum = ?
-# )",
-# 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
-# } );
-
-#seems to benchmark slightly faster...
- qsearch( {
- #'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
- AND pkg_svc.pkgpart = ?
- AND quantity > 0
- )
- LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
- LEFT JOIN cust_pkg USING ( pkgnum )
- ',
- 'hashref' => {},
- 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
- 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
- } );
-}
-
-=item status
-
-Returns a short status string for this package, currently:
-
-=over 4
-
-=item not yet billed
-
-=item one-time charge
-
-=item active
-
-=item suspended
-
-=item cancelled
-
-=back
-
-=cut
-
-sub status {
- my $self = shift;
-
- my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
-
- return 'cancelled' if $self->get('cancel');
- return 'suspended' if $self->susp;
- return 'not yet billed' unless $self->setup;
- return 'one-time charge' if $freq =~ /^(0|$)/;
- return 'active';
-}
-
-=item ucfirst_status
-
-Returns the status with the first character capitalized.
-
-=cut
-
-sub ucfirst_status {
- ucfirst(shift->status);
-}
-
-=item statuses
-
-Class method that returns the list of possible status strings for packages
-(see L<the status method|/status>). For example:
-
- @statuses = FS::cust_pkg->statuses();
-
-=cut
-
-tie my %statuscolor, 'Tie::IxHash',
- 'not yet billed' => '009999', #teal? cyan?
- 'one-time charge' => '000000',
- 'active' => '00CC00',
- 'suspended' => 'FF9900',
- 'cancelled' => 'FF0000',
-;
-
-sub statuses {
- my $self = shift; #could be class...
- #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
- # # mayble split btw one-time vs. recur
- keys %statuscolor;
-}
-
-=item statuscolor
-
-Returns a hex triplet color string for this package's status.
-
-=cut
-
-sub statuscolor {
- my $self = shift;
- $statuscolor{$self->status};
-}
-
-=item pkg_label
-
-Returns a label for this package. (Currently "pkgnum: pkg - comment" or
-"pkg-comment" depending on user preference).
-
-=cut
-
-sub pkg_label {
- my $self = shift;
- my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
- $label = $self->pkgnum. ": $label"
- if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
- $label;
-}
-
-=item pkg_label_long
-
-Returns a long label for this package, adding the primary service's label to
-pkg_label.
-
-=cut
-
-sub pkg_label_long {
- my $self = shift;
- my $label = $self->pkg_label;
- my $cust_svc = $self->primary_cust_svc;
- $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
- $label;
-}
-
-=item primary_cust_svc
-
-Returns a primary service (as FS::cust_svc object) if one can be identified.
-
-=cut
-
-#for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
-
-sub primary_cust_svc {
- my $self = shift;
-
- my @cust_svc = $self->cust_svc;
-
- return '' unless @cust_svc; #no serivces - irrelevant then
-
- return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
-
- # primary service as specified in the package definition
- # or exactly one service definition with quantity one
- my $svcpart = $self->part_pkg->svcpart;
- @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
- return $cust_svc[0] if scalar(@cust_svc) == 1;
-
- #couldn't identify one thing..
- return '';
-}
-
-=item labels
-
-Returns a list of lists, calling the label method for all services
-(see L<FS::cust_svc>) of this billing item.
-
-=cut
-
-sub labels {
- my $self = shift;
- map { [ $_->label ] } $self->cust_svc;
-}
-
-=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
-
-Like the labels method, but returns historical information on services that
-were active as of END_TIMESTAMP and (optionally) not cancelled before
-START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the
-I<pkg_svc.hidden> flag will be omitted.
-
-Returns a list of lists, calling the label method for all (historical) services
-(see L<FS::h_cust_svc>) of this billing item.
-
-=cut
-
-sub h_labels {
- my $self = shift;
- map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
-}
-
-=item labels_short
-
-Like labels, except returns a simple flat list, and shortens long
-(currently >5 or the cust_bill-max_same_services configuration value) lists of
-identical services to one line that lists the service label and the number of
-individual services rather than individual items.
-
-=cut
-
-sub labels_short {
- shift->_labels_short( 'labels', @_ );
-}
-
-=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
-
-Like h_labels, except returns a simple flat list, and shortens long
-(currently >5 or the cust_bill-max_same_services configuration value) lists of
-identical services to one line that lists the service label and the number of
-individual services rather than individual items.
-
-=cut
-
-sub h_labels_short {
- shift->_labels_short( 'h_labels', @_ );
-}
-
-sub _labels_short {
- my( $self, $method ) = ( shift, shift );
-
- my $conf = new FS::Conf;
- my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
-
- my %labels;
- #tie %labels, 'Tie::IxHash';
- push @{ $labels{$_->[0]} }, $_->[1]
- foreach $self->$method(@_);
- my @labels;
- foreach my $label ( keys %labels ) {
- my %seen = ();
- my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
- my $num = scalar(@values);
- if ( $num > $max_same_services ) {
- push @labels, "$label ($num)";
- } else {
- if ( $conf->exists('cust_bill-consolidate_services') ) {
- # push @labels, "$label: ". join(', ', @values);
- while ( @values ) {
- my $detail = "$label: ";
- $detail .= shift(@values). ', '
- while @values && length($detail.$values[0]) < 78;
- $detail =~ s/, $//;
- push @labels, $detail;
- }
- } else {
- push @labels, map { "$label: $_" } @values;
- }
- }
- }
-
- @labels;
-
-}
-
-=item cust_main
-
-Returns the parent customer object (see L<FS::cust_main>).
-
-=cut
-
-sub cust_main {
- my $self = shift;
- 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>).
-
-=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>).
-
-=item location_label [ OPTION => VALUE ... ]
-
-Returns the label of the location object (see L<FS::cust_location>).
-
-=cut
-
-#end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
-
-=item seconds_since TIMESTAMP
-
-Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
-package have been online since TIMESTAMP, according to the session monitor.
-
-TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=cut
-
-sub seconds_since {
- my($self, $since) = @_;
- my $seconds = 0;
-
- foreach my $cust_svc (
- grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
- ) {
- $seconds += $cust_svc->seconds_since($since);
- }
-
- $seconds;
-
-}
-
-=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
-
-Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
-package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
-(exclusive).
-
-TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
-L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-
-=cut
-
-sub seconds_since_sqlradacct {
- my($self, $start, $end) = @_;
-
- my $seconds = 0;
-
- foreach my $cust_svc (
- grep {
- my $part_svc = $_->part_svc;
- $part_svc->svcdb eq 'svc_acct'
- && scalar($part_svc->part_export('sqlradius'));
- } $self->cust_svc
- ) {
- $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
- }
-
- $seconds;
-
-}
-
-=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
-
-Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
-in this package for sessions ending between TIMESTAMP_START (inclusive) and
-TIMESTAMP_END
-(exclusive).
-
-TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
-L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-=cut
-
-sub attribute_since_sqlradacct {
- my($self, $start, $end, $attrib) = @_;
-
- my $sum = 0;
-
- foreach my $cust_svc (
- grep {
- my $part_svc = $_->part_svc;
- $part_svc->svcdb eq 'svc_acct'
- && scalar($part_svc->part_export('sqlradius'));
- } $self->cust_svc
- ) {
- $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
- }
-
- $sum;
-
-}
-
-=item quantity
-
-=cut
-
-sub quantity {
- my( $self, $value ) = @_;
- if ( defined($value) ) {
- $self->setfield('quantity', $value);
- }
- $self->getfield('quantity') || 1;
-}
-
-=item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
-
-Transfers as many services as possible from this package to another package.
-
-The destination package can be specified by pkgnum by passing an FS::cust_pkg
-object. The destination package must already exist.
-
-Services are moved only if the destination allows services with the correct
-I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
-this option with caution! No provision is made for export differences
-between the old and new service definitions. Probably only should be used
-when your exports for all service definitions of a given svcdb are identical.
-(attempt a transfer without it first, to move all possible svcpart-matching
-services)
-
-Any services that can't be moved remain in the original package.
-
-Returns an error, if there is one; otherwise, returns the number of services
-that couldn't be moved.
-
-=cut
-
-sub transfer {
- my ($self, $dest_pkgnum, %opt) = @_;
-
- my $remaining = 0;
- my $dest;
- my %target;
-
- if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
- $dest = $dest_pkgnum;
- $dest_pkgnum = $dest->pkgnum;
- } else {
- $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
- }
-
- return ('Package does not exist: '.$dest_pkgnum) unless $dest;
-
- foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
- $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
- }
-
- foreach my $cust_svc ($dest->cust_svc) {
- $target{$cust_svc->svcpart}--;
- }
-
- my %svcpart2svcparts = ();
- if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
- warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
- foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
- next if exists $svcpart2svcparts{$svcpart};
- my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
- $svcpart2svcparts{$svcpart} = [
- map { $_->[0] }
- sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
- map {
- my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
- 'svcpart' => $_ } );
- [ $_,
- $pkg_svc ? $pkg_svc->primary_svc : '',
- $pkg_svc ? $pkg_svc->quantity : 0,
- ];
- }
-
- grep { $_ != $svcpart }
- map { $_->svcpart }
- qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
- ];
- warn "alternates for svcpart $svcpart: ".
- join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
- if $DEBUG;
- }
- }
-
- foreach my $cust_svc ($self->cust_svc) {
- if($target{$cust_svc->svcpart} > 0) {
- $target{$cust_svc->svcpart}--;
- my $new = new FS::cust_svc { $cust_svc->hash };
- $new->pkgnum($dest_pkgnum);
- my $error = $new->replace($cust_svc);
- return $error if $error;
- } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
- if ( $DEBUG ) {
- warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
- warn "alternates to consider: ".
- join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
- }
- my @alternate = grep {
- warn "considering alternate svcpart $_: ".
- "$target{$_} available in new package\n"
- if $DEBUG;
- $target{$_} > 0;
- } @{$svcpart2svcparts{$cust_svc->svcpart}};
- if ( @alternate ) {
- warn "alternate(s) found\n" if $DEBUG;
- my $change_svcpart = $alternate[0];
- $target{$change_svcpart}--;
- my $new = new FS::cust_svc { $cust_svc->hash };
- $new->svcpart($change_svcpart);
- $new->pkgnum($dest_pkgnum);
- my $error = $new->replace($cust_svc);
- return $error if $error;
- } else {
- $remaining++;
- }
- } else {
- $remaining++
- }
- }
- return $remaining;
-}
-
-=item reexport
-
-This method is deprecated. See the I<depend_jobnum> option to the insert and
-order_pkgs methods in FS::cust_main for a better way to defer provisioning.
-
-=cut
-
-sub reexport {
- 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 $cust_svc ( $self->cust_svc ) {
- #false laziness w/svc_Common::insert
- my $svc_x = $cust_svc->svc_x;
- foreach my $part_export ( $cust_svc->part_svc->part_export ) {
- my $error = $part_export->export_insert($svc_x);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item insert_reason
-
-Associates this package with a (suspension or cancellation) reason (see
-L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
-L<FS::reason>).
-
-Available options are:
-
-=over 4
-
-=item reason
-
-can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
-
-=item reason_otaker
-
-the access_user (see L<FS::access_user>) providing the reason
-
-=item date
-
-a unix timestamp
-
-=item action
-
-the action (cancel, susp, adjourn, expire) associated with the reason
-
-=back
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub insert_reason {
- my ($self, %options) = @_;
-
- my $otaker = $options{reason_otaker} ||
- $FS::CurrentUser::CurrentUser->username;
-
- my $reasonnum;
- if ( $options{'reason'} =~ /^(\d+)$/ ) {
-
- $reasonnum = $1;
-
- } elsif ( ref($options{'reason'}) ) {
-
- return 'Enter a new reason (or select an existing one)'
- unless $options{'reason'}->{'reason'} !~ /^\s*$/;
-
- my $reason = new FS::reason({
- 'reason_type' => $options{'reason'}->{'typenum'},
- 'reason' => $options{'reason'}->{'reason'},
- });
- my $error = $reason->insert;
- return $error if $error;
-
- $reasonnum = $reason->reasonnum;
-
- } else {
- return "Unparsable reason: ". $options{'reason'};
- }
-
- my $cust_pkg_reason =
- new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
- 'reasonnum' => $reasonnum,
- 'otaker' => $otaker,
- 'action' => substr(uc($options{'action'}),0,1),
- 'date' => $options{'date'}
- ? $options{'date'}
- : time,
- });
-
- $cust_pkg_reason->insert;
-}
-
-=item insert_discount
-
-Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
-inserting a new discount on the fly (see L<FS::discount>).
-
-Available options are:
-
-=over 4
-
-=item discountnum
-
-=back
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub insert_discount {
- #my ($self, %options) = @_;
- my $self = shift;
-
- my $cust_pkg_discount = new FS::cust_pkg_discount {
- 'pkgnum' => $self->pkgnum,
- 'discountnum' => $self->discountnum,
- 'months_used' => 0,
- 'end_date' => '', #XXX
- 'otaker' => $self->otaker,
- #for the create a new discount case
- '_type' => $self->discountnum__type,
- 'amount' => $self->discountnum_amount,
- 'percent' => $self->discountnum_percent,
- 'months' => $self->discountnum_months,
- #'disabled' => $self->discountnum_disabled,
- };
-
- $cust_pkg_discount->insert;
-}
-
-=item set_usage USAGE_VALUE_HASHREF
-
-USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
-to which they should be set (see L<FS::svc_acct>). Currently seconds,
-upbytes, downbytes, and totalbytes are appropriate keys.
-
-All svc_accts which are part of this package have their values reset.
-
-=cut
-
-sub set_usage {
- my ($self, $valueref, %opt) = @_;
-
- foreach my $cust_svc ($self->cust_svc){
- my $svc_x = $cust_svc->svc_x;
- $svc_x->set_usage($valueref, %opt)
- if $svc_x->can("set_usage");
- }
-}
-
-=item recharge USAGE_VALUE_HASHREF
-
-USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
-to which they should be set (see L<FS::svc_acct>). Currently seconds,
-upbytes, downbytes, and totalbytes are appropriate keys.
-
-All svc_accts which are part of this package have their values incremented.
-
-=cut
-
-sub recharge {
- my ($self, $valueref) = @_;
-
- foreach my $cust_svc ($self->cust_svc){
- my $svc_x = $cust_svc->svc_x;
- $svc_x->recharge($valueref)
- if $svc_x->can("recharge");
- }
-}
-
-=item cust_pkg_discount
-
-=cut
-
-sub cust_pkg_discount {
- my $self = shift;
- qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
-}
-
-=item cust_pkg_discount_active
-
-=cut
-
-sub cust_pkg_discount_active {
- my $self = shift;
- grep { $_->status eq 'active' } $self->cust_pkg_discount;
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item recurring_sql
-
-Returns an SQL expression identifying recurring packages.
-
-=cut
-
-sub recurring_sql { "
- '0' != ( select freq from part_pkg
- where cust_pkg.pkgpart = part_pkg.pkgpart )
-"; }
-
-=item onetime_sql
-
-Returns an SQL expression identifying one-time packages.
-
-=cut
-
-sub onetime_sql { "
- '0' = ( select freq from part_pkg
- where cust_pkg.pkgpart = part_pkg.pkgpart )
-"; }
-
-=item ordered_sql
-
-Returns an SQL expression identifying ordered packages (recurring packages not
-yet billed).
-
-=cut
-
-sub ordered_sql {
- $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
-}
-
-=item active_sql
-
-Returns an SQL expression identifying active packages.
-
-=cut
-
-sub active_sql {
- $_[0]->recurring_sql. "
- AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
- AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
- AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
-"; }
-
-=item not_yet_billed_sql
-
-Returns an SQL expression identifying packages which have not yet been billed.
-
-=cut
-
-sub not_yet_billed_sql { "
- ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
- AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
- AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
-"; }
-
-=item inactive_sql
-
-Returns an SQL expression identifying inactive packages (one-time packages
-that are otherwise unsuspended/uncancelled).
-
-=cut
-
-sub inactive_sql { "
- ". $_[0]->onetime_sql(). "
- AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
- AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
- AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
-"; }
-
-=item susp_sql
-=item suspended_sql
-
-Returns an SQL expression identifying suspended packages.
-
-=cut
-
-sub suspended_sql { susp_sql(@_); }
-sub susp_sql {
- #$_[0]->recurring_sql(). ' AND '.
- "
- ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
- AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
- ";
-}
-
-=item cancel_sql
-=item cancelled_sql
-
-Returns an SQL exprression identifying cancelled packages.
-
-=cut
-
-sub cancelled_sql { cancel_sql(@_); }
-sub cancel_sql {
- #$_[0]->recurring_sql(). ' AND '.
- "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
-}
-
-=item status_sql
-
-Returns an SQL expression to give the package status as a string.
-
-=cut
-
-sub status_sql {
-"CASE
- WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
- WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
- WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
- WHEN ".onetime_sql()." THEN 'one-time charge'
- ELSE 'active'
-END"
-}
-
-=item search HASHREF
-
-(Class method)
-
-Returns a qsearch hash expression to search for parameters specified in HASHREF.
-Valid parameters are
-
-=over 4
-
-=item agentnum
-
-=item magic
-
-active, inactive, suspended, cancel (or cancelled)
-
-=item status
-
-active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
-
-=item custom
-
- boolean selects custom packages
-
-=item classnum
-
-=item pkgpart
-
-pkgpart or arrayref or hashref of pkgparts
-
-=item setup
-
-arrayref of beginning and ending epoch date
-
-=item last_bill
-
-arrayref of beginning and ending epoch date
-
-=item bill
-
-arrayref of beginning and ending epoch date
-
-=item adjourn
-
-arrayref of beginning and ending epoch date
-
-=item susp
-
-arrayref of beginning and ending epoch date
-
-=item expire
-
-arrayref of beginning and ending epoch date
-
-=item cancel
-
-arrayref of beginning and ending epoch date
-
-=item query
-
-pkgnum or APKG_pkgnum
-
-=item cust_fields
-
-a value suited to passing to FS::UI::Web::cust_header
-
-=item CurrentUser
-
-specifies the user for agent virtualization
-
-=item fcc_line
-
- boolean selects packages containing fcc form 477 telco lines
-
-=back
-
-=cut
-
-sub search {
- my ($class, $params) = @_;
- my @where = ();
-
- ##
- # parse agent
- ##
-
- if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
- push @where,
- "cust_main.agentnum = $1";
- }
-
- ##
- # parse custnum
- ##
-
- if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
- push @where,
- "cust_pkg.custnum = $1";
- }
-
- ##
- # custbatch
- ##
-
- if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
- push @where,
- "cust_pkg.pkgbatch = '$1'";
- }
-
- ##
- # parse status
- ##
-
- if ( $params->{'magic'} eq 'active'
- || $params->{'status'} eq 'active' ) {
-
- push @where, FS::cust_pkg->active_sql();
-
- } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
- || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
-
- push @where, FS::cust_pkg->not_yet_billed_sql();
-
- } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
- || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
-
- push @where, FS::cust_pkg->inactive_sql();
-
- } elsif ( $params->{'magic'} eq 'suspended'
- || $params->{'status'} eq 'suspended' ) {
-
- push @where, FS::cust_pkg->suspended_sql();
-
- } elsif ( $params->{'magic'} =~ /^cancell?ed$/
- || $params->{'status'} =~ /^cancell?ed$/ ) {
-
- push @where, FS::cust_pkg->cancelled_sql();
-
- }
-
- ###
- # parse package class
- ###
-
- #false lazinessish w/graph/cust_bill_pkg.cgi
- my $classnum = 0;
- my @pkg_class = ();
- if ( exists($params->{'classnum'})
- && $params->{'classnum'} =~ /^(\d*)$/
- )
- {
- $classnum = $1;
- if ( $classnum ) { #a specific class
- push @where, "part_pkg.classnum = $classnum";
-
- #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
- #die "classnum $classnum not found!" unless $pkg_class[0];
- #$title .= $pkg_class[0]->classname.' ';
-
- } elsif ( $classnum eq '' ) { #the empty class
-
- push @where, "part_pkg.classnum IS NULL";
- #$title .= 'Empty class ';
- #@pkg_class = ( '(empty class)' );
- } elsif ( $classnum eq '0' ) {
- #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
- #push @pkg_class, '(empty class)';
- } else {
- die "illegal classnum";
- }
- }
- #eslaf
-
- ###
- # parse package report options
- ###
-
- my @report_option = ();
- if ( exists($params->{'report_option'})
- && $params->{'report_option'} =~ /^([,\d]*)$/
- )
- {
- @report_option = split(',', $1);
- }
-
- if (@report_option) {
- # this will result in the empty set for the dangling comma case as it should
- push @where,
- map{ "0 < ( SELECT count(*) FROM part_pkg_option
- WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
- AND optionname = 'report_option_$_'
- AND optionvalue = '1' )"
- } @report_option;
- }
-
- #eslaf
-
- ###
- # parse custom
- ###
-
- push @where, "part_pkg.custom = 'Y'" if $params->{custom};
-
- ###
- # parse fcc_line
- ###
-
- push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
-
- ###
- # parse censustract
- ###
-
- if ( exists($params->{'censustract'}) ) {
- $params->{'censustract'} =~ /^([.\d]*)$/;
- my $censustract = "cust_main.censustract = '$1'";
- $censustract .= ' OR cust_main.censustract is NULL' unless $1;
- push @where, "( $censustract )";
- }
-
- ###
- # parse part_pkg
- ###
-
- if ( ref($params->{'pkgpart'}) ) {
-
- my @pkgpart = ();
- if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
- @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
- } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
- @pkgpart = @{ $params->{'pkgpart'} };
- } else {
- die 'unhandled pkgpart ref '. $params->{'pkgpart'};
- }
-
- @pkgpart = grep /^(\d+)$/, @pkgpart;
-
- push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
-
- } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
- push @where, "pkgpart = $1";
- }
-
- ###
- # parse dates
- ###
-
- my $orderby = '';
-
- #false laziness w/report_cust_pkg.html
- my %disable = (
- 'all' => {},
- 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
- 'active' => { 'susp'=>1, 'cancel'=>1 },
- 'suspended' => { 'cancel' => 1 },
- 'cancelled' => {},
- '' => {},
- );
-
- if( exists($params->{'active'} ) ) {
- # This overrides all the other date-related fields
- my($beginning, $ending) = @{$params->{'active'}};
- push @where,
- "cust_pkg.setup IS NOT NULL",
- "cust_pkg.setup <= $ending",
- "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
- "NOT (".FS::cust_pkg->onetime_sql . ")";
- }
- else {
- foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) {
-
- next unless exists($params->{$field});
-
- my($beginning, $ending) = @{$params->{$field}};
-
- next if $beginning == 0 && $ending == 4294967295;
-
- push @where,
- "cust_pkg.$field IS NOT NULL",
- "cust_pkg.$field >= $beginning",
- "cust_pkg.$field <= $ending";
-
- $orderby ||= "ORDER BY cust_pkg.$field";
-
- }
- }
-
- $orderby ||= 'ORDER BY bill';
-
- ###
- # parse magic, legacy, etc.
- ###
-
- if ( $params->{'magic'} &&
- $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
- ) {
-
- $orderby = 'ORDER BY pkgnum';
-
- if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
- push @where, "pkgpart = $1";
- }
-
- } elsif ( $params->{'query'} eq 'pkgnum' ) {
-
- $orderby = 'ORDER BY pkgnum';
-
- } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
-
- $orderby = 'ORDER BY pkgnum';
-
- push @where, '0 < (
- SELECT count(*) FROM pkg_svc
- WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
- AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
- WHERE cust_svc.pkgnum = cust_pkg.pkgnum
- AND cust_svc.svcpart = pkg_svc.svcpart
- )
- )';
-
- }
-
- ##
- # setup queries, links, subs, etc. for the search
- ##
-
- # here is the agent virtualization
- if ($params->{CurrentUser}) {
- my $access_user =
- qsearchs('access_user', { username => $params->{CurrentUser} });
-
- if ($access_user) {
- push @where, $access_user->agentnums_sql('table'=>'cust_main');
- } else {
- push @where, "1=0";
- }
- } else {
- push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
- }
-
- my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
-
- my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
- 'LEFT JOIN part_pkg USING ( pkgpart ) '.
- 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
-
- my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
-
- my $sql_query = {
- 'table' => 'cust_pkg',
- 'hashref' => {},
- 'select' => join(', ',
- 'cust_pkg.*',
- ( map "part_pkg.$_", qw( pkg freq ) ),
- 'pkg_class.classname',
- 'cust_main.custnum AS cust_main_custnum',
- FS::UI::Web::cust_sql_fields(
- $params->{'cust_fields'}
- ),
- ),
- 'extra_sql' => "$extra_sql $orderby",
- 'addl_from' => $addl_from,
- 'count_query' => $count_query,
- };
-
-}
-
-=item fcc_477_count
-
-Returns a list of two package counts. The first is a count of packages
-based on the supplied criteria and the second is the count of residential
-packages with those same criteria. Criteria are specified as in the search
-method.
-
-=cut
-
-sub fcc_477_count {
- my ($class, $params) = @_;
-
- my $sql_query = $class->search( $params );
-
- my $count_sql = delete($sql_query->{'count_query'});
- $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
- or die "couldn't parse count_sql";
-
- my $count_sth = dbh->prepare($count_sql)
- or die "Error preparing $count_sql: ". dbh->errstr;
- $count_sth->execute
- or die "Error executing $count_sql: ". $count_sth->errstr;
- my $count_arrayref = $count_sth->fetchrow_arrayref;
-
- return ( @$count_arrayref );
-
-}
-
-
-=item location_sql
-
-Returns a list: the first item is an SQL fragment identifying matching
-packages/customers via location (taking into account shipping and package
-address taxation, if enabled), and subsequent items are the parameters to
-substitute for the placeholders in that fragment.
-
-=cut
-
-sub location_sql {
- my($class, %opt) = @_;
- my $ornull = $opt{'ornull'};
-
- my $conf = new FS::Conf;
-
- # '?' placeholders in _location_sql_where
- my $x = $ornull ? 3 : 2;
- my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
-
- my $main_where;
- my @main_param;
- if ( $conf->exists('tax-ship_address') ) {
-
- $main_where = "(
- ( ( ship_last IS NULL OR ship_last = '' )
- AND ". _location_sql_where('cust_main', '', $ornull ). "
- )
- OR ( ship_last IS NOT NULL AND ship_last != ''
- AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
- )
- )";
- # AND payby != 'COMP'
-
- @main_param = ( @bill_param, @bill_param );
-
- } else {
-
- $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
- @main_param = @bill_param;
-
- }
-
- my $where;
- my @param;
- if ( $conf->exists('tax-pkg_address') ) {
-
- my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
-
- $where = " (
- ( cust_pkg.locationnum IS NULL AND $main_where )
- OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
- )
- ";
- @param = ( @main_param, @bill_param );
-
- } else {
-
- $where = $main_where;
- @param = @main_param;
-
- }
-
- ( $where, @param );
-
-}
-
-#subroutine, helper for location_sql
-sub _location_sql_where {
- my $table = shift;
- my $prefix = @_ ? shift : '';
- my $ornull = @_ ? shift : '';
-
-# $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
-
- $ornull = $ornull ? ' OR ? IS NULL ' : '';
-
- my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
- my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
- my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
-
-# ( $table.${prefix}city = ? $or_empty_city $ornull )
- "
- ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
- AND ( $table.${prefix}county = ? $or_empty_county $ornull )
- AND ( $table.${prefix}state = ? $or_empty_state $ornull )
- AND $table.${prefix}country = ?
- ";
-}
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
-
-CUSTNUM is a customer (see L<FS::cust_main>)
-
-PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
-L<FS::part_pkg>) to order for this customer. Duplicates are of course
-permitted.
-
-REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
-remove for this customer. The services (see L<FS::cust_svc>) are moved to the
-new billing items. An error is returned if this is not possible (see
-L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
-parameter.
-
-RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
-newly-created cust_pkg objects.
-
-REFNUM, if specified, will specify the FS::pkg_referral record to be created
-and inserted. Multiple FS::pkg_referral records can be created by
-setting I<refnum> to an array reference of refnums or a hash reference with
-refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
-record will be created corresponding to cust_main.refnum.
-
-=cut
-
-sub order {
- my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
-
- my $conf = new FS::Conf;
-
- # Transactionize this whole mess
- 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;
-# my $cust_main = qsearchs('cust_main', { custnum => $custnum });
-# return "Customer not found: $custnum" unless $cust_main;
-
- warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
- if $DEBUG;
-
- my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
- @$remove_pkgnum;
-
- my $change = scalar(@old_cust_pkg) != 0;
-
- my %hash = ();
- if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
-
- warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
- " to pkgpart ". $pkgparts->[0]. "\n"
- if $DEBUG;
-
- my $err_or_cust_pkg =
- $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
- 'refnum' => $refnum,
- );
-
- unless (ref($err_or_cust_pkg)) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_cust_pkg;
- }
-
- push @$return_cust_pkg, $err_or_cust_pkg;
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return '';
-
- }
-
- # Create the new packages.
- foreach my $pkgpart (@$pkgparts) {
-
- warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
-
- my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
- pkgpart => $pkgpart,
- refnum => $refnum,
- %hash,
- };
- $error = $cust_pkg->insert( 'change' => $change );
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- push @$return_cust_pkg, $cust_pkg;
- }
- # $return_cust_pkg now contains refs to all of the newly
- # created packages.
-
- # Transfer services and cancel old packages.
- foreach my $old_pkg (@old_cust_pkg) {
-
- warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
- if $DEBUG;
-
- foreach my $new_pkg (@$return_cust_pkg) {
- $error = $old_pkg->transfer($new_pkg);
- if ($error and $error == 0) {
- # $old_pkg->transfer failed.
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
- warn "trying transfer again with change_svcpart option\n" if $DEBUG;
- foreach my $new_pkg (@$return_cust_pkg) {
- $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
- if ($error and $error == 0) {
- # $old_pkg->transfer failed.
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- if ($error > 0) {
- # Transfers were successful, but we went through all of the
- # new packages and still had services left on the old package.
- # We can't cancel the package under the circumstances, so abort.
- $dbh->rollback if $oldAutoCommit;
- return "Unable to transfer all services from package ".$old_pkg->pkgnum;
- }
- $error = $old_pkg->cancel( quiet=>1 );
- if ($error) {
- $dbh->rollback;
- return $error;
- }
- }
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
-=item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
-
-A bulk change method to change packages for multiple customers.
-
-PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
-L<FS::part_pkg>) to order for each customer. Duplicates are of course
-permitted.
-
-REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
-replace. The services (see L<FS::cust_svc>) are moved to the
-new billing items. An error is returned if this is not possible (see
-L<FS::pkg_svc>).
-
-RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
-newly-created cust_pkg objects.
-
-=cut
-
-sub bulk_change {
- my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
-
- # Transactionize this whole mess
- 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 @errors;
- my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
- @$remove_pkgnum;
-
- while(scalar(@old_cust_pkg)) {
- my @return = ();
- my $custnum = $old_cust_pkg[0]->custnum;
- my (@remove) = map { $_->pkgnum }
- grep { $_->custnum == $custnum } @old_cust_pkg;
- @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
-
- my $error = order $custnum, $pkgparts, \@remove, \@return;
-
- push @errors, $error
- if $error;
- push @$return_cust_pkg, @return;
- }
-
- if (scalar(@errors)) {
- $dbh->rollback if $oldAutoCommit;
- return join(' / ', @errors);
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
-# Used by FS::Upgrade to migrate to a new database.
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
- $class->_upgrade_otaker(%opts);
- my @statements = (
- # RT#10139, bug resulting in contract_end being set when it shouldn't
- 'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
- # RT#10830, bad calculation of prorate date near end of year
- # the date range for bill is December 2009, and we move it forward
- # one year if it's before the previous bill date (which it should
- # never be)
- 'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
- AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
- WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
- );
- foreach my $sql (@statements) {
- my $sth = dbh->prepare($sql);
- $sth->execute or die $sth->errstr;
- }
-}
-
-=back
-
-=head1 BUGS
-
-sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
-
-In sub order, the @pkgparts array (passed by reference) is clobbered.
-
-Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
-method to pass dates to the recur_prog expression, it should do so.
-
-FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
-loaded via 'use' at compile time, rather than via 'require' in sub { setup,
-suspend, unsuspend, cancel } because they use %FS::UID::callback to load
-configuration values. Probably need a subroutine which decides what to do
-based on whether or not we've fetched the user yet, rather than a hash. See
-FS::UID and the TODO.
-
-Now that things are transactional should the check in the insert method be
-moved to check ?
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
-L<FS::pkg_svc>, schema.html from the base documentation
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_pkg/Import.pm b/FS/FS/cust_pkg/Import.pm
deleted file mode 100644
index 43470a4..0000000
--- a/FS/FS/cust_pkg/Import.pm
+++ /dev/null
@@ -1,373 +0,0 @@
-package FS::cust_pkg::Import;
-
-use strict;
-use vars qw( $DEBUG ); #$conf );
-use Storable qw(thaw);
-use Data::Dumper;
-use MIME::Base64;
-use FS::Misc::DateTime qw( parse_datetime );
-use FS::Record qw( qsearchs );
-use FS::cust_pkg;
-use FS::cust_main;
-use FS::svc_acct;
-use FS::svc_external;
-use FS::svc_phone;
-
-$DEBUG = 0;
-
-#install_callback FS::UID sub {
-# $conf = new FS::Conf;
-#};
-
-=head1 NAME
-
-FS::cust_pkg::Import - Batch customer importing
-
-=head1 SYNOPSIS
-
- use FS::cust_pkg::Import;
-
- #import
- FS::cust_pkg::Import::batch_import( {
- file => $file, #filename
- type => $type, #csv or xls
- format => $format, #extended, extended-plus_company, svc_external,
- # or svc_external_svc_phone
- agentnum => $agentnum,
- job => $job, #optional job queue job, for progressbar updates
- pkgbatch => $pkgbatch, #optional batch unique identifier
- } );
- die $error if $error;
-
- #ajax helper
- use FS::UI::Web::JSRPC;
- my $server =
- new FS::UI::Web::JSRPC 'FS::cust_pkg::Import::process_batch_import', $cgi;
- print $server->process;
-
-=head1 DESCRIPTION
-
-Batch package importing.
-
-=head1 SUBROUTINES
-
-=item process_batch_import
-
-Load a batch import as a queued JSRPC job
-
-=cut
-
-sub process_batch_import {
- my $job = shift;
-
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- my $files = $param->{'uploaded_files'}
- or die "No files provided.\n";
-
- my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
-
- my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
- my $file = $dir. $files{'file'};
-
- my $type;
- if ( $file =~ /\.(\w+)$/i ) {
- $type = lc($1);
- } else {
- #or error out???
- warn "can't parse file type from filename $file; defaulting to CSV";
- $type = 'csv';
- }
-
- my $error =
- FS::cust_pkg::Import::batch_import( {
- job => $job,
- file => $file,
- type => $type,
- 'params' => { pkgbatch => $param->{pkgbatch} },
- agentnum => $param->{'agentnum'},
- 'format' => $param->{'format'},
- } );
-
- unlink $file;
-
- die "$error\n" if $error;
-
-}
-
-=item batch_import
-
-=cut
-
-my %formatfields = (
- 'default' => [],
- 'svc_acct' => [qw( username _password domsvc )],
- 'svc_phone' => [qw( countrycode phonenum sip_password pin )],
- 'svc_external' => [qw( id title )],
-);
-
-sub _formatfields {
- \%formatfields;
-}
-
-my %import_options = (
- 'table' => 'cust_pkg',
-
- 'postinsert_callback' => sub {
- my( $record, $param ) = @_;
-
- my $formatfields = _formatfields;
- foreach my $svc_x ( grep { $_ ne 'default' } keys %$formatfields ) {
-
- my $ff = $formatfields->{$svc_x};
-
- if ( grep $param->{"$svc_x.$_"}, @$ff ) {
- my $svc_x = "FS::$svc_x"->new( {
- 'pkgnum' => $record->pkgnum,
- 'svcpart' => $record->part_pkg->svcpart($svc_x),
- map { $_ => $param->{"$svc_x.$_"} } @$ff
- } );
- my $error = $svc_x->insert;
- return $error if $error;
- }
-
- }
-
- return ''; #no error
-
- },
-);
-
-sub _import_options {
- \%import_options;
-}
-
-sub batch_import {
- my $opt = shift;
-
- my $iopt = _import_options;
- $opt->{$_} = $iopt->{$_} foreach keys %$iopt;
-
- my $agentnum = delete $opt->{agentnum}; # i like closures (delete though?)
-
- my $format = delete $opt->{'format'};
- my @fields = ();
-
- if ( $format =~ /^(.*)-agent_custid$/ ) {
- $format = $1;
- @fields = (
- sub {
- my( $self, $value ) = @_; # $conf, $param
- my $cust_main = qsearchs('cust_main', {
- 'agentnum' => $agentnum,
- 'agent_custid' => $value,
- });
- $self->custnum($cust_main->custnum) if $cust_main;
- },
- );
- } else {
- @fields = ( 'custnum' );
- }
-
- push @fields, ( 'pkgpart', 'discountnum' );
-
- foreach my $field (
- qw( start_date setup bill last_bill susp adjourn cancel expire )
- ) {
- push @fields, sub {
- my( $self, $value ) = @_; # $conf, $param
- #->$field has undesirable effects
- $self->set($field, parse_datetime($value) ); #$field closure
- };
- }
-
- my $formatfields = _formatfields();
-
- die "unknown format $format" unless $formatfields->{$format};
-
- foreach my $field ( @{ $formatfields->{$format} } ) {
-
- push @fields, sub {
- my( $self, $value, $conf, $param ) = @_;
- $param->{"$format.$field"} = $value;
- };
-
- }
-
- $opt->{'fields'} = \@fields;
-
- FS::Record::batch_import( $opt );
-
-}
-
-=for comment
-
- my $billtime = time;
- my %cust_pkg = ( pkgpart => $pkgpart );
- my %svc_x = ();
- foreach my $field ( @fields ) {
-
- if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
-
- #$cust_pkg{$1} = parse_datetime( shift @$columns );
- if ( $1 eq 'pkgpart' ) {
- $cust_pkg{$1} = shift @columns;
- } elsif ( $1 eq 'setup' ) {
- $billtime = parse_datetime(shift @columns);
- } else {
- $cust_pkg{$1} = parse_datetime( shift @columns );
- }
-
- } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
-
- $svc_x{$1} = shift @columns;
-
- } elsif ( $field =~ /^svc_external\.(id|title)$/ ) {
-
- $svc_x{$1} = shift @columns;
-
- } elsif ( $field =~ /^svc_phone\.(countrycode|phonenum|sip_password|pin)$/ ) {
- $svc_x{$1} = shift @columns;
-
- } else {
-
- #refnum interception
- if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
-
- my $referral = $columns[0];
- my %hash = ( 'referral' => $referral,
- 'agentnum' => $agentnum,
- 'disabled' => '',
- );
-
- my $part_referral = qsearchs('part_referral', \%hash )
- || new FS::part_referral \%hash;
-
- unless ( $part_referral->refnum ) {
- my $error = $part_referral->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't auto-insert advertising source: $referral: $error";
- }
- }
-
- $columns[0] = $part_referral->refnum;
- }
-
- my $value = shift @columns;
- $cust_main{$field} = $value if length($value);
- }
- }
-
- $cust_main{'payby'} = 'CARD'
- if defined $cust_main{'payinfo'}
- && length $cust_main{'payinfo'};
-
- my $invoicing_list = $cust_main{'invoicing_list'}
- ? [ delete $cust_main{'invoicing_list'} ]
- : [];
-
- my $cust_main = new FS::cust_main ( \%cust_main );
-
- use Tie::RefHash;
- tie my %hash, 'Tie::RefHash'; #this part is important
-
- if ( $cust_pkg{'pkgpart'} ) {
- my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
-
- my @svc_x = ();
- my $svcdb = '';
- if ( $svc_x{'username'} ) {
- $svcdb = 'svc_acct';
- } elsif ( $svc_x{'id'} || $svc_x{'title'} ) {
- $svcdb = 'svc_external';
- }
-
- my $svc_phone = '';
- if ( $svc_x{'countrycode'} || $svc_x{'phonenum'} ) {
- $svc_phone = FS::svc_phone->new( {
- map { $_ => delete($svc_x{$_}) }
- qw( countrycode phonenum sip_password pin)
- } );
- }
-
- if ( $svcdb || $svc_phone ) {
- my $part_pkg = $cust_pkg->part_pkg;
- unless ( $part_pkg ) {
- $dbh->rollback if $oldAutoCommit;
- return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
- }
- if ( $svcdb ) {
- $svc_x{svcpart} = $part_pkg->svcpart_unique_svcdb( $svcdb );
- my $class = "FS::$svcdb";
- push @svc_x, $class->new( \%svc_x );
- }
- if ( $svc_phone ) {
- $svc_phone->svcpart( $part_pkg->svcpart_unique_svcdb('svc_phone') );
- push @svc_x, $svc_phone;
- }
- }
-
- $hash{$cust_pkg} = \@svc_x;
- }
-
- my $error = $cust_main->insert( \%hash, $invoicing_list );
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert customer". ( $line ? " for $line" : '' ). ": $error";
- }
-
- if ( $format eq 'simple' ) {
-
- #false laziness w/bill.cgi
- $error = $cust_main->bill( 'time' => $billtime );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't bill customer for $line: $error";
- }
-
- $error = $cust_main->apply_payments_and_credits;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't bill customer for $line: $error";
- }
-
- $error = $cust_main->collect();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't collect customer for $line: $error";
- }
-
- }
-
- $row++;
-
- if ( $job && time - $min_sec > $last ) { #progress bar
- $job->update_statustext( int(100 * $row / $count) );
- $last = time;
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
-
- return "Empty file!" unless $row;
-
- ''; #no error
-
-}
-
-=head1 BUGS
-
-Not enough documentation.
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, L<FS::cust_pkg>,
-L<FS::svc_acct>, L<FS::svc_external>, L<FS::svc_phone>
-
-=cut
-
-1;
diff --git a/FS/FS/cust_pkg_detail.pm b/FS/FS/cust_pkg_detail.pm
deleted file mode 100644
index e2d8987..0000000
--- a/FS/FS/cust_pkg_detail.pm
+++ /dev/null
@@ -1,140 +0,0 @@
-package FS::cust_pkg_detail;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record; # qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cust_pkg_detail - Object methods for cust_pkg_detail records
-
-=head1 SYNOPSIS
-
- use FS::cust_pkg_detail;
-
- $record = new FS::cust_pkg_detail \%hash;
- $record = new FS::cust_pkg_detail { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_pkg_detail object represents additional customer package details.
-FS::cust_pkg_detail inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item pkgdetailnum
-
-primary key
-
-=item pkgnum
-
-pkgnum (see L<FS::cust_pkg>)
-
-=item detail
-
-detail
-
-=item detailtype
-
-"I" for Invoice details or "C" for comments
-
-=item weight
-
-Optional display weight
-
-=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 { 'cust_pkg_detail'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('pkgdetailnum')
- || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum')
- || $self->ut_text('detail')
- || $self->ut_enum('detailtype', [ 'I', 'C' ] )
- || $self->ut_numbern('weight')
- ;
- return $error if $error;
-
- $self->weight(0) unless $self->weight;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_pkg>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_pkg_discount.pm b/FS/FS/cust_pkg_discount.pm
deleted file mode 100644
index 3770a2b..0000000
--- a/FS/FS/cust_pkg_discount.pm
+++ /dev/null
@@ -1,246 +0,0 @@
-package FS::cust_pkg_discount;
-
-use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record );
-use FS::Record qw( dbh qsearchs ); # qsearch );
-use FS::cust_pkg;
-use FS::discount;
-
-=head1 NAME
-
-FS::cust_pkg_discount - Object methods for cust_pkg_discount records
-
-=head1 SYNOPSIS
-
- use FS::cust_pkg_discount;
-
- $record = new FS::cust_pkg_discount \%hash;
- $record = new FS::cust_pkg_discount { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_pkg_discount object represents the application of a discount to a
-customer package. FS::cust_pkg_discount inherits from FS::Record. The
-following fields are currently supported:
-
-=over 4
-
-=item pkgdiscountnum
-
-primary key
-
-=item pkgnum
-
-Customer package (see L<FS::cust_pkg>)
-
-=item discountnum
-
-Discount (see L<FS::discount>)
-
-=item months_used
-
-months_used
-
-=item end_date
-
-end_date
-
-=item usernum
-
-order taker, see L<FS::access_user>
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new discount application. 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 { 'cust_pkg_discount'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- #my( $self, %options ) = @_;
- 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;
-
- if ( $self->discountnum == -1 ) {
- my $discount = new FS::discount {
- '_type' => $self->_type,
- 'amount' => $self->amount,
- 'percent' => $self->percent,
- 'months' => $self->months,
- 'disabled' => 'Y',
- };
- my $error = $discount->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $self->discountnum($discount->discountnum);
- }
-
- my $error = $self->SUPER::insert; #(@_); #(%options);
- 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
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid discount applciation. 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('pkgdiscountnum')
- || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum')
- || $self->ut_foreign_key('discountnum', 'discount', 'discountnum' )
- || $self->ut_float('months_used') #actually decimal, but this will do
- || $self->ut_numbern('end_date')
- || $self->ut_alphan('otaker')
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item cust_pkg
-
-Returns the customer package (see L<FS::cust_pkg>).
-
-=cut
-
-sub cust_pkg {
- my $self = shift;
- qsearchs('cust_pkg', { 'pkgnum' => $self->pkgnum } );
-}
-
-=item discount
-
-Returns the discount (see L<FS::discount>).
-
-=cut
-
-sub discount {
- my $self = shift;
- qsearchs('discount', { 'discountnum' => $self->discountnum } );
-}
-
-=item increment_months_used
-
-Increments months_used by the given parameter
-
-=cut
-
-sub increment_months_used {
- my( $self, $used ) = @_;
- #UPDATE cust_pkg_discount SET months_used = months_used + ?
- #leaves no history, and billing is mutexed per-customer, so the dum way is ok
- $self->months_used( $self->months_used + $used );
- $self->replace();
-}
-
-=item status
-
-=cut
-
-sub status {
- my $self = shift;
- my $discount = $self->discount;
-
- if ( $self->disabled ne 'Y'
- and ( ! $discount->months || $self->months_used < $discount->months )
- #XXX also end date
- ) {
- 'active';
- } else {
- 'expired';
- }
-}
-
-# Used by FS::Upgrade to migrate to a new database.
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
- $class->_upgrade_otaker(%opts);
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::discount>, L<FS::cust_pkg>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_pkg_option.pm b/FS/FS/cust_pkg_option.pm
deleted file mode 100644
index 43a1530..0000000
--- a/FS/FS/cust_pkg_option.pm
+++ /dev/null
@@ -1,115 +0,0 @@
-package FS::cust_pkg_option;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cust_pkg_option - Object methods for cust_pkg_option records
-
-=head1 SYNOPSIS
-
- use FS::cust_pkg_option;
-
- $record = new FS::cust_pkg_option \%hash;
- $record = new FS::cust_pkg_option { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_pkg_option object represents an option key an value for a
-customer package. FS::cust_pkg_option inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item optionnum - primary key
-
-=item pkgnum -
-
-=item optionname -
-
-=item optionvalue -
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new option. To add the option 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 { 'cust_pkg_option'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid option. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('optionnum')
- || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum')
- || $self->ut_text('optionname')
- || $self->ut_textn('optionvalue')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_pkg>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_pkg_reason.pm b/FS/FS/cust_pkg_reason.pm
deleted file mode 100644
index 72a2319..0000000
--- a/FS/FS/cust_pkg_reason.pm
+++ /dev/null
@@ -1,331 +0,0 @@
-package FS::cust_pkg_reason;
-
-use strict;
-use vars qw( $ignore_empty_action );
-use base qw( FS::otaker_Mixin FS::Record );
-use FS::Record qw( qsearch qsearchs );
-
-$ignore_empty_action = 0;
-
-=head1 NAME
-
-FS::cust_pkg_reason - Object methods for cust_pkg_reason records
-
-=head1 SYNOPSIS
-
- use FS::cust_pkg_reason;
-
- $record = new FS::cust_pkg_reason \%hash;
- $record = new FS::cust_pkg_reason { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_pkg_reason object represents a relationship between a cust_pkg
-and a reason, for example cancellation or suspension reasons.
-FS::cust_pkg_reason inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item num
-
-primary key
-
-=item pkgnum
-
-=item reasonnum
-
-=item usernum
-
-=item date
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new cust_pkg_reason. To add the example 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 { 'cust_pkg_reason'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid cust_pkg_reason. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my @actions = ( 'A', 'C', 'E', 'S' );
- push @actions, '' if $ignore_empty_action;
-
- my $error =
- $self->ut_numbern('num')
- || $self->ut_number('pkgnum')
- || $self->ut_number('reasonnum')
- || $self->ut_enum('action', \@actions)
- || $self->ut_alphan('otaker')
- || $self->ut_numbern('date')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item reason
-
-Returns the reason (see L<FS::reason>) associated with this cust_pkg_reason.
-
-=cut
-
-sub reason {
- my $self = shift;
- qsearchs( 'reason', { 'reasonnum' => $self->reasonnum } );
-}
-
-=item reasontext
-
-Returns the text of the reason (see L<FS::reason>) associated with this
-cust_pkg_reason.
-
-=cut
-
-sub reasontext {
- my $reason = shift->reason;
- $reason ? $reason->reason : '';
-}
-
-# _upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-
-use FS::h_cust_pkg;
-use FS::h_cust_pkg_reason;
-
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
-
- my $action_replace =
- " AND ( history_action = 'replace_old' OR history_action = 'replace_new' )";
-
- my $count = 0;
- my @unmigrated = qsearch('cust_pkg_reason', { 'action' => '' } );
- foreach ( @unmigrated ) {
-
- my @history_cust_pkg_reason = qsearch( 'h_cust_pkg_reason', { $_->hash } );
-
- next unless scalar(@history_cust_pkg_reason) == 1;
-
- my $hashref = { pkgnum => $_->pkgnum,
- history_date => $history_cust_pkg_reason[0]->history_date,
- };
-
- my @history = qsearch({ table => 'h_cust_pkg',
- hashref => $hashref,
- extra_sql => $action_replace,
- order_by => 'ORDER BY history_action',
- });
-
- my $fuzz = 0;
- while (scalar(@history) < 2 && $fuzz < 3) {
- $hashref->{history_date}++;
- $fuzz++;
- push @history, qsearch({ table => 'h_cust_pkg',
- hashref => $hashref,
- extra_sql => $action_replace,
- order_by => 'ORDER BY history_action',
- });
- }
-
- next unless scalar(@history) == 2;
-
- my @new = grep { $_->history_action eq 'replace_new' } @history;
- my @old = grep { $_->history_action eq 'replace_old' } @history;
-
- next if (scalar(@new) == 2 || scalar(@old) == 2);
-
- if ( !$old[0]->get('cancel') && $new[0]->get('cancel') ) {
- $_->action('C');
- }elsif( !$old[0]->susp && $new[0]->susp ){
- $_->action('S');
- }elsif( $new[0]->expire &&
- (!$old[0]->expire || !$old[0]->expire != $new[0]->expire )
- ){
- $_->action('E');
- $_->date($new[0]->expire);
- }elsif( $new[0]->adjourn &&
- (!$old[0]->adjourn || $old[0]->adjourn != $new[0]->adjourn )
- ){
- $_->action('A');
- $_->date($new[0]->adjourn);
- }
-
- my $error = $_->replace
- if $_->modified;
-
- die $error if $error;
-
- $count++;
- }
-
- #remove nullability if scalar(@migrated) - $count == 0 && ->column('action');
-
- #seek expirations/adjourns without reason
- foreach my $field qw( expire adjourn cancel susp ) {
- my $addl_from =
- "LEFT JOIN h_cust_pkg ON ".
- "(cust_pkg_reason.pkgnum = h_cust_pkg.pkgnum AND".
- " cust_pkg_reason.date = h_cust_pkg.$field AND".
- " history_action = 'replace_new')";
-
- my $extra_sql = 'AND h_cust_pkg.pkgnum IS NULL';
-
- my @unmigrated = qsearch({ table => 'cust_pkg_reason',
- hashref => { action => uc(substr($field,0,1)) },
- addl_from => $addl_from,
- select => 'cust_pkg_reason.*',
- extra_sql => $extra_sql,
- });
- foreach ( @unmigrated ) {
-
- my $hashref = { pkgnum => $_->pkgnum,
- history_date => $_->date,
- };
-
- my @history = qsearch({ table => 'h_cust_pkg',
- hashref => $hashref,
- extra_sql => $action_replace,
- order_by => 'ORDER BY history_action',
- });
-
- my $fuzz = 0;
- while (scalar(@history) < 2 && $fuzz < 3) {
- $hashref->{history_date}++;
- $fuzz++;
- push @history, qsearch({ table => 'h_cust_pkg',
- hashref => $hashref,
- extra_sql => $action_replace,
- order_by => 'ORDER BY history_action',
- });
- }
-
- next unless scalar(@history) == 2;
-
- my @new = grep { $_->history_action eq 'replace_new' } @history;
- my @old = grep { $_->history_action eq 'replace_old' } @history;
-
- next if (scalar(@new) == 2 || scalar(@old) == 2);
-
- $_->date($new[0]->get($field))
- if ( $new[0]->get($field) &&
- ( !$old[0]->get($field) ||
- $old[0]->get($field) != $new[0]->get($field)
- )
- );
-
- my $error = $_->replace
- if $_->modified;
-
- die $error if $error;
- }
- }
-
- #seek cancels/suspends without reason, but with expire/adjourn reason
- foreach my $field qw( cancel susp ) {
-
- my %precursor_map = ( 'cancel' => 'expire', 'susp' => 'adjourn' );
- my $precursor = $precursor_map{$field};
- my $preaction = uc(substr($precursor,0,1));
- my $action = uc(substr($field,0,1));
- my $addl_from =
- "LEFT JOIN cust_pkg_reason ON ".
- "(cust_pkg.pkgnum = cust_pkg_reason.pkgnum AND".
- " cust_pkg.$precursor = cust_pkg_reason.date AND".
- " cust_pkg_reason.action = '$preaction') ".
- "LEFT JOIN cust_pkg_reason AS target ON ".
- "(cust_pkg.pkgnum = target.pkgnum AND".
- " cust_pkg.$field = target.date AND".
- " target.action = '$action')"
- ;
-
- my $extra_sql = "WHERE target.pkgnum IS NULL AND ".
- "cust_pkg.$field IS NOT NULL AND ".
- "cust_pkg.$field < cust_pkg.$precursor + 86400 AND ".
- "cust_pkg_reason.action = '$preaction'";
-
- my @unmigrated = qsearch({ table => 'cust_pkg',
- hashref => { },
- select => 'cust_pkg.*',
- addl_from => $addl_from,
- extra_sql => $extra_sql,
- });
- foreach ( @unmigrated ) {
- my $cpr = new FS::cust_pkg_reason { $_->last_cust_pkg_reason($precursor)->hash, 'num' => '' };
- $cpr->date($_->get($field));
- $cpr->action($action);
-
- my $error = $cpr->insert;
- die $error if $error;
- }
- }
-
- #still can't fill in an action? don't abort the upgrade
- local($ignore_empty_action) = 1;
-
- $class->_upgrade_otaker(%opts);
-}
-
-=back
-
-=head1 BUGS
-
-Here be termites. Don't use on wooden computers.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_recon.pm b/FS/FS/cust_recon.pm
deleted file mode 100644
index 0a1ca3a..0000000
--- a/FS/FS/cust_recon.pm
+++ /dev/null
@@ -1,193 +0,0 @@
-package FS::cust_recon;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::cust_recon - Object methods for cust_recon records
-
-=head1 SYNOPSIS
-
- use FS::cust_recon;
-
- $record = new FS::cust_recon \%hash;
- $record = new FS::cust_recon { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_recon object represents a customer reconcilation. FS::cust_recon
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item reconid
-
-primary key
-
-=item recondate
-
-recondate
-
-=item custnum
-
-custnum
-
-=item agentnum
-
-agentnum
-
-=item last
-
-last
-
-=item first
-
-first
-
-=item address1
-
-address1
-
-=item address2
-
-address2
-
-=item city
-
-city
-
-=item state
-
-state
-
-=item zip
-
-zip
-
-=item pkg
-
-pkg
-
-=item adjourn
-
-adjourn
-
-=item status
-
-status
-
-=item agent_custid
-
-agent_custid
-
-=item agent_pkg
-
-agent_pkg
-
-=item agent_adjourn
-
-agent_adjourn
-
-=item comments
-
-comments
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new customer reconcilation. To add the reconcilation 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 { 'cust_recon'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid reconcilation. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('reconid')
- || $self->ut_numbern('recondate')
- || $self->ut_number('custnum')
- || $self->ut_number('agentnum')
- || $self->ut_text('last')
- || $self->ut_text('first')
- || $self->ut_text('address1')
- || $self->ut_textn('address2')
- || $self->ut_text('city')
- || $self->ut_textn('state')
- || $self->ut_textn('zip')
- || $self->ut_textn('pkg')
- || $self->ut_numbern('adjourn')
- || $self->ut_textn('status')
- || $self->ut_text('agent_custid')
- || $self->ut_textn('agent_pkg')
- || $self->ut_numbern('agent_adjourn')
- || $self->ut_textn('comments')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-Possibly the existance of this module.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm
deleted file mode 100644
index 7df7a55..0000000
--- a/FS/FS/cust_refund.pm
+++ /dev/null
@@ -1,394 +0,0 @@
-package FS::cust_refund;
-
-use strict;
-use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
- FS::Record );
-use vars qw( @encrypted_fields );
-use Business::CreditCard;
-use FS::UID qw(getotaker);
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::CurrentUser;
-use FS::cust_credit;
-use FS::cust_credit_refund;
-use FS::cust_pay_refund;
-use FS::cust_main;
-
-@encrypted_fields = ('payinfo');
-
-=head1 NAME
-
-FS::cust_refund - Object method for cust_refund objects
-
-=head1 SYNOPSIS
-
- use FS::cust_refund;
-
- $record = new FS::cust_refund \%hash;
- $record = new FS::cust_refund { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_refund represents a refund: the transfer of money to a customer;
-equivalent to a negative payment (see L<FS::cust_pay>). FS::cust_refund
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item refundnum
-
-primary key (assigned automatically for new refunds)
-
-=item custnum
-
-customer (see L<FS::cust_main>)
-
-=item refund
-
-Amount of the refund
-
-=item reason
-
-Reason for the refund
-
-=item _date
-
-specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item payby
-
-Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
-
-=item payinfo
-
-Payment Information (See L<FS::payinfo_Mixin> for data format)
-
-=item paymask
-
-Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
-
-=item paybatch
-
-text field for tracking card processing
-
-=item usernum
-
-order taker (see L<FS::access_user>
-
-=item closed
-
-books closed flag, empty or `Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new refund. To add the refund to the database, see L<"insert">.
-
-=cut
-
-sub table { 'cust_refund'; }
-
-=item insert
-
-Adds this refund to the database.
-
-For backwards-compatibility and convenience, if the additional field crednum is
-defined, an FS::cust_credit_refund record for the full amount of the refund
-will be created. Or (this time for convenience and consistancy), if the
-additional field paynum is defined, an FS::cust_pay_refund record for the full
-amount of the refund will be created. In both cases, custnum is optional.
-
-=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;
-
- if ( $self->crednum ) {
- my $cust_credit = qsearchs('cust_credit', { 'crednum' => $self->crednum } )
- or do {
- $dbh->rollback if $oldAutoCommit;
- return "Unknown cust_credit.crednum: ". $self->crednum;
- };
- $self->custnum($cust_credit->custnum);
- } elsif ( $self->paynum ) {
- my $cust_pay = qsearchs('cust_pay', { 'paynum' => $self->paynum } )
- or do {
- $dbh->rollback if $oldAutoCommit;
- return "Unknown cust_pay.paynum: ". $self->paynum;
- };
- $self->custnum($cust_pay->custnum);
- }
-
- my $error = $self->check;
- return $error if $error;
-
- $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $self->crednum ) {
- my $cust_credit_refund = new FS::cust_credit_refund {
- 'crednum' => $self->crednum,
- 'refundnum' => $self->refundnum,
- 'amount' => $self->refund,
- '_date' => $self->_date,
- };
- $error = $cust_credit_refund->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- #$self->custnum($cust_credit_refund->cust_credit->custnum);
- } elsif ( $self->paynum ) {
- my $cust_pay_refund = new FS::cust_pay_refund {
- 'paynum' => $self->paynum,
- 'refundnum' => $self->refundnum,
- 'amount' => $self->refund,
- '_date' => $self->_date,
- };
- $error = $cust_pay_refund->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item delete
-
-Unless the closed flag is set, deletes this refund and all associated
-applications (see L<FS::cust_credit_refund> and L<FS::cust_pay_refund>).
-
-=cut
-
-sub delete {
- my $self = shift;
- return "Can't delete closed refund" if $self->closed =~ /^Y/i;
-
- 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 $cust_credit_refund ( $self->cust_credit_refund ) {
- my $error = $cust_credit_refund->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- foreach my $cust_pay_refund ( $self->cust_pay_refund ) {
- my $error = $cust_pay_refund->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
-
-You can, but probably shouldn't modify refunds...
-
-Replaces the OLD_RECORD with this one in the database, or, if OLD_RECORD is not
-supplied, replaces this record. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub replace {
- my $self = shift;
- return "Can't modify closed refund" if $self->closed =~ /^Y/i;
- $self->SUPER::replace(@_);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid refund. If there is an error,
-returns the error, otherwise returns false. Called by the insert method.
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
-
- my $error =
- $self->ut_numbern('refundnum')
- || $self->ut_numbern('custnum')
- || $self->ut_money('refund')
- || $self->ut_alphan('otaker')
- || $self->ut_text('reason')
- || $self->ut_numbern('_date')
- || $self->ut_textn('paybatch')
- || $self->ut_enum('closed', [ '', 'Y' ])
- ;
- return $error if $error;
-
- return "refund must be > 0 " if $self->refund <= 0;
-
- $self->_date(time) unless $self->_date;
-
- return "unknown cust_main.custnum: ". $self->custnum
- unless $self->crednum
- || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-
- $error = $self->payinfo_check;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item cust_credit_refund
-
-Returns all applications to credits (see L<FS::cust_credit_refund>) for this
-refund.
-
-=cut
-
-sub cust_credit_refund {
- my $self = shift;
- map { $_ } #return $self->num_cust_credit_refund unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_credit_refund', { 'refundnum' => $self->refundnum } )
- ;
-}
-
-=item cust_pay_refund
-
-Returns all applications to payments (see L<FS::cust_pay_refund>) for this
-refund.
-
-=cut
-
-sub cust_pay_refund {
- my $self = shift;
- map { $_ } #return $self->num_cust_pay_refund unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay_refund', { 'refundnum' => $self->refundnum } )
- ;
-}
-
-=item unapplied
-
-Returns the amount of this refund that is still unapplied; which is
-amount minus all credit applications (see L<FS::cust_credit_refund>) and
-payment applications (see L<FS::cust_pay_refund>).
-
-=cut
-
-sub unapplied {
- my $self = shift;
- my $amount = $self->refund;
- $amount -= $_->amount foreach ( $self->cust_credit_refund );
- $amount -= $_->amount foreach ( $self->cust_pay_refund );
- sprintf("%.2f", $amount );
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item unapplied_sql
-
-Returns an SQL fragment to retreive the unapplied amount.
-
-=cut
-
-sub unapplied_sql {
- my ($class, $start, $end) = @_;
- my $credit_start = $start ? "AND cust_credit_refund._date <= $start" : '';
- my $credit_end = $end ? "AND cust_credit_refund._date > $end" : '';
- my $pay_start = $start ? "AND cust_pay_refund._date <= $start" : '';
- my $pay_end = $end ? "AND cust_pay_refund._date > $end" : '';
-
- "refund
- - COALESCE(
- ( SELECT SUM(amount) FROM cust_credit_refund
- WHERE cust_refund.refundnum = cust_credit_refund.refundnum
- $credit_start $credit_end )
- ,0
- )
- - COALESCE(
- ( SELECT SUM(amount) FROM cust_pay_refund
- WHERE cust_refund.refundnum = cust_pay_refund.refundnum
- $pay_start $pay_end )
- ,0
- )
- ";
-
-}
-
-# Used by FS::Upgrade to migrate to a new database.
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
- $class->_upgrade_otaker(%opts);
-}
-
-=back
-
-=head1 BUGS
-
-Delete and replace methods.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_credit>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_statement.pm b/FS/FS/cust_statement.pm
deleted file mode 100644
index 83dd5c1..0000000
--- a/FS/FS/cust_statement.pm
+++ /dev/null
@@ -1,272 +0,0 @@
-package FS::cust_statement;
-
-use strict;
-use base qw( FS::cust_bill );
-use FS::Record qw( dbh qsearch ); #qsearchs );
-use FS::cust_main;
-use FS::cust_bill;
-
-=head1 NAME
-
-FS::cust_statement - Object methods for cust_statement records
-
-=head1 SYNOPSIS
-
- use FS::cust_statement;
-
- $record = new FS::cust_statement \%hash;
- $record = new FS::cust_statement { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_statement object represents an informational statement which
-aggregates one or more invoices. FS::cust_statement inherits from
-FS::cust_bill.
-
-The following fields are currently supported:
-
-=over 4
-
-=item statementnum
-
-primary key
-
-=item custnum
-
-customer
-
-=item _date
-
-date
-
-=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
-
-sub new { FS::Record::new(@_); }
-
-sub table { 'cust_statement'; }
-
-=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;
-
- FS::Record::insert($self);
-
- foreach my $cust_bill (
- qsearch({
- 'table' => 'cust_bill',
- 'hashref' => { 'custnum' => $self->custnum,
- 'statementnum' => '',
- },
- 'extra_sql' => 'FOR UPDATE' ,
- })
- )
- {
- $cust_bill->statementnum( $self->statementnum );
- my $error = $cust_bill->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error associating invoice: $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-
-}
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-sub delete { FS::Record::delete(@_); }
-
-=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 { FS::Record::replace(@_); }
-
-sub replace_check { ''; }
-
-=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
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('statementnum')
- || $self->ut_foreign_key('custnum', 'cust_main', 'custnum' )
- || $self->ut_numbern('_date')
- ;
- return $error if $error;
-
- $self->_date(time) unless $self->_date;
-
- #don't want to call cust_bill, and Record just checks virtual fields
- #$self->SUPER::check;
- '';
-
-}
-
-=item cust_bill
-
-Returns the associated invoices (cust_bill records) for this statement.
-
-=cut
-
-sub cust_bill {
- my $self = shift;
- qsearch('cust_bill', { 'statementnum' => $self->statementnum } );
-}
-
-sub _aggregate {
- my( $self, $method ) = ( shift, shift );
-
- my @agg = ();
-
- foreach my $cust_bill ( $self->cust_bill ) {
- push @agg, $cust_bill->$method( @_ );
- }
-
- @agg;
-}
-
-sub _total {
- my( $self, $method ) = ( shift, shift );
-
- my $total = 0;
-
- foreach my $cust_bill ( $self->cust_bill ) {
- $total += $cust_bill->$method( @_ );
- }
-
- $total;
-}
-
-=item cust_bill_pkg
-
-Returns the line items (see L<FS::cust_bill_pkg>) for all associated invoices.
-
-=item cust_bill_pkg_pkgnum PKGNUM
-
-Returns the line items (see L<FS::cust_bill_pkg>) for all associated invoices
-and specified pkgnum.
-
-=item cust_bill_pay
-
-Returns all payment applications (see L<FS::cust_bill_pay>) for all associated
-invoices.
-
-=item cust_credited
-
-Returns all applied credits (see L<FS::cust_credit_bill>) for all associated
-invoices.
-
-=item cust_bill_pay_pkgnum PKGNUM
-
-Returns all payment applications (see L<FS::cust_bill_pay>) for all associated
-invoices with matching pkgnum.
-
-=item cust_credited_pkgnum PKGNUM
-
-Returns all applied credits (see L<FS::cust_credit_bill>) for all associated
-invoices with matching pkgnum.
-
-=cut
-
-sub cust_bill_pay { shift->_aggregate('cust_bill_pay', @_); }
-sub cust_credited { shift->_aggregate('cust_credited', @_); }
-sub cust_bill_pay_pkgnum { shift->_aggregate('cust_bill_pay_pkgnum', @_); }
-sub cust_credited_pkgnum { shift->_aggregate('cust_credited_pkgnum', @_); }
-
-sub cust_bill_pkg { shift->_aggregate('cust_bill_pkg', @_); }
-sub cust_bill_pkg_pkgnum { shift->_aggregate('cust_bill_pkg_pkgnum', @_); }
-
-=item tax
-
-Returns the total tax amount for all assoicated invoices.0
-
-=cut
-
-=item charged
-
-Returns the total amount charged for all associated invoices.
-
-=cut
-
-=item owed
-
-Returns the total amount owed for all associated invoices.
-
-=cut
-
-sub tax { shift->_total('tax', @_); }
-sub charged { shift->_total('charged', @_); }
-sub owed { shift->_total('owed', @_); }
-
-#don't show previous info
-sub previous {
- ( 0 ); # 0, empty list
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_bill>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm
deleted file mode 100644
index 0a58d55..0000000
--- a/FS/FS/cust_svc.pm
+++ /dev/null
@@ -1,775 +0,0 @@
-package FS::cust_svc;
-
-use strict;
-use vars qw( @ISA $DEBUG $me $ignore_quantity );
-use Carp;
-#use Scalar::Util qw( blessed );
-use FS::Conf;
-use FS::Record qw( qsearch qsearchs dbh str2time_sql );
-use FS::cust_pkg;
-use FS::part_pkg;
-use FS::part_svc;
-use FS::pkg_svc;
-use FS::domain_record;
-use FS::part_export;
-use FS::cdr;
-
-#most FS::svc_ classes are autoloaded in svc_x emthod
-use FS::svc_acct; #this one is used in the cache stuff
-
-@ISA = qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record );
-
-$DEBUG = 0;
-$me = '[cust_svc]';
-
-$ignore_quantity = 0;
-
-sub _cache {
- my $self = shift;
- my ( $hashref, $cache ) = @_;
- if ( $hashref->{'username'} ) {
- $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
- }
- if ( $hashref->{'svc'} ) {
- $self->{'_svcpart'} = FS::part_svc->new($hashref);
- }
-}
-
-=head1 NAME
-
-FS::cust_svc - Object method for cust_svc objects
-
-=head1 SYNOPSIS
-
- use FS::cust_svc;
-
- $record = new FS::cust_svc \%hash
- $record = new FS::cust_svc { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- ($label, $value) = $record->label;
-
-=head1 DESCRIPTION
-
-An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
-The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key (assigned automatically for new services)
-
-=item pkgnum - Package (see L<FS::cust_pkg>)
-
-=item svcpart - Service definition (see L<FS::part_svc>)
-
-=item overlimit - date the service exceeded its usage limit
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new service. To add the refund to the database, see L<"insert">.
-Services are normally created by creating FS::svc_ objects (see
-L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
-
-=cut
-
-sub table { 'cust_svc'; }
-
-=item insert
-
-Adds this service to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this service from the database. If there is an error, returns the
-error, otherwise returns false. Note that this only removes the cust_svc
-record - you should probably use the B<cancel> method instead.
-
-=item cancel
-
-Cancels the relevant service by calling the B<cancel> method of the associated
-FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
-deleting the FS::svc_XXX record and then deleting this record.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub cancel {
- my($self,%opt) = @_;
-
- 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 $part_svc = $self->part_svc;
-
- $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
- $dbh->rollback if $oldAutoCommit;
- return "Illegal svcdb value in part_svc!";
- };
- my $svcdb = $1;
- require "FS/$svcdb.pm";
-
- my $svc = $self->svc_x;
- if ($svc) {
- if ( %opt && $opt{'date'} ) {
- my $error = $svc->expire($opt{'date'});
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error expiring service: $error";
- }
- } else {
- my $error = $svc->cancel;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error canceling service: $error";
- }
- $error = $svc->delete; #this deletes this cust_svc record as well
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error deleting service: $error";
- }
- }
-
- } elsif ( !%opt ) {
-
- #huh?
- warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
- "; deleting cust_svc only\n";
-
- my $error = $self->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error deleting cust_svc: $error";
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ''; #no errors
-
-}
-
-=item overlimit [ ACTION ]
-
-Retrieves or sets the overlimit date. If ACTION is absent, return
-the present value of overlimit. If ACTION is present, it can
-have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
-is set to the current time if it is not already set. The 'unsuspend' value
-causes the time to be cleared.
-
-If there is an error on setting, returns the error, otherwise returns false.
-
-=cut
-
-sub overlimit {
- my $self = shift;
- my $action = shift or return $self->getfield('overlimit');
-
- 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 ( $action eq 'suspend' ) {
- $self->setfield('overlimit', time) unless $self->getfield('overlimit');
- }elsif ( $action eq 'unsuspend' ) {
- $self->setfield('overlimit', '');
- }else{
- die "unexpected action value: $action";
- }
-
- local $ignore_quantity = 1;
- my $error = $self->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error setting overlimit: $error";
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ''; #no errors
-
-}
-
-=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;
- my ( $new, $old ) = ( shift, shift );
- $old = $new->replace_old unless defined($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;
-
- if ( $new->svcpart != $old->svcpart ) {
- my $svc_x = $new->svc_x;
- my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
- local($FS::Record::nowarn_identical) = 1;
- my $error = $new_svc_x->replace($svc_x);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error if $error;
- }
- }
-
-# #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 ) {
- $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 service. If there is an error,
-returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('svcnum')
- || $self->ut_numbern('pkgnum')
- || $self->ut_number('svcpart')
- || $self->ut_numbern('overlimit')
- ;
- return $error if $error;
-
- my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
- return "Unknown svcpart" unless $part_svc;
-
- if ( $self->pkgnum ) {
- my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
- return "Unknown pkgnum" unless $cust_pkg;
- my $pkg_svc = qsearchs( 'pkg_svc', {
- 'pkgpart' => $cust_pkg->pkgpart,
- 'svcpart' => $self->svcpart,
- });
- # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
- # 'svcpart' => $self->svcpart,
- # 'quantity' => 0 } );
- my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
-
- my @cust_svc = qsearch('cust_svc', {
- 'pkgnum' => $self->pkgnum,
- 'svcpart' => $self->svcpart,
- });
- return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
- " services for pkgnum ". $self->pkgnum
- if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
- }
-
- $self->SUPER::check;
-}
-
-=item part_svc
-
-Returns the definition for this service, as a FS::part_svc object (see
-L<FS::part_svc>).
-
-=cut
-
-sub part_svc {
- my $self = shift;
- $self->{'_svcpart'}
- ? $self->{'_svcpart'}
- : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
-}
-
-=item cust_pkg
-
-Returns the package this service belongs to, as a FS::cust_pkg object (see
-L<FS::cust_pkg>).
-
-=cut
-
-sub cust_pkg {
- my $self = shift;
- qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
-}
-
-=item pkg_svc
-
-Returns the pkg_svc record for for this service, if applicable.
-
-=cut
-
-sub pkg_svc {
- my $self = shift;
- my $cust_pkg = $self->cust_pkg;
- return undef unless $cust_pkg;
-
- qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
- 'pkgpart' => $cust_pkg->pkgpart,
- }
- );
-}
-
-=item date_inserted
-
-Returns the date this service was inserted.
-
-=cut
-
-sub date_inserted {
- my $self = shift;
- $self->h_date('insert');
-}
-
-=item label
-
-Returns a list consisting of:
-- The name of this service (from part_svc)
-- A meaningful identifier (username, domain, or mail alias)
-- The table name (i.e. svc_domain) for this service
-- svcnum
-
-Usage example:
-
- my($label, $value, $svcdb) = $cust_svc->label;
-
-=item label_long
-
-Like the B<label> method, except the second item in the list ("meaningful
-identifier") may be longer - typically, a full name is included.
-
-=cut
-
-sub label { shift->_label('svc_label', @_); }
-sub label_long { shift->_label('svc_label_long', @_); }
-
-sub _label {
- my $self = shift;
- my $method = shift;
- my $svc_x = $self->svc_x
- or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
-
- $self->$method($svc_x);
-}
-
-sub svc_label { shift->_svc_label('label', @_); }
-sub svc_label_long { shift->_svc_label('label_long', @_); }
-
-sub _svc_label {
- my( $self, $method, $svc_x ) = ( shift, shift, shift );
-
- (
- $self->part_svc->svc,
- $svc_x->$method(@_),
- $self->part_svc->svcdb,
- $self->svcnum
- );
-
-}
-
-=item export_links
-
-Returns a listref of html elements associated with this service's exports.
-
-=cut
-
-sub export_links {
- my $self = shift;
- my $svc_x = $self->svc_x
- or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
-
- $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
-FS::svc_domain object, etc.)
-
-=cut
-
-sub svc_x {
- my $self = shift;
- my $svcdb = $self->part_svc->svcdb;
- if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
- $self->{'_svc_acct'};
- } else {
- require "FS/$svcdb.pm";
- warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
- ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
- if $DEBUG;
- qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
- }
-}
-
-=item seconds_since TIMESTAMP
-
-See L<FS::svc_acct/seconds_since>. Equivalent to
-$cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
-where B<svcdb> is not "svc_acct".
-
-=cut
-
-#note: implementation here, POD in FS::svc_acct
-sub seconds_since {
- my($self, $since) = @_;
- my $dbh = dbh;
- my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
- WHERE svcnum = ?
- AND login >= ?
- AND logout IS NOT NULL'
- ) or die $dbh->errstr;
- $sth->execute($self->svcnum, $since) or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
-}
-
-=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
-
-See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
-$cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
-for records where B<svcdb> is not "svc_acct".
-
-=cut
-
-#note: implementation here, POD in FS::svc_acct
-sub seconds_since_sqlradacct {
- my($self, $start, $end) = @_;
-
- my $mes = "$me seconds_since_sqlradacct:";
-
- my $svc_x = $self->svc_x;
-
- my @part_export = $self->part_svc->part_export_usage;
- die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
- " service definition"
- unless @part_export;
- #or return undef;
-
- my $seconds = 0;
- foreach my $part_export ( @part_export ) {
-
- next if $part_export->option('ignore_accounting');
-
- warn "$mes connecting to sqlradius database\n"
- if $DEBUG;
-
- my $dbh = DBI->connect( map { $part_export->option($_) }
- qw(datasrc username password) )
- or die "can't connect to sqlradius database: ". $DBI::errstr;
-
- warn "$mes connected to sqlradius database\n"
- if $DEBUG;
-
- #select a unix time conversion function based on database type
- my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
-
- my $username = $part_export->export_username($svc_x);
-
- my $query;
-
- warn "$mes finding closed sessions completely within the given range\n"
- if $DEBUG;
-
- my $realm = '';
- my $realmparam = '';
- if ($part_export->option('process_single_realm')) {
- $realm = 'AND Realm = ?';
- $realmparam = $part_export->option('realm');
- }
-
- my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
- FROM radacct
- WHERE UserName = ?
- $realm
- AND $str2time AcctStartTime) >= ?
- AND $str2time AcctStopTime ) < ?
- AND $str2time AcctStopTime ) > 0
- AND AcctStopTime IS NOT NULL"
- ) or die $dbh->errstr;
- $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
- or die $sth->errstr;
- my $regular = $sth->fetchrow_arrayref->[0];
-
- warn "$mes finding open sessions which start in the range\n"
- if $DEBUG;
-
- # count session start->range end
- $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
- FROM radacct
- WHERE UserName = ?
- $realm
- AND $str2time AcctStartTime ) >= ?
- AND $str2time AcctStartTime ) < ?
- AND ( ? - $str2time AcctStartTime ) ) < 86400
- AND ( $str2time AcctStopTime ) = 0
- OR AcctStopTime IS NULL )";
- $sth = $dbh->prepare($query) or die $dbh->errstr;
- $sth->execute( $end,
- $username,
- ($realm ? $realmparam : ()),
- $start,
- $end,
- $end )
- or die $sth->errstr. " executing query $query";
- my $start_during = $sth->fetchrow_arrayref->[0];
-
- warn "$mes finding closed sessions which start before the range but stop during\n"
- if $DEBUG;
-
- #count range start->session end
- $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
- FROM radacct
- WHERE UserName = ?
- $realm
- AND $str2time AcctStartTime ) < ?
- AND $str2time AcctStopTime ) >= ?
- AND $str2time AcctStopTime ) < ?
- AND $str2time AcctStopTime ) > 0
- AND AcctStopTime IS NOT NULL"
- ) or die $dbh->errstr;
- $sth->execute( $start,
- $username,
- ($realm ? $realmparam : ()),
- $start,
- $start,
- $end )
- or die $sth->errstr;
- my $end_during = $sth->fetchrow_arrayref->[0];
-
- warn "$mes finding closed sessions which start before the range but stop after\n"
- if $DEBUG;
-
- # count range start->range end
- # don't count open sessions anymore (probably missing stop record)
- $sth = $dbh->prepare("SELECT COUNT(*)
- FROM radacct
- WHERE UserName = ?
- $realm
- AND $str2time AcctStartTime ) < ?
- AND ( $str2time AcctStopTime ) >= ?
- )"
- # OR AcctStopTime = 0
- # OR AcctStopTime IS NULL )"
- ) or die $dbh->errstr;
- $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
- or die $sth->errstr;
- my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
-
- $seconds += $regular + $end_during + $start_during + $entire_range;
-
- warn "$mes done finding sessions\n"
- if $DEBUG;
-
- }
-
- $seconds;
-
-}
-
-=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
-
-See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
-$cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
-for records where B<svcdb> is not "svc_acct".
-
-=cut
-
-#note: implementation here, POD in FS::svc_acct
-#(false laziness w/seconds_since_sqlradacct above)
-sub attribute_since_sqlradacct {
- my($self, $start, $end, $attrib) = @_;
-
- my $mes = "$me attribute_since_sqlradacct:";
-
- my $svc_x = $self->svc_x;
-
- my @part_export = $self->part_svc->part_export_usage;
- die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
- " service definition"
- unless @part_export;
- #or return undef;
-
- my $sum = 0;
-
- foreach my $part_export ( @part_export ) {
-
- next if $part_export->option('ignore_accounting');
-
- warn "$mes connecting to sqlradius database\n"
- if $DEBUG;
-
- my $dbh = DBI->connect( map { $part_export->option($_) }
- qw(datasrc username password) )
- or die "can't connect to sqlradius database: ". $DBI::errstr;
-
- warn "$mes connected to sqlradius database\n"
- if $DEBUG;
-
- #select a unix time conversion function based on database type
- my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
-
- my $username = $part_export->export_username($svc_x);
-
- warn "$mes SUMing $attrib sessions\n"
- if $DEBUG;
-
- my $realm = '';
- my $realmparam = '';
- if ($part_export->option('process_single_realm')) {
- $realm = 'AND Realm = ?';
- $realmparam = $part_export->option('realm');
- }
-
- my $sth = $dbh->prepare("SELECT SUM($attrib)
- FROM radacct
- WHERE UserName = ?
- $realm
- AND $str2time AcctStopTime ) >= ?
- AND $str2time AcctStopTime ) < ?
- AND AcctStopTime IS NOT NULL"
- ) or die $dbh->errstr;
- $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
- or die $sth->errstr;
-
- my $row = $sth->fetchrow_arrayref;
- $sum += $row->[0] if defined($row->[0]);
-
- warn "$mes done SUMing sessions\n"
- if $DEBUG;
-
- }
-
- $sum;
-
-}
-
-=item get_session_history TIMESTAMP_START TIMESTAMP_END
-
-See L<FS::svc_acct/get_session_history>. Equivalent to
-$cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
-records where B<svcdb> is not "svc_acct".
-
-=cut
-
-sub get_session_history {
- my($self, $start, $end, $attrib) = @_;
-
- #$attrib ???
-
- my @part_export = $self->part_svc->part_export_usage;
- die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
- " service definition"
- unless @part_export;
- #or return undef;
-
- my @sessions = ();
-
- foreach my $part_export ( @part_export ) {
- push @sessions,
- @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
- }
-
- @sessions;
-
-}
-
-=back
-
-=head1 BUGS
-
-Behaviour of changing the svcpart of cust_svc records is undefined and should
-possibly be prohibited, and pkg_svc records are not checked.
-
-pkg_svc records are not checked in general (here).
-
-Deleting this record doesn't check or delete the svc_* record associated
-with this record.
-
-In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
-a DBI database handle is not yet implemented.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
-schema.html from the base documentation
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_svc_option.pm b/FS/FS/cust_svc_option.pm
deleted file mode 100644
index 07fec90..0000000
--- a/FS/FS/cust_svc_option.pm
+++ /dev/null
@@ -1,134 +0,0 @@
-package FS::cust_svc_option;
-
-use strict;
-use vars qw( @ISA );
-#use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cust_svc_option - Object methods for cust_svc_option records
-
-=head1 SYNOPSIS
-
- use FS::cust_svc_option;
-
- $record = new FS::cust_svc_option \%hash;
- $record = new FS::cust_svc_option { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_svc_option object represents an customer service option.
- FS::cust_svc_option inherits from FS::Record. The following fields are
- currently supported:
-
-=over 4
-
-=item optionnum
-
-primary key
-
-=item svcnum
-
-svcnum (see L<FS::cust_svc>)
-
-=item optionname
-
-Option Name
-
-=item optionvalue
-
-Option Value
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new option. To add the option 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 { 'cust_svc_option'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid option. 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('optionnum')
- || $self->ut_foreign_key('svcnum', 'cust_svc', 'svcnum')
- || $self->ut_alpha('optionname')
- || $self->ut_anything('optionvalue')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_tag.pm b/FS/FS/cust_tag.pm
deleted file mode 100644
index 5dfd156..0000000
--- a/FS/FS/cust_tag.pm
+++ /dev/null
@@ -1,147 +0,0 @@
-package FS::cust_tag;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearchs );
-use FS::cust_main;
-use FS::part_tag;
-
-=head1 NAME
-
-FS::cust_tag - Object methods for cust_tag records
-
-=head1 SYNOPSIS
-
- use FS::cust_tag;
-
- $record = new FS::cust_tag \%hash;
- $record = new FS::cust_tag { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_tag object represents a customer tag. FS::cust_tag inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item custtagnum
-
-primary key
-
-=item custnum
-
-custnum
-
-=item tagnum
-
-tagnum
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new customer tag. To add the tag 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 { 'cust_tag'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid customer tag. 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('custtagnum')
- || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
- || $self->ut_foreign_key('tagnum', 'part_tag', 'tagnum' )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item cust_main
-
-=cut
-
-sub cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
-=item part_tag
-
-=cut
-
-sub part_tag {
- my $self = shift;
- qsearchs( 'part_tag', { 'tagnum' => $self->tagnum } );
-}
-
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_tax_adjustment.pm b/FS/FS/cust_tax_adjustment.pm
deleted file mode 100644
index 5891368..0000000
--- a/FS/FS/cust_tax_adjustment.pm
+++ /dev/null
@@ -1,149 +0,0 @@
-package FS::cust_tax_adjustment;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_main;
-use FS::cust_bill_pkg;
-
-=head1 NAME
-
-FS::cust_tax_adjustment - Object methods for cust_tax_adjustment records
-
-=head1 SYNOPSIS
-
- use FS::cust_tax_adjustment;
-
- $record = new FS::cust_tax_adjustment \%hash;
- $record = new FS::cust_tax_adjustment { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_tax_adjustment object represents an taxation adjustment.
-FS::cust_tax_adjustment inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item adjustmentnum
-
-primary key
-
-=item custnum
-
-custnum
-
-=item taxname
-
-taxname
-
-=item amount
-
-amount
-
-=item comment
-
-comment
-
-=item billpkgnum
-
-billpkgnum
-
-
-=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 { 'cust_tax_adjustment'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('adjustmentnum')
- || $self->ut_foreign_key('custnum', 'cust_main', 'custnum' )
- || $self->ut_text('taxname')
- || $self->ut_money('amount')
- || $self->ut_textn('comment')
- || $self->ut_foreign_keyn('billpkgnum', 'cust_bill_pkg', 'billpkgnum' )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-sub cust_bill_pkg {
- my $self = shift;
- qsearchs('cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_tax_exempt.pm b/FS/FS/cust_tax_exempt.pm
deleted file mode 100644
index 045421c..0000000
--- a/FS/FS/cust_tax_exempt.pm
+++ /dev/null
@@ -1,152 +0,0 @@
-package FS::cust_tax_exempt;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_main_Mixin;
-use FS::cust_main;
-use FS::cust_main_county;
-
-@ISA = qw( FS::cust_main_Mixin FS::Record );
-
-=head1 NAME
-
-FS::cust_tax_exempt - Object methods for cust_tax_exempt records
-
-=head1 SYNOPSIS
-
- use FS::cust_tax_exempt;
-
- $record = new FS::cust_tax_exempt \%hash;
- $record = new FS::cust_tax_exempt { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_tax_exempt object represents a record of an old-style customer tax
-exemption. Currently this is only used for "texas tax". FS::cust_tax_exempt
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item exemptnum - primary key
-
-=item custnum - customer (see L<FS::cust_main>)
-
-=item taxnum - tax rate (see L<FS::cust_main_county>)
-
-=item year
-
-=item month
-
-=item amount
-
-=back
-
-=head1 NOTE
-
-Old-style customer tax exemptions are only useful for legacy migrations - if
-you are looking for current customer tax exemption data see
-L<FS::cust_tax_exempt_pkg>.
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new exemption record. To add the example 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 { 'cust_tax_exempt'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
-sub check {
- my $self = shift;
-
- $self->ut_numbern('exemptnum')
- || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
- || $self->ut_foreign_key('taxnum', 'cust_main_county', 'taxnum')
- || $self->ut_number('year') #check better
- || $self->ut_number('month') #check better
- || $self->ut_money('amount')
- || $self->SUPER::check
- ;
-}
-
-=item cust_main_county
-
-Returns the FS::cust_main_county object associated with this tax exemption.
-
-=cut
-
-sub cust_main_county {
- my $self = shift;
- qsearchs( 'cust_main_county', { 'taxnum' => $self->taxnum } );
-}
-
-=back
-
-=head1 BUGS
-
-Texas tax is a royal pain in the ass.
-
-=head1 SEE ALSO
-
-L<FS::cust_main_county>, L<FS::cust_main>, L<FS::Record>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_tax_exempt_pkg.pm b/FS/FS/cust_tax_exempt_pkg.pm
deleted file mode 100644
index e63b84b..0000000
--- a/FS/FS/cust_tax_exempt_pkg.pm
+++ /dev/null
@@ -1,152 +0,0 @@
-package FS::cust_tax_exempt_pkg;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_main_Mixin;
-use FS::cust_bill_pkg;
-use FS::cust_main_county;
-use FS::cust_credit_bill_pkg;
-
-@ISA = qw( FS::cust_main_Mixin FS::Record );
-
-=head1 NAME
-
-FS::cust_tax_exempt_pkg - Object methods for cust_tax_exempt_pkg records
-
-=head1 SYNOPSIS
-
- use FS::cust_tax_exempt_pkg;
-
- $record = new FS::cust_tax_exempt_pkg \%hash;
- $record = new FS::cust_tax_exempt_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_tax_exempt_pkg object represents a record of a customer tax
-exemption. Currently this is only used for "texas tax". FS::cust_tax_exempt
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item exemptpkgnum - primary key
-
-=item billpkgnum - invoice line item (see L<FS::cust_bill_pkg>)
-
-=item taxnum - tax rate (see L<FS::cust_main_county>)
-
-=item year
-
-=item month
-
-=item amount
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new exemption record. To add the examption 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 { 'cust_tax_exempt_pkg'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid exemption 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;
-
- $self->ut_numbern('exemptnum')
-# || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
- || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum')
- || $self->ut_foreign_key('taxnum', 'cust_main_county', 'taxnum')
- || $self->ut_foreign_keyn('creditbillpkgnum',
- 'cust_credit_bill_pkg',
- 'creditbillpkgnum')
- || $self->ut_number('year') #check better
- || $self->ut_number('month') #check better
- || $self->ut_money('amount')
- || $self->SUPER::check
- ;
-}
-
-=item cust_main_county
-
-Returns the associated tax definition if it still exists in the database.
-Otherwise returns false.
-
-=cut
-
-sub cust_main_county {
- my $self = shift;
- qsearchs( 'cust_main_county', { 'taxnum', $self->taxnum } );
-}
-
-=back
-
-=head1 BUGS
-
-Texas tax is still a royal pain in the ass.
-
-=head1 SEE ALSO
-
-L<FS::cust_main_county>, L<FS::cust_bill_pkg>, L<FS::Record>, schema.html from
-the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/cust_tax_location.pm b/FS/FS/cust_tax_location.pm
deleted file mode 100644
index 161a654..0000000
--- a/FS/FS/cust_tax_location.pm
+++ /dev/null
@@ -1,344 +0,0 @@
-package FS::cust_tax_location;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::Misc qw ( csv_from_fixed );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::cust_tax_location - Object methods for cust_tax_location records
-
-=head1 SYNOPSIS
-
- use FS::cust_tax_location;
-
- $record = new FS::cust_tax_location \%hash;
- $record = new FS::cust_tax_location { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_tax_location object represents a mapping between a customer and
-a tax location. FS::cust_tax_location inherits from FS::Record. The
-following fields are currently supported:
-
-=over 4
-
-=item custlocationnum
-
-primary key
-
-=item data_vendor
-
-a tax data vendor
-
-=item zip
-
-=item state
-
-=item plus4hi
-
-the upper bound of the last 4 zip code digits
-
-=item plus4lo
-
-the lower bound of the last 4 zip code digits
-
-=item default_location
-
-'Y' when this record represents the default for zip
-
-=item geocode - the foreign key into FS::part_pkg_tax_rate and FS::tax_rate
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new cust_tax_location. To add the cust_tax_location 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 { 'cust_tax_location'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid cust_tax_location. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('custlocationnum')
- || $self->ut_text('data_vendor')
- || $self->ut_textn('city')
- || $self->ut_textn('postalcity')
- || $self->ut_textn('county')
- || $self->ut_text('state')
- || $self->ut_numbern('plus4hi')
- || $self->ut_numbern('plus4lo')
- || $self->ut_enum('default_location', [ '', 'Y' ] )
- || $self->ut_enum('cityflag', [ '', 'I', 'O', 'B' ] )
- || $self->ut_alpha('geocode')
- ;
- return $error if $error;
-
- #ugh! cch canada weirdness and more
- if ($self->state eq 'CN' && $self->data_vendor eq 'cch-zip' ) {
- $error = "Illegal cch canadian zip"
- unless $self->zip =~ /^[A-Z]$/;
- } elsif ($self->state =~ /^E([B-DFGILNPR-UW])$/ && $self->data_vendor eq 'cch-zip' ) {
- $error = "Illegal cch european zip"
- unless $self->zip =~ /^E$1$/;
- } else {
- $error = $self->ut_number('zip', $self->state eq 'CN' ? 'CA' : 'US');
- }
- return $error if $error;
-
- #ugh! cch canada weirdness and more
- return "must specify either city/county or plus4lo/plus4hi"
- unless ( $self->plus4lo && $self->plus4hi ||
- ( $self->city ||
- $self->state eq 'CN' ||
- $self->state =~ /^E([B-DFGILNPR-UW])$/
- ) && $self->county
- );
-
- $self->SUPER::check;
-}
-
-
-sub batch_import {
- my ($param, $job) = @_;
-
- my $fh = $param->{filehandle};
- my $format = $param->{'format'};
-
- my $imported = 0;
- my @fields;
- my $hook;
-
- my @column_lengths = ();
- my @column_callbacks = ();
- if ( $format =~ /^cch-fixed/ ) {
- $format =~ s/-fixed//;
- my $f = $format;
- my $update = 0;
- $f =~ s/-update// && ($update = 1);
- if ($f eq 'cch') {
- push @column_lengths, qw( 5 2 4 4 10 1 );
- } elsif ( $f eq 'cch-zip' ) {
- push @column_lengths, qw( 5 28 25 2 28 5 1 1 10 1 2 );
- } else {
- return "Unknown format: $format";
- }
- push @column_lengths, 1 if $update;
- }
-
- my $line;
- my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar
- if ( $job || scalar(@column_lengths) ) {
- my $error = csv_from_fixed(\$fh, \$count, \@column_lengths);
- return $error if $error;
- }
-
- if ( $format eq 'cch' || $format eq 'cch-update' ) {
- @fields = qw( zip state plus4lo plus4hi geocode default_location );
- push @fields, 'actionflag' if $format eq 'cch-update';
-
- $imported++ if $format eq 'cch-update'; #empty file ok
-
- $hook = sub {
- my $hash = shift;
-
- $hash->{'data_vendor'} = 'cch';
- $hash->{'default_location'} =~ s/ //g;
-
- if (exists($hash->{actionflag}) && $hash->{actionflag} eq 'D') {
- delete($hash->{actionflag});
-
- my $cust_tax_location = qsearchs('cust_tax_location', $hash);
- return "Can't find cust_tax_location to delete: ".
- join(" ", map { "$_ => ". $hash->{$_} } @fields)
- unless $cust_tax_location;
-
- my $error = $cust_tax_location->delete;
- return $error if $error;
-
- delete($hash->{$_}) foreach (keys %$hash);
- }
-
- delete($hash->{'actionflag'});
-
- '';
-
- };
-
- } elsif ( $format eq 'cch-zip' || $format eq 'cch-update-zip' ) {
- @fields = qw( zip city county state postalcity countyfips countydef default_location geocode cityflag unique );
- push @fields, 'actionflag' if $format eq 'cch-update-zip';
-
- $imported++ if $format eq 'cch-update'; #empty file ok
-
- $hook = sub {
- my $hash = shift;
-
- $hash->{'data_vendor'} = 'cch-zip';
- delete($hash->{$_}) foreach qw( countyfips countydef unique );
-
- $hash->{'cityflag'} =~ s/ //g;
- $hash->{'default_location'} =~ s/ //g;
-
- if (exists($hash->{actionflag}) && $hash->{actionflag} eq 'D') {
- delete($hash->{actionflag});
-
- my $cust_tax_location = qsearchs('cust_tax_location', $hash);
- return "Can't find cust_tax_location to delete: ".
- join(" ", map { "$_ => ". $hash->{$_} } @fields)
- unless $cust_tax_location;
-
- my $error = $cust_tax_location->delete;
- return $error if $error;
-
- delete($hash->{$_}) foreach (keys %$hash);
- }
-
- delete($hash->{'actionflag'});
-
- '';
-
- };
-
- } elsif ( $format eq 'extended' ) {
- die "unimplemented\n";
- @fields = qw( );
- } else {
- die "unknown format $format";
- }
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
-
- my $csv = new Text::CSV_XS;
-
- 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;
-
- while ( defined($line=<$fh>) ) {
- $csv->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $csv->error_input();
- };
-
- if ( $job ) { # progress bar
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $imported / $count ). ",Importing locations"
- );
- die $error if $error;
- $last = time;
- }
- }
-
- my @columns = $csv->fields();
-
- my %cust_tax_location = ( 'data_vendor' => $format );;
- foreach my $field ( @fields ) {
- $cust_tax_location{$field} = shift @columns;
- }
- if ( scalar( @columns ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Unexpected trailing columns in line (wrong format?): $line";
- }
-
- my $error = &{$hook}(\%cust_tax_location);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- next unless scalar(keys %cust_tax_location);
-
- my $cust_tax_location = new FS::cust_tax_location( \%cust_tax_location );
- $error = $cust_tax_location->insert;
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert cust_tax_location for $line: $error";
- }
-
- $imported++;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return "Empty file!" unless ( $imported || $format =~ /^cch-update/ );
-
- ''; #no error
-
-}
-
-=back
-
-=head1 BUGS
-
-The author should be informed of any you find.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/discount.pm b/FS/FS/discount.pm
deleted file mode 100644
index 4f42c5b..0000000
--- a/FS/FS/discount.pm
+++ /dev/null
@@ -1,193 +0,0 @@
-package FS::discount;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::discount - Object methods for discount records
-
-=head1 SYNOPSIS
-
- use FS::discount;
-
- $record = new FS::discount \%hash;
- $record = new FS::discount { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::discount object represents a discount definition. FS::discount inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item discountnum
-
-primary key
-
-=item name
-
-name
-
-=item amount
-
-amount
-
-=item percent
-
-percent
-
-=item months
-
-months
-
-=item disabled
-
-disabled
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new discount. To add the discount 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 { 'discount'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid discount. 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;
-
- if ( $self->_type eq 'Select discount type' ) {
- return 'Please select a discount type';
- } elsif ( $self->_type eq 'Amount' ) {
- $self->percent('0');
- return 'Amount must be greater than 0' unless $self->amount > 0;
- } elsif ( $self->_type eq 'Percentage' ) {
- $self->amount('0.00');
- return 'Percentage must be greater than 0' unless $self->percent > 0;
- }
-
- my $error =
- $self->ut_numbern('discountnum')
- || $self->ut_textn('name')
- || $self->ut_money('amount')
- || $self->ut_float('percent') #actually decimal, but this will do
- || $self->ut_floatn('months') #actually decimal, but this will do
- || $self->ut_enum('disabled', [ '', 'Y' ])
- ;
- return $error if $error;
-
- #discourage non-integer months for package discounts
- if ($self->discountnum) {
- my $sql =
- "SELECT count(*) FROM part_pkg_discount WHERE part_pkg_discount.discountnum = ".
- $self->discountnum;
-
- my $count = $self->scalar_sql($sql);
- return "months must be integers greater than 1"
- if ( $count && ($self->ut_number('months') || $self->months < 2) );
- }
-
- $self->SUPER::check;
-}
-
-=item description_short
-
-=item description
-
-Returns a text description incorporating the amount, percent and months fields.
-
-description_short omits term information
-
-=cut
-
-sub description_short {
- my $self = shift;
-
- my $conf = new FS::Conf;
- my $money_char = $conf->config('money_char') || '$';
-
- my $desc = $self->name ? $self->name.': ' : '';
- $desc .= $money_char. sprintf('%.2f/month ', $self->amount)
- if $self->amount > 0;
- $desc .= $self->percent. '% '
- if $self->percent > 0;
-
- $desc;
-}
-
-sub description {
- my $self = shift;
- my $desc = $self->description_short;
- $desc .= ' for '. $self->months. ' months' if $self->months;
- $desc;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_pkg_discount>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm
deleted file mode 100644
index 8d767d5..0000000
--- a/FS/FS/domain_record.pm
+++ /dev/null
@@ -1,465 +0,0 @@
-package FS::domain_record;
-
-use strict;
-use vars qw( @ISA $noserial_hack $DEBUG $me );
-use FS::Conf;
-#use FS::Record qw( qsearch qsearchs );
-use FS::Record qw( qsearchs dbh );
-use FS::svc_domain;
-use FS::svc_www;
-
-@ISA = qw(FS::Record);
-
-$DEBUG = 0;
-$me = '[FS::domain_record]';
-
-=head1 NAME
-
-FS::domain_record - Object methods for domain_record records
-
-=head1 SYNOPSIS
-
- use FS::domain_record;
-
- $record = new FS::domain_record \%hash;
- $record = new FS::domain_record { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::domain_record object represents an entry in a DNS zone.
-FS::domain_record inherits from FS::Record. The following fields are currently
-supported:
-
-=over 4
-
-=item recnum - primary key
-
-=item svcnum - Domain (see L<FS::svc_domain>) of this entry
-
-=item reczone - partial (or full) zone for this entry
-
-=item recaf - address family for this entry, currently only `IN' is recognized.
-
-=item rectype - record type for this entry (A, MX, etc.)
-
-=item recdata - data for this entry
-
-=item ttl - time to live
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new entry. To add the entry 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 { 'domain_record'; }
-
-=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;
-
- if ( $self->rectype eq '_mstr' ) { #delete all other records
- foreach my $domain_record ( reverse $self->svc_domain->domain_record ) {
- my $error = $domain_record->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- my $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
- my $error = $self->increment_serial;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my $conf = new FS::Conf;
- if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) {
- my $reverse = $self->reverse_record;
- if ( $reverse && ! $reverse->recnum ) {
- my $error = $reverse->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error adding corresponding reverse-ARPA record: $error";
- }
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-sub delete {
- my $self = shift;
-
- return "Can't delete a domain record which has a website!"
- if qsearchs( 'svc_www', { 'recnum' => $self->recnum } );
-
- 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;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
- my $error = $self->increment_serial;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my $conf = new FS::Conf;
- if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) {
- my $reverse = $self->reverse_record;
- if ( $reverse && $reverse->recnum && $reverse->recdata eq $self->zone.'.' ){
- my $error = $reverse->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error removing corresponding reverse-ARPA record: $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 $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::replace(@_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- unless ( $self->rectype eq 'SOA' ) {
- my $error = $self->increment_serial;
- 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 entry. 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('recnum')
- || $self->ut_number('svcnum')
- ;
- return $error if $error;
-
- return "Unknown svcnum (in svc_domain)"
- unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } );
-
- my $conf = new FS::Conf;
-
- if ( $conf->exists('zone-underscore') ) {
- $self->reczone =~ /^(@|[a-z0-9_\.\-\*]+)$/i
- or return "Illegal reczone: ". $self->reczone;
- $self->reczone($1);
- } else {
- $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i
- or return "Illegal reczone: ". $self->reczone;
- $self->reczone($1);
- }
-
- $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf;
- $self->recaf($1);
-
- $self->ttl =~ /^([0-9]{0,6})$/ or return "Illegal ttl: ". $self->ttl;
- $self->ttl($1);
-
- my %rectypes = map { $_=>1 } ( @{ $self->rectypes }, '_mstr' );
- return 'Illegal rectype: '. $self->rectype
- unless exists $rectypes{$self->rectype} && $rectypes{$self->rectype};
-
- return "Illegal reczone for ". $self->rectype. ": ". $self->reczone
- if $self->rectype !~ /^MX$/i && $self->reczone =~ /\*/;
-
- if ( $self->rectype eq 'SOA' ) {
- my $recdata = $self->recdata;
- $recdata =~ s/\s+/ /g;
- $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ((\d+|((\d+[WDHMS])+)) ){5}\))$/i
- or return "Illegal data for SOA record: $recdata";
- $self->recdata($1);
- } elsif ( $self->rectype eq 'NS' ) {
- $self->recdata =~ /^([a-z0-9\.\-]+)$/i
- or return "Illegal data for NS record: ". $self->recdata;
- $self->recdata($1);
- } elsif ( $self->rectype eq 'MX' ) {
- $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/i
- or return "Illegal data for MX record: ". $self->recdata;
- $self->recdata("$1 $2");
- } elsif ( $self->rectype eq 'A' ) {
- $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
- or return "Illegal data for A record: ". $self->recdata;
- $self->recdata($1);
- } elsif ( $self->rectype eq 'AAAA' ) {
- $self->recdata =~ /^([\da-z:]+)$/
- or return "Illegal data for AAAA record: ". $self->recdata;
- $self->recdata($1);
- } elsif ( $self->rectype eq 'PTR' ) {
- if ( $conf->exists('zone-underscore') ) {
- $self->recdata =~ /^([a-z0-9_\.\-]+)$/i
- or return "Illegal data for PTR record: ". $self->recdata;
- $self->recdata($1);
- } else {
- $self->recdata =~ /^([a-z0-9\.\-]+)$/i
- or return "Illegal data for PTR record: ". $self->recdata;
- $self->recdata($1);
- }
- } elsif ( $self->rectype eq 'CNAME' ) {
- $self->recdata =~ /^([a-z0-9\.\-]+|\@)$/i
- or return "Illegal data for CNAME record: ". $self->recdata;
- $self->recdata($1);
- } elsif ( $self->rectype eq 'TXT' ) {
- if ( $self->recdata =~ /^((?:\S+)|(?:".+"))$/ ) {
- $self->recdata($1);
- } else {
- $self->recdata('"'. $self->recdata. '"'); #?
- }
- # or return "Illegal data for TXT record: ". $self->recdata;
- } elsif ( $self->rectype eq 'SRV' ) {
- $self->recdata =~ /^(\d+)\s+(\d+)\s+(\d+)\s+([a-z0-9\.\-]+)$/i
- or return "Illegal data for SRV record: ". $self->recdata;
- $self->recdata("$1 $2 $3 $4");
- } elsif ( $self->rectype eq '_mstr' ) {
- $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
- or return "Illegal data for _master pseudo-record: ". $self->recdata;
- } else {
- warn "$me no specific check for ". $self->rectype. " records yet";
- $error = $self->ut_text('recdata');
- return $error if $error;
- }
-
- $self->SUPER::check;
-}
-
-=item increment_serial
-
-=cut
-
-sub increment_serial {
- return '' if $noserial_hack;
- my $self = shift;
-
- my $soa = qsearchs('domain_record', {
- svcnum => $self->svcnum,
- reczone => '@',
- recaf => 'IN',
- rectype => 'SOA', } )
- || qsearchs('domain_record', {
- svcnum => $self->svcnum,
- reczone => $self->svc_domain->domain.'.',
- recaf => 'IN',
- rectype => 'SOA',
- } )
- or return "soa record not found; can't increment serial";
-
- my $data = $soa->recdata;
- $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works.
-
- my %hash = $soa->hash;
- $hash{recdata} = $data;
- my $new = new FS::domain_record \%hash;
- $new->replace($soa);
-}
-
-=item svc_domain
-
-Returns the domain (see L<FS::svc_domain>) for this record.
-
-=cut
-
-sub svc_domain {
- my $self = shift;
- qsearchs('svc_domain', { svcnum => $self->svcnum } );
-}
-
-=item zone
-
-Returns the canonical zone name.
-
-=cut
-
-sub zone {
- my $self = shift;
- my $zone = $self->reczone; # or die ?
- if ( $zone =~ /\.$/ ) {
- $zone =~ s/\.$//;
- } else {
- my $svc_domain = $self->svc_domain; # or die ?
- $zone .= '.'. $svc_domain->domain;
- $zone =~ s/^\@\.//;
- }
- $zone;
-}
-
-=item reverse_record
-
-Returns the corresponding reverse-ARPA record as another FS::domain_record
-object. If the specific record does not exist in the database but the
-reverse-ARPA zone itself does, an appropriate new record is created. If no
-reverse-ARPA zone is available at all, returns false.
-
-(You can test whether or not record itself exists in the database or is a new
-object that might need to be inserted by checking the recnum field)
-
-Mostly used by the insert and delete methods - probably should see them for
-examples.
-
-=cut
-
-sub reverse_record {
- my $self = shift;
- warn "reverse_record called\n" if $DEBUG;
- #should support classless reverse-ARPA ala rfc2317 too
- $self->recdata =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/
- or return '';
- my $domain = "$3.$2.$1.in-addr.arpa";
- my $ptr_reczone = $4;
- warn "reverse_record: searching for domain: $domain\n" if $DEBUG;
- my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
- or return '';
- warn "reverse_record: found domain: $domain\n" if $DEBUG;
- my %hash = (
- 'svcnum' => $svc_domain->svcnum,
- 'reczone' => $ptr_reczone,
- 'recaf' => 'IN',
- 'rectype' => 'PTR',
- );
- qsearchs('domain_record', \%hash )
- or new FS::domain_record { %hash, 'recdata' => $self->zone.'.' };
-}
-
-=item rectypes
-
-=cut
-#http://en.wikipedia.org/wiki/List_of_DNS_record_types
-#DHCID? other things?
-sub rectypes {
- [ qw(SOA A AAAA CNAME MX NS PTR SPF SRV TXT), #most common types
- #qw(DNAME), #uncommon types
- qw(DLV DNSKEY DS NSEC NSEC3 NSEC3PARAM RRSIG), #DNSSEC types
- ];
-}
-
-=back
-
-=head1 BUGS
-
-The data validation doesn't check everything it could. In particular,
-there is no protection against bad data that passes the regex, duplicate
-SOA records, forgetting the trailing `.', impossible IP addersses, etc. Of
-course, it's still better than editing the zone files directly. :)
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/dsl_note.pm b/FS/FS/dsl_note.pm
deleted file mode 100644
index 832fced..0000000
--- a/FS/FS/dsl_note.pm
+++ /dev/null
@@ -1,127 +0,0 @@
-package FS::dsl_note;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::dsl_note - Object methods for dsl_note records
-
-=head1 SYNOPSIS
-
- use FS::dsl_note;
-
- $record = new FS::dsl_note \%hash;
- $record = new FS::dsl_note { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::dsl_note object represents a DSL order note. FS::dsl_note inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item notenum - primary key
-
-=item svcnum - the DSL for this note, see L<FS::svc_dsl>
-
-=item author - export-specific, e.g. note's author or ISP vs. telco/vendor
-
-=item priority - export-specific, e.g. high priority or not; not used by most
-
-=item _date - note date
-
-=item note - the note
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new note. To add the note 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 { 'dsl_note'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid note. 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('notenum')
- || $self->ut_foreign_key('svcnum', 'svc_dsl', 'svcnum')
- || $self->ut_textn('author')
- || $self->ut_alphasn('priority')
- || $self->ut_numbern('_date')
- || $self->ut_text('note')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/export_device.pm b/FS/FS/export_device.pm
deleted file mode 100644
index 69e3826..0000000
--- a/FS/FS/export_device.pm
+++ /dev/null
@@ -1,136 +0,0 @@
-package FS::export_device;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::part_export;
-use FS::part_device;
-
-=head1 NAME
-
-FS::export_device - Object methods for export_device records
-
-=head1 SYNOPSIS
-
- use FS::export_device;
-
- $record = new FS::export_device \%hash;
- $record = new FS::export_device { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::export_device object links a device definition (see L<FS::part_device>)
-to an export (see L<FS::part_export>). FS::export_device inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item exportdevicenum - primary key
-
-=item exportnum - export (see L<FS::part_export>)
-
-=item devicepart - device definition (see L<FS::part_device>)
-
-=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
-
-sub table { 'export_device'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# may want to check for duplicates against either services or devices
-# cf FS::export_svc
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=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
-
-sub check {
- my $self = shift;
-
- $self->ut_numbern('exportdevicenum')
- || $self->ut_number('exportnum')
- || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum')
- || $self->ut_number('devicepart')
- || $self->ut_foreign_key('devicepart', 'part_device', 'devicepart')
- || $self->SUPER::check
- ;
-}
-
-=item part_export
-
-Returns the FS::part_export object (see L<FS::part_export>).
-
-=cut
-
-sub part_export {
- my $self = shift;
- qsearchs( 'part_export', { 'exportnum' => $self->exportnum } );
-}
-
-=item part_device
-
-Returns the FS::part_device object (see L<FS::part_device>).
-
-=cut
-
-sub part_device {
- my $self = shift;
- qsearchs( 'part_device', { 'svcpart' => $self->devicepart } );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::part_export>, L<FS::part_device>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm
deleted file mode 100644
index 0370f5f..0000000
--- a/FS/FS/export_svc.pm
+++ /dev/null
@@ -1,322 +0,0 @@
-package FS::export_svc;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::part_export;
-use FS::part_svc;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::export_svc - Object methods for export_svc records
-
-=head1 SYNOPSIS
-
- use FS::export_svc;
-
- $record = new FS::export_svc \%hash;
- $record = new FS::export_svc { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::export_svc object links a service definition (see L<FS::part_svc>) to
-an export (see L<FS::part_export>). FS::export_svc inherits from FS::Record.
-The following fields are currently supported:
-
-=over 4
-
-=item exportsvcnum - primary key
-
-=item exportnum - export (see L<FS::part_export>)
-
-=item svcpart - service definition (see L<FS::part_svc>)
-
-=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 { 'export_svc'; }
-
-=item insert [ JOB, OFFSET, MULTIPLIER ]
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-TODOC: JOB, OFFSET, MULTIPLIER
-
-=cut
-
-sub insert {
- my $self = shift;
- my( $job, $offset, $mult ) = ( '', 0, 100);
- $job = shift if @_;
- $offset = shift if @_;
- $mult = shift if @_;
-
- 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->check;
- return $error if $error;
-
- #check for duplicates!
- my @checks = ();
- my $svcdb = $self->part_svc->svcdb;
- if ( $svcdb eq 'svc_acct' ) {
-
- if ( $self->part_export->nodomain =~ /^Y/i ) {
- push @checks, {
- label => 'usernames',
- method => 'username',
- sortby => sub { $a cmp $b },
- };
- } else {
- push @checks, {
- label => 'username@domain',
- method => 'email',
- sortby => sub {
- my($auser, $adomain) = split('@', $a);
- my($buser, $bdomain) = split('@', $b);
- $adomain cmp $bdomain || $auser cmp $buser;
- },
- };
- }
-
- unless ( $self->part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
- push @checks, {
- label => 'uids',
- method => 'uid',
- sortby => sub { $a <=> $b },
- };
- }
-
- } elsif ( $svcdb eq 'svc_domain' ) {
- push @checks, {
- label => 'domains',
- method => 'domain',
- sortby => sub { $a cmp $b },
- };
- } else {
- warn "WARNING: No duplicate checking done on merge of $svcdb exports";
- }
-
- if ( @checks ) {
-
- my $done = 0;
- my $percheck = $mult / scalar(@checks);
-
- foreach my $check ( @checks ) {
-
- if ( $job ) {
- $error = $job->update_statustext(int( $offset + ($done+.33) *$percheck ));
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my @current_svc = $self->part_export->svc_x;
- #warn "current: ". scalar(@current_svc). " $current_svc[0]\n";
-
- if ( $job ) {
- $error = $job->update_statustext(int( $offset + ($done+.67) *$percheck ));
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my @new_svc = $self->part_svc->svc_x;
- #warn "new: ". scalar(@new_svc). " $new_svc[0]\n";
-
- if ( $job ) {
- $error = $job->update_statustext(int( $offset + ($done+1) *$percheck ));
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my $method = $check->{'method'};
- my %cur_svc = map { $_->$method() => $_ } @current_svc;
- my @dup_svc = grep { $cur_svc{$_->$method()} } @new_svc;
- #my @diff_customer = grep {
- # $_->cust_pkg->custnum != $cur_svc{$_->$method()}->cust_pkg->custnum
- # } @dup_svc;
-
-
-
- if ( @dup_svc ) { #aye, that's the rub
- #error out for now, eventually accept different options of adjustments
- # to make to allow us to continue forward
- $dbh->rollback if $oldAutoCommit;
-
- my @diff_customer_svc = grep {
- my $cust_pkg = $_->cust_svc->cust_pkg;
- my $custnum = $cust_pkg ? $cust_pkg->custnum : 0;
- my $other_cust_pkg = $cur_svc{$_->$method()}->cust_svc->cust_pkg;
- my $other_custnum = $other_cust_pkg ? $other_cust_pkg->custnum : 0;
- $custnum != $other_custnum;
- } @dup_svc;
-
- my $label = $check->{'label'};
- my $sortby = $check->{'sortby'};
- return "Can't export ".
- $self->part_svc->svcpart.':'.$self->part_svc->svc. " service to ".
- $self->part_export->exportnum.':'.$self->part_export->exporttype.
- ' on '. $self->part_export->machine.
- ' : '. scalar(@dup_svc). " duplicate $label".
- ' ('. scalar(@diff_customer_svc). " from different customers)".
- ": ". join(', ', sort $sortby map { $_->$method() } @dup_svc )
- #": ". join(', ', sort $sortby map { $_->$method() } @diff_customer_svc )
- ;
- }
-
- $done++;
- }
-
- } #end of duplicate check, whew
-
- $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
-# if ( $self->part_svc->svcdb eq 'svc_acct' ) {
-#
-# if ( $self->part_export->nodomain =~ /^Y/i ) {
-#
-# select username from svc_acct where svcpart = $svcpart
-# group by username having count(*) > 1;
-#
-# } else {
-#
-# select username, domain
-# from svc_acct
-# join svc_domain on ( svc_acct.domsvc = svc_domain.svcnum )
-# group by username, domain having count(*) > 1;
-#
-# }
-#
-# } elsif ( $self->part_svc->svcdb eq 'svc_domain' ) {
-#
-# #similar but easier domain checking one
-#
-# } #etc.?
-#
-# my @services =
-# map { $_->part_svc }
-# grep { $_->svcpart != $self->svcpart }
-# $self->part_export->export_svc;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-}
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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;
-
- $self->ut_numbern('exportsvcnum')
- || $self->ut_number('exportnum')
- || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum')
- || $self->ut_number('svcpart')
- || $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart')
- || $self->SUPER::check
- ;
-}
-
-=item part_export
-
-Returns the FS::part_export object (see L<FS::part_export>).
-
-=cut
-
-sub part_export {
- my $self = shift;
- qsearchs( 'part_export', { 'exportnum' => $self->exportnum } );
-}
-
-=item part_svc
-
-Returns the FS::part_svc object (see L<FS::part_svc>).
-
-=cut
-
-sub part_svc {
- my $self = shift;
- qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::part_export>, L<FS::part_svc>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/geocode_Mixin.pm b/FS/FS/geocode_Mixin.pm
deleted file mode 100644
index 08e7b86..0000000
--- a/FS/FS/geocode_Mixin.pm
+++ /dev/null
@@ -1,164 +0,0 @@
-package FS::geocode_Mixin;
-
-use strict;
-use vars qw( $DEBUG $me );
-use Carp;
-use Locale::Country;
-use FS::Record qw( qsearchs qsearch );
-use FS::Conf;
-use FS::cust_pkg;
-use FS::cust_location;
-use FS::cust_tax_location;
-use FS::part_pkg;
-
-$DEBUG = 0;
-$me = '[FS::geocode_Mixin]';
-
-=head1 NAME
-
-FS::geocode_Mixin - Mixin class for records that contain address and other
-location fields.
-
-=head1 SYNOPSIS
-
- package FS::some_table;
- use base ( FS::geocode_Mixin FS::Record );
-
-=head1 DESCRIPTION
-
-FS::geocode_Mixin - This is a mixin class for records that contain address
-and other location fields.
-
-=head1 METHODS
-
-=over 4
-
-=cut
-
-=item location_hash
-
-Returns a list of key/value pairs, with the following keys: address1, address2,
-city, county, state, zip, country. The shipping address is used if present.
-
-=cut
-
-#geocode dependent on tax-ship_address config
-
-sub location_hash {
- my $self = shift;
- my $prefix = $self->has_ship_address ? 'ship_' : '';
-
- map { my $method = ($_ eq 'geocode') ? $_ : $prefix.$_;
- $_ => $self->get($method);
- }
- qw( address1 address2 city county state zip country geocode
- location_type location_number location_kind );
-}
-
-=item location_label [ OPTION => VALUE ... ]
-
-Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
-
-Options are
-
-=over 4
-
-=item join_string
-
-used to separate the address elements (defaults to ', ')
-
-=item escape_function
-
-a callback used for escaping the text of the address elements
-
-=back
-
-=cut
-
-sub location_label {
- my $self = shift;
- my %opt = @_;
-
- my $separator = $opt{join_string} || ', ';
- my $escape = $opt{escape_function} || sub{ shift };
- my $ds = $opt{double_space} || ' ';
- my $line = '';
- my $cydefault =
- $opt{'countrydefault'} || FS::Conf->new->config('countrydefault') || 'US';
- my $prefix = $self->has_ship_address ? 'ship_' : '';
-
- my $notfirst = 0;
- foreach (qw ( address1 address2 location_type location_number ) ) {
- my $method = "$prefix$_";
- $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
- if $self->$method;
- $notfirst++;
- }
- $notfirst = 0;
- foreach (qw ( city county state zip ) ) {
- my $method = "$prefix$_";
- if ( $self->$method ) {
- $line .= ' (' if $method eq 'county';
- $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
- $line .= ' )' if $method eq 'county';
- $notfirst++;
- }
- }
- $line .= $separator. &$escape(code2country($self->country))
- if $self->country ne $cydefault;
-
- $line;
-}
-
-=item geocode DATA_VENDOR
-
-Returns a value for the customer location as encoded by DATA_VENDOR.
-Currently this only makes sense for "CCH" as DATA_VENDOR.
-
-=cut
-
-sub geocode {
- my ($self, $data_vendor) = (shift, shift); #always cch for now
-
- my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
- return $geocode if $geocode;
-
- my $prefix =
- ( FS::Conf->new->exists('tax-ship_address') && $self->has_ship_address )
- ? 'ship_'
- : '';
-
- my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
- if $self->country eq 'US';
-
- $zip ||= '';
- $plus4 ||= '';
- #CCH specific location stuff
- my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
-
- my @cust_tax_location =
- qsearch( {
- 'table' => 'cust_tax_location',
- 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
- 'extra_sql' => $extra_sql,
- 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
- }
- );
- $geocode = $cust_tax_location[0]->geocode
- if scalar(@cust_tax_location);
-
- $geocode;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_Common.pm b/FS/FS/h_Common.pm
deleted file mode 100644
index ca13e1b..0000000
--- a/FS/FS/h_Common.pm
+++ /dev/null
@@ -1,124 +0,0 @@
-package FS::h_Common;
-
-use strict;
-use FS::Record qw(dbdef);
-use Carp qw(confess);
-
-=head1 NAME
-
-FS::h_Common - History table "mixin" common base class
-
-=head1 SYNOPSIS
-
-package FS::h_tablename;
-@ISA = qw( FS::h_Common FS::tablename );
-
-sub table { 'h_table_name'; }
-
-sub insert { return "can't insert history records manually"; }
-sub delete { return "can't delete history records"; }
-sub replace { return "can't modify history records"; }
-
-=head1 DESCRIPTION
-
-FS::h_Common is intended as a "mixin" base class for history table classes to
-inherit from.
-
-=head1 METHODS
-
-=over 4
-
-=item sql_h_search END_TIMESTAMP [ START_TIMESTAMP ]
-
-Returns an a list consisting of the "SELECT", "EXTRA_SQL", SQL fragments, a
-placeholder for "CACHE_OBJ" and an "AS" SQL fragment, to search for the
-appropriate history records created before END_TIMESTAMP and (optionally) not
-deleted before START_TIMESTAMP.
-
-=cut
-
-sub sql_h_search {
- my( $self, $end ) = ( shift, shift );
-
- my $table = $self->table;
- my $real_table = ($table =~ /^h_(.*)$/) ? $1 : $table;
- my $pkey = dbdef->table($real_table)->primary_key
- or die "can't (yet) search history table $real_table without a primary key";
-
- unless ($end) {
- confess 'Called sql_h_search without END_TIMESTAMP';
- }
-
- my( $notdeleted, $notdeleted_mr ) = ( '', '' );
- if ( scalar(@_) && $_[0] ) {
- $notdeleted =
- "AND 0 = ( SELECT COUNT(*) FROM $table as notdel
- WHERE notdel.$pkey = maintable.$pkey
- AND notdel.history_action = 'delete'
- AND notdel.history_date > maintable.history_date
- AND notdel.history_date <= $_[0]
- )";
- $notdeleted_mr =
- "AND 0 = ( SELECT COUNT(*) FROM $table as notdel_mr
- WHERE notdel_mr.$pkey = mostrecent.$pkey
- AND notdel_mr.history_action = 'delete'
- AND notdel_mr.history_date > mostrecent.history_date
- AND notdel_mr.history_date <= $_[0]
- )";
- }
-
- (
- #"DISTINCT ON ( $pkey ) *",
- "*",
-
- "AND history_date <= $end
- AND ( history_action = 'insert'
- OR history_action = 'replace_new'
- )
- $notdeleted
- AND history_date = ( SELECT MAX(mostrecent.history_date)
- FROM $table AS mostrecent
- WHERE mostrecent.$pkey = maintable.$pkey
- AND mostrecent.history_date <= $end
- AND ( mostrecent.history_action = 'insert'
- OR mostrecent.history_action = 'replace_new'
- )
- $notdeleted_mr
- )
-
- ORDER BY $pkey ASC",
- #ORDER BY $pkey ASC, history_date DESC",
-
- '',
-
- 'AS maintable',
- );
-
-}
-
-=item sql_h_searchs END_TIMESTAMP [ START_TIMESTAMP ]
-
-Like sql_h_search, but limited to the single most recent record (before
-END_TIMESTAMP)
-
-=cut
-
-sub sql_h_searchs {
- my $self = shift;
- my($select, $where, $cacheobj, $as) = $self->sql_h_search(@_);
- $where .= ' LIMIT 1';
- ($select, $where, $cacheobj, $as);
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_cust_bill.pm b/FS/FS/h_cust_bill.pm
deleted file mode 100644
index 7a3d811..0000000
--- a/FS/FS/h_cust_bill.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::h_cust_bill;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::cust_bill;
-
-@ISA = qw( FS::h_Common FS::cust_bill );
-
-sub table { 'h_cust_bill' };
-
-=head1 NAME
-
-FS::h_cust_bill - Historical record of customer tax changes (old-style)
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_cust_bill object represents historical changes to invoices.
-FS::h_cust_bill inherits from FS::h_Common and FS::cust_bill.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_bill>, L<FS::h_Common>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_cust_credit.pm b/FS/FS/h_cust_credit.pm
deleted file mode 100644
index 1425a26..0000000
--- a/FS/FS/h_cust_credit.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::h_cust_credit;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::cust_credit;
-
-@ISA = qw( FS::h_Common FS::cust_credit );
-
-sub table { 'h_cust_credit' };
-
-=head1 NAME
-
-FS::h_cust_credit - Historical record of customer credit changes
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_cust_credit object represents historical changes to credits.
-FS::h_cust_credit inherits from FS::h_Common and FS::cust_credit.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_credit>, L<FS::h_Common>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_cust_pay.pm b/FS/FS/h_cust_pay.pm
deleted file mode 100644
index 6434b3f..0000000
--- a/FS/FS/h_cust_pay.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::h_cust_pay;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::cust_pay;
-
-@ISA = qw( FS::h_Common FS::cust_pay );
-
-sub table { 'h_cust_pay' };
-
-=head1 NAME
-
-FS::h_cust_pay - Historical record of customer payment changes
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_cust_pay object represents historical changes to payments.
-FS::h_cust_pay inherits from FS::h_Common and FS::cust_pay.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_pay>, L<FS::h_Common>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_cust_pkg.pm b/FS/FS/h_cust_pkg.pm
deleted file mode 100644
index e796f41..0000000
--- a/FS/FS/h_cust_pkg.pm
+++ /dev/null
@@ -1,34 +0,0 @@
-package FS::h_cust_pkg;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::cust_pkg;
-
-@ISA = qw( FS::h_Common FS::cust_pkg );
-
-sub table { 'h_cust_pkg' };
-
-=head1 NAME
-
-FS::h_cust_pkg - Historical record of customer package changes
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_cust_pkg object represents historical changes to packages.
-FS::h_cust_pkg inherits from FS::h_Common and FS::cust_pkg.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_pkg>, L<FS::h_Common>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
-
diff --git a/FS/FS/h_cust_pkg_reason.pm b/FS/FS/h_cust_pkg_reason.pm
deleted file mode 100644
index dda2009..0000000
--- a/FS/FS/h_cust_pkg_reason.pm
+++ /dev/null
@@ -1,34 +0,0 @@
-package FS::h_cust_pkg_reason;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::cust_pkg_reason;
-
-@ISA = qw( FS::h_Common FS::cust_pkg_reason );
-
-sub table { 'h_cust_pkg_reason' };
-
-=head1 NAME
-
-FS::h_cust_pkg_reason - Historical record of customer package changes
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_cust_pkg_reason object represents historical changes to packages.
-FS::h_cust_pkg_reason inherits from FS::h_Common and FS::cust_pkg_reason.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_pkg_reason>, L<FS::h_Common>, L<FS::Record>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
-
diff --git a/FS/FS/h_cust_svc.pm b/FS/FS/h_cust_svc.pm
deleted file mode 100644
index d280d53..0000000
--- a/FS/FS/h_cust_svc.pm
+++ /dev/null
@@ -1,165 +0,0 @@
-package FS::h_cust_svc;
-
-use strict;
-use vars qw( @ISA $DEBUG );
-use Carp;
-use FS::Record qw(qsearchs);
-use FS::h_Common;
-use FS::cust_svc;
-
-@ISA = qw( FS::h_Common FS::cust_svc );
-
-$DEBUG = 0;
-
-sub table { 'h_cust_svc'; }
-
-=head1 NAME
-
-FS::h_cust_svc - Object method for h_cust_svc objects
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_cust_svc object represents a historical service. FS::h_cust_svc
-inherits from FS::h_Common and FS::cust_svc.
-
-=head1 METHODS
-
-=over 4
-
-=item date_deleted
-
-Returns the date this service was deleted, if any.
-
-=cut
-
-sub date_deleted {
- my $self = shift;
- $self->h_date('delete');
-}
-
-=item label END_TIMESTAMP [ START_TIMESTAMP ]
-
-Returns a label for this historical service, if the service was created before
-END_TIMESTAMP and (optionally) not deleted before START_TIMESTAMP. Otherwise,
-returns an empty list.
-
-If a service is found, returns a list consisting of:
-- The name of this historical service (from part_svc)
-- A meaningful identifier (username, domain, or mail alias)
-- The table name (i.e. svc_domain) for this historical service
-
-=cut
-
-sub label { shift->_label('svc_label', @_); }
-sub label_long { shift->_label('svc_label_long', @_); }
-
-sub _label {
- my $self = shift;
- my $method = shift;
-
- #carp "FS::h_cust_svc::_label called on $self" if $DEBUG;
- warn "FS::h_cust_svc::_label called on $self for $method" if $DEBUG;
- my $svc_x = $self->h_svc_x(@_);
- return () unless $svc_x;
- my $part_svc = $self->part_svc;
-
- unless ($svc_x) {
- carp "can't find h_". $self->part_svc->svcdb. '.svcnum '. $self->svcnum if $DEBUG;
- return $part_svc->svc, 'n/a', $part_svc->svcdb;
- }
-
- my @label;
- eval { @label = $self->$method($svc_x, @_); };
-
- if ($@) {
- carp 'while resolving history record for svcdb/svcnum ' .
- $part_svc->svcdb . '/' . $self->svcnum . ': ' . $@ if $DEBUG;
- return $part_svc->svc, 'n/a', $part_svc->svcdb;
- } else {
- return @label;
- }
-
-}
-
-=item h_svc_x END_TIMESTAMP [ START_TIMESTAMP ]
-
-Returns the FS::h_svc_XXX object for this service as of END_TIMESTAMP (i.e. an
-FS::h_svc_acct object or FS::h_svc_domain object, etc.) and (optionally) not
-cancelled before START_TIMESTAMP.
-
-=cut
-
-#false laziness w/cust_pkg::h_cust_svc
-sub h_svc_x {
- my $self = shift;
- my $svcdb = $self->part_svc->svcdb;
-
- warn "requiring FS/h_$svcdb.pm" if $DEBUG;
- require "FS/h_$svcdb.pm";
- my $svc_x = qsearchs(
- "h_$svcdb",
- { 'svcnum' => $self->svcnum, },
- "FS::h_$svcdb"->sql_h_searchs(@_),
- ) || $self->SUPER::svc_x;
-
- if ($svc_x) {
- carp "Using $svcdb in place of missing h_${svcdb} record."
- if ($svc_x->isa('FS::' . $svcdb) and $DEBUG);
- return $svc_x;
- } else {
- return '';
- }
-
-}
-
-# _upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-
-use FS::UID qw( driver_name dbh );
-
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
-
- warn "[FS::h_cust_svc] upgrading $class\n" if $DEBUG;
-
- return if driver_name =~ /^mysql/; #You can't specify target table 'h_cust_svc' for update in FROM clause
-
- my $sql = "
- DELETE FROM h_cust_svc
- WHERE history_action = 'delete'
- AND historynum != ( SELECT min(historynum) FROM h_cust_svc AS main
- WHERE main.history_date = h_cust_svc.history_date
- AND main.history_user = h_cust_svc.history_user
- AND main.svcnum = h_cust_svc.svcnum
- AND main.svcpart = h_cust_svc.svcpart
- AND ( main.pkgnum = h_cust_svc.pkgnum
- OR ( main.pkgnum IS NULL AND h_cust_svc.pkgnum IS NULL )
- )
- AND ( main.overlimit = h_cust_svc.overlimit
- OR ( main.overlimit IS NULL AND h_cust_svc.overlimit IS NULL )
- )
- )
- ";
-
- warn $sql if $DEBUG;
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::h_Common>, L<FS::cust_svc>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_cust_tax_exempt.pm b/FS/FS/h_cust_tax_exempt.pm
deleted file mode 100644
index 9d2318b..0000000
--- a/FS/FS/h_cust_tax_exempt.pm
+++ /dev/null
@@ -1,40 +0,0 @@
-package FS::h_cust_tax_exempt;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::cust_tax_exempt;
-
-@ISA = qw( FS::h_Common FS::cust_tax_exempt );
-
-sub table { 'h_cust_tax_exempt' };
-
-=head1 NAME
-
-FS::h_cust_tax_exempt - Historical record of customer tax changes (old-style)
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_cust_tax_exempt object represents historical changes to old-style
-customer tax exemptions. FS::h_cust_tax_exempt inherits from FS::h_Common and
-FS::cust_tax_exempt.
-
-=head1 NOTE
-
-Old-style customer tax exemptions are only useful for legacy migrations - if
-you are looking for current customer tax exemption data see
-L<FS::cust_tax_exempt_pkg>.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cust_tax_exempt>, L<FS::cust_tax_exempt_pkg>, L<FS::h_Common>,
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_domain_record.pm b/FS/FS/h_domain_record.pm
deleted file mode 100644
index 0ab974f..0000000
--- a/FS/FS/h_domain_record.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::h_domain_record;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::domain_record;
-
-@ISA = qw( FS::h_Common FS::domain_record );
-
-sub table { 'h_domain_record' };
-
-=head1 NAME
-
-FS::h_domain_record - Historical DNS entry objects
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_domain_record object represents a historical entry in a DNS zone.
-FS::h_domain_record inherits from FS::h_Common and FS::domain_record.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::h_Common>, L<FS::svc_external>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_inventory_item.pm b/FS/FS/h_inventory_item.pm
deleted file mode 100644
index b4f0161..0000000
--- a/FS/FS/h_inventory_item.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::h_inventory_item;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::inventory_item;
-
-@ISA = qw( FS::h_Common FS::inventory_item );
-
-sub table { 'h_inventory_item' };
-
-=head1 NAME
-
-FS::h_inventory_item - Historical record of inventory item activity
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_inventory_item object represents a change in the state of an
-inventory item.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::inventory_item>, L<FS::h_Common>, L<FS::Record>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_svc_acct.pm b/FS/FS/h_svc_acct.pm
deleted file mode 100644
index 247d20c..0000000
--- a/FS/FS/h_svc_acct.pm
+++ /dev/null
@@ -1,78 +0,0 @@
-package FS::h_svc_acct;
-
-use strict;
-use vars qw( @ISA $DEBUG );
-use Carp qw(carp);
-use FS::Record qw(qsearchs);
-use FS::h_Common;
-use FS::svc_acct;
-use FS::svc_domain;
-use FS::h_svc_domain;
-
-@ISA = qw( FS::h_Common FS::svc_acct );
-
-$DEBUG = 0;
-
-sub table { 'h_svc_acct' };
-
-=head1 NAME
-
-FS::h_svc_acct - Historical account objects
-
-=head1 SYNOPSIS
-
-=head1 METHODS
-
-=over 4
-
-=item svc_domain
-
-=cut
-
-sub svc_domain {
- my $self = shift;
- qsearchs( 'h_svc_domain',
- { 'svcnum' => $self->domsvc },
- FS::h_svc_domain->sql_h_searchs(@_),
- );
-}
-
-=item domain
-
-Returns the domain associated with this account.
-
-=cut
-
-sub domain {
- my $self = shift;
- die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc;
-
- my $svc_domain = $self->svc_domain(@_) || $self->SUPER::svc_domain()
- or die 'no history svc_domain.svcnum for svc_acct.domsvc ' . $self->domsvc;
-
- carp 'Using FS::svc_acct record in place of missing FS::h_svc_acct record.'
- if ($svc_domain->isa('FS::svc_acct') and $DEBUG);
-
- $svc_domain->domain;
-
-}
-
-
-=back
-
-=head1 DESCRIPTION
-
-An FS::h_svc_acct object represents a historical account. FS::h_svc_acct
-inherits from FS::h_Common and FS::svc_acct.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::h_Common>, L<FS::svc_acct>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_svc_broadband.pm b/FS/FS/h_svc_broadband.pm
deleted file mode 100644
index d6038fb..0000000
--- a/FS/FS/h_svc_broadband.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::h_svc_broadband;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::svc_broadband;
-
-@ISA = qw( FS::h_Common FS::svc_broadband );
-
-sub table { 'h_svc_broadband' };
-
-=head1 NAME
-
-FS::h_svc_broadband - Historical broadband connection objects
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_svc_broadband object represents a historical broadband connection.
-FS::h_svc_broadband inherits from FS::h_Common and FS::svc_broadband.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::h_Common>, L<FS::svc_broadband>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_svc_domain.pm b/FS/FS/h_svc_domain.pm
deleted file mode 100644
index 60d54f7..0000000
--- a/FS/FS/h_svc_domain.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::h_svc_domain;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::svc_domain;
-
-@ISA = qw( FS::h_Common FS::svc_domain );
-
-sub table { 'h_svc_domain' };
-
-=head1 NAME
-
-FS::h_svc_domain - Historical domain objects
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_svc_domain object represents a historical domain. FS::h_svc_domain
-inherits from FS::h_Common and FS::svc_domain.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::h_Common>, L<FS::svc_domain>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_svc_dsl.pm b/FS/FS/h_svc_dsl.pm
deleted file mode 100644
index 5f4080b..0000000
--- a/FS/FS/h_svc_dsl.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::h_svc_dsl;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::svc_dsl;
-
-@ISA = qw( FS::h_Common FS::svc_dsl );
-
-sub table { 'h_svc_dsl' };
-
-=head1 NAME
-
-FS::h_svc_dsl - Historical DSL service objects
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_svc_dsl object represents a historical DSL service.
-FS::h_svc_dsl inherits from FS::h_Common and FS::svc_dsl.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::h_Common>, L<FS::svc_dsl>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_svc_external.pm b/FS/FS/h_svc_external.pm
deleted file mode 100644
index 5eb7064..0000000
--- a/FS/FS/h_svc_external.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::h_svc_external;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::svc_external;
-
-@ISA = qw( FS::h_Common FS::svc_external );
-
-sub table { 'h_svc_external' };
-
-=head1 NAME
-
-FS::h_svc_external - Historical externally tracked service objects
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_svc_external object represents a historical externally tracked service.
-FS::h_svc_external inherits from FS::h_Common and FS::svc_external.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::h_Common>, L<FS::svc_external>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_svc_forward.pm b/FS/FS/h_svc_forward.pm
deleted file mode 100644
index 25b2039..0000000
--- a/FS/FS/h_svc_forward.pm
+++ /dev/null
@@ -1,85 +0,0 @@
-package FS::h_svc_forward;
-
-use strict;
-use vars qw( @ISA $DEBUG );
-use FS::Record qw(qsearchs);
-use FS::h_Common;
-use FS::svc_forward;
-use FS::svc_acct;
-use FS::h_svc_acct;
-
-use Carp qw(carp);
-
-$DEBUG = 0;
-
-@ISA = qw( FS::h_Common FS::svc_forward );
-
-sub table { 'h_svc_forward' };
-
-=head1 NAME
-
-FS::h_svc_forward - Historical mail forwarding alias objects
-
-=head1 SYNOPSIS
-
-=head1 METHODS
-
-=over 4
-
-=item srcsvc_acct
-
-=cut
-
-sub srcsvc_acct {
- my $self = shift;
- my $h_svc_acct = qsearchs(
- 'h_svc_acct',
- { 'svcnum' => $self->srcsvc },
- FS::h_svc_acct->sql_h_searchs(@_),
- ) || $self->SUPER::srcsvc_acct
- or die "no history svc_acct.svcnum for svc_forward.srcsvc ". $self->srcsvc;
-
- carp 'Using svc_acct in place of missing h_svc_acct record.'
- if ($h_svc_acct->isa('FS::domain_record') and $DEBUG);
-
- return $h_svc_acct;
-
-}
-
-=item dstsvc_acct
-
-=cut
-
-sub dstsvc_acct {
- my $self = shift;
- my $h_svc_acct = qsearchs(
- 'h_svc_acct',
- { 'svcnum' => $self->dstsvc },
- FS::h_svc_acct->sql_h_searchs(@_),
- ) || $self->SUPER::dstsvc_acct
- or die "no history svc_acct.svcnum for svc_forward.dstsvc ". $self->dstsvc;
-
- carp 'Using svc_acct in place of missing h_svc_acct record.'
- if ($h_svc_acct->isa('FS::domain_record') and $DEBUG);
-
- return $h_svc_acct;
-}
-
-=back
-
-=head1 DESCRIPTION
-
-An FS::h_svc_forward object represents a historical mail forwarding alias.
-FS::h_svc_forward inherits from FS::h_Common and FS::svc_forward.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::h_Common>, L<FS::svc_forward>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_svc_mailinglist.pm b/FS/FS/h_svc_mailinglist.pm
deleted file mode 100644
index 3d1fd27..0000000
--- a/FS/FS/h_svc_mailinglist.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-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
deleted file mode 100644
index db702f3..0000000
--- a/FS/FS/h_svc_pbx.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-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/h_svc_phone.pm b/FS/FS/h_svc_phone.pm
deleted file mode 100644
index 95898c7..0000000
--- a/FS/FS/h_svc_phone.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::h_svc_phone;
-
-use strict;
-use vars qw( @ISA );
-use FS::h_Common;
-use FS::svc_phone;
-
-@ISA = qw( FS::h_Common FS::svc_phone );
-
-sub table { 'h_svc_phone' };
-
-=head1 NAME
-
-FS::h_svc_phone - Historical phone number objects
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-An FS::h_svc_phone object represents a historical phone number.
-FS::h_svc_phone inherits from FS::h_Common and FS::svc_phone.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::h_Common>, L<FS::svc_phone>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/h_svc_www.pm b/FS/FS/h_svc_www.pm
deleted file mode 100644
index 2a3b6dc..0000000
--- a/FS/FS/h_svc_www.pm
+++ /dev/null
@@ -1,67 +0,0 @@
-package FS::h_svc_www;
-
-use strict;
-use vars qw( @ISA $DEBUG );
-use Carp qw(carp);
-use FS::Record qw(qsearchs);
-use FS::h_Common;
-use FS::svc_www;
-use FS::h_domain_record;
-
-@ISA = qw( FS::h_Common FS::svc_www );
-
-$DEBUG = 0;
-
-sub table { 'h_svc_www' };
-
-=head1 NAME
-
-FS::h_svc_www - Historical web virtual host objects
-
-=head1 SYNOPSIS
-
-=head1 METHODS
-
-=over 4
-
-=item domain_record
-
-=cut
-
-sub domain_record {
- my $self = shift;
-
- carp 'Called FS::h_svc_www->domain_record on svcnum ' . $self->svcnum if $DEBUG;
-
- my $domain_record = qsearchs(
- 'h_domain_record',
- { 'recnum' => $self->recnum },
- FS::h_domain_record->sql_h_searchs(@_),
- ) || $self->SUPER::domain_record
- or die "no history domain_record.recnum for svc_www.recnum ". $self->domsvc;
-
- carp 'Using domain_record in place of missing h_domain_record record.'
- if ($domain_record->isa('FS::domain_record') and $DEBUG);
-
- return $domain_record;
-
-}
-
-=back
-
-=head1 DESCRIPTION
-
-An FS::h_svc_www object represents a historical web virtual host.
-FS::h_svc_www inherits from FS::h_Common and FS::svc_www.
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::h_Common>, L<FS::svc_www>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/inventory_class.pm b/FS/FS/inventory_class.pm
deleted file mode 100644
index 4747241..0000000
--- a/FS/FS/inventory_class.pm
+++ /dev/null
@@ -1,264 +0,0 @@
-package FS::inventory_class;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( dbh qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::inventory_class - Object methods for inventory_class records
-
-=head1 SYNOPSIS
-
- use FS::inventory_class;
-
- $record = new FS::inventory_class \%hash;
- $record = new FS::inventory_class { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::inventory_class object represents a class of inventory, such as "DID
-numbers" or "physical equipment serials". FS::inventory_class inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item classnum - primary key
-
-=item classname - Name of this class
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new inventory class. To add the class 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 { 'inventory_class'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid inventory class. 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('classnum')
- || $self->ut_textn('classname')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item num_avail
-
-Returns the number of available (unused/unallocated) inventory items of this
-class (see L<FS::inventory_item>).
-
-=cut
-
-sub num_avail {
- my( $self, $sql ) = @_;
- $sql .= ' AND ' if length($sql);
- $sql .= '( svcnum IS NULL OR svcnum = 0 )';
- $self->num_sql($sql);
-}
-
-sub num_sql {
- my( $self, $sql ) = @_;
- $sql = "AND $sql" if length($sql);
-
- my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
- 'null' => 1,
- 'table' => 'inventory_item',
- );
-
- my $st = "SELECT COUNT(*) FROM inventory_item ".
- " WHERE classnum = ? AND $agentnums_sql $sql";
- my $sth = dbh->prepare($st) or die dbh->errstr. " preparing $st";
- $sth->execute($self->classnum) or die $sth->errstr. " executing $st";
- $sth->fetchrow_arrayref->[0];
-}
-
-=item num_used
-
-Returns the number of used (allocated) inventory items of this class (see
-L<FS::inventory_class>).
-
-=cut
-
-sub num_used {
- my( $self, $sql ) = @_;
- $sql .= ' AND ' if length($sql);
- $sql .= 'svcnum IS NOT NULL AND svcnum > 0 ';
- $self->num_sql($sql);
-}
-
-=item num_total
-
-Returns the total number of inventory items of this class (see
-L<FS::inventory_class>).
-
-=cut
-
-sub num_total {
- my( $self, $sql ) = @_;
- $self->num_sql($sql);
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item searchcell_factory
-
-=cut
-
-sub countcell_factory {
- my($class, %opt) = @_;
-
- my $p = $opt{p};
-
- my $sql = $opt{'agentnum'} ? 'agentnum = '.$opt{'agentnum'} : '';
-
- use Tie::IxHash;
- tie my %labels, 'Tie::IxHash',
- 'num_avail' => 'Available', # <FONT SIZE="-1"><A HREF="eventually">(upload batch)</A></FONT>',
- 'num_used' => 'In use', #'Used', #'Allocated',
- 'num_total' => 'Total',
- ;
-
- my %link = (
- 'num_avail' => ';avail=1',
- 'num_used' => ';used=1',
- 'num_total' => '',
- );
-
- my %inv_action_link = (
- 'num_avail' => [ 'upload batch',
- $p.'misc/inventory_item-import.html?classnum=',
- 'classnum'
- ],
- );
-
- sub {
- my $inventory_class = shift;
-
- my $link =
- $p. 'search/inventory_item.html?'.
- 'classnum='. $inventory_class->classnum;
- $link .= ';agentnum='.$opt{'agentnum'} if $opt{'agentnum'};
-
- my %actioncol = ();
- foreach ( keys %inv_action_link ) {
- my($label, $baseurl, $method) =
- @{ $inv_action_link{$_} };
- my $url = $baseurl. $inventory_class->$method();
- $actioncol{$_} =
- '<FONT SIZE="-1">'.
- '('.
- '<A HREF="'.$url.'">'.
- $label.
- '</A>'.
- ')'.
- '</FONT>';
- }
-
- my %num = map {
- $_ => $inventory_class->$_($sql);
- } keys %labels;
-
- [ map {
- [
- {
- 'data' => '<B>'. $num{$_}. '</B>',
- 'align' => 'right',
- },
- {
- 'data' => $labels{$_},
- 'align' => 'left',
- 'link' => ( $num{$_}
- ? $link.$link{$_}
- : ''
- ),
- },
- { 'data' => $actioncol{$_},
- 'align' => 'left',
- },
- ]
- } keys %labels
- ];
- };
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::inventory_item>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/inventory_item.pm b/FS/FS/inventory_item.pm
deleted file mode 100644
index 39a0dff..0000000
--- a/FS/FS/inventory_item.pm
+++ /dev/null
@@ -1,182 +0,0 @@
-package FS::inventory_item;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( dbh qsearch qsearchs );
-use FS::cust_main_Mixin;
-use FS::inventory_class;
-use FS::cust_svc;
-
-@ISA = qw( FS::cust_main_Mixin FS::Record );
-
-=head1 NAME
-
-FS::inventory_item - Object methods for inventory_item records
-
-=head1 SYNOPSIS
-
- use FS::inventory_item;
-
- $record = new FS::inventory_item \%hash;
- $record = new FS::inventory_item { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::inventory_item object represents a specific piece of (real or virtual)
-inventory, such as a specific DID or serial number. FS::inventory_item
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item itemnum - primary key
-
-=item classnum - Inventory class (see L<FS::inventory_class>)
-
-=item item - Item identifier (unique within its inventory class)
-
-=item svcnum - Customer servcie (see L<FS::cust_svc>)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new item. To add the item 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 { 'inventory_item'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid item. 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('itemnum')
- || $self->ut_foreign_key('classnum', 'inventory_class', 'classnum' )
- #|| $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
- || $self->ut_agentnum_acl('agentnum', ['Configuration',
- 'Edit global inventory'] )
- || $self->ut_text('item')
- || $self->ut_foreign_keyn('svcnum', 'cust_svc', 'svcnum' )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item cust_svc
-
-Returns the customer service associated with this inventory item, if the
-item has been used (see L<FS::cust_svc>).
-
-=cut
-
-sub cust_svc {
- my $self = shift;
- return '' unless $self->svcnum;
- qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
-}
-
-=item agent
-
-Returns the associated agent for this event, if any, as an FS::agent object.
-
-=cut
-
-sub agent {
- my $self = shift;
- qsearchs('agent', { 'agentnum' => $self->agentnum } );
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item process_batch_import
-
-=cut
-
-sub process_batch_import {
- my $job = shift;
-
- my $opt = { 'table' => 'inventory_item',
- #'params' => [ 'itembatch', 'classnum', ],
- 'params' => [ 'classnum', 'agentnum', ],
- 'formats' => { 'default' => [ 'item' ] },
- 'default_csv' => 1,
- };
-
- FS::Record::process_batch_import( $job, $opt, @_ );
-
-}
-
-=back
-
-=head1 BUGS
-
-maybe batch_import should be a regular method in FS::inventory_class
-
-=head1 SEE ALSO
-
-L<inventory_class>, L<cust_svc>, 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
deleted file mode 100644
index d457386..0000000
--- a/FS/FS/location_Mixin.pm
+++ /dev/null
@@ -1,57 +0,0 @@
-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/m2m_Common.pm b/FS/FS/m2m_Common.pm
deleted file mode 100644
index 6774a48..0000000
--- a/FS/FS/m2m_Common.pm
+++ /dev/null
@@ -1,170 +0,0 @@
-package FS::m2m_Common;
-
-use strict;
-use vars qw( @ISA $DEBUG $me );
-use FS::Schema qw( dbdef );
-use FS::Record qw( qsearch qsearchs dbh );
-
-#hmm. well. we seem to be used as a mixin.
-#@ISA = qw( FS::Record );
-
-$DEBUG = 0;
-$me = '[FS::m2m_Common]';
-
-=head1 NAME
-
-FS::m2m_Common - Mixin class for classes in a many-to-many relationship
-
-=head1 SYNOPSIS
-
-use FS::m2m_Common;
-
-@ISA = qw( FS::m2m_Common FS::Record );
-
-=head1 DESCRIPTION
-
-FS::m2m_Common is intended as a mixin class for classes which have a
-many-to-many relationship with another table (via a linking table).
-
-It is currently assumed that the link table contains two fields named the same
-as the primary keys of the base and target tables, but you can ovverride this
-assumption if your table is different.
-
-=head1 METHODS
-
-=over 4
-
-=item process_m2m OPTION => VALUE, ...
-
-Available options:
-
-=over 4
-
-=item link_table (required)
-
-=item target_table (required)
-
-=item params (required)
-
-hashref; keys are primary key values in target_table (values are boolean). For convenience, keys may optionally be prefixed with the name
-of the primary key, as in "agentnum54" instead of "54", or passed as an arrayref
-of values.
-
-=item base_field (optional)
-
-base field, defaults to primary key of this base table
-
-=item target_field (optional)
-
-target field, defaults to the primary key of the target table
-
-=item hashref (optional)
-
-static hashref further qualifying the m2m fields
-
-=cut
-
-sub process_m2m {
- my( $self, %opt ) = @_;
-
- #use Data::Dumper;
- #warn "$me process_m2m called on $self with options:\n". Dumper(%opt)
- warn "$me process_m2m called on $self"
- if $DEBUG;
-
- my $self_pkey = $self->dbdef_table->primary_key;
- my $base_field = $opt{'base_field'} || $self_pkey;
- my $hashref = $opt{'hashref'} || {};
- $hashref->{$base_field} = $self->$self_pkey();
-
- my $link_table = $self->_load_table($opt{'link_table'});
-
- my $target_table = $self->_load_table($opt{'target_table'});
- my $target_field = $opt{'target_field'}
- || dbdef->table($target_table)->primary_key;
-
- if ( ref($opt{'params'}) eq 'ARRAY' ) {
- $opt{'params'} = { map { $_=>1 } @{$opt{'params'}} };
- }
-
- 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 $del_obj (
- grep {
- my $targetnum = $_->$target_field();
- ( ! $opt{'params'}->{$targetnum}
- && ! $opt{'params'}->{"$target_field$targetnum"}
- );
- }
- qsearch( $link_table, $hashref )
- ) {
- my $error = $del_obj->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- foreach my $add_targetnum (
- grep { ! qsearchs( $link_table, { %$hashref, $target_field => $_ } ) }
- map { /^($target_field)?(\d+)$/; $2; }
- grep { /^($target_field)?(\d+)$/ }
- grep { $opt{'params'}->{$_} }
- keys %{ $opt{'params'} }
- ) {
-
- my $add_obj = "FS::$link_table"->new( {
- %$hashref,
- $target_field => $add_targetnum,
- });
- my $error = $add_obj->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
-sub _load_table {
- my( $self, $table ) = @_;
- eval "use FS::$table";
- die $@ if $@;
- $table;
-}
-
-#=item target_table
-#
-#=cut
-#
-#sub target_table {
-# my $self = shift;
-# my $target_table = $self->_target_table;
-# eval "use FS::$target_table";
-# die $@ if $@;
-# $target_table;
-#}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>
-
-=cut
-
-1;
-
diff --git a/FS/FS/m2name_Common.pm b/FS/FS/m2name_Common.pm
deleted file mode 100644
index e9dcee9..0000000
--- a/FS/FS/m2name_Common.pm
+++ /dev/null
@@ -1,177 +0,0 @@
-package FS::m2name_Common;
-
-use strict;
-use vars qw( $DEBUG $me );
-use Carp;
-use FS::Schema qw( dbdef );
-use FS::Record qw( qsearchs ); #qsearch dbh );
-
-$DEBUG = 0;
-
-$me = '[FS::m2name_Common]';
-
-=head1 NAME
-
-FS::m2name_Common - Mixin class for tables with a related table listing names
-
-=head1 SYNOPSIS
-
-use FS::m2name_Common;
-
-@ISA = qw( FS::m2name_Common FS::Record );
-
-=head1 DESCRIPTION
-
-FS::m2name_Common is intended as a mixin class for classes which have a
-related table that lists names.
-
-=head1 METHODS
-
-=over 4
-
-=item process_m2name OPTION => VALUE, ...
-
-Available options:
-
-link_table (required) - Table into which the records are inserted.
-
-num_col (optional) - Column in link_table which links to the primary key of the base table. If not specified, it is assumed this has the same name.
-
-name_col (required) - Name of the column in link_table that stores the string names.
-
-names_list (required) - List reference of the possible string name values.
-
-params (required) - Hashref of keys and values, often passed as C<scalar($cgi->Vars)> from a form. Processing is controlled by the B<param_style param> option.
-
-param_style (required) - Controls processing of B<params>. I<'link_table.value checkboxes'> specifies that parameters keys are in the form C<link_table.name>, and the values are booleans controlling whether or not to insert that name into link_table. I<'name_colN values'> specifies that parameter keys are in the form C<name_col0>, C<name_col1>, and so on, and values are the names inserted into link_table.
-
-args_callback (optional) - Coderef. Optional callback that may modify arguments for insert and replace operations. The callback is run with four arguments: the first argument is object being inserted or replaced (i.e. FS::I<link_table> object), the second argument is a prefix to use when retreiving CGI arguements from the params hashref, the third argument is the params hashref (see above), and the final argument is a listref of arguments that the callback should modify.
-
-=cut
-
-sub process_m2name {
- my( $self, %opt ) = @_;
-
- my $self_pkey = $self->dbdef_table->primary_key;
- my $link_sourcekey = $opt{'num_col'} || $self_pkey;
-
- my $link_table = $self->_load_table($opt{'link_table'});
-
- my $link_static = $opt{'link_static'} || {};
-
- warn "$me processing m2name from ". $self->table. ".$link_sourcekey".
- " to $link_table\n"
- if $DEBUG;
-
- foreach my $name ( @{ $opt{'names_list'} } ) {
-
- warn "$me checking $name\n" if $DEBUG;
-
- my $name_col = $opt{'name_col'};
-
- my $obj = qsearchs( $link_table, {
- $link_sourcekey => $self->$self_pkey(),
- $name_col => $name,
- %$link_static,
- });
-
- my $param = '';
- my $prefix = '';
- if ( $opt{'param_style'} =~ /link_table.value\s+checkboxes/i ) {
- #access_group.html style
- my $paramname = "$link_table.$name";
- $param = $opt{'params'}->{$paramname};
- } elsif ( $opt{'param_style'} =~ /name_colN values/i ) {
- #part_event.html style
-
- my @fields = grep { /^$name_col\d+$/ }
- keys %{$opt{'params'}};
-
- $param = grep { $name eq $opt{'params'}->{$_} } @fields;
-
- if ( $param ) {
- #this depends on their being one condition per name...
- #which needs to be enforced on the edit page...
- #(it is on part_event and access_group edit)
- foreach my $field (@fields) {
- $prefix = "$field." if $name eq $opt{'params'}->{$field};
- }
- warn "$me prefix $prefix\n" if $DEBUG;
- }
- } else { #??
- croak "unknown param_style: ". $opt{'param_style'};
- $param = $opt{'params'}->{$name};
- }
-
- if ( $obj && ! $param ) {
-
- warn "$me deleting $name\n" if $DEBUG;
-
- my $d_obj = $obj; #need to save $obj for below.
- my $error = $d_obj->delete;
- die "error deleting $d_obj for $link_table.$name: $error" if $error;
-
- } elsif ( $param && ! $obj ) {
-
- warn "$me inserting $name\n" if $DEBUG;
-
- #ok to clobber it now (but bad form nonetheless?)
- #$obj = new "FS::$link_table" ( {
- $obj = "FS::$link_table"->new( {
- $link_sourcekey => $self->$self_pkey(),
- $opt{'name_col'} => $name,
- %$link_static,
- });
-
- my @args = ();
- if ( $opt{'args_callback'} ) { #edit/process/part_event.html
- &{ $opt{'args_callback'} }( $obj,
- $prefix,
- $opt{'params'},
- \@args
- );
- }
-
- my $error = $obj->insert( @args );
- die "error inserting $obj for $link_table.$name: $error" if $error;
-
- } elsif ( $param && $obj && $opt{'args_callback'} ) {
-
- my @args = ();
- if ( $opt{'args_callback'} ) { #edit/process/part_event.html
- &{ $opt{'args_callback'} }( $obj,
- $prefix,
- $opt{'params'},
- \@args
- );
- }
-
- my $error = $obj->replace( $obj, @args );
- die "error replacing $obj for $link_table.$name: $error" if $error;
-
- }
-
- }
-
- '';
-}
-
-sub _load_table {
- my( $self, $table ) = @_;
- eval "use FS::$table";
- die $@ if $@;
- $table;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>
-
-=cut
-
-1;
-
diff --git a/FS/FS/mailinglist.pm b/FS/FS/mailinglist.pm
deleted file mode 100644
index 1294610..0000000
--- a/FS/FS/mailinglist.pm
+++ /dev/null
@@ -1,173 +0,0 @@
-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
deleted file mode 100644
index 49688d8..0000000
--- a/FS/FS/mailinglistmember.pm
+++ /dev/null
@@ -1,245 +0,0 @@
-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;
-use FS::contact_email;
-
-=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 contactemailnum
-
-contactemailnum
-
-=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_foreign_keyn('contactemailnum', 'contact_email', 'contactemailnum')
- || $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, contactemailnum
- $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/msg_template.pm b/FS/FS/msg_template.pm
deleted file mode 100644
index f0cda41..0000000
--- a/FS/FS/msg_template.pm
+++ /dev/null
@@ -1,572 +0,0 @@
-package FS::msg_template;
-
-use strict;
-use base qw( FS::Record );
-use Text::Template;
-use FS::Misc qw( generate_email send_email );
-use FS::Conf;
-use FS::Record qw( qsearch qsearchs );
-
-use Date::Format qw( time2str );
-use HTML::Entities qw( decode_entities encode_entities ) ;
-use HTML::FormatText;
-use HTML::TreeBuilder;
-use vars '$DEBUG';
-
-$DEBUG=0;
-
-=head1 NAME
-
-FS::msg_template - Object methods for msg_template records
-
-=head1 SYNOPSIS
-
- use FS::msg_template;
-
- $record = new FS::msg_template \%hash;
- $record = new FS::msg_template { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::msg_template object represents a customer message template.
-FS::msg_template inherits from FS::Record. The following fields are currently
-supported:
-
-=over 4
-
-=item msgnum
-
-primary key
-
-=item msgname
-
-Template name.
-
-=item agentnum
-
-Agent associated with this template. Can be NULL for a global template.
-
-=item mime_type
-
-MIME type. Defaults to text/html.
-
-=item from_addr
-
-Source email address.
-
-=item subject
-
-The message subject line, in L<Text::Template> format.
-
-=item body
-
-The message body, as plain text or HTML, in L<Text::Template> format.
-
-=item disabled
-
-disabled
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new template. To add the template 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 { 'msg_template'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid template. 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('msgnum')
- || $self->ut_text('msgname')
- || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
- || $self->ut_textn('mime_type')
- || $self->ut_anything('subject')
- || $self->ut_anything('body')
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- || $self->ut_textn('from_addr')
- ;
- return $error if $error;
-
- $self->mime_type('text/html') unless $self->mime_type;
-
- $self->SUPER::check;
-}
-
-=item prepare OPTION => VALUE
-
-Fills in the template and returns a hash of the 'from' address, 'to'
-addresses, subject line, and body.
-
-Options are passed as a list of name/value pairs:
-
-=over 4
-
-=item cust_main
-
-Customer object (required).
-
-=item object
-
-Additional context object (currently, can be a cust_main, cust_pkg,
-cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband,
-domain) ). If the object is a svc_*, its cust_pkg will be fetched and
-used for substitution.
-
-As a special case, this may be an arrayref of two objects. Both
-objects will be available for substitution, with their field names
-prefixed with 'new_' and 'old_' respectively. This is used in the
-rt_ticket export when exporting "replace" events.
-
-=item to
-
-Destination address. The default is to use the customer's
-invoicing_list addresses.
-
-=back
-
-=cut
-
-sub prepare {
- my( $self, %opt ) = @_;
-
- my $cust_main = $opt{'cust_main'};
- my $object = $opt{'object'};
- warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n"
- if($DEBUG);
-
- my $subs = $self->substitutions;
-
- ###
- # create substitution table
- ###
- my %hash;
- my @objects = ($cust_main);
- my @prefixes = ('');
- my $svc;
- if( ref $object ) {
- if( ref($object) eq 'ARRAY' ) {
- # [new, old], for provisioning tickets
- push @objects, $object->[0], $object->[1];
- push @prefixes, 'new_', 'old_';
- $svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
- }
- else {
- push @objects, $object;
- push @prefixes, '';
- $svc = $object if $object->isa('FS::svc_Common');
- }
- }
- if( $svc ) {
- push @objects, $svc->cust_svc->cust_pkg;
- push @prefixes, '';
- }
-
- foreach my $obj (@objects) {
- my $prefix = shift @prefixes;
- foreach my $name (@{ $subs->{$obj->table} }) {
- if(!ref($name)) {
- # simple case
- $hash{$prefix.$name} = $obj->$name();
- }
- elsif( ref($name) eq 'ARRAY' ) {
- # [ foo => sub { ... } ]
- $hash{$prefix.($name->[0])} = $name->[1]->($obj);
- }
- else {
- warn "bad msg_template substitution: '$name'\n";
- #skip it?
- }
- }
- }
- $_ = encode_entities($_) foreach values(%hash);
-
-
- ###
- # clean up template
- ###
- my $subject_tmpl = new Text::Template (
- TYPE => 'STRING',
- SOURCE => $self->subject,
- );
- my $subject = $subject_tmpl->fill_in( HASH => \%hash );
-
- my $body = $self->body;
- my ($skin, $guts) = eviscerate($body);
- @$guts = map {
- $_ = decode_entities($_); # turn all punctuation back into itself
- s/\r//gs; # remove \r's
- s/<br[^>]*>/\n/gsi; # and <br /> tags
- s/<p>/\n/gsi; # and <p>
- s/<\/p>//gsi; # and </p>
- s/\240/ /gs; # and &nbsp;
- $_
- } @$guts;
-
- $body = '{ use Date::Format qw(time2str); "" }';
- while(@$skin || @$guts) {
- $body .= shift(@$skin) || '';
- $body .= shift(@$guts) || '';
- }
-
- ###
- # fill-in
- ###
-
- my $body_tmpl = new Text::Template (
- TYPE => 'STRING',
- SOURCE => $body,
- );
-
- $body = $body_tmpl->fill_in( HASH => \%hash );
-
- ###
- # and email
- ###
-
- my @to = ($opt{'to'}) || $cust_main->invoicing_list_emailonly;
- #warn "prepared msg_template with no email destination (custnum ".
- # $cust_main->custnum.")\n"
- # if !@to;
- # warning is not appropriate now that we use these for tickets
-
- my $conf = new FS::Conf;
-
- (
- 'from' => $self->from_addr ||
- scalar( $conf->config('invoice_from', $cust_main->agentnum) ),
- 'to' => \@to,
- 'bcc' => $self->bcc_addr || undef,
- 'subject' => $subject,
- 'html_body' => $body,
- 'text_body' => HTML::FormatText->new(leftmargin => 0, rightmargin => 70
- )->format( HTML::TreeBuilder->new_from_content($body) ),
- );
-
-}
-
-=item send OPTION => VALUE
-
-Fills in the template and sends it to the customer. Options are as for
-'prepare'.
-
-=cut
-
-# broken out from prepare() in case we want to queue the sending,
-# preview it, etc.
-sub send {
- my $self = shift;
- send_email(generate_email($self->prepare(@_)));
-}
-
-# helper sub for package dates
-my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
-
-# needed for some things
-my $conf = new FS::Conf;
-
-#return contexts and fill-in values
-# If you add anything, be sure to add a description in
-# httemplate/edit/msg_template.html.
-sub substitutions {
- { 'cust_main' => [qw(
- display_custnum agentnum agent_name
-
- last first company
- name name_short contact contact_firstlast
- address1 address2 city county state zip
- country
- daytime night fax
-
- has_ship_address
- ship_last ship_first ship_company
- ship_name ship_name_short ship_contact ship_contact_firstlast
- ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
- ship_country
- ship_daytime ship_night ship_fax
-
- paymask payname paytype payip
- num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
- classname categoryname
- balance
- credit_limit
- invoicing_list_emailonly
- cust_status ucfirst_cust_status cust_statuscolor
-
- signupdate dundate
- expdate
- packages recurdates
- ),
- # expdate is a special case
- [ signupdate_ymd => sub { time2str('%Y-%m-%d', shift->signupdate) } ],
- [ dundate_ymd => sub { time2str('%Y-%m-%d', shift->dundate) } ],
- [ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
- [ otaker_first => sub { shift->access_user->first } ],
- [ otaker_last => sub { shift->access_user->last } ],
- [ payby => sub { FS::payby->shortname(shift->payby) } ],
- [ company_name => sub {
- $conf->config('company_name', shift->agentnum)
- } ],
- [ company_address => sub {
- $conf->config('company_address', shift->agentnum)
- } ],
- ],
- # next_bill_date
- 'cust_pkg' => [qw(
- pkgnum pkg_label pkg_label_long
- location_label
- status statuscolor
-
- start_date setup bill last_bill
- adjourn susp expire
- labels_short
- ),
- [ pkg => sub { shift->part_pkg->pkg } ],
- [ cancel => sub { shift->getfield('cancel') } ], # grrr...
- [ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ],
- [ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ],
- [ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ],
- [ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ],
- [ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ],
- [ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ],
- [ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ],
- [ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ],
- ],
- 'cust_bill' => [qw(
- invnum
- _date
- )],
- #XXX not really thinking about cust_bill substitutions quite yet
-
- # for welcome and limit warning messages
- 'svc_acct' => [qw(
- svcnum
- username
- domain
- ),
- [ password => sub { shift->getfield('_password') } ],
- ],
- 'svc_domain' => [qw(
- svcnum
- domain
- ),
- [ registrar => sub {
- my $registrar = qsearchs('registrar',
- { registrarnum => shift->registrarnum} );
- $registrar ? $registrar->registrarname : ''
- }
- ],
- [ catchall => sub {
- my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
- $svc_acct ? $svc_acct->email : ''
- }
- ],
- ],
- 'svc_phone' => [qw(
- svcnum
- phonenum
- countrycode
- domain
- )
- ],
- 'svc_broadband' => [qw(
- svcnum
- speed_up
- speed_down
- ip_addr
- mac_addr
- )
- ],
- # for payment receipts
- 'cust_pay' => [qw(
- paynum
- _date
- ),
- [ paid => sub { sprintf("%.2f", shift->paid) } ],
- # overrides the one in cust_main in cases where a cust_pay is passed
- [ payby => sub { FS::payby->shortname(shift->payby) } ],
- [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
- [ payinfo => sub {
- my $cust_pay = shift;
- ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
- $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
- } ],
- ],
- # for payment decline messages
- # try to support all cust_pay fields
- # 'error' is a special case, it contains the raw error from the gateway
- 'cust_pay_pending' => [qw(
- _date
- error
- ),
- [ paid => sub { sprintf("%.2f", shift->paid) } ],
- [ payby => sub { FS::payby->shortname(shift->payby) } ],
- [ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
- [ payinfo => sub {
- my $pending = shift;
- ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
- $pending->paymask : $pending->decrypt($pending->payinfo)
- } ],
- ],
- };
-}
-
-sub _upgrade_data {
- my ($self, %opts) = @_;
-
- my @fixes = (
- [ 'alerter_msgnum', 'alerter_template', '', '', '' ],
- [ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ],
- [ 'decline_msgnum', 'declinetemplate', '', '', '' ],
- [ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ],
- [ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ],
- [ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ],
- [ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ],
- );
-
- my $conf = new FS::Conf;
- my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
- foreach my $agentnum (@agentnums) {
- foreach (@fixes) {
- my ($newname, $oldname, $subject, $from, $bcc) = @$_;
- if ($conf->exists($oldname, $agentnum)) {
- my $new = new FS::msg_template({
- 'msgname' => $oldname,
- 'agentnum' => $agentnum,
- 'from_addr' => ($from && $conf->config($from, $agentnum)) ||
- $conf->config('invoice_from', $agentnum),
- 'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '',
- 'subject' => ($subject && $conf->config($subject, $agentnum)) || '',
- 'mime_type' => 'text/html',
- 'body' => join('<BR>',$conf->config($oldname, $agentnum)),
- });
- my $error = $new->insert;
- die $error if $error;
- $conf->set($newname, $new->msgnum, $agentnum);
- $conf->delete($oldname, $agentnum);
- $conf->delete($from, $agentnum) if $from;
- $conf->delete($subject, $agentnum) if $subject;
- }
- }
- }
-}
-
-sub eviscerate {
- # Every bit as pleasant as it sounds.
- #
- # We do this because Text::Template::Preprocess doesn't
- # actually work. It runs the entire template through
- # the preprocessor, instead of the code segments. Which
- # is a shame, because Text::Template already contains
- # the code to do this operation.
- my $body = shift;
- my (@outside, @inside);
- my $depth = 0;
- my $chunk = '';
- while($body || $chunk) {
- my ($first, $delim, $rest);
- # put all leading non-delimiters into $first
- ($first, $rest) =
- ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
- $chunk .= $first;
- # put a leading delimiter into $delim if there is one
- ($delim, $rest) =
- ($rest =~ /^([{}]?)(.*)$/s);
-
- if( $delim eq '{' ) {
- $chunk .= '{';
- if( $depth == 0 ) {
- push @outside, $chunk;
- $chunk = '';
- }
- $depth++;
- }
- elsif( $delim eq '}' ) {
- $depth--;
- if( $depth == 0 ) {
- push @inside, $chunk;
- $chunk = '';
- }
- $chunk .= '}';
- }
- else {
- # no more delimiters
- if( $depth == 0 ) {
- push @outside, $chunk . $rest;
- } # else ? something wrong
- last;
- }
- $body = $rest;
- }
- (\@outside, \@inside);
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/msgcat.pm b/FS/FS/msgcat.pm
deleted file mode 100644
index d1224f3..0000000
--- a/FS/FS/msgcat.pm
+++ /dev/null
@@ -1,166 +0,0 @@
-package FS::msgcat;
-
-use strict;
-use vars qw( @ISA );
-use Exporter;
-use FS::UID;
-use FS::Record; # qw( qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::msgcat - Object methods for message catalog entries
-
-=head1 SYNOPSIS
-
- use FS::msgcat;
-
- $record = new FS::msgcat \%hash;
- $record = new FS::msgcat { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::msgcat object represents an message catalog entry. FS::msgcat inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item msgnum - primary key
-
-=item msgcode - Error code
-
-=item locale - Locale
-
-=item msg - Message
-
-=back
-
-If you just want to B<use> message catalogs, see L<FS::Msgcat>.
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new message catalog entry. To add the message catalog entry 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 { 'msgcat'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid message catalog entry. 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('msgnum')
- || $self->ut_text('msgcode')
- || $self->ut_text('msg')
- ;
- return $error if $error;
-
- $self->locale =~ /^([\w\@]+)$/ or return "illegal locale: ". $self->locale;
- $self->locale($1);
-
- $self->SUPER::check
-}
-
-
-sub _upgrade_data { #class method
- my( $class, %opts) = @_;
-
- eval "use FS::Setup;";
- die $@ if $@;
-
- #"repopulate_msgcat", false laziness w/FS::Setup::populate_msgcat
-
- my %messages = FS::Setup::msgcat_messages();
-
- foreach my $msgcode ( keys %messages ) {
- foreach my $locale ( keys %{$messages{$msgcode}} ) {
- my %msgcat = (
- 'msgcode' => $msgcode,
- 'locale' => $locale,
- #'msg' => $messages{$msgcode}{$locale},
- );
- #my $msgcat = qsearchs('msgcat', \%msgcat);
- my $msgcat = FS::Record::qsearchs('msgcat', \%msgcat); #wtf?
- next if $msgcat;
-
- $msgcat = new FS::msgcat( {
- %msgcat,
- 'msg' => $messages{$msgcode}{$locale},
- } );
- my $error = $msgcat->insert;
- die $error if $error;
- }
- }
-
-}
-
-=back
-
-=head1 BUGS
-
-i18n/l10n, eek
-
-=head1 SEE ALSO
-
-L<FS::Msgcat>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm
deleted file mode 100644
index 97b0ea1..0000000
--- a/FS/FS/nas.pm
+++ /dev/null
@@ -1,150 +0,0 @@
-package FS::nas;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw(qsearchs); #qsearch);
-use FS::UID qw( dbh );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::nas - Object methods for nas records
-
-=head1 SYNOPSIS
-
- use FS::nas;
-
- $record = new FS::nas \%hash;
- $record = new FS::nas {
- 'nasnum' => 1,
- 'nasip' => '10.4.20.23',
- 'nasfqdn' => 'box1.brc.nv.us.example.net',
- };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->heartbeat($timestamp);
-
-=head1 DESCRIPTION
-
-An FS::nas object represents an Network Access Server on your network, such as
-a terminal server or equivalent. FS::nas inherits from FS::Record. The
-following fields are currently supported:
-
-=over 4
-
-=item nasnum - primary key
-
-=item nas - NAS name
-
-=item nasip - NAS ip address
-
-=item nasfqdn - NAS fully-qualified domain name
-
-=item last - timestamp indicating the last instant the NAS was in a known
- state (used by the session monitoring).
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new NAS. To add the NAS 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 { 'nas'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid NAS. 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;
-
- $self->ut_numbern('nasnum')
- || $self->ut_text('nas')
- || $self->ut_ip('nasip')
- || $self->ut_domain('nasfqdn')
- || $self->ut_numbern('last')
- || $self->SUPER::check
- ;
-}
-
-=item heartbeat TIMESTAMP
-
-Updates the timestamp for this nas
-
-=cut
-
-sub heartbeat {
- my($self, $timestamp) = @_;
- my $dbh = dbh;
- my $sth =
- $dbh->prepare("UPDATE nas SET last = ? WHERE nasnum = ? AND last < ?");
- $sth->execute($timestamp, $self->nasnum, $timestamp) or die $sth->errstr;
- $self->last($timestamp);
-}
-
-=back
-
-=head1 BUGS
-
-heartbeat method uses SQL directly and doesn't update history tables.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/o2m_Common.pm b/FS/FS/o2m_Common.pm
deleted file mode 100644
index 0e03b52..0000000
--- a/FS/FS/o2m_Common.pm
+++ /dev/null
@@ -1,152 +0,0 @@
-package FS::o2m_Common;
-
-use strict;
-use vars qw( $DEBUG $me );
-use Carp;
-use FS::Schema qw( dbdef );
-use FS::Record qw( qsearch qsearchs dbh );
-
-$DEBUG = 0;
-
-$me = '[FS::o2m_Common]';
-
-=head1 NAME
-
-FS::o2m_Common - Mixin class for tables with a related table
-
-=head1 SYNOPSIS
-
-use FS::o2m_Common;
-
-@ISA = qw( FS::o2m_Common FS::Record );
-
-=head1 DESCRIPTION
-
-FS::o2m_Common is intended as a mixin class for classes which have a
-related table.
-
-=head1 METHODS
-
-=over 4
-
-=item process_o2m OPTION => VALUE, ...
-
-Available options:
-
-table (required) - Table into which the records are inserted.
-
-num_col (optional) - Column in table which links to the primary key of the base table. If not specified, it is assumed this has the same name.
-
-params (required) - Hashref of keys and values, often passed as C<scalar($cgi->Vars)> from a form.
-
-fields (required) - Arrayref of field names for each record in table. Pulled from params as "pkeyNN_field" where pkey is table's primary key and NN is the entry's numeric identifier.
-
-=cut
-
-#a little more false laziness w/m2m_Common.pm than m2_name_Common.pm
-# still, far from the worse of it. at least we're a reuable mixin!
-sub process_o2m {
- my( $self, %opt ) = @_;
-
- my $self_pkey = $self->dbdef_table->primary_key;
- my $link_sourcekey = $opt{'num_col'} || $self_pkey;
-
- my $hashref = {}; #$opt{'hashref'} || {};
- $hashref->{$link_sourcekey} = $self->$self_pkey();
-
- my $table = $self->_load_table($opt{'table'});
- my $table_pkey = dbdef->table($table)->primary_key;
-
-# my $link_static = $opt{'link_static'} || {};
-
- warn "$me processing o2m from ". $self->table. ".$link_sourcekey".
- " to $table\n"
- if $DEBUG;
-
- #if ( ref($opt{'params'}) eq 'ARRAY' ) {
- # $opt{'params'} = { map { $_=>1 } @{$opt{'params'}} };
- #}
-
- 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 @fields = grep { /^$table_pkey\d+$/ }
- keys %{ $opt{'params'} };
-
- my %edits = map { $opt{'params'}->{$_} => $_ }
- grep { $opt{'params'}->{$_} }
- @fields;
-
- foreach my $del_obj (
- grep { ! $edits{$_->$table_pkey()} }
- qsearch( $table, $hashref )
- ) {
- my $error = $del_obj->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- foreach my $pkey_value ( keys %edits ) {
- my $old_obj = qsearchs( $table, { %$hashref, $table_pkey => $pkey_value } ),
- my $add_param = $edits{$pkey_value};
- my %hash = ( $table_pkey => $pkey_value,
- map { $_ => $opt{'params'}->{$add_param."_$_"} }
- @{ $opt{'fields'} }
- );
- #next unless grep { $_ =~ /\S/ } values %hash;
-
- my $new_obj = "FS::$table"->new( { %$hashref, %hash } );
- my $error = $new_obj->replace($old_obj);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- foreach my $add_param ( grep { ! $opt{'params'}->{$_} } @fields ) {
-
- my %hash = map { $_ => $opt{'params'}->{$add_param."_$_"} }
- @{ $opt{'fields'} };
- next unless grep { $_ =~ /\S/ } values %hash;
-
- my $add_obj = "FS::$table"->new( { %$hashref, %hash } );
- my $error = $add_obj->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
-sub _load_table {
- my( $self, $table ) = @_;
- eval "use FS::$table";
- die $@ if $@;
- $table;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>
-
-=cut
-
-1;
-
diff --git a/FS/FS/option_Common.pm b/FS/FS/option_Common.pm
deleted file mode 100644
index 26bb7ca..0000000
--- a/FS/FS/option_Common.pm
+++ /dev/null
@@ -1,352 +0,0 @@
-package FS::option_Common;
-
-use strict;
-use vars qw( @ISA $DEBUG );
-use Scalar::Util qw( blessed );
-use FS::Record qw( qsearch qsearchs dbh );
-
-@ISA = qw( FS::Record );
-
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::option_Common - Base class for option sub-classes
-
-=head1 SYNOPSIS
-
-use FS::option_Common;
-
-@ISA = qw( FS::option_Common );
-
-#optional for non-standard names
-sub _option_table { 'table_name'; } #defaults to ${table}_option
-sub _option_namecol { 'column_name'; } #defaults to optionname
-sub _option_valuecol { 'column_name'; } #defaults to optionvalue
-
-=head1 DESCRIPTION
-
-FS::option_Common is intended as a base class for classes which have a
-simple one-to-many class associated with them, used to store a hash-like data
-structure of keys and values.
-
-=head1 METHODS
-
-=over 4
-
-=item insert [ HASHREF | OPTION => VALUE ... ]
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-If a list or hash reference of options is supplied, option records are also
-created.
-
-=cut
-
-#false laziness w/queue.pm
-sub insert {
- my $self = shift;
- my $options =
- ( ref($_[0]) eq 'HASH' )
- ? shift
- : { @_ };
- warn "FS::option_Common::insert called on $self with options ".
- join(', ', map "$_ => ".$options->{$_}, keys %$options)
- if $DEBUG;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- my $pkey = $self->primary_key;
- my $option_table = $self->option_table;
-
- my $namecol = $self->_option_namecol;
- my $valuecol = $self->_option_valuecol;
-
- foreach my $optionname ( keys %{$options} ) {
-
- my $optionvalue = $options->{$optionname};
-
- my $href = {
- $pkey => $self->get($pkey),
- $namecol => $optionname,
- $valuecol => ( ref($optionvalue) || $optionvalue ),
- };
-
- #my $option_record = eval "new FS::$option_table \$href";
- #if ( $@ ) {
- # $dbh->rollback if $oldAutoCommit;
- # return $@;
- #}
- my $option_record = "FS::$option_table"->new($href);
-
- my @args = ();
- push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
-
- $error = $option_record->insert(@args);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item delete
-
-Delete this record from the database. Any associated option records are also
-deleted.
-
-=cut
-
-#foreign keys would make this much less tedious... grr dumb mysql
-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;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- my $pkey = $self->primary_key;
- #my $option_table = $self->option_table;
-
- foreach my $obj ( $self->option_objects ) {
- my $error = $obj->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-If a list or hash reference of options is supplied, option records are created
-or modified.
-
-=cut
-
-sub replace {
- my $self = shift;
-
- my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
- ? shift
- : $self->replace_old;
-
- my $options;
- my $options_supplied = 0;
- if ( ref($_[0]) eq 'HASH' ) {
- $options = shift;
- $options_supplied = 1;
- } else {
- $options = { @_ };
- $options_supplied = scalar(@_) ? 1 : 0;
- }
-
- warn "FS::option_Common::replace called on $self with options ".
- join(', ', map "$_ => ". $options->{$_}, keys %$options)
- if $DEBUG;
-
- 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::replace($old);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- my $pkey = $self->primary_key;
- my $option_table = $self->option_table;
-
- my $namecol = $self->_option_namecol;
- my $valuecol = $self->_option_valuecol;
-
- foreach my $optionname ( keys %{$options} ) {
-
- warn "FS::option_Common::replace: inserting or replacing option: $optionname"
- if $DEBUG > 1;
-
- my $oldopt = qsearchs( $option_table, {
- $pkey => $self->get($pkey),
- $namecol => $optionname,
- } );
-
- my $optionvalue = $options->{$optionname};
-
- my %oldhash = $oldopt ? $oldopt->hash : ();
-
- my $href = {
- %oldhash,
- $pkey => $self->get($pkey),
- $namecol => $optionname,
- $valuecol => ( ref($optionvalue) || $optionvalue ),
- };
-
- #my $newopt = eval "new FS::$option_table \$href";
- #if ( $@ ) {
- # $dbh->rollback if $oldAutoCommit;
- # return $@;
- #}
- my $newopt = "FS::$option_table"->new($href);
-
- my $opt_pkey = $newopt->primary_key;
-
- $newopt->$opt_pkey($oldopt->$opt_pkey) if $oldopt;
-
- my @args = ();
- push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
-
- warn "FS::option_Common::replace: ".
- ( $oldopt ? "$newopt -> replace($oldopt)" : "$newopt -> insert" )
- if $DEBUG > 2;
- my $error = $oldopt ? $newopt->replace($oldopt, @args)
- : $newopt->insert( @args);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- #remove extraneous old options
- if ( $options_supplied ) {
- foreach my $opt (
- grep { !exists $options->{$_->$namecol()} } $old->option_objects
- ) {
- my $error = $opt->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item option_objects
-
-Returns all options as FS::I<tablename>_option objects.
-
-=cut
-
-sub option_objects {
- my $self = shift;
- my $pkey = $self->primary_key;
- my $option_table = $self->option_table;
- qsearch($option_table, { $pkey => $self->get($pkey) } );
-}
-
-=item options
-
-Returns a list of option names and values suitable for assigning to a hash.
-
-=cut
-
-sub options {
- my $self = shift;
- my $namecol = $self->_option_namecol;
- my $valuecol = $self->_option_valuecol;
- map { $_->$namecol() => $_->$valuecol() } $self->option_objects;
-}
-
-=item option OPTIONNAME
-
-Returns the option value for the given name, or the empty string.
-
-=cut
-
-sub option {
- my $self = shift;
- my $pkey = $self->primary_key;
- my $option_table = $self->option_table;
- my $namecol = $self->_option_namecol;
- my $valuecol = $self->_option_valuecol;
- my $hashref = {
- $pkey => $self->get($pkey),
- $namecol => shift,
- };
- warn "$self -> option: searching for ".
- join(' / ', map { "$_ => ". $hashref->{$_} } keys %$hashref )
- if $DEBUG;
- my $obj = qsearchs($option_table, $hashref);
- $obj ? $obj->$valuecol() : '';
-}
-
-
-sub option_table {
- my $self = shift;
- my $option_table = $self->_option_table;
- eval "use FS::$option_table";
- die $@ if $@;
- $option_table;
-}
-
-#defaults
-sub _option_table { shift->table .'_option'; }
-sub _option_namecol { 'optionname'; }
-sub _option_valuecol { 'optionvalue'; }
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>
-
-=cut
-
-1;
-
diff --git a/FS/FS/otaker_Mixin.pm b/FS/FS/otaker_Mixin.pm
deleted file mode 100644
index 8d9c882..0000000
--- a/FS/FS/otaker_Mixin.pm
+++ /dev/null
@@ -1,84 +0,0 @@
-package FS::otaker_Mixin;
-
-use strict;
-use Carp qw( croak ); #confess );
-use FS::Record qw( qsearch qsearchs );
-use FS::access_user;
-
-sub otaker {
- my $self = shift;
- if ( scalar(@_) ) { #set
- my $otaker = shift;
- my $access_user = qsearchs('access_user', { 'username' => $otaker } );
- if ( !$access_user && $otaker =~ /^(.+), (.+)$/ ) { #same as below..
- my($lastname, $firstname) = ($1, $2);
- $otaker = lc($firstname.$lastname);
- $otaker =~ s/ //g;
- $access_user = qsearchs('access_user', { 'first' => $firstname,
- 'last' => $lastname } )
- || qsearchs('access_user', { 'username' => $otaker } );
- }
- croak "can't set otaker: $otaker not found!" unless $access_user; #confess?
- $self->usernum( $access_user->usernum );
- $otaker; #not sure return is used anywhere, but just in case
- } else { #get
- if ( $self->usernum ) {
- $self->access_user->username;
- } elsif ( length($self->get('otaker')) ) {
- $self->get('otaker');
- } else {
- '';
- }
- }
-}
-
-sub access_user {
- my $self = shift;
- qsearchs('access_user', { 'usernum' => $self->usernum } );
-}
-
-sub _upgrade_otaker {
- my $class = shift;
- my $table = $class->table;
-
- my $limit = ( $table eq 'cust_attachment' ? 10 : 1000 );
-
- while ( 1 ) {
- my @records = qsearch({
- 'table' => $table,
- 'hashref' => {},
- 'extra_sql' => "WHERE otaker IS NOT NULL LIMIT $limit",
- });
- last unless @records;
-
- foreach my $record (@records) {
- eval { $record->otaker($record->otaker) };
- if ( $@ ) {
- my $username = $record->otaker;
- my($lastname, $firstname) = ( 'User', 'Legacy' );
- if ( $username =~ /^(.+), (.+)$/ ) {
- ($lastname, $firstname) = ($1, $2);
- $username = lc($firstname.$lastname);
- $username =~ s/ //g;
- }
- my $access_user = new FS::access_user {
- 'username' => $username,
- '_password' => 'CHANGEME',
- 'first' => $firstname,
- 'last' => $lastname,
- 'disabled' => 'Y',
- };
- my $error = $access_user->insert;
- die $error if $error;
- $record->otaker($record->otaker);
- }
- $record->set('otaker', '');
- my $error = $record->replace;
- die $error if $error;
- }
-
- }
-
-}
-
-1;
diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm
deleted file mode 100644
index 4e7aa52..0000000
--- a/FS/FS/part_bill_event.pm
+++ /dev/null
@@ -1,368 +0,0 @@
-package FS::part_bill_event;
-
-use strict;
-use vars qw( @ISA $DEBUG @EXPORT_OK );
-use Carp qw(cluck confess);
-use FS::Record qw( dbh qsearch qsearchs );
-use FS::Conf;
-use FS::cust_main;
-use FS::cust_bill;
-
-@ISA = qw( FS::Record );
-@EXPORT_OK = qw( due_events );
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::part_bill_event - Object methods for part_bill_event records
-
-=head1 SYNOPSIS
-
- use FS::part_bill_event;
-
- $record = new FS::part_bill_event \%hash;
- $record = new FS::part_bill_event { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->do_event( $direct_object );
-
- @events = due_events ( { 'record' => $event_triggering_record,
- 'payby' => $payby,
- 'event_time => $_date,
- 'extra_sql => $extra } );
-
-=head1 DESCRIPTION
-
-An FS::part_bill_event object represents a deprecated, old-style invoice event
-definition - a callback which is triggered when an invoice is a certain amount
-of time overdue. FS::part_bill_event inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item eventpart - primary key
-
-=item payby - CARD, DCRD, CHEK, DCHK, LECB, BILL, or COMP
-
-=item event - event name
-
-=item eventcode - event action
-
-=item seconds - how long after the invoice date events of this type are triggered
-
-=item weight - ordering for events with identical seconds
-
-=item plan - eventcode plan
-
-=item plandata - additional plan data
-
-=item reason - an associated reason for this event to fire
-
-=item disabled - Disabled flag, empty or `Y'
-
-=back
-
-=head1 NOTE
-
-Old-style invoice events are only useful for legacy migrations - if you are
-looking for current events see L<FS::part_event>.
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new invoice event definition. To add the invoice event definition 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 { 'part_bill_event'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid invoice event definition. 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;
-
- $self->weight(0) unless $self->weight;
-
- my $conf = new FS::Conf;
- if ( $conf->exists('safe-part_bill_event') ) {
- my $error = $self->ut_anything('eventcode');
- return $error if $error;
-
- my $c = $self->eventcode;
-
- #yay, these regexen will go away with the event refactor
-
- $c =~ /^\s*\$cust_main\->(suspend|cancel|invoicing_list_addpost|bill|collect)\(\);\s*("";)?\s*$/
-
- or $c =~ /^\s*\$cust_bill\->(comp|realtime_(card|ach|lec)|batch_card|send)\((%options)*\);\s*$/
-
- or $c =~ /^\s*\$cust_bill\->send(_if_newest)?\(\'[\w\-\s]+\'\s*(,\s*(\d+|\[\s*\d+(,\s*\d+)*\s*\])\s*,\s*'[\w\@\.\-\+]*'\s*)?\);\s*$/
-
-# or $c =~ /^\s*\$cust_main\->apply_payments; \$cust_main->apply_credits; "";\s*$/
- or $c =~ /^\s*\$cust_main\->apply_payments_and_credits; "";\s*$/
-
- or $c =~ /^\s*\$cust_main\->charge\( \s*\d*\.?\d*\s*,\s*\'[\w \!\@\#\$\%\&\(\)\-\+\;\:\"\,\.\?\/]*\'\s*\);\s*$/
-
- or $c =~ /^\s*\$cust_main\->suspend_(if|unless)_pkgpart\([\d\,\s]*\);\s*$/
-
- or $c =~ /^\s*\$cust_bill\->cust_suspend_if_balance_over\([\d\.\s]*\);\s*$/
-
- or do {
- #log
- return "illegal eventcode: $c";
- };
-
- }
-
- my $error = $self->ut_numbern('eventpart')
- || $self->ut_enum('payby', [qw( CARD DCLN DCRD CHEK DCHK LECB BILL COMP )] )
- || $self->ut_text('event')
- || $self->ut_anything('eventcode')
- || $self->ut_number('seconds')
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- || $self->ut_number('weight')
- || $self->ut_textn('plan')
- || $self->ut_anything('plandata')
- || $self->ut_numbern('reason')
- ;
- #|| $self->ut_snumber('seconds')
- return $error if $error;
-
- #quelle kludge
- if ( $self->plandata =~ /^(agent_)?templatename\s+(.*)$/m ) {
- my $name= $2;
-
- foreach my $file (qw( template
- latex latexnotes latexreturnaddress latexfooter
- latexsmallfooter
- html htmlnotes htmlreturnaddress htmlfooter
- ))
- {
- unless ( $conf->exists("invoice_${file}_$name") ) {
- $conf->set(
- "invoice_${file}_$name" =>
- join("\n", $conf->config("invoice_$file") )
- );
- }
- }
- }
-
- if ($self->reason){
- my $reasonr = qsearchs('reason', {'reasonnum' => $self->reason});
- return "Unknown reason" unless $reasonr;
- }
-
- $self->SUPER::check;
-}
-
-=item templatename
-
-Returns the alternate invoice template name, if any, or false if there is
-no alternate template for this invoice event.
-
-=cut
-
-sub templatename {
- my $self = shift;
- if ( $self->plan =~ /^send_(alternate|agent)$/
- && $self->plandata =~ /^(agent_)?templatename (.*)$/m
- )
- {
- $2;
- } else {
- '';
- }
-}
-
-=item due_events
-
-Returns the list of events due, if any, or false if there is none.
-Requires record and payby, but event_time and extra_sql are optional.
-
-=cut
-
-sub due_events {
- my ($record, $payby, $event_time, $extra_sql) = @_;
-
- #cluck "DEPRECATED: FS::part_bill_event::due_events called on $record";
- confess "DEPRECATED: FS::part_bill_event::due_events called on $record";
-
- my $interval = 0;
- if ($record->_date){
- $event_time = time unless $event_time;
- $interval = $event_time - $record->_date;
- }
- sort { $a->seconds <=> $b->seconds
- || $a->weight <=> $b->weight
- || $a->eventpart <=> $b->eventpart }
- grep { ref($record) ne 'FS::cust_bill' || $_->eventcode !~ /honor_dundate/
- || $event_time > $record->cust_main->dundate
- }
- grep { $_->seconds <= ( $interval )
- && ! qsearch( 'cust_bill_event', {
- 'invnum' => $record->get($record->dbdef_table->primary_key),
- 'eventpart' => $_->eventpart,
- 'status' => 'done',
- } )
- }
- qsearch( {
- 'table' => 'part_bill_event',
- 'hashref' => { 'payby' => $payby,
- 'disabled' => '', },
- 'extra_sql' => $extra_sql,
- } );
-
-
-}
-
-=item do_event
-
-Performs the event and returns any errors that occur.
-Requires a record on which to perform the event.
-Should only be performed inside a transaction.
-
-=cut
-
-sub do_event {
- my ($self, $object, %options) = @_;
-
- #cluck "DEPRECATED: FS::part_bill_event::do_event called on $self";
- confess "DEPRECATED: FS::part_bill_event::do_event called on $self";
-
- warn " calling event (". $self->eventcode. ") for " . $object->table . " " ,
- $object->get($object->dbdef_table->primary_key) . "\n" if $DEBUG > 1;
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
-
- # for "callback" -- heh
- my $cust_main = $object->cust_main;
- my $cust_bill;
- if ($object->table eq 'cust_bill'){
- $cust_bill = $object;
- }
- my $cust_pay_batch;
- if ($object->table eq 'cust_pay_batch'){
- $cust_pay_batch = $object;
- }
-
- my $error;
- {
- local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
- $error = eval $self->eventcode;
- }
-
- my $status = '';
- my $statustext = '';
- if ( $@ ) {
- $status = 'failed';
- $statustext = $@;
- } elsif ( $error ) {
- $status = 'done';
- $statustext = $error;
- } else {
- $status = 'done';
- }
-
- #add cust_bill_event
- my $cust_bill_event = new FS::cust_bill_event {
-# 'invnum' => $object->get($object->dbdef_table->primary_key),
- 'invnum' => $object->invnum,
- 'eventpart' => $self->eventpart,
- '_date' => time,
- 'status' => $status,
- 'statustext' => $statustext,
- };
- $error = $cust_bill_event->insert;
- if ( $error ) {
- my $e = 'WARNING: Event run but database not updated - '.
- 'error inserting cust_bill_event, invnum #'. $object->invnum .
- ', eventpart '. $self->eventpart.": $error";
- warn $e;
- return $e;
- }
- '';
-}
-
-=item reasontext
-
-Returns the text of any reason associated with this event.
-
-=cut
-
-sub reasontext {
- my $self = shift;
- my $r = qsearchs('reason', { 'reasonnum' => $self->reason });
- if ($r){
- $r->reason;
- }else{
- '';
- }
-}
-
-=back
-
-=head1 BUGS
-
-The whole "eventcode" idea is bunk. This should be refactored with subclasses
-like part_pkg/ and part_export/
-
-=head1 SEE ALSO
-
-L<FS::cust_bill>, L<FS::cust_bill_event>, L<FS::Record>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_device.pm b/FS/FS/part_device.pm
deleted file mode 100644
index 4963584..0000000
--- a/FS/FS/part_device.pm
+++ /dev/null
@@ -1,148 +0,0 @@
-package FS::part_device;
-
-use strict;
-use base qw( FS::Record FS::m2m_Common );
-use FS::Record qw( qsearch qsearchs );
-use FS::part_export;
-use FS::export_device;
-
-=head1 NAME
-
-FS::part_device - Object methods for part_device records
-
-=head1 SYNOPSIS
-
- use FS::part_device;
-
- $record = new FS::part_device \%hash;
- $record = new FS::part_device { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_device object represents a phone device definition. FS::part_device
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item devicepart
-
-primary key
-
-=item devicename
-
-devicename
-
-
-=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 { 'part_device'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('devicepart')
- || $self->ut_text('devicename')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item part_export
-
-Returns a list of all exports (see L<FS::part_export>) for this device.
-
-=cut
-
-sub part_export {
- my $self = shift;
- map { qsearchs( 'part_export', { 'exportnum' => $_->exportnum } ) }
- qsearch( 'export_device', { 'devicepart' => $self->devicepart } );
-}
-
-sub process_batch_import {
- my $job = shift;
-
- my $opt = { 'table' => 'part_device',
- 'params' => [],
- 'formats' => { 'default' => [ 'devicename' ] },
- 'default_csv' => 1,
- };
-
- FS::Record::process_batch_import( $job, $opt, @_ );
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_event.pm b/FS/FS/part_event.pm
deleted file mode 100644
index c98c3f8..0000000
--- a/FS/FS/part_event.pm
+++ /dev/null
@@ -1,444 +0,0 @@
-package FS::part_event;
-
-use strict;
-use vars qw( @ISA $DEBUG );
-use Carp qw(confess);
-use FS::Record qw( dbh qsearch qsearchs );
-use FS::option_Common;
-use FS::m2name_Common;
-use FS::Conf;
-use FS::part_event_option;
-use FS::part_event_condition;
-use FS::cust_event;
-use FS::agent;
-
-@ISA = qw( FS::m2name_Common FS::option_Common ); # FS::Record );
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::part_event - Object methods for part_event records
-
-=head1 SYNOPSIS
-
- use FS::part_event;
-
- $record = new FS::part_event \%hash;
- $record = new FS::part_event { 'column' => 'value' };
-
- $error = $record->insert( { 'option' => 'value' } );
- $error = $record->insert( \%options );
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->do_event( $direct_object );
-
-=head1 DESCRIPTION
-
-An FS::part_event object represents an event definition - a billing, collection
-or other callback which is triggered when certain customer, invoice, package or
-other conditions are met. FS::part_event inherits from FS::Record. The
-following fields are currently supported:
-
-=over 4
-
-=item eventpart - primary key
-
-=item agentnum - Optional agentnum (see L<FS::agent>)
-
-=item event - event name
-
-=item eventtable - table name against which this event is triggered; currently "cust_bill" (the traditional invoice events), "cust_main" (customer events) or "cust_pkg (package events) (or "cust_statement")
-
-=item check_freq - how often events of this type are checked; currently "1d" (daily) and "1m" (monthly) are recognized. Note that the apprioriate freeside-daily and/or freeside-monthly cron job needs to be in place.
-
-=item weight - ordering for events
-
-=item action - event action (like part_bill_event.plan - eventcode plan)
-
-=item disabled - Disabled flag, empty or `Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new invoice event definition. To add the invoice event definition 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 { 'part_event'; }
-
-=item insert [ HASHREF ]
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-If a list or hash reference of options is supplied, part_export_option records
-are created (see L<FS::part_event_option>).
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD [ HASHREF | OPTION => VALUE ... ]
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-If a list or hash reference of options is supplied, part_event_option
-records are created or modified (see L<FS::part_event_option>).
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid invoice event definition. 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;
-
- $self->weight(0) unless $self->weight;
-
- my $error =
- $self->ut_numbern('eventpart')
- || $self->ut_text('event')
- || $self->ut_enum('eventtable', [ $self->eventtables ] )
- || $self->ut_enum('check_freq', [ '1d', '1m' ])
- || $self->ut_number('weight')
- || $self->ut_alpha('action')
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- || $self->ut_agentnum_acl('agentnum', 'Edit global billing events')
- ;
- return $error if $error;
-
- #XXX check action to make sure a module exists?
- # well it'll die in _rebless...
-
- $self->SUPER::check;
-}
-
-=item _rebless
-
-Reblesses the object into the FS::part_event::Action::ACTION class, where
-ACTION is the object's I<action> field.
-
-=cut
-
-sub _rebless {
- my $self = shift;
- my $action = $self->action or return $self;
- #my $class = ref($self). "::$action";
- my $class = "FS::part_event::Action::$action";
- eval "use $class";
- die $@ if $@;
- bless($self, $class); # unless $@;
- $self;
-}
-
-=item part_event_condition
-
-Returns the conditions associated with this event, as FS::part_event_condition
-objects (see L<FS::part_event_condition>)
-
-=cut
-
-sub part_event_condition {
- my $self = shift;
- qsearch( 'part_event_condition', { 'eventpart' => $self->eventpart } );
-}
-
-=item new_cust_event OBJECT
-
-Creates a new customer event (see L<FS::cust_event>) for the provided object.
-
-=cut
-
-sub new_cust_event {
- my( $self, $object ) = @_;
-
- confess "**** $object is not a ". $self->eventtable
- if ref($object) ne "FS::". $self->eventtable;
-
- my $pkey = $object->primary_key;
-
- new FS::cust_event {
- 'eventpart' => $self->eventpart,
- 'tablenum' => $object->$pkey(),
- '_date' => time, #i think we always want the real "now" here.
- 'status' => 'new',
- };
-}
-
-#surely this doesn't work
-sub reasontext { confess "part_event->reasontext deprecated"; }
-#=item reasontext
-#
-#Returns the text of any reason associated with this event.
-#
-#=cut
-#
-#sub reasontext {
-# my $self = shift;
-# my $r = qsearchs('reason', { 'reasonnum' => $self->reason });
-# if ($r){
-# $r->reason;
-# }else{
-# '';
-# }
-#}
-
-=item agent
-
-Returns the associated agent for this event, if any, as an FS::agent object.
-
-=cut
-
-sub agent {
- my $self = shift;
- qsearchs('agent', { 'agentnum' => $self->agentnum } );
-}
-
-=item templatename
-
-Returns the alternate invoice template name, if any, or false if there is
-no alternate template for this event.
-
-=cut
-
-sub templatename {
-
- my $self = shift;
- if ( $self->action =~ /^cust_bill_send_(alternate|agent)$/
- && ( $self->option('agent_templatename')
- || $self->option('templatename') )
- )
- {
- $self->option('agent_templatename')
- || $self->option('templatename');
-
- } else {
- '';
- }
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item eventtable_labels
-
-Returns a hash reference of labels for eventtable values,
-i.e. 'cust_main'=>'Customer'
-
-=cut
-
-sub eventtable_labels {
- #my $class = shift;
-
- tie my %hash, 'Tie::IxHash',
- 'cust_pkg' => 'Package',
- 'cust_bill' => 'Invoice',
- 'cust_main' => 'Customer',
- 'cust_pay_batch' => 'Batch payment',
- 'cust_statement' => 'Statement', #too general a name here? "Invoice group"?
- ;
-
- \%hash
-}
-
-=item eventtable_pkey_sql
-
-Returns a hash reference of full SQL primary key names for eventtable values,
-i.e. 'cust_main'=>'cust_main.custnum'
-
-=cut
-
-sub eventtable_pkey_sql {
- my $class = shift;
-
- my $hashref = $class->eventtable_pkey;
-
- my %hash = map { $_ => "$_.". $hashref->{$_} } keys %$hashref;
-
- \%hash;
-}
-
-=item eventtable_pkey
-
-Returns a hash reference of full SQL primary key names for eventtable values,
-i.e. 'cust_main'=>'custnum'
-
-=cut
-
-sub eventtable_pkey {
- #my $class = shift;
-
- {
- 'cust_main' => 'custnum',
- 'cust_bill' => 'invnum',
- 'cust_pkg' => 'pkgnum',
- 'cust_pay_batch' => 'paybatchnum',
- 'cust_statement' => 'statementnum',
- };
-}
-
-=item eventtables
-
-Returns a list of eventtable values (default ordering; suited for display).
-
-=cut
-
-sub eventtables {
- my $class = shift;
- my $eventtables = $class->eventtable_labels;
- keys %$eventtables;
-}
-
-=item eventtables_runorder
-
-Returns a list of eventtable values (run order).
-
-=cut
-
-sub eventtables_runorder {
- shift->eventtables; #same for now
-}
-
-=item check_freq_labels
-
-Returns a hash reference of labels for check_freq values,
-i.e. '1d'=>'daily'
-
-=cut
-
-sub check_freq_labels {
- #my $class = shift;
-
- #Tie::IxHash??
- {
- '1d' => 'daily',
- '1m' => 'monthly',
- };
-}
-
-=item actions [ EVENTTABLE ]
-
-Return information about the available actions. If an eventtable is specified,
-only return information about actions available for that eventtable.
-
-Information is returned as key-value pairs. Keys are event names. Values are
-hashrefs with the following keys:
-
-=over 4
-
-=item description
-
-=item eventtable_hashref
-
-=item option_fields
-
-=item default_weight
-
-=item deprecated
-
-=back
-
-See L<FS::part_event::Action> for more information.
-
-=cut
-
-#false laziness w/part_event_condition.pm
-#some false laziness w/part_export & part_pkg
-my %actions;
-foreach my $INC ( @INC ) {
- foreach my $file ( glob("$INC/FS/part_event/Action/*.pm") ) {
- warn "attempting to load Action from $file\n" if $DEBUG;
- $file =~ /\/(\w+)\.pm$/ or do {
- warn "unrecognized file in $INC/FS/part_event/Action/: $file\n";
- next;
- };
- my $mod = $1;
- eval "use FS::part_event::Action::$mod;";
- if ( $@ ) {
- die "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
- #warn "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
- #next;
- }
- $actions{$mod} = {
- ( map { $_ => "FS::part_event::Action::$mod"->$_() }
- qw( description eventtable_hashref default_weight deprecated )
- #option_fields_hashref
- ),
- 'option_fields' => [ "FS::part_event::Action::$mod"->option_fields() ],
- };
- }
-}
-
-sub actions {
- my( $class, $eventtable ) = @_;
- (
- map { $_ => $actions{$_} }
- sort { $actions{$a}->{'default_weight'}<=>$actions{$b}->{'default_weight'} }
- $class->all_actions( $eventtable )
- );
-
-}
-
-=item all_actions [ EVENTTABLE ]
-
-Returns a list of just the action names
-
-=cut
-
-sub all_actions {
- my ( $class, $eventtable ) = @_;
-
- grep { !$eventtable || $actions{$_}->{'eventtable_hashref'}{$eventtable} }
- keys %actions
-}
-
-=back
-
-=head1 SEE ALSO
-
-L<FS::part_event_option>, L<FS::part_event_condition>, L<FS::cust_main>,
-L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_bill_event>, L<FS::Record>,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_event/Action.pm b/FS/FS/part_event/Action.pm
deleted file mode 100644
index 45219a3..0000000
--- a/FS/FS/part_event/Action.pm
+++ /dev/null
@@ -1,240 +0,0 @@
-package FS::part_event::Action;
-
-use strict;
-use base qw( FS::part_event );
-use Tie::IxHash;
-
-=head1 NAME
-
-FS::part_event::Action - Base class for event actions
-
-=head1 SYNOPSIS
-
-package FS::part_event::Action::myaction;
-
-use base FS::part_event::Action;
-
-=head1 DESCRIPTION
-
-FS::part_event::Action is a base class for event action classes.
-
-=head1 METHODS
-
-These methods are implemented in each action class.
-
-=over 4
-
-=item description
-
-Action classes must define a description method. This method should return a
-scalar description of the action.
-
-=item eventtable_hashref
-
-Action classes must define a eventtable_hashref method if they can only be
-triggered against some kinds of tables. This method should return a hash
-reference of eventtables (values set true indicate the action can be performed):
-
- sub eventtable_hashref {
- { 'cust_main' => 1,
- 'cust_bill' => 1,
- 'cust_pkg' => 0,
- 'cust_pay_batch' => 0,
- };
- }
-
-=cut
-
-#fallback
-sub eventtable_hashref {
- { 'cust_main' => 1,
- 'cust_bill' => 1,
- 'cust_pkg' => 1,
- 'cust_pay_batch' => 1,
- };
-}
-
-=item event_stage
-
-Action classes may define an event_stage method to indicate a preference
-for being run at a non-standard stage of the billing and collection process.
-
-This method may currently return "collect" (the default) or "pre-bill".
-
-=cut
-
-sub event_stage {
- 'collect';
-}
-
-=item option_fields
-
-Action classes may define an option_fields method to indicate that they
-accept one or more options.
-
-This method should return a list of option names and option descriptions.
-Each option description can be a scalar description, for simple options, or a
-hashref with the following values:
-
-=over 4
-
-=item label - Description
-
-=item type - Currently text, money, checkbox, checkbox-multiple, select, select-agent, select-pkg_class, select-part_referral, select-table, fixed, hidden, (others can be implemented as httemplate/elements/tr-TYPE.html mason components). Defaults to text.
-
-=item size - Size for text fields
-
-=item options - For checkbox-multiple and select, a list reference of available option values.
-
-=item option_labels - For select, a hash reference of availble option values and labels.
-
-=item value - for checkbox, fixed, hidden
-
-=item table - for select-table
-
-=item name_col - for select-table
-
-=item NOTE: See httemplate/elements/select-table.html for a full list of the optinal options for the select-table type
-
-=back
-
-NOTE: A database connection is B<not> yet available when this subroutine is
-executed.
-
-Example:
-
- sub option_fields {
- (
- 'field' => 'description',
-
- 'another_field' => { 'label'=>'Amount', 'type'=>'money', },
-
- 'third_field' => { 'label' => 'Types',
- 'type' => 'select',
- 'options' => [ 'h', 's' ],
- 'option_labels' => { 'h' => 'Happy',
- 's' => 'Sad',
- },
- );
- }
-
-=cut
-
-#fallback
-sub option_fields {
- ();
-}
-
-=item default_weight
-
-Action classes may define a default weighting. Weights control execution order
-relative to other actions (that are triggered at the same time).
-
-=cut
-
-#fallback
-sub default_weight {
- 100;
-}
-
-=item deprecated
-
-Action classes may define a deprecated method that returns true, indicating
-that this action is deprecated.
-
-=cut
-
-#default
-sub deprecated {
- 0;
-}
-
-=item do_action CUSTOMER_EVENT_OBJECT
-
-Action classes must define an action method. This method is triggered if
-all conditions have been met.
-
-The object which triggered the event (an FS::cust_main, FS::cust_bill or
-FS::cust_pkg object) is passed as an argument.
-
-To retreive option values, call the option method on the desired option, i.e.:
-
- my( $self, $cust_object ) = @_;
- $value_of_field = $self->option('field');
-
-To indicate sucessful completion, simply return. Optionally, you can return a
-string of information status information about the sucessful completion, or
-simply return the empty string.
-
-To indicate a failure and that this event should retry, die with the desired
-error message.
-
-=back
-
-=head1 BASE METHODS
-
-These methods are defined in the base class for use in action classes.
-
-=over 4
-
-=item cust_main CUST_OBJECT
-
-Return the customer object (see L<FS::cust_main>) associated with the provided
-object (the object itself if it is already a customer object).
-
-=cut
-
-sub cust_main {
- my( $self, $cust_object ) = @_;
-
- $cust_object->isa('FS::cust_main') ? $cust_object : $cust_object->cust_main;
-
-}
-
-=item option_label OPTIONNAME
-
-Returns the label for the specified option name.
-
-=cut
-
-sub option_label {
- my( $self, $optionname ) = @_;
-
- my %option_fields = $self->option_fields;
-
- ref( $option_fields{$optionname} )
- ? $option_fields{$optionname}->{'label'}
- : $option_fields{$optionname}
- or $optionname;
-}
-
-=item option_fields_hashref
-
-Returns the option fields as an (ordered) hash reference.
-
-=cut
-
-sub option_fields_hashref {
- my $self = shift;
- tie my %hash, 'Tie::IxHash', $self->option_fields;
- \%hash;
-}
-
-=item option_fields_listref
-
-Returns just the option field names as a list reference.
-
-=cut
-
-sub option_fields_listref {
- my $self = shift;
- my $hashref = $self->option_fields_hashref;
- [ keys %$hashref ];
-}
-
-=back
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_event/Action/Mixin/credit_pkg.pm b/FS/FS/part_event/Action/Mixin/credit_pkg.pm
deleted file mode 100644
index aeda92f..0000000
--- a/FS/FS/part_event/Action/Mixin/credit_pkg.pm
+++ /dev/null
@@ -1,63 +0,0 @@
-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/addpost.pm b/FS/FS/part_event/Action/addpost.pm
deleted file mode 100644
index f92e72e..0000000
--- a/FS/FS/part_event/Action/addpost.pm
+++ /dev/null
@@ -1,20 +0,0 @@
-package FS::part_event::Action::addpost;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Add postal invoicing'; }
-
-sub default_weight { 20; }
-
-sub do_action {
- my( $self, $cust_object ) = @_;
-
- my $cust_main = $self->cust_main($cust_object);
-
- $cust_main->invoicing_list_addpost();
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/apply.pm b/FS/FS/part_event/Action/apply.pm
deleted file mode 100644
index 823d1e0..0000000
--- a/FS/FS/part_event/Action/apply.pm
+++ /dev/null
@@ -1,24 +0,0 @@
-package FS::part_event::Action::apply;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description {
- 'Apply unapplied payments and credits';
-}
-
-sub deprecated { 1; }
-
-sub default_weight { 70; }
-
-sub do_action {
- my( $self, $cust_object ) = @_;
-
- my $cust_main = $self->cust_main($cust_object);
-
- $cust_main->apply_payments_and_credits;
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/bill.pm b/FS/FS/part_event/Action/bill.pm
deleted file mode 100644
index b96614d..0000000
--- a/FS/FS/part_event/Action/bill.pm
+++ /dev/null
@@ -1,26 +0,0 @@
-package FS::part_event::Action::bill;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description {
- #'Generate invoices (normally only used with a <i>Late Fee</i> event)';
- 'Generate invoices (normally only used with a Late Fee event)';
-}
-
-sub deprecated { 1; }
-
-sub default_weight { 60; }
-
-sub do_action {
- my( $self, $cust_object ) = @_;
-
- my $cust_main = $self->cust_main($cust_object);
-
- my $error = $cust_main->bill;
- die $error if $error;
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cancel.pm b/FS/FS/part_event/Action/cancel.pm
deleted file mode 100644
index b93682b..0000000
--- a/FS/FS/part_event/Action/cancel.pm
+++ /dev/null
@@ -1,30 +0,0 @@
-package FS::part_event::Action::cancel;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Cancel all of this customer\'s packages'; }
-
-sub option_fields {
- (
- 'reasonnum' => { 'label' => 'Reason',
- 'type' => 'select-reason',
- 'reason_class' => 'C',
- },
- );
-}
-
-sub default_weight { 20; }
-
-sub do_action {
- my( $self, $cust_object ) = @_;
-
- my $cust_main = $self->cust_main($cust_object);
-
- my $error = $cust_main->cancel( 'reason' => $self->option('reasonnum') );
- die $error if $error;
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/collect.pm b/FS/FS/part_event/Action/collect.pm
deleted file mode 100644
index 9881440..0000000
--- a/FS/FS/part_event/Action/collect.pm
+++ /dev/null
@@ -1,26 +0,0 @@
-package FS::part_event::Action::collect;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description {
- #'Collect on invoices (normally only used with a <i>Late Fee</i> and <i>Generate Invoice</i> events)';
- 'Collect on invoices (normally only used with a Late Fee and Generate Invoice events)';
-}
-
-sub deprecated { 1; }
-
-sub default_weight { 80; }
-
-sub do_action {
- my( $self, $cust_object ) = @_;
-
- my $cust_main = $self->cust_main($cust_object);
-
- my $error = $cust_main->collect;
- die $error if $error;
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_batch.pm b/FS/FS/part_event/Action/cust_bill_batch.pm
deleted file mode 100644
index 50c306a..0000000
--- a/FS/FS/part_event/Action/cust_bill_batch.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-package FS::part_event::Action::cust_bill_batch;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Add card or check to a pending batch'; }
-
-sub deprecated { 1; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub default_weight { 40; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- $cust_bill->batch_card; # ( %options ); #XXX options??
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_comp.pm b/FS/FS/part_event/Action/cust_bill_comp.pm
deleted file mode 100644
index 76fd274..0000000
--- a/FS/FS/part_event/Action/cust_bill_comp.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-package FS::part_event::Action::cust_bill_comp;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Pay invoice with a complimentary "payment"'; }
-
-sub deprecated { 1; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub default_weight { 30; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- my $error = $cust_bill->comp;
- die $error if $error;
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_email.pm b/FS/FS/part_event/Action/cust_bill_email.pm
deleted file mode 100644
index a5cd861..0000000
--- a/FS/FS/part_event/Action/cust_bill_email.pm
+++ /dev/null
@@ -1,23 +0,0 @@
-package FS::part_event::Action::cust_bill_email;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Send invoice (email only)'; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub default_weight { 51; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- $cust_bill->email;
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_fee_percent.pm b/FS/FS/part_event/Action/cust_bill_fee_percent.pm
deleted file mode 100644
index 48daf15..0000000
--- a/FS/FS/part_event/Action/cust_bill_fee_percent.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-package FS::part_event::Action::cust_bill_fee_percent;
-
-use strict;
-use base qw( FS::part_event::Action::fee );
-use Tie::IxHash;
-
-sub description { 'Late fee (percentage of invoice)'; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub option_fields {
- my $class = shift;
-
- my $t = tie my %option_fields, 'Tie::IxHash', $class->SUPER::option_fields();
- $t->Shift; #assumes charge is first
- $t->Unshift( 'percent' => { label=>'Percent', size=>2, } );
-
- %option_fields;
-}
-
-sub _calc_fee {
- my( $self, $cust_bill ) = @_;
- sprintf('%.2f', $cust_bill->owed * $self->option('percent') / 100 );
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_realtime_card.pm b/FS/FS/part_event/Action/cust_bill_realtime_card.pm
deleted file mode 100644
index c1fdba9..0000000
--- a/FS/FS/part_event/Action/cust_bill_realtime_card.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-package FS::part_event::Action::cust_bill_realtime_card;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description {
- #'Run card with a <a href="http://420.am/business-onlinepayment/">Business::OnlinePayment</a> realtime gateway';
- 'Run card with a Business::OnlinePayment realtime gateway';
-}
-
-sub deprecated { 1; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub default_weight { 30; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- $cust_bill->realtime_card;
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_realtime_check.pm b/FS/FS/part_event/Action/cust_bill_realtime_check.pm
deleted file mode 100644
index 11b13a9..0000000
--- a/FS/FS/part_event/Action/cust_bill_realtime_check.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-package FS::part_event::Action::cust_bill_realtime_check;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description {
- #'Run check with a <a href="http://420.am/business-onlinepayment/">Business::OnlinePayment</a> realtime gateway';
- 'Run check with a Business::OnlinePayment realtime gateway';
-}
-
-sub deprecated { 1; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub default_weight { 30; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- $cust_bill->realtime_ach;
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_realtime_lec.pm b/FS/FS/part_event/Action/cust_bill_realtime_lec.pm
deleted file mode 100644
index cd03ddc..0000000
--- a/FS/FS/part_event/Action/cust_bill_realtime_lec.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-package FS::part_event::Action::cust_bill_realtime_lec;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description {
- #'Run phone bill ("LEC") billing with a <a href="http://420.am/business-onlinepayment/">Business::OnlinePayment</a> realtime gateway';
- 'Run phone bill ("LEC") billing with a Business::OnlinePayment realtime gateway';
-}
-
-sub deprecated { 1; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub default_weight { 30; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- $cust_bill->realtime_lec;
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_send.pm b/FS/FS/part_event/Action/cust_bill_send.pm
deleted file mode 100644
index 587a7c6..0000000
--- a/FS/FS/part_event/Action/cust_bill_send.pm
+++ /dev/null
@@ -1,20 +0,0 @@
-package FS::part_event::Action::cust_bill_send;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Send invoice (email/print/fax)'; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub default_weight { 50; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- $cust_bill->send;
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_send_agent.pm b/FS/FS/part_event/Action/cust_bill_send_agent.pm
deleted file mode 100644
index 670a32c..0000000
--- a/FS/FS/part_event/Action/cust_bill_send_agent.pm
+++ /dev/null
@@ -1,42 +0,0 @@
-package FS::part_event::Action::cust_bill_send_agent;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description {
- 'Send invoice (email/print/fax) with alternate template, for specific agents';
-}
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub option_fields {
- (
- 'agentnum' => { label => 'Only for agent(s)',
- type => 'select-agent',
- multiple => 1
- },
- 'agent_templatename' => { label => 'Template',
- type => 'select-invoice_template',
- },
- 'agent_invoice_from' => 'Invoice email From: address',
- );
-}
-
-sub default_weight { 50; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- $cust_bill->send(
- $self->option('agent_templatename'),
- [ split(/\s*,\s*/, $self->option('agentnum') ) ],
- $self->option('agent_invoice_from'),
- );
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_send_alternate.pm b/FS/FS/part_event/Action/cust_bill_send_alternate.pm
deleted file mode 100644
index cfd9264..0000000
--- a/FS/FS/part_event/Action/cust_bill_send_alternate.pm
+++ /dev/null
@@ -1,31 +0,0 @@
-package FS::part_event::Action::cust_bill_send_alternate;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Send invoice (email/print/fax) with alternate template'; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub option_fields {
- (
- 'templatename' => { label => 'Template',
- type => 'select-invoice_template',
- },
- );
-}
-
-sub default_weight { 50; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- $cust_bill->send( $self->option('templatename') );
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm b/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm
deleted file mode 100644
index bf47268..0000000
--- a/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm
+++ /dev/null
@@ -1,50 +0,0 @@
-package FS::part_event::Action::cust_bill_send_csv_ftp;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Upload CSV invoice data to an FTP server'; }
-
-sub deprecated { 1; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub option_fields {
- (
- 'ftpformat' => { label => 'Format',
- type =>'select',
- options => ['default', 'billco'],
- option_labels => { 'default' => 'Default',
- 'billco' => 'Billco',
- },
- },
- 'ftpserver' => 'FTP server',
- 'ftpusername' => 'FTP username',
- 'ftppassword' => 'FTP password',
- 'ftpdir' => 'FTP directory',
- );
-}
-
-sub default_weight { 50; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- $cust_bill->send_csv(
- 'protocol' => 'ftp',
- 'server' => $self->option('ftpserver'),
- 'username' => $self->option('ftpusername'),
- 'password' => $self->option('ftppassword'),
- 'dir' => $self->option('ftpdir'),
- 'format' => $self->option('ftpformat'),
- );
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_send_if_newest.pm b/FS/FS/part_event/Action/cust_bill_send_if_newest.pm
deleted file mode 100644
index 083da8b..0000000
--- a/FS/FS/part_event/Action/cust_bill_send_if_newest.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-package FS::part_event::Action::cust_bill_send_if_newest;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description {
- 'Send invoice (email/print/fax) with alternate template, if it is still the newest invoice (useful for late notices - set to 31 days or later)';
-}
-
-# XXX is this handled better by something against customers??
-#sub deprecated {
-# 1;
-#}
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub option_fields {
- (
- 'if_newest_templatename' => { label => 'Template',
- type => 'select-invoice_template',
- },
- );
-}
-
-sub default_weight { 50; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- $cust_bill->send( $self->option('templatename') );
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_send_reminder.pm b/FS/FS/part_event/Action/cust_bill_send_reminder.pm
deleted file mode 100644
index 2ba8136..0000000
--- a/FS/FS/part_event/Action/cust_bill_send_reminder.pm
+++ /dev/null
@@ -1,31 +0,0 @@
-package FS::part_event::Action::cust_bill_send_reminder;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Send invoice (email/print/fax) reminder'; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub option_fields {
- (
- 'notice_name' => 'Reminder name',
- #'notes' => { 'label' => 'Reminder notes' },
- #include standard notes? no/prepend/append
- );
-}
-
-sub default_weight { 50; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- #my $cust_main = $cust_bill->cust_main;
-
- $cust_bill->send({ 'notice_name' => $self->option('notice_name') });
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_spool_csv.pm b/FS/FS/part_event/Action/cust_bill_spool_csv.pm
deleted file mode 100644
index 43d2300..0000000
--- a/FS/FS/part_event/Action/cust_bill_spool_csv.pm
+++ /dev/null
@@ -1,59 +0,0 @@
-package FS::part_event::Action::cust_bill_spool_csv;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Spool CSV invoice data'; }
-
-sub deprecated { 1; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub option_fields {
- (
- 'spoolformat' => { label => 'Format',
- type => 'select',
- options => ['default', 'billco'],
- option_labels => { 'default' => 'Default',
- 'billco' => 'Billco',
- },
- },
- 'spooldest' => { label => 'For destination',
- type => 'select',
- options => [ '', qw( POST EMAIL FAX ) ],
- option_labels => { '' => '(all)',
- 'POST' => 'Postal Mail',
- 'EMAIL' => 'Email',
- 'FAX' => 'Fax',
- },
- },
- 'spoolbalanceover' => { label =>
- 'If balance (this invoice and previous) over',
- type => 'money',
- },
- 'spoolagent_spools' => { label => 'Individual per-agent spools',
- type => 'checkbox',
- value => '1',
- },
- );
-}
-
-sub default_weight { 50; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- $cust_bill->spool_csv(
- 'format' => $self->option('spoolformat'),
- 'dest' => $self->option('spooldest'),
- 'balanceover' => $self->option('spoolbalanceover'),
- 'agent_spools' => $self->option('spoolagent_spools'),
- );
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_bill_suspend_if_balance.pm b/FS/FS/part_event/Action/cust_bill_suspend_if_balance.pm
deleted file mode 100644
index 13188ab..0000000
--- a/FS/FS/part_event/Action/cust_bill_suspend_if_balance.pm
+++ /dev/null
@@ -1,42 +0,0 @@
-package FS::part_event::Action::cust_bill_suspend_if_balance;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Suspend if balance (this invoice and previous) over'; }
-
-sub deprecated { 1; }
-
-sub eventtable_hashref {
- { 'cust_bill' => 1 };
-}
-
-sub option_fields {
- (
- 'balanceover' => { label=>'Balance over', type=>'money', }, # size=>7 },
- 'reasonnum' => { 'label' => 'Reason',
- 'type' => 'select-reason',
- 'reason_class' => 'S',
- },
- );
-}
-
-sub default_weight { 10; }
-
-sub do_action {
- my( $self, $cust_bill ) = @_;
-
- #my $cust_main = $self->cust_main($cust_bill);
- my $cust_main = $cust_bill->cust_main;
-
- my @err = $cust_bill->cust_suspend_if_balance_over(
- $self->option('balanceover'),
- 'reason' => $self->option('reasonnum'),
- );
-
- die join(' / ', @err) if scalar(@err);
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_statement.pm b/FS/FS/part_event/Action/cust_statement.pm
deleted file mode 100644
index 2d9e877..0000000
--- a/FS/FS/part_event/Action/cust_statement.pm
+++ /dev/null
@@ -1,39 +0,0 @@
-package FS::part_event::Action::cust_statement;
-
-use strict;
-
-use base qw( FS::part_event::Action );
-
-use FS::cust_statement;
-
-sub description {
- 'Group invoices into an informational statement.';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 1,
- 'cust_pkg' => 1,
- };
-}
-
-sub default_weight {
- 90;
-}
-
-sub do_action {
- my( $self, $cust_main ) = @_;
-
- #my( $self, $object ) = @_;
- #my $cust_main = $self->cust_main($object);
-
- my $cust_statement = new FS::cust_statement {
- 'custnum' => $cust_main->custnum
- };
- my $error = $cust_statement->insert;
- die $error if $error;
-
- '';
-
-}
-
-1;
diff --git a/FS/FS/part_event/Action/cust_statement_send.pm b/FS/FS/part_event/Action/cust_statement_send.pm
deleted file mode 100644
index 74cc48c..0000000
--- a/FS/FS/part_event/Action/cust_statement_send.pm
+++ /dev/null
@@ -1,26 +0,0 @@
-package FS::part_event::Action::cust_statement_send;
-
-use strict;
-
-use base qw( FS::part_event::Action );
-
-sub description {
- 'Send statement (email/print/fax)';
-}
-
-sub eventtable_hashref {
- { 'cust_statement' => 1, };
-}
-
-sub default_weight {
- 95;
-}
-
-sub do_action {
- my( $self, $cust_statement ) = @_;
-
- $cust_statement->send( 'statement' ); #XXX configure
-
-}
-
-1;
diff --git a/FS/FS/part_event/Action/fee.pm b/FS/FS/part_event/Action/fee.pm
deleted file mode 100644
index 68288d0..0000000
--- a/FS/FS/part_event/Action/fee.pm
+++ /dev/null
@@ -1,58 +0,0 @@
-package FS::part_event::Action::fee;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Late fee (flat)'; }
-
-sub event_stage { 'pre-bill'; }
-
-sub option_fields {
- (
- 'charge' => { label=>'Amount', type=>'money', }, # size=>7, },
- 'reason' => 'Reason (invoice line item)',
- 'classnum' => { label=>'Package class' => type=>'select-pkg_class', },
- 'taxclass' => { label=>'Tax class', type=>'select-taxclass', },
- 'setuptax' => { label=>'Late fee is tax exempt',
- type=>'checkbox', value=>'Y' },
- 'nextbill' => { label=>'Hold late fee until next invoice',
- type=>'checkbox', value=>'Y' },
- );
-}
-
-sub default_weight { 10; }
-
-sub _calc_fee {
- #my( $self, $cust_object ) = @_;
- my $self = shift;
- $self->option('charge');
-}
-
-sub do_action {
- my( $self, $cust_object ) = @_;
-
- my $cust_main = $self->cust_main($cust_object);
-
- my $conf = new FS::Conf;
-
- my %charge = (
- 'amount' => $self->_calc_fee($cust_object),
- 'pkg' => $self->option('reason'),
- 'taxclass' => $self->option('taxclass'),
- 'classnum' => ( $self->option('classnum')
- || scalar($conf->config('finance_pkgclass')) ),
- 'setuptax' => $self->option('setuptax'),
- );
-
- #unless its more than N months away?
- $charge{'start_date'} = $cust_main->next_bill_date
- if $self->option('nextbill');
-
- my $error = $cust_main->charge( \%charge );
-
- die $error if $error;
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/notice.pm b/FS/FS/part_event/Action/notice.pm
deleted file mode 100644
index 8e22c68..0000000
--- a/FS/FS/part_event/Action/notice.pm
+++ /dev/null
@@ -1,47 +0,0 @@
-package FS::part_event::Action::notice;
-
-use strict;
-use base qw( FS::part_event::Action );
-use FS::Record qw( qsearchs );
-use FS::msg_template;
-
-sub description { 'Email a notice to the customer\'s billing address'; }
-
-#sub eventtable_hashref {
-# { 'cust_main' => 1,
-# 'cust_bill' => 1,
-# 'cust_pkg' => 1,
-# };
-#}
-
-sub option_fields {
- (
- 'msgnum' => { 'label' => 'Template',
- 'type' => 'select-table',
- 'table' => 'msg_template',
- 'name_col' => 'msgname',
- 'disable_empty' => 1,
- },
- );
-}
-
-sub default_weight { 55; } #?
-
-sub do_action {
- my( $self, $object ) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- my $msgnum = $self->option('msgnum');
-
- my $msg_template = qsearchs('msg_template', { 'msgnum' => $msgnum } )
- or die "Template $msgnum not found";
-
- $msg_template->send(
- 'cust_main' => $cust_main,
- 'object' => $object,
- );
-
-}
-
-1;
diff --git a/FS/FS/part_event/Action/notice_to.pm b/FS/FS/part_event/Action/notice_to.pm
deleted file mode 100644
index 194aeb8..0000000
--- a/FS/FS/part_event/Action/notice_to.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-package FS::part_event::Action::notice_to;
-
-use strict;
-use base qw( FS::part_event::Action );
-use FS::Record qw( qsearchs );
-use FS::msg_template;
-
-sub description { 'Email a notice to a specific address'; }
-
-#sub eventtable_hashref {
-# { 'cust_main' => 1,
-# 'cust_bill' => 1,
-# 'cust_pkg' => 1,
-# };
-#}
-
-sub option_fields {
- (
- 'to' => { 'label' => 'Destination',
- 'type' => 'text',
- 'size' => 30,
- },
- 'msgnum' => { 'label' => 'Template',
- 'type' => 'select-table',
- 'table' => 'msg_template',
- 'name_col' => 'msgname',
- 'disable_empty' => 1,
- },
- );
-}
-
-sub default_weight { 56; } #?
-
-sub do_action {
- my( $self, $object ) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- my $msgnum = $self->option('msgnum');
-
- my $msg_template = qsearchs('msg_template', { 'msgnum' => $msgnum } )
- or die "Template $msgnum not found";
-
- my $to = $self->option('to')
- or die "Can't send notice without a destination address";
-
- $msg_template->send(
- 'to' => $to,
- 'cust_main' => $cust_main,
- 'object' => $object,
- );
-
-}
-
-1;
diff --git a/FS/FS/part_event/Action/pkg_agent_credit.pm b/FS/FS/part_event/Action/pkg_agent_credit.pm
deleted file mode 100644
index 4bcee98..0000000
--- a/FS/FS/part_event/Action/pkg_agent_credit.pm
+++ /dev/null
@@ -1,39 +0,0 @@
-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
deleted file mode 100644
index b3e1181..0000000
--- a/FS/FS/part_event/Action/pkg_agent_credit_pkg.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-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_cancel.pm b/FS/FS/part_event/Action/pkg_cancel.pm
deleted file mode 100644
index 2bfd35c..0000000
--- a/FS/FS/part_event/Action/pkg_cancel.pm
+++ /dev/null
@@ -1,32 +0,0 @@
-package FS::part_event::Action::pkg_cancel;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Cancel this package'; }
-
-sub eventtable_hashref {
- { 'cust_pkg' => 1 };
-}
-
-sub option_fields {
- (
- 'reasonnum' => { 'label' => 'Reason',
- 'type' => 'select-reason',
- 'reason_class' => 'C',
- },
- );
-}
-
-sub default_weight { 20; }
-
-sub do_action {
- my( $self, $cust_pkg, $cust_event ) = @_;
-
- my $error = $cust_pkg->cancel( 'reason' => $self->option('reasonnum') );
- die $error if $error;
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/pkg_employee_credit.pm b/FS/FS/part_event/Action/pkg_employee_credit.pm
deleted file mode 100644
index 64dd8b2..0000000
--- a/FS/FS/part_event/Action/pkg_employee_credit.pm
+++ /dev/null
@@ -1,39 +0,0 @@
-package FS::part_event::Action::pkg_employee_credit;
-
-use strict;
-use base qw( FS::part_event::Action::pkg_referral_credit );
-
-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);
-
- my $employee = $cust_pkg->access_user;
- 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
deleted file mode 100644
index e3b867f..0000000
--- a/FS/FS/part_event/Action/pkg_employee_credit_pkg.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-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
deleted file mode 100644
index e7c92d6..0000000
--- a/FS/FS/part_event/Action/pkg_referral_credit.pm
+++ /dev/null
@@ -1,62 +0,0 @@
-package FS::part_event::Action::pkg_referral_credit;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Credit the referring customer a specific amount'; }
-
-sub eventtable_hashref {
- { 'cust_pkg' => 1 };
-}
-
-sub option_fields {
- (
- 'reasonnum' => { 'label' => 'Credit reason',
- 'type' => 'select-reason',
- 'reason_class' => 'R',
- },
- 'amount' => { 'label' => 'Credit amount',
- 'type' => 'money',
- },
- );
-
-}
-
-sub do_action {
- my( $self, $cust_pkg, $cust_event ) = @_;
-
- my $cust_main = $self->cust_main($cust_pkg);
-
-# my $part_pkg = $cust_pkg->part_pkg;
-
- return 'No referring customer' unless $cust_main->referral_custnum;
-
- my $referring_cust_main = $cust_main->referring_cust_main;
- return 'Referring customer is cancelled'
- if $referring_cust_main->status eq 'cancelled';
-
- my $amount = $self->_calc_credit($cust_pkg);
- return '' unless $amount > 0;
-
- my $reasonnum = $self->option('reasonnum');
-
- my $error = $referring_cust_main->credit(
- $amount,
- \$reasonnum,
- '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"
- if $error;
-
-}
-
-sub _calc_credit {
- my( $self, $cust_pkg ) = @_;
-
- $self->option('amount');
-}
-
-1;
diff --git a/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm b/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm
deleted file mode 100644
index 667c4ce..0000000
--- a/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-package FS::part_event::Action::pkg_referral_credit_pkg;
-
-use strict;
-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'; }
-
-1;
diff --git a/FS/FS/part_event/Action/suspend.pm b/FS/FS/part_event/Action/suspend.pm
deleted file mode 100644
index c77728e..0000000
--- a/FS/FS/part_event/Action/suspend.pm
+++ /dev/null
@@ -1,32 +0,0 @@
-package FS::part_event::Action::suspend;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Suspend'; }
-
-sub option_fields {
- (
- 'reasonnum' => { 'label' => 'Reason',
- 'type' => 'select-reason',
- 'reason_class' => 'S',
- },
- );
-}
-
-sub default_weight { 10; }
-
-sub do_action {
- my( $self, $cust_object ) = @_;
-
- my $cust_main = $self->cust_main($cust_object);
-
- my @err = $cust_main->suspend( 'reason' => $self->option('reasonnum') );
-
- die join(' / ', @err) if scalar(@err);
-
- '';
-
-}
-
-1;
diff --git a/FS/FS/part_event/Action/suspend_if_pkgpart.pm b/FS/FS/part_event/Action/suspend_if_pkgpart.pm
deleted file mode 100644
index 6f2007c..0000000
--- a/FS/FS/part_event/Action/suspend_if_pkgpart.pm
+++ /dev/null
@@ -1,40 +0,0 @@
-package FS::part_event::Action::suspend_if_pkgpart;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Suspend packages'; }
-
-#i should be deprecated in favor of using the if_pkgpart condition
-
-sub option_fields {
- (
- 'if_pkgpart' => { 'label' => 'Suspend packages:',
- 'type' => 'select-part_pkg',
- 'multiple' => 1,
- },
- 'reasonnum' => { 'label' => 'Reason',
- 'type' => 'select-reason',
- 'reason_class' => 'S',
- },
- );
-}
-
-sub default_weight { 10; }
-
-sub do_action {
- my( $self, $cust_object ) = @_;
-
- my $cust_main = $self->cust_main($cust_object);
-
- my @err = $cust_main->suspend_if_pkgpart( {
- 'pkgparts' => [ split(/\s*,\s*/, $self->option('if_pkgpart') ) ],
- 'reason' => $self->option('reasonnum'),
- } );
-
- die join(' / ', @err) if scalar(@err);
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/suspend_unless_pkgpart.pm b/FS/FS/part_event/Action/suspend_unless_pkgpart.pm
deleted file mode 100644
index efc7a2d..0000000
--- a/FS/FS/part_event/Action/suspend_unless_pkgpart.pm
+++ /dev/null
@@ -1,40 +0,0 @@
-package FS::part_event::Action::suspend_unless_pkgpart;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Suspend packages except'; }
-
-#i should be deprecated in favor of using the unless_pkgpart condition
-
-sub option_fields {
- (
- 'unless_pkgpart' => { 'label' => 'Suspend packages except:',
- 'type' => 'select-part_pkg',
- 'multiple' => 1,
- },
- 'reasonnum' => { 'label' => 'Reason',
- 'type' => 'select-reason',
- 'reason_class' => 'S',
- },
- );
-}
-
-sub default_weight { 10; }
-
-sub do_action {
- my( $self, $cust_object ) = @_;
-
- my $cust_main = $self->cust_main($cust_object);
-
- my @err = $cust_main->suspend_unless_pkgpart( {
- 'pkgparts' => [ split(/\s*,\s*/, $self->option('unless_pkgpart') ) ],
- 'reason' => $self->option('reasonnum'),
- } );
-
- die join(' / ', @err) if scalar(@err);
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Action/writeoff.pm b/FS/FS/part_event/Action/writeoff.pm
deleted file mode 100644
index 8529d29..0000000
--- a/FS/FS/part_event/Action/writeoff.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::part_event::Action::writeoff;
-
-use strict;
-use base qw( FS::part_event::Action );
-
-sub description { 'Write off bad debt with a credit entry.'; }
-
-sub option_fields {
- (
- #'charge' => { label=>'Amount', type=>'money', }, # size=>7, },
- 'reasonnum' => { 'label' => 'Reason',
- 'type' => 'select-reason',
- 'reason_class' => 'R',
- },
- );
-}
-
-sub default_weight { 65; }
-
-sub do_action {
- my( $self, $cust_object ) = @_;
-
- my $cust_main = $self->cust_main($cust_object);
-
- my $reasonnum = $self->option('reasonnum');
-
- my $error = $cust_main->credit( $cust_main->balance, \$reasonnum );
- die $error if $error;
-
- '';
-}
-
-1;
diff --git a/FS/FS/part_event/Condition.pm b/FS/FS/part_event/Condition.pm
deleted file mode 100644
index 90b8385..0000000
--- a/FS/FS/part_event/Condition.pm
+++ /dev/null
@@ -1,470 +0,0 @@
-package FS::part_event::Condition;
-
-use strict;
-use base qw( FS::part_event_condition );
-use Time::Local qw(timelocal_nocheck);
-use FS::UID qw( driver_name );
-
-=head1 NAME
-
-FS::part_event::Condition - Base class for event conditions
-
-=head1 SYNOPSIS
-
-package FS::part_event::Condition::mycondition;
-
-use base FS::part_event::Condition;
-
-=head1 DESCRIPTION
-
-FS::part_event::Condition is a base class for event conditions classes.
-
-=head1 METHODS
-
-These methods are implemented in each condition class.
-
-=over 4
-
-=item description
-
-Condition classes must define a description method. This method should return
-a scalar description of the condition.
-
-=item eventtable_hashref
-
-Condition classes must define an eventtable_hashref method if they can only be
-tested against some kinds of tables. This method should return a hash reference
-of eventtables (values set true indicate the condition can be tested):
-
- sub eventtable_hashref {
- { 'cust_main' => 1,
- 'cust_bill' => 1,
- 'cust_pkg' => 0,
- 'cust_pay_batch' => 0,
- 'cust_statement' => 0,
- };
- }
-
-=cut
-
-#fallback
-sub eventtable_hashref {
- { 'cust_main' => 1,
- 'cust_bill' => 1,
- 'cust_pkg' => 1,
- 'cust_pay_batch' => 1,
- 'cust_statement' => 1,
- };
-}
-
-=item option_fields
-
-Condition classes may define an option_fields method to indicate that they
-accept one or more options.
-
-This method should return a list of option names and option descriptions.
-Each option description can be a scalar description, for simple options, or a
-hashref with the following values:
-
-=over 4
-
-=item label - Description
-
-=item type - Currently text, money, checkbox, checkbox-multiple, select, select-agent, select-pkg_class, select-part_referral, select-table, fixed, hidden, (others can be implemented as httemplate/elements/tr-TYPE.html mason components). Defaults to text.
-
-=item options - For checkbox-multiple and select, a list reference of available option values.
-
-=item option_labels - For checkbox-multiple (and select?), a hash reference of availble option values and labels.
-
-=item value - for checkbox, fixed, hidden (also a default for text, money, more?)
-
-=item table - for select-table
-
-=item name_col - for select-table
-
-=item NOTE: See httemplate/elements/select-table.html for a full list of the optinal options for the select-table type
-
-=back
-
-NOTE: A database connection is B<not> yet available when this subroutine is
-executed.
-
-Example:
-
- sub option_fields {
- (
- 'field' => 'description',
-
- 'another_field' => { 'label'=>'Amount', 'type'=>'money', },
-
- 'third_field' => { 'label' => 'Types',
- 'type' => 'checkbox-multiple',
- 'options' => [ 'h', 's' ],
- 'option_labels' => { 'h' => 'Happy',
- 's' => 'Sad',
- },
- );
- }
-
-=cut
-
-#fallback
-sub option_fields {
- ();
-}
-
-=item condition CUSTOMER_EVENT_OBJECT
-
-Condition classes must define a condition method. This method is evaluated
-to determine if the condition has been met. The object which triggered the
-event (an FS::cust_main, FS::cust_bill or FS::cust_pkg object) is passed as
-the first argument. Additional arguments are list of key-value pairs.
-
-To retreive option values, call the option method on the desired option, i.e.:
-
- my( $self, $cust_object, %opts ) = @_;
- $value_of_field = $self->option('field');
-
-Available additional arguments:
-
- $time = $opt{'time'}; #use this instead of time or $^T
-
- $cust_event = $opt{'cust_event'}; #to retreive the cust_event object being tested
-
-Return a true value if the condition has been met, and a false value if it has
-not.
-
-=item condition_sql EVENTTABLE
-
-Condition classes may optionally define a condition_sql method. This B<class>
-method should return an SQL fragment that tests for this condition. The
-fragment is evaluated and a true value of this expression indicates that the
-condition has been met. The event table (cust_main, cust_bill or cust_pkg) is
-passed as an argument.
-
-This method is used for optimizing event queries. You may want to add indices
-for any columns referenced. It is acceptable to return an SQL fragment which
-partially tests the condition; doing so will still reduce the number of
-records which much be returned and tested with the B<condition> method.
-
-=cut
-
-# fallback.
-sub condition_sql {
- my( $class, $eventtable ) = @_;
- #...
- 'true';
-}
-
-=item disabled
-
-Condition classes may optionally define a disabled method. Returning a true
-value disbles the condition entirely.
-
-=cut
-
-sub disabled {
- 0;
-}
-
-=item implicit_flag
-
-This is used internally by the I<once> and I<balance> conditions. You probably
-do B<not> want to define this method for new custom conditions, unless you're
-sure you want B<every> new action to start with your condition.
-
-Condition classes may define an implicit_flag method that returns true to
-indicate that all new events should start with this condition. (Currently,
-condition classes which do so should be applicable to all kinds of
-I<eventtable>s.) The numeric value of the flag also defines the ordering of
-implicit conditions.
-
-=cut
-
-#fallback
-sub implicit_flag { 0; }
-
-=item remove_warning
-
-Again, used internally by the I<once> and I<balance> conditions; probably not
-a good idea for new custom conditions.
-
-Condition classes may define a remove_warning method containing a string
-warning message to enable a confirmation dialog triggered when the condition
-is removed from an event.
-
-=cut
-
-#fallback
-sub remove_warning { ''; }
-
-=item order_sql
-
-This is used internally by the I<balance_age> and I<cust_bill_age> conditions
-to declare ordering; probably not of general use for new custom conditions.
-
-=item order_sql_weight
-
-In conjunction with order_sql, this defines which order the ordering fragments
-supplied by different B<order_sql> should be used.
-
-=cut
-
-sub order_sql_weight { ''; }
-
-=back
-
-=head1 BASE METHODS
-
-These methods are defined in the base class for use in condition classes.
-
-=over 4
-
-=item cust_main CUST_OBJECT
-
-Return the customer object (see L<FS::cust_main>) associated with the provided
-object (the object itself if it is already a customer object).
-
-=cut
-
-sub cust_main {
- my( $self, $cust_object ) = @_;
-
- $cust_object->isa('FS::cust_main') ? $cust_object : $cust_object->cust_main;
-
-}
-
-=item option_label OPTIONNAME
-
-Returns the label for the specified option name.
-
-=cut
-
-sub option_label {
- my( $self, $optionname ) = @_;
-
- my %option_fields = $self->option_fields;
-
- ref( $option_fields{$optionname} )
- ? $option_fields{$optionname}->{'label'}
- : $option_fields{$optionname}
- or $optionname;
-}
-
-=back
-
-=item option_age_from OPTION FROM_TIMESTAMP
-
-Retreives a condition option, parses it from a frequency (such as "1d", "1w" or
-"12m"), and subtracts that interval from the supplied timestamp. It is
-primarily intended for use in B<condition>.
-
-=cut
-
-sub option_age_from {
- my( $self, $option, $time ) = @_;
- my $age = $self->option($option);
- $age = '0m' unless length($age);
-
- my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
-
- if ( $age =~ /^(\d+)m$/i ) {
- $mon -= $1;
- until ( $mon >= 0 ) { $mon += 12; $year--; }
- } elsif ( $age =~ /^(\d+)y$/i ) {
- $year -= $1;
- } elsif ( $age =~ /^(\d+)w$/i ) {
- $mday -= $1 * 7;
- } elsif ( $age =~ /^(\d+)d$/i ) {
- $mday -= $1;
- } elsif ( $age =~ /^(\d+)h$/i ) {
- $hour -= $hour;
- } else {
- die "unparsable age: $age";
- }
-
- timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
-
-}
-
-=item condition_sql_option OPTION
-
-This is a class method that returns an SQL fragment for retreiving a condition
-option. It is primarily intended for use in B<condition_sql>.
-
-=cut
-
-sub condition_sql_option {
- my( $class, $option ) = @_;
-
- ( my $condname = $class ) =~ s/^.*:://;
-
- "( SELECT optionvalue FROM part_event_condition_option
- WHERE part_event_condition_option.eventconditionnum =
- cond_$condname.eventconditionnum
- AND part_event_condition_option.optionname = '$option'
- )";
-}
-
-#c.f. part_event_condition_option.pm / part_event_condition_option_option
-#used for part_event/Condition/payby.pm
-sub condition_sql_option_option {
- my( $class, $option ) = @_;
-
- ( my $condname = $class ) =~ s/^.*:://;
-
- my $optionnum =
- "( SELECT optionnum FROM part_event_condition_option
- WHERE part_event_condition_option.eventconditionnum =
- cond_$condname.eventconditionnum
- AND part_event_condition_option.optionname = '$option'
- AND part_event_condition_option.optionvalue = 'HASH'
- )";
-
- "( SELECT optionname FROM part_event_condition_option_option
- WHERE optionnum = $optionnum
- )";
-
-}
-
-
-=item condition_sql_option_age_from OPTION FROM_TIMESTAMP
-
-This is a class method that returns an SQL fragment that will retreive a
-condition option, parse it from a frequency (such as "1d", "1w" or "12m"),
-and subtract that interval from the supplied timestamp. It is primarily
-intended for use in B<condition_sql>.
-
-=cut
-
-sub condition_sql_option_age_from {
- my( $class, $option, $from ) = @_;
-
- my $value = $class->condition_sql_option($option);
-
-# my $str2time = str2time_sql;
-
- if ( driver_name =~ /^Pg/i ) {
-
- #can we do better with Pg now that we have $from? yes we can, bob
- "( $from - EXTRACT( EPOCH FROM REPLACE( $value, 'm', 'mon')::interval ) )";
-
- } elsif ( driver_name =~ /^mysql/i ) {
-
- #hmm... is there a way we can save $value? we're just an expression, hmm
- #we might be able to do something like "AS ${option}_value" except we get
- #used in more complicated expressions and we need some sort of unique
- #identifer passed down too... yow
-
- "CASE WHEN $value IS NULL OR $value = ''
- THEN $from
- WHEN $value LIKE '%m'
- THEN UNIX_TIMESTAMP(
- FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'm', '' ) MONTH
- )
- WHEN $value LIKE '%y'
- THEN UNIX_TIMESTAMP(
- FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'y', '' ) YEAR
- )
- WHEN $value LIKE '%w'
- THEN UNIX_TIMESTAMP(
- FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'w', '' ) WEEK
- )
- WHEN $value LIKE '%d'
- THEN UNIX_TIMESTAMP(
- FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'd', '' ) DAY
- )
- WHEN $value LIKE '%h'
- THEN UNIX_TIMESTAMP(
- FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'h', '' ) HOUR
- )
- END
- "
- } else {
-
- die "FATAL: don't know how to subtract frequencies from dates for ".
- driver_name. " databases";
-
- }
-
-}
-
-=item condition_sql_option_age OPTION
-
-This is a class method that returns an SQL fragment for retreiving a condition
-option, and additionaly parsing it from a frequency (such as "1d", "1w" or
-"12m") into an approximate number of seconds.
-
-Note that since months vary in length, the results of this method should B<not>
-be used in computations (use condition_sql_option_age_from for that). They are
-useful for for ordering and comparison to other ages.
-
-This method is primarily intended for use in B<order_sql>.
-
-=cut
-
-sub condition_sql_option_age {
- my( $class, $option ) = @_;
- $class->age2seconds_sql( $class->condition_sql_option($option) );
-}
-
-=item age2seconds_sql
-
-Class method returns an SQL fragment for parsing an arbitrary frequeny (such
-as "1d", "1w", "12m", "2y" or "12h") into an approximate number of seconds.
-
-Approximate meaning: months are considered to be 30 days, years to be
-365.25 days. Otherwise the numbers of seconds returned is exact.
-
-=cut
-
-sub age2seconds_sql {
- my( $class, $value ) = @_;
-
- if ( driver_name =~ /^Pg/i ) {
-
- "EXTRACT( EPOCH FROM REPLACE( $value, 'm', 'mon')::interval )";
-
- } elsif ( driver_name =~ /^mysql/i ) {
-
- #hmm... is there a way we can save $value? we're just an expression, hmm
- #we might be able to do something like "AS ${option}_age" except we get
- #used in more complicated expressions and we need some sort of unique
- #identifer passed down too... yow
- # 2592000 = 30d "1 month"
- # 31557600 = 365.25d "1 year"
-
- "CASE WHEN $value IS NULL OR $value = ''
- THEN 0
- WHEN $value LIKE '%m'
- THEN REPLACE( $value, 'm', '' ) * 2592000
- WHEN $value LIKE '%y'
- THEN REPLACE( $value, 'y', '' ) * 31557600
- WHEN $value LIKE '%w'
- THEN REPLACE( $value, 'w', '' ) * 604800
- WHEN $value LIKE '%d'
- THEN REPLACE( $value, 'd', '' ) * 86400
- WHEN $value LIKE '%h'
- THEN REPLACE( $value, 'h', '' ) * 3600
- END
- "
- } else {
-
- die "FATAL: don't know how to approximate frequencies for ". driver_name.
- " databases";
-
- }
-
-}
-
-=head1 NEW CONDITION CLASSES
-
-A module should be added in FS/FS/part_event/Condition/ which implements the
-methods desribed above in L</METHODS>. An example may be found in the
-eg/part_event-Condition-template.pm file.
-
-=cut
-
-1;
-
-
diff --git a/FS/FS/part_event/Condition/agent.pm b/FS/FS/part_event/Condition/agent.pm
deleted file mode 100644
index da428c1..0000000
--- a/FS/FS/part_event/Condition/agent.pm
+++ /dev/null
@@ -1,37 +0,0 @@
-package FS::part_event::Condition::agent;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-
-# see the FS::part_event::Condition manpage for full documentation on each
-# of the required and optional methods.
-
-sub description {
- 'Agent';
-}
-
-sub option_fields {
- (
- 'agentnum' => { label=>'Agent', type=>'select-agent', },
- );
-}
-
-sub condition {
- my($self, $object, %opt) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- my $agentnum = $self->option('agentnum');
-
- $cust_main->agentnum == $agentnum;
-
-}
-
-#sub condition_sql {
-# my( $self, $table ) = @_;
-#
-# 'true';
-#}
-
-1;
diff --git a/FS/FS/part_event/Condition/agent_type.pm b/FS/FS/part_event/Condition/agent_type.pm
deleted file mode 100644
index 54c8932..0000000
--- a/FS/FS/part_event/Condition/agent_type.pm
+++ /dev/null
@@ -1,40 +0,0 @@
-package FS::part_event::Condition::agent_type;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-
-# see the FS::part_event::Condition manpage for full documentation on each
-# of the required and optional methods.
-
-sub description {
- 'Agent Type';
-}
-
-sub option_fields {
- (
- 'typenum' => { label => 'Agent Type',
- type => 'select-agent_type',
- disable_empty => 1,
- },
- );
-}
-
-sub condition {
- my($self, $object, %opt) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- my $typenum = $self->option('typenum');
-
- $cust_main->agent->typenum == $typenum;
-
-}
-
-#sub condition_sql {
-# my( $self, $table ) = @_;
-#
-# 'true';
-#}
-
-1;
diff --git a/FS/FS/part_event/Condition/balance.pm b/FS/FS/part_event/Condition/balance.pm
deleted file mode 100644
index 3b8854a..0000000
--- a/FS/FS/part_event/Condition/balance.pm
+++ /dev/null
@@ -1,48 +0,0 @@
-package FS::part_event::Condition::balance;
-
-use strict;
-use FS::cust_main;
-
-use base qw( FS::part_event::Condition );
-
-sub description { 'Customer balance'; }
-
-sub implicit_flag { 20; }
-
-sub remove_warning {
- 'Are you sure you want to remove this condition? Doing so will allow this event to run even if the customer has no outstanding balance. Perhaps you want to reset "Balance over" to 0 instead of removing the condition entirely?'; #better error msg?
-}
-
-sub option_fields {
- (
- 'balance' => { 'label' => 'Balance over',
- 'type' => 'money',
- 'value' => '0.00', #default
- },
- );
-}
-
-sub condition {
- my($self, $object) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- my $over = $self->option('balance');
- $over = 0 unless length($over);
-
- $cust_main->balance > $over;
-}
-
-sub condition_sql {
- my( $class, $table ) = @_;
-
- my $over = $class->condition_sql_option('balance');
-
- my $balance_sql = FS::cust_main->balance_sql;
-
- "$balance_sql > CAST( $over AS DECIMAL(10,2) )";
-
-}
-
-1;
-
diff --git a/FS/FS/part_event/Condition/balance_age.pm b/FS/FS/part_event/Condition/balance_age.pm
deleted file mode 100644
index 8480659..0000000
--- a/FS/FS/part_event/Condition/balance_age.pm
+++ /dev/null
@@ -1,52 +0,0 @@
-package FS::part_event::Condition::balance_age;
-
-use strict;
-use base qw( FS::part_event::Condition );
-
-sub description { 'Customer balance age'; }
-
-sub option_fields {
- (
- 'balance' => { 'label' => 'Balance over',
- 'type' => 'money',
- 'value' => '0.00', #default
- },
- 'age' => { 'label' => 'Age',
- 'type' => 'freq',
- },
- );
-}
-
-sub condition {
- my($self, $object, %opt) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- my $over = $self->option('balance');
- $over = 0 unless length($over);
-
- my $age = $self->option_age_from('age', $opt{'time'} );
-
- $cust_main->balance_date($age) > $over;
-}
-
-sub condition_sql {
- my( $class, $table, %opt ) = @_;
-
- my $over = $class->condition_sql_option('balance');
- my $age = $class->condition_sql_option_age_from('age', $opt{'time'});
-
- my $balance_sql = FS::cust_main->balance_date_sql( $age );
-
- "$balance_sql > CAST( $over AS DECIMAL(10,2) )";
-}
-
-sub order_sql {
- shift->condition_sql_option_age('age');
-}
-
-sub order_sql_weight {
- 10;
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/balance_credit_limit.pm b/FS/FS/part_event/Condition/balance_credit_limit.pm
deleted file mode 100644
index 1bc2aa1..0000000
--- a/FS/FS/part_event/Condition/balance_credit_limit.pm
+++ /dev/null
@@ -1,32 +0,0 @@
-package FS::part_event::Condition::balance_credit_limit;
-
-use strict;
-use FS::cust_main;
-
-use base qw( FS::part_event::Condition );
-
-sub description { 'Customer is over credit limit'; }
-
-sub condition {
- my($self, $object) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- my $over = $cust_main->credit_limit;
- return 0 if !length($over); # if credit limit is null, no limit
-
- $cust_main->balance > $over;
-}
-
-sub condition_sql {
- my( $class, $table ) = @_;
-
- my $balance_sql = FS::cust_main->balance_sql;
-
- "(cust_main.credit_limit IS NULL OR
- $balance_sql - cust_main.credit_limit > 0 )";
-
-}
-
-1;
-
diff --git a/FS/FS/part_event/Condition/balance_under.pm b/FS/FS/part_event/Condition/balance_under.pm
deleted file mode 100644
index 2002c70..0000000
--- a/FS/FS/part_event/Condition/balance_under.pm
+++ /dev/null
@@ -1,42 +0,0 @@
-package FS::part_event::Condition::balance_under;
-
-use strict;
-use FS::cust_main;
-
-use base qw( FS::part_event::Condition );
-
-sub description { 'Customer balance (under)'; }
-
-sub option_fields {
- (
- 'balance' => { 'label' => 'Balance under (or equal to)',
- 'type' => 'money',
- 'value' => '0.00', #default
- },
- );
-}
-
-sub condition {
- my($self, $object) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- my $under = $self->option('balance');
- $under = 0 unless length($under);
-
- $cust_main->balance <= $under;
-}
-
-sub condition_sql {
- my( $class, $table ) = @_;
-
- my $under = $class->condition_sql_option('balance');
-
- my $balance_sql = FS::cust_main->balance_sql;
-
- "$balance_sql <= CAST( $under AS DECIMAL(10,2) )";
-
-}
-
-1;
-
diff --git a/FS/FS/part_event/Condition/cust_bill_age.pm b/FS/FS/part_event/Condition/cust_bill_age.pm
deleted file mode 100644
index 2295e02..0000000
--- a/FS/FS/part_event/Condition/cust_bill_age.pm
+++ /dev/null
@@ -1,46 +0,0 @@
-package FS::part_event::Condition::cust_bill_age;
-
-use strict;
-use base qw( FS::part_event::Condition );
-
-sub description { 'Invoice age'; }
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 1,
- 'cust_pkg' => 0,
- };
-}
-
-sub option_fields {
- (
- 'age' => { label=>'Age', type=>'freq', },
- );
-}
-
-sub condition {
- my( $self, $cust_bill, %opt ) = @_;
-
- my $age = $self->option_age_from('age', $opt{'time'} );
-
- ( $cust_bill->_date - 60 ) <= $age;
-
-}
-
-sub condition_sql {
- my( $class, $table, %opt ) = @_;
-
- my $age = $class->condition_sql_option_age_from('age', $opt{'time'} );
-
- "( cust_bill._date - 60 ) <= $age";
-}
-
-sub order_sql {
- shift->condition_sql_option_age('age');
-}
-
-sub order_sql_weight {
- 0;
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/cust_bill_has_noauto.pm b/FS/FS/part_event/Condition/cust_bill_has_noauto.pm
deleted file mode 100644
index 6cb94c0..0000000
--- a/FS/FS/part_event/Condition/cust_bill_has_noauto.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::part_event::Condition::cust_bill_has_noauto;
-
-use strict;
-use FS::cust_bill;
-
-use base qw( FS::part_event::Condition );
-
-sub description {
- 'Invoice ineligible for automatic collection';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 1,
- 'cust_pkg' => 0,
- };
-}
-
-sub condition {
- #my($self, $cust_bill, %opt) = @_;
- my($self, $cust_bill) = @_;
-
- $cust_bill->no_auto;
-}
-
-#sub condition_sql {
-# my( $class, $table ) = @_;
-#
-# my $sql = qq| |;
-# return $sql;
-#}
-
-1;
diff --git a/FS/FS/part_event/Condition/cust_bill_has_service.pm b/FS/FS/part_event/Condition/cust_bill_has_service.pm
deleted file mode 100644
index d85af26..0000000
--- a/FS/FS/part_event/Condition/cust_bill_has_service.pm
+++ /dev/null
@@ -1,56 +0,0 @@
-package FS::part_event::Condition::cust_bill_has_service;
-
-use strict;
-use FS::cust_bill;
-
-use base qw( FS::part_event::Condition );
-
-sub description {
- 'Invoice is billing for a certain service type';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 1,
- 'cust_pkg' => 0,
- };
-}
-
-# could not find component for path '/elements/tr-select-part_svc.html'
-# sub disabled { 1; }
-
-sub option_fields {
- (
- 'has_service' => { 'label' => 'Has service',
- 'type' => 'select-part_svc',
- },
- );
-}
-
-sub condition {
- #my($self, $cust_bill, %opt) = @_;
- my($self, $cust_bill) = @_;
-
- my $servicenum = $self->option('has_service');
- grep { $servicenum == $_->svcpart }
- map { $_->cust_pkg->cust_svc }
- $cust_bill->cust_bill_pkg ;
-}
-
-sub condition_sql {
- 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 )
- )
- |;
- return $sql;
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/cust_bill_hasnt_noauto.pm b/FS/FS/part_event/Condition/cust_bill_hasnt_noauto.pm
deleted file mode 100644
index 78a6d51..0000000
--- a/FS/FS/part_event/Condition/cust_bill_hasnt_noauto.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::part_event::Condition::cust_bill_hasnt_noauto;
-
-use strict;
-use FS::cust_bill;
-
-use base qw( FS::part_event::Condition );
-
-sub description {
- 'Invoice eligible for automatic collection';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 1,
- 'cust_pkg' => 0,
- };
-}
-
-sub condition {
- #my($self, $cust_bill, %opt) = @_;
- my($self, $cust_bill) = @_;
-
- ! $cust_bill->no_auto;
-}
-
-#sub condition_sql {
-# my( $class, $table ) = @_;
-#
-# my $sql = qq| |;
-# return $sql;
-#}
-
-1;
diff --git a/FS/FS/part_event/Condition/cust_bill_owed.pm b/FS/FS/part_event/Condition/cust_bill_owed.pm
deleted file mode 100644
index d8c77c7..0000000
--- a/FS/FS/part_event/Condition/cust_bill_owed.pm
+++ /dev/null
@@ -1,54 +0,0 @@
-package FS::part_event::Condition::cust_bill_owed;
-
-use strict;
-use FS::cust_bill;
-
-use base qw( FS::part_event::Condition );
-
-sub description {
- 'Amount owed on specific invoice';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 1,
- 'cust_pkg' => 0,
- };
-}
-
-sub implicit_flag { 30; }
-
-sub remove_warning {
- 'Are you sure you want to remove this condition? Doing so will allow this event to run even for invoices which have no outstanding balance. Perhaps you want to reset "Amount owed over" to 0 instead of removing the condition entirely?'; #better error msg?
-}
-
-sub option_fields {
- (
- 'owed' => { 'label' => 'Amount owed over',
- 'type' => 'money',
- 'value' => '0.00', #default
- },
- );
-}
-
-sub condition {
- #my($self, $cust_bill, %opt) = @_;
- my($self, $cust_bill) = @_;
-
- my $over = $self->option('owed');
- $over = 0 unless length($over);
-
- $cust_bill->owed > $over;
-}
-
-sub condition_sql {
- my( $class, $table ) = @_;
-
- my $over = $class->condition_sql_option('owed');
-
- my $owed_sql = FS::cust_bill->owed_sql;
-
- "$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
deleted file mode 100644
index 4eb6439..0000000
--- a/FS/FS/part_event/Condition/cust_bill_owed_under.pm
+++ /dev/null
@@ -1,49 +0,0 @@
-package FS::part_event::Condition::cust_bill_owed_under;
-
-use strict;
-use FS::cust_bill;
-
-use base qw( FS::part_event::Condition );
-
-sub description {
- 'Amount owed on specific invoice (under)';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 1,
- 'cust_pkg' => 0,
- };
-}
-
-sub option_fields {
- (
- 'owed' => { 'label' => 'Amount owed under (or equal to)',
- 'type' => 'money',
- 'value' => '0.00', #default
- },
- );
-}
-
-sub condition {
- #my($self, $cust_bill, %opt) = @_;
- my($self, $cust_bill) = @_;
-
- my $under = $self->option('owed');
- $under = 0 unless length($under);
-
- $cust_bill->owed <= $under;
-
-}
-
-sub condition_sql {
- my( $class, $table ) = @_;
-
- my $under = $class->condition_sql_option('owed');
-
- my $owed_sql = FS::cust_bill->owed_sql;
-
- "$owed_sql <= CAST( $under AS DECIMAL(10,2) )";
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/cust_bill_past_due.pm b/FS/FS/part_event/Condition/cust_bill_past_due.pm
deleted file mode 100644
index a889a00..0000000
--- a/FS/FS/part_event/Condition/cust_bill_past_due.pm
+++ /dev/null
@@ -1,41 +0,0 @@
-package FS::part_event::Condition::cust_bill_past_due;
-
-use strict;
-use FS::cust_bill;
-use Time::Local 'timelocal';
-
-use base qw( FS::part_event::Condition );
-
-sub description {
- 'Invoice due date has passed';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 1,
- 'cust_pkg' => 0,
- };
-}
-
-sub condition {
- my($self, $cust_bill, %opt) = @_;
-
- # If the invoice date is 1/1 at noon and the terms are Net 15,
- # the due_date will be 1/16 at noon. Past due events will not
- # trigger until after the start of 1/17.
- my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($opt{'time'}))[0..5];
- my $start_of_today = timelocal(0,0,0,$mday,$mon,$year)+1;
- ($cust_bill->due_date || $cust_bill->_date) < $start_of_today;
-}
-
-sub condition_sql {
- return 'true' if $FS::UID::driver_name ne 'Pg';
- my( $class, $table, %opt ) = @_;
- my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($opt{'time'}))[0..5];
- my $start_of_today = timelocal(0,0,0,$mday,$mon,$year)+1;
-
- FS::cust_bill->due_date_sql . " < $start_of_today";
-
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/cust_pay_batch_declined.pm b/FS/FS/part_event/Condition/cust_pay_batch_declined.pm
deleted file mode 100644
index b3a8d70..0000000
--- a/FS/FS/part_event/Condition/cust_pay_batch_declined.pm
+++ /dev/null
@@ -1,51 +0,0 @@
-package FS::part_event::Condition::cust_pay_batch_declined;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-
-sub description {
- 'Batch payment declined';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 0,
- 'cust_pkg' => 0,
- 'cust_pay_batch' => 1,
- };
-}
-
-#sub option_fields {
-# (
-# 'field' => 'description',
-#
-# 'another_field' => { 'label'=>'Amount', 'type'=>'money', },
-#
-# 'third_field' => { 'label' => 'Types',
-# 'type' => 'checkbox-multiple',
-# 'options' => [ 'h', 's' ],
-# 'option_labels' => { 'h' => 'Happy',
-# 's' => 'Sad',
-# },
-# );
-#}
-
-sub condition {
- my($self, $cust_pay_batch, %opt) = @_;
-
- #my $cust_main = $self->cust_main($object);
- #my $value_of_field = $self->option('field');
- #my $time = $opt{'time'}; #use this instead of time or $^T
-
- $cust_pay_batch->status =~ /Declined/i;
-
-}
-
-#sub condition_sql {
-# my( $class, $table ) = @_;
-# #...
-# 'true';
-#}
-
-1;
diff --git a/FS/FS/part_event/Condition/cust_payments.pm b/FS/FS/part_event/Condition/cust_payments.pm
deleted file mode 100644
index 477ecdb..0000000
--- a/FS/FS/part_event/Condition/cust_payments.pm
+++ /dev/null
@@ -1,43 +0,0 @@
-package FS::part_event::Condition::cust_payments;
-
-use strict;
-use base qw( FS::part_event::Condition );
-
-sub description { 'Customer total payments (amount)'; }
-
-sub option_fields {
- (
- 'over' => { 'label' => 'Customer total payments at least',
- 'type' => 'money',
- 'value' => '0.00', #default
- },
- );
-}
-
-sub condition {
- my($self, $object) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- my $over = $self->option('over');
- $over = 0 unless length($over);
-
- $cust_main->total_paid >= $over;
-
-}
-
-#XXX add for efficiency. could use cust_main::total_paid_sql
-#use FS::cust_main;
-#sub condition_sql {
-# my( $class, $table ) = @_;
-#
-# my $over = $class->condition_sql_option('balance');
-#
-# my $balance_sql = FS::cust_main->balance_sql;
-#
-# "$balance_sql > $over";
-#
-#}
-
-1;
-
diff --git a/FS/FS/part_event/Condition/cust_payments_pkg.pm b/FS/FS/part_event/Condition/cust_payments_pkg.pm
deleted file mode 100644
index d6c493b..0000000
--- a/FS/FS/part_event/Condition/cust_payments_pkg.pm
+++ /dev/null
@@ -1,68 +0,0 @@
-package FS::part_event::Condition::cust_payments_pkg;
-
-use strict;
-use base qw( FS::part_event::Condition );
-
-sub description { 'Customer total payments (multiplier of package)'; }
-
-sub eventtable_hashref {
- { 'cust_pkg' => 1 };
-}
-
-sub option_fields {
- (
- 'over_times' => { 'label' => 'Customer total payments as least',
- 'type' => 'text',
- 'value' => '1', #default
- },
- 'what' => { 'label' => 'Times',
- '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 condition {
- my($self, $cust_pkg) = @_;
-
- my $cust_main = $self->cust_main($cust_pkg);
-
- my $part_pkg = $cust_pkg->part_pkg;
-
- my $over_times = $self->option('over_times');
- $over_times = 0 unless length($over_times);
-
- 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';
- }
- }
-
- $cust_main->total_paid >= $over_times * $part_pkg->$what($cust_pkg);
-
-}
-
-#XXX add for efficiency. could use cust_main::total_paid_sql
-#use FS::cust_main;
-#sub condition_sql {
-# my( $class, $table ) = @_;
-#
-# my $over = $class->condition_sql_option('balance');
-#
-# my $balance_sql = FS::cust_main->balance_sql;
-#
-# "$balance_sql > $over";
-#
-#}
-
-1;
-
diff --git a/FS/FS/part_event/Condition/cust_status.pm b/FS/FS/part_event/Condition/cust_status.pm
deleted file mode 100644
index 066ee48..0000000
--- a/FS/FS/part_event/Condition/cust_status.pm
+++ /dev/null
@@ -1,40 +0,0 @@
-package FS::part_event::Condition::cust_status;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-use FS::Record qw( qsearch );
-
-sub description {
- 'Customer Status';
-}
-
-#something like this
-sub option_fields {
- (
- 'status' => { 'label' => 'Customer Status',
- 'type' => 'select-cust_main-status',
- 'multiple' => 1,
- },
- );
-}
-
-sub condition {
- my( $self, $object) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- #XXX test
- my $hashref = $self->option('status') || {};
- $hashref->{ $cust_main->status };
-}
-
-sub condition_sql {
- my( $self, $table ) = @_;
-
- '('.FS::cust_main->cust_status_sql . ') IN '.
- $self->condition_sql_option_option('status');
-}
-
-
-1;
diff --git a/FS/FS/part_event/Condition/dundate.pm b/FS/FS/part_event/Condition/dundate.pm
deleted file mode 100644
index ee2a95f..0000000
--- a/FS/FS/part_event/Condition/dundate.pm
+++ /dev/null
@@ -1,26 +0,0 @@
-package FS::part_event::Condition::dundate;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-
-sub description {
- "Skip until customer dun date is reached";
-}
-
-sub condition {
- my($self, $object, %opt) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- $cust_main->dundate <= $opt{time};
-
-}
-
-#sub condition_sql {
-# my( $self, $table ) = @_;
-#
-# 'true';
-#}
-
-1;
diff --git a/FS/FS/part_event/Condition/every.pm b/FS/FS/part_event/Condition/every.pm
deleted file mode 100644
index 1910674..0000000
--- a/FS/FS/part_event/Condition/every.pm
+++ /dev/null
@@ -1,67 +0,0 @@
-package FS::part_event::Condition::every;
-
-use strict;
-use FS::UID qw( dbh );
-use FS::Record qw( qsearch );
-use FS::cust_event;
-
-use base qw( FS::part_event::Condition );
-
-sub description { "Don't retry failures more often than specified interval"; }
-
-sub option_fields {
- (
- 'retry_delay' => { label=>'Retry after', type=>'freq', value=>'1d', },
- 'max_tries' => { label=>'Maximum # of attempts', type=>'text', size=>3, },
- );
-}
-
-my %after = (
- 'h' => 3600,
- 'd' => 86400,
- 'w' => 604800,
- 'm' => 2592000, #well, 30 days... presumably people would mostly use d or w
- '' => 2592000,
- 'y' => 31536000, #well, 365 days...
-);
-
-my $sql =
- "SELECT COUNT(*) FROM cust_event WHERE eventpart = ? AND tablenum = ?";
-
-sub condition {
- my($self, $object, %opt) = @_;
-
- my $obj_pkey = $object->primary_key;
- my $tablenum = $object->$obj_pkey();
-
- if ( $self->option('max_tries') =~ /^\s*(\d+)\s*$/ ) {
- my $max_tries = $1;
- my $sth = dbh->prepare($sql)
- or die dbh->errstr. " preparing: $sql";
- $sth->execute($self->eventpart, $tablenum)
- or die $sth->errstr. " executing: $sql";
- my $tries = $sth->fetchrow_arrayref->[0];
- return 0 if $tries >= $max_tries;
- }
-
- my $time = $opt{'time'};
- my $retry_delay = $self->option('retry_delay');
- $retry_delay =~ /^(\d+)([hdwmy]?)$/
- or die "unparsable retry_delay: $retry_delay";
- my $date_after = $time - $1 * $after{$2};
-
- 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";
- ! $sth->fetchrow_arrayref->[0];
-
-}
-
-#sub condition_sql {
-# my( $self, $table ) = @_;
-#
-# 'true';
-#}
-
-1;
diff --git a/FS/FS/part_event/Condition/has_pkg_class.pm b/FS/FS/part_event/Condition/has_pkg_class.pm
deleted file mode 100644
index 59a3675..0000000
--- a/FS/FS/part_event/Condition/has_pkg_class.pm
+++ /dev/null
@@ -1,40 +0,0 @@
-package FS::part_event::Condition::has_pkg_class;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-use FS::Record qw( qsearch );
-use FS::pkg_class;
-
-sub description {
- 'Customer has uncancelled package with class';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 1,
- 'cust_bill' => 1,
- 'cust_pkg' => 1,
- };
-}
-
-#something like this
-sub option_fields {
- (
- 'pkgclass' => { 'label' => 'Package Class',
- 'type' => 'select-pkg_class',
- 'multiple' => 1,
- },
- );
-}
-
-sub condition {
- my( $self, $object ) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- #XXX test
- my $hashref = $self->option('pkgclass') || {};
- grep $hashref->{ $_->part_pkg->classnum }, $cust_main->ncancelled_pkgs;
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/has_pkgpart.pm b/FS/FS/part_event/Condition/has_pkgpart.pm
deleted file mode 100644
index c54b7e2..0000000
--- a/FS/FS/part_event/Condition/has_pkgpart.pm
+++ /dev/null
@@ -1,41 +0,0 @@
-package FS::part_event::Condition::has_pkgpart;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-
-sub description { 'Customer has uncancelled package of specified definitions'; }
-
-sub eventtable_hashref {
- { 'cust_main' => 1,
- 'cust_bill' => 1,
- 'cust_pkg' => 1,
- };
-}
-
-sub option_fields {
- (
- 'if_pkgpart' => { 'label' => 'Only packages: ',
- 'type' => 'select-part_pkg',
- 'multiple' => 1,
- },
- );
-}
-
-sub condition {
- my( $self, $object) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- #XXX test
- my $if_pkgpart = $self->option('if_pkgpart') || {};
- grep $if_pkgpart->{ $_->pkgpart }, $cust_main->ncancelled_pkgs;
-
-}
-
-#XXX
-#sub condition_sql {
-#
-#}
-
-1;
diff --git a/FS/FS/part_event/Condition/has_referral_custnum.pm b/FS/FS/part_event/Condition/has_referral_custnum.pm
deleted file mode 100644
index 70c9c7f..0000000
--- a/FS/FS/part_event/Condition/has_referral_custnum.pm
+++ /dev/null
@@ -1,50 +0,0 @@
-package FS::part_event::Condition::has_referral_custnum;
-
-use strict;
-use FS::cust_main;
-
-use base qw( FS::part_event::Condition );
-
-sub description { 'Customer has a referring customer'; }
-
-sub option_fields {
- (
- 'active' => { 'label' => 'Referring customer is active',
- 'type' => 'checkbox',
- 'value' => 'Y',
- },
- );
-}
-
-sub condition {
- my($self, $object) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- if ( $self->option('active') ) {
-
- return 0 unless $cust_main->referral_custnum;
-
- #check for no cust_main for referral_custnum? (deleted?)
-
- $cust_main->referral_custnum_cust_main->status eq 'active';
-
- } else {
-
- $cust_main->referral_custnum; # ? 1 : 0;
-
- }
-
-}
-
-sub condition_sql {
- my( $class, $table ) = @_;
-
- my $sql = FS::cust_main->active_sql;
- $sql =~ s/cust_main.custnum/cust_main.referral_custnum/;
- $sql = 'cust_main.referral_custnum IS NOT NULL AND ('.
- $class->condition_sql_option('active') . ' IS NULL OR '.$sql.')';
- return $sql;
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/hasnt_pkgpart.pm b/FS/FS/part_event/Condition/hasnt_pkgpart.pm
deleted file mode 100644
index 421d023..0000000
--- a/FS/FS/part_event/Condition/hasnt_pkgpart.pm
+++ /dev/null
@@ -1,40 +0,0 @@
-package FS::part_event::Condition::hasnt_pkgpart;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-
-sub description { 'Customer does not have uncancelled package of specified definitions'; }
-
-sub eventtable_hashref {
- { 'cust_main' => 1,
- 'cust_bill' => 1,
- 'cust_pkg' => 1,
- };
-}
-
-sub option_fields {
- (
- 'unless_pkgpart' => { 'label' => 'Packages: ',
- 'type' => 'select-part_pkg',
- 'multiple' => 1,
- },
- );
-}
-
-sub condition {
- my( $self, $object ) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- #XXX test
- my $unless_pkgpart = $self->option('unless_pkgpart') || {};
- ! grep $unless_pkgpart->{ $_->pkgpart }, $cust_main->ncancelled_pkgs;
-}
-
-#XXX
-#sub condition_sql {
-#
-#}
-
-1;
diff --git a/FS/FS/part_event/Condition/once.pm b/FS/FS/part_event/Condition/once.pm
deleted file mode 100644
index d004814..0000000
--- a/FS/FS/part_event/Condition/once.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-package FS::part_event::Condition::once;
-
-use strict;
-use FS::Record qw( qsearch );
-use FS::part_event;
-use FS::cust_event;
-
-use base qw( FS::part_event::Condition );
-
-sub description { "Don't run this event again after it has completed successfully"; }
-
-sub implicit_flag { 10; }
-
-sub remove_warning {
- 'Are you sure you want to remove this condition? Doing so will allow this event to run every time the other conditions are satisfied, even if it has already run sucessfully.'; #better error msg?
-}
-
-sub condition {
- my($self, $object, %opt) = @_;
-
- my $obj_pkey = $object->primary_key;
- my $tablenum = $object->$obj_pkey();
-
- my @existing = qsearch( {
- 'table' => 'cust_event',
- 'hashref' => {
- 'eventpart' => $self->eventpart,
- 'tablenum' => $tablenum,
- 'status' => { op=>'!=', value=>'failed' },
- },
- 'extra_sql' => ( $opt{'cust_event'}->eventnum =~ /^(\d+)$/
- ? " AND eventnum != $1 "
- : ''
- ),
- } );
-
- ! scalar(@existing);
-
-}
-
-sub condition_sql {
- my( $self, $table ) = @_;
-
- my %tablenum = %{ FS::part_event->eventtable_pkey_sql };
-
- "0 = ( SELECT COUNT(*) FROM cust_event
- WHERE cust_event.eventpart = part_event.eventpart
- AND cust_event.tablenum = $tablenum{$table}
- AND status != 'failed'
- )
- ";
-
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/once_every.pm b/FS/FS/part_event/Condition/once_every.pm
deleted file mode 100644
index 2921b3a..0000000
--- a/FS/FS/part_event/Condition/once_every.pm
+++ /dev/null
@@ -1,46 +0,0 @@
-package FS::part_event::Condition::once_every;
-
-use strict;
-use FS::Record qw( qsearch );
-use FS::part_event;
-use FS::cust_event;
-
-use base qw( FS::part_event::Condition );
-
-sub description { "Don't run this event more than once in the specified interval"; }
-
-# Runs the event at most "once every X".
-
-sub option_fields {
- (
- 'run_delay' => { label=>'Interval', type=>'freq', value=>'1m', },
- );
-}
-
-sub condition {
- my($self, $object, %opt) = @_;
-
- my $obj_pkey = $object->primary_key;
- my $tablenum = $object->$obj_pkey();
-
- my $max_date = $self->option_age_from('run_delay',$opt{'time'});
-
- my @existing = qsearch( {
- 'table' => 'cust_event',
- 'hashref' => {
- 'eventpart' => $self->eventpart,
- 'tablenum' => $tablenum,
- 'status' => { op=>'!=', value=>'failed' },
- '_date' => { op=>'>=', value=>$max_date },
- },
- 'extra_sql' => ( $opt{'cust_event'}->eventnum =~ /^(\d+)$/
- ? " AND eventnum != $1 "
- : ''
- ),
- } );
-
- ! scalar(@existing);
-
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/once_percust.pm b/FS/FS/part_event/Condition/once_percust.pm
deleted file mode 100644
index b8a8fbf..0000000
--- a/FS/FS/part_event/Condition/once_percust.pm
+++ /dev/null
@@ -1,67 +0,0 @@
-package FS::part_event::Condition::once_percust;
-
-use strict;
-use FS::Record qw( qsearch );
-use FS::part_event;
-use FS::cust_event;
-
-use base qw( FS::part_event::Condition );
-
-sub description { "Don't run more than once per customer"; }
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 1,
- 'cust_pkg' => 1,
- };
-}
-
-sub condition {
- my($self, $object, %opt) = @_;
-
- my $obj_pkey = $object->primary_key;
- my $obj_table = $object->table;
- my $custnum = $object->custnum;
-
- my @where = (
- "tablenum IN ( SELECT $obj_pkey FROM $obj_table WHERE custnum = $custnum )"
- );
- if ( $opt{'cust_event'}->eventnum =~ /^(\d+)$/ ) {
- push @where, " eventnum != $1 ";
- }
- my $extra_sql = ' AND '. join(' AND ', @where);
-
- my @existing = qsearch( {
- 'table' => 'cust_event',
- 'hashref' => {
- 'eventpart' => $self->eventpart,
- #'tablenum' => $tablenum,
- 'status' => { op=>'!=', value=>'failed' },
- },
- 'extra_sql' => $extra_sql,
- } );
-
- ! scalar(@existing);
-
-}
-
-#XXX test?
-sub condition_sql {
- my( $self, $table ) = @_;
-
- my %pkey = %{ FS::part_event->eventtable_pkey };
-
- my $pkey = $pkey{$table};
-
- "0 = ( SELECT COUNT(*) FROM cust_event
- WHERE cust_event.eventpart = part_event.eventpart
- AND cust_event.tablenum IN (
- SELECT $pkey FROM $table AS once_percust
- WHERE once_percust.custnum = cust_main.custnum )
- AND status != 'failed'
- )
- ";
-
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/once_perinv.pm b/FS/FS/part_event/Condition/once_perinv.pm
deleted file mode 100644
index f85a056..0000000
--- a/FS/FS/part_event/Condition/once_perinv.pm
+++ /dev/null
@@ -1,57 +0,0 @@
-package FS::part_event::Condition::once_perinv;
-
-use strict;
-use FS::Record qw( qsearch );
-use FS::part_event;
-use FS::cust_event;
-
-use base qw( FS::part_event::Condition );
-
-sub description { "Run only once for each time the package has been billed"; }
-
-# Run the event, at most, a number of times equal to the number of
-# distinct invoices that contain line items from this package.
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 0,
- 'cust_pkg' => 1,
- };
-}
-
-sub condition {
- my($self, $cust_pkg, %opt) = @_;
-
- my %invnum;
- $invnum{$_->invnum} = 1
- foreach ( qsearch('cust_bill_pkg', { 'pkgnum' => $cust_pkg->pkgnum }) );
- my @events = qsearch( {
- 'table' => 'cust_event',
- 'hashref' => { 'eventpart' => $self->eventpart,
- 'status' => { op=>'!=', value=>'failed' },
- 'tablenum' => $cust_pkg->pkgnum,
- },
- 'extra_sql' => ( $opt{'cust_event'}->eventnum =~ /^(\d+)$/
- ? " AND eventnum != $1 " : '' ),
- } );
- scalar(@events) < scalar(keys %invnum);
-}
-
-sub condition_sql {
- my( $self, $table ) = @_;
-
- "(
- ( SELECT COUNT(distinct(invnum))
- FROM cust_bill_pkg
- WHERE cust_bill_pkg.pkgnum = cust_pkg.pkgnum )
- >
- ( SELECT COUNT(*)
- FROM cust_event
- WHERE cust_event.eventpart = part_event.eventpart
- AND cust_event.tablenum = cust_pkg.pkgnum
- AND status != 'failed' )
- )"
-
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/payby.pm b/FS/FS/part_event/Condition/payby.pm
deleted file mode 100644
index 16bf480..0000000
--- a/FS/FS/part_event/Condition/payby.pm
+++ /dev/null
@@ -1,44 +0,0 @@
-package FS::part_event::Condition::payby;
-
-use strict;
-use Tie::IxHash;
-use FS::payby;
-
-use base qw( FS::part_event::Condition );
-
-sub description {
- #'customer payment types: ';
- 'Customer payment type';
-}
-
-#something like this
-tie my %payby, 'Tie::IxHash', FS::payby->cust_payby2longname;
-sub option_fields {
- (
- 'payby' => {
- label => 'Customer payment type',
- #type => 'select-multiple',
- type => 'checkbox-multiple',
- options => [ keys %payby ],
- option_labels => \%payby,
- },
- );
-}
-
-sub condition {
- my( $self, $object ) = @_;
-
- my $cust_main = $self->cust_main($object);
-
- my $hashref = $self->option('payby') || {};
- $hashref->{ $cust_main->payby };
-
-}
-
-sub condition_sql {
- my( $self, $table ) = @_;
-
- 'cust_main.payby IN '. $self->condition_sql_option_option('payby');
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/pkg_age.pm b/FS/FS/part_event/Condition/pkg_age.pm
deleted file mode 100644
index 4a85387..0000000
--- a/FS/FS/part_event/Condition/pkg_age.pm
+++ /dev/null
@@ -1,66 +0,0 @@
-package FS::part_event::Condition::pkg_age;
-
-use strict;
-use base qw( FS::part_event::Condition );
-use FS::Record qw( qsearch );
-
-sub description {
- 'Package Age';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 0,
- 'cust_pkg' => 1,
- };
-}
-
-#something like this
-sub option_fields {
- (
- 'age' => { 'label' => 'Package date age',
- 'type' => 'freq',
- },
- 'field' => { 'label' => 'Compare date',
- 'type' => 'select',
- 'options' =>
- [qw( setup last_bill bill adjourn susp expire cancel )],
- 'labels' => {
- 'setup' => 'Setup date',
- 'last_bill' => 'Last bill date',
- 'bill' => 'Next bill date',
- 'adjourn' => 'Adjournment date',
- 'susp' => 'Suspension date',
- 'expire' => 'Expiration date',
- 'cancel' => 'Cancellation date',
- },
- },
- );
-}
-
-sub condition {
- my( $self, $cust_pkg, %opt ) = @_;
-
- my $age = $self->option_age_from('age', $opt{'time'} );
-
- my $pkg_date = $cust_pkg->get( $self->option('field') );
-
- $pkg_date && $pkg_date <= $age;
-
-}
-
-sub condition_sql {
- my( $class, $table, %opt ) = @_;
- my $age = $class->condition_sql_option_age_from('age', $opt{'time'});
- my $field = $class->condition_sql_option('field');
-#amazingly, this is actually faster
- my $sql = '( CASE';
- foreach( qw(setup last_bill bill adjourn susp expire cancel) ) {
- $sql .= " WHEN $field = '$_' THEN (cust_pkg.$_ IS NOT NULL AND cust_pkg.$_ <= $age)";
- }
- $sql .= ' END )';
- return $sql;
-}
-
-1;
-
diff --git a/FS/FS/part_event/Condition/pkg_class.pm b/FS/FS/part_event/Condition/pkg_class.pm
deleted file mode 100644
index 8c9031c..0000000
--- a/FS/FS/part_event/Condition/pkg_class.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-package FS::part_event::Condition::pkg_class;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-use FS::Record qw( qsearch );
-use FS::pkg_class;
-
-sub description {
- 'Package Class';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 0,
- 'cust_pkg' => 1,
- };
-}
-
-#something like this
-sub option_fields {
- (
- 'pkgclass' => { 'label' => 'Package Class',
- 'type' => 'select-pkg_class',
- 'multiple' => 1,
- },
- );
-}
-
-sub condition {
- my( $self, $cust_pkg ) = @_;
-
- #XXX test
- my $hashref = $self->option('pkgclass') || {};
- $hashref->{ $cust_pkg->part_pkg->classnum };
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/pkg_freq.pm b/FS/FS/part_event/Condition/pkg_freq.pm
deleted file mode 100644
index 1fb8484..0000000
--- a/FS/FS/part_event/Condition/pkg_freq.pm
+++ /dev/null
@@ -1,36 +0,0 @@
-package FS::part_event::Condition::pkg_freq;
-
-use strict;
-use FS::Misc;
-use FS::cust_pkg;
-
-use base qw( FS::part_event::Condition );
-
-sub description { 'Package billing frequency'; }
-
-sub option_fields {
- my $freqs = FS::Misc::pkg_freqs();
- (
- 'freq' => { 'label' => 'Frequency',
- 'type' => 'select',
- 'labels' => $freqs,
- 'options' => [ keys(%$freqs) ],
- },
- );
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 0,
- 'cust_pkg' => 1,
- };
-}
-
-sub condition {
- my($self, $cust_pkg) = @_;
-
- $cust_pkg->part_pkg->freq eq $self->option('freq')
-}
-
-1;
-
diff --git a/FS/FS/part_event/Condition/pkg_next_bill_within.pm b/FS/FS/part_event/Condition/pkg_next_bill_within.pm
deleted file mode 100644
index 90c4c6a..0000000
--- a/FS/FS/part_event/Condition/pkg_next_bill_within.pm
+++ /dev/null
@@ -1,51 +0,0 @@
-package FS::part_event::Condition::pkg_next_bill_within;
-
-use strict;
-use base qw( FS::part_event::Condition );
-use FS::Record qw( qsearch );
-
-sub description {
- 'Next bill date within upcoming interval';
-}
-
-# Run the event when the next bill date is within X days.
-# To clarify, that's within X days _after_ the current date,
-# not before.
-# Combine this with a "once_every" condition so that the event
-# won't repeat every day until the bill date.
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 0,
- 'cust_pkg' => 1,
- };
-}
-
-sub option_fields {
- (
- 'within' => { 'label' => 'Bill date within',
- 'type' => 'freq',
- },
- # possibly "field" to allow date fields besides 'bill'?
- );
-}
-
-sub condition {
- my( $self, $cust_pkg, %opt ) = @_;
-
- my $pkg_date = $cust_pkg->get('bill') or return 0;
- $pkg_date = $self->option_age_from('within', $pkg_date );
-
- $opt{'time'} >= $pkg_date;
-
-}
-
-#XXX write me for efficiency
-sub condition_sql {
- my ($self, $table, %opt) = @_;
- $opt{'time'}.' >= '.
- $self->condition_sql_option_age_from('within', 'cust_pkg.bill')
-}
-
-1;
-
diff --git a/FS/FS/part_event/Condition/pkg_notchange.pm b/FS/FS/part_event/Condition/pkg_notchange.pm
deleted file mode 100644
index 4c103c2..0000000
--- a/FS/FS/part_event/Condition/pkg_notchange.pm
+++ /dev/null
@@ -1,31 +0,0 @@
-package FS::part_event::Condition::pkg_notchange;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-use FS::Record qw( qsearch );
-
-sub description {
- 'Package is a new order, not a change';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 0,
- 'cust_pkg' => 1,
- };
-}
-
-sub condition {
- my( $self, $cust_pkg ) = @_;
-
- ! $cust_pkg->change_date;
-
-}
-
-sub condition_sql {
- '( cust_pkg.change_date IS NULL OR cust_pkg.change_date = 0 )';
-}
-
-1;
-
diff --git a/FS/FS/part_event/Condition/pkg_pkgpart.pm b/FS/FS/part_event/Condition/pkg_pkgpart.pm
deleted file mode 100644
index 6adef8e..0000000
--- a/FS/FS/part_event/Condition/pkg_pkgpart.pm
+++ /dev/null
@@ -1,39 +0,0 @@
-package FS::part_event::Condition::pkg_pkgpart;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-
-sub description { 'Package definitions'; }
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 0,
- 'cust_pkg' => 1,
- };
-}
-
-sub option_fields {
- (
- 'if_pkgpart' => { 'label' => 'Only packages: ',
- 'type' => 'select-part_pkg',
- 'multiple' => 1,
- },
- );
-}
-
-sub condition {
- my( $self, $cust_pkg) = @_;
-
- #XXX test
- my $if_pkgpart = $self->option('if_pkgpart') || {};
- $if_pkgpart->{ $cust_pkg->pkgpart };
-
-}
-
-#XXX
-#sub condition_sql {
-#
-#}
-
-1;
diff --git a/FS/FS/part_event/Condition/pkg_recurring.pm b/FS/FS/part_event/Condition/pkg_recurring.pm
deleted file mode 100644
index 1a08869..0000000
--- a/FS/FS/part_event/Condition/pkg_recurring.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-package FS::part_event::Condition::pkg_recurring;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-
-sub description { 'Package is recurring'; }
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 0,
- 'cust_pkg' => 1,
- };
-}
-
-sub condition {
- my( $self, $cust_pkg ) = @_;
-
- $cust_pkg->part_pkg->freq !~ /^0+\D?$/; #just in case, probably just != '0'
-
-}
-
-sub condition_sql {
- FS::cust_pkg->recurring_sql()
-}
-
-1;
-
diff --git a/FS/FS/part_event/Condition/pkg_status.pm b/FS/FS/part_event/Condition/pkg_status.pm
deleted file mode 100644
index 3fb374e..0000000
--- a/FS/FS/part_event/Condition/pkg_status.pm
+++ /dev/null
@@ -1,44 +0,0 @@
-package FS::part_event::Condition::pkg_status;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-use FS::Record qw( qsearch );
-
-sub description {
- 'Package Status';
-}
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 0,
- 'cust_pkg' => 1,
- };
-}
-
-#something like this
-sub option_fields {
- (
- 'status' => { 'label' => 'Package Status',
- 'type' => 'select-cust_pkg-status',
- 'multiple' => 1,
- },
- );
-}
-
-sub condition {
- my( $self, $cust_pkg ) = @_;
-
- #XXX test
- my $hashref = $self->option('status') || {};
- $hashref->{ $cust_pkg->status };
-}
-
-sub condition_sql {
- my( $self, $table ) = @_;
-
- '('.FS::cust_pkg->status_sql . ') IN '.
- $self->condition_sql_option_option('status');
-}
-
-1;
diff --git a/FS/FS/part_event/Condition/pkg_unless_pkgpart.pm b/FS/FS/part_event/Condition/pkg_unless_pkgpart.pm
deleted file mode 100644
index 47fa8c3..0000000
--- a/FS/FS/part_event/Condition/pkg_unless_pkgpart.pm
+++ /dev/null
@@ -1,39 +0,0 @@
-package FS::part_event::Condition::pkg_unless_pkgpart;
-
-use strict;
-
-use base qw( FS::part_event::Condition );
-
-sub description { 'Except package definitions'; }
-
-sub eventtable_hashref {
- { 'cust_main' => 0,
- 'cust_bill' => 0,
- 'cust_pkg' => 1,
- };
-}
-
-sub option_fields {
- (
- 'unless_pkgpart' => { 'label' => 'Except packages: ',
- 'type' => 'select-part_pkg',
- 'multiple' => 1,
- },
- );
-}
-
-sub condition {
- my( $self, $cust_pkg) = @_;
-
- #XXX test
- my $unless_pkgpart = $self->option('unless_pkgpart') || {};
- ! $unless_pkgpart->{ $cust_pkg->pkgpart };
-
-}
-
-#XXX
-#sub condition_sql {
-#
-#}
-
-1;
diff --git a/FS/FS/part_event_condition.pm b/FS/FS/part_event_condition.pm
deleted file mode 100644
index 32f19a3..0000000
--- a/FS/FS/part_event_condition.pm
+++ /dev/null
@@ -1,354 +0,0 @@
-package FS::part_event_condition;
-
-use strict;
-use vars qw( @ISA $DEBUG @SKIP_CONDITION_SQL );
-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...
-
-@ISA = qw( FS::option_Common ); # FS::Record );
-$DEBUG = 0;
-
-@SKIP_CONDITION_SQL = ();
-
-=head1 NAME
-
-FS::part_event_condition - Object methods for part_event_condition records
-
-=head1 SYNOPSIS
-
- use FS::part_event_condition;
-
- $record = new FS::part_event_condition \%hash;
- $record = new FS::part_event_condition { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_event_condition object represents an event condition.
-FS::part_event_condition inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item eventconditionnum - primary key
-
-=item eventpart - Event definition (see L<FS::part_event>)
-
-=item conditionname - Condition name - defines which FS::part_event::Condition::I<conditionname> evaluates this condition
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new event. To add the example 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 { 'part_event_condition'; }
-
-=item insert [ HASHREF | OPTION => VALUE ... ]
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-If a list or hash reference of options is supplied, part_event_condition_option
-records are created (see L<FS::part_event_condition_option>).
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD [ HASHREF | OPTION => VALUE ... ]
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-If a list or hash reference of options is supplied, part_event_condition_option
-records are created or modified (see L<FS::part_event_condition_option>).
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('eventconditionnum')
- || $self->ut_foreign_key('eventpart', 'part_event', 'eventpart')
- || $self->ut_alpha('conditionname')
- ;
- return $error if $error;
-
- #XXX check conditionname to make sure a module exists?
- # well it'll die in _rebless...
-
- $self->SUPER::check;
-}
-
-
-=item _rebless
-
-Reblesses the object into the FS::part_event::Condition::CONDITIONNAME class,
-where CONDITIONNAME is the object's I<conditionname> field.
-
-=cut
-
-sub _rebless {
- my $self = shift;
- my $conditionname = $self->conditionname;
- #my $class = ref($self). "::$conditionname";
- my $class = "FS::part_event::Condition::$conditionname";
- eval "use $class";
- die $@ if $@;
- bless($self, $class); #unless $@;
- $self;
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item conditions [ EVENTTABLE ]
-
-Return information about the available conditions. If an eventtable is
-specified, only return information about conditions available for that
-eventtable.
-
-Information is returned as key-value pairs. Keys are condition names. Values
-are hashrefs with the following keys:
-
-=over 4
-
-=item description
-
-=item option_fields
-
-# =item default_weight
-
-# =item deprecated
-
-=back
-
-See L<FS::part_event::Condition> for more information.
-
-=cut
-
-#false laziness w/part_event.pm
-#some false laziness w/part_export & part_pkg
-my %conditions;
-foreach my $INC ( @INC ) {
- foreach my $file ( glob("$INC/FS/part_event/Condition/*.pm") ) {
- warn "attempting to load Condition from $file\n" if $DEBUG;
- $file =~ /\/(\w+)\.pm$/ or do {
- warn "unrecognized file in $INC/FS/part_event/Condition/: $file\n";
- next;
- };
- my $mod = $1;
- my $fullmod = "FS::part_event::Condition::$mod";
- eval "use $fullmod;";
- if ( $@ ) {
- die "error using $fullmod (skipping): $@\n" if $@;
- #warn "error using $fullmod (skipping): $@\n" if $@;
- #next;
- }
- if ( $fullmod->disabled ) {
- warn "$fullmod is disabled; skipping\n";
- next;
- }
- #my $full_condition_sql = $fullmod. '::condition_sql';
- my $condition_sql_coderef = sub { $fullmod->condition_sql(@_) };
- my $order_sql_coderef = $fullmod->can('order_sql')
- ? sub { $fullmod->order_sql(@_) }
- : '';
- $conditions{$mod} = {
- ( map { $_ => $fullmod->$_() }
- qw( description eventtable_hashref
- implicit_flag remove_warning
- order_sql_weight
- )
- # deprecated
- #option_fields_hashref
- ),
- 'option_fields' => [ $fullmod->option_fields() ],
- 'condition_sql' => $condition_sql_coderef,
- 'order_sql' => $order_sql_coderef,
- };
- }
-}
-
-sub conditions {
- my( $class, $eventtable ) = @_;
- (
- map { $_ => $conditions{$_} }
-# sort { $conditions{$a}->{'default_weight'}<=>$conditions{$b}->{'default_weight'} }
-# sort by ?
- $class->all_conditionnames( $eventtable )
- );
-
-}
-
-=item all_conditionnames [ EVENTTABLE ]
-
-Returns a list of just the condition names
-
-=cut
-
-sub all_conditionnames {
- my ( $class, $eventtable ) = @_;
-
- grep { !$eventtable || $conditions{$_}->{'eventtable_hashref'}{$eventtable} }
- keys %conditions
-}
-
-=item join_conditions_sql [ EVENTTABLE ]
-
-Returns an SQL fragment selecting joining all condition options for an event as
-tables titled "cond_I<conditionname>". Typically used in conjunction with
-B<where_conditions_sql>.
-
-=cut
-
-sub join_conditions_sql {
- my ( $class, $eventtable ) = @_;
- my %conditions = $class->conditions( $eventtable );
-
- join(' ',
- map {
- "LEFT JOIN part_event_condition AS cond_$_".
- " ON ( part_event.eventpart = cond_$_.eventpart".
- " AND cond_$_.conditionname = ". dbh->quote($_).
- " )";
- }
- keys %conditions
- );
-
-}
-
-=item where_conditions_sql [ EVENTTABLE [ , OPTION => VALUE, ... ] ]
-
-Returns an SQL fragment to select events which have unsatisfied conditions.
-Must be used in conjunction with B<join_conditions_sql>.
-
-The only current option is "time", the current time (or "pretend" current time
-as passed to freeside-daily), as a UNIX timestamp.
-
-=cut
-
-sub where_conditions_sql {
- my ( $class, $eventtable, %options ) = @_;
-
- my $time = $options{'time'};
-
- my %conditions = $class->conditions( $eventtable );
-
- my $where = join(' AND ',
- map {
- my $conditionname = $_;
- my $coderef = $conditions{$conditionname}->{condition_sql};
- 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 )";
- }
- grep { my $cond = $_;
- ! grep { $_ eq $cond } @SKIP_CONDITION_SQL
- }
- keys %conditions
- );
-
- $where;
-}
-
-=item order_conditions_sql [ EVENTTABLE ]
-
-Returns an SQL fragment to order selected events. Must be used in conjunction
-with B<join_conditions_sql>.
-
-=cut
-
-sub order_conditions_sql {
- my( $class, $eventtable ) = @_;
-
- my %conditions = $class->conditions( $eventtable );
-
- my $eventtables = join(' ', FS::part_event->eventtables_runorder);
-
- my $order_by = join(', ',
- "position( part_event.eventtable in ' $eventtables ')",
- ( map {
- my $conditionname = $_;
- my $coderef = $conditions{$conditionname}->{order_sql};
- my $sql = &$coderef( $eventtable );
- "CASE WHEN cond_$conditionname.conditionname IS NULL
- THEN -1
- ELSE $sql
- END
- ";
- }
- sort { $conditions{$a}->{order_sql_weight}
- <=> $conditions{$b}->{order_sql_weight}
- }
- grep { $conditions{$_}->{order_sql} }
- keys %conditions
- ),
- 'part_event.weight'
- );
-
- "ORDER BY $order_by";
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::part_event::Condition>, L<FS::part_event>, L<FS::Record>, schema.html from
-the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_event_condition_option.pm b/FS/FS/part_event_condition_option.pm
deleted file mode 100644
index 3256dc0..0000000
--- a/FS/FS/part_event_condition_option.pm
+++ /dev/null
@@ -1,151 +0,0 @@
-package FS::part_event_condition_option;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::option_Common;
-use FS::part_event_condition;
-
-@ISA = qw( FS::option_Common ); # FS::Record);
-
-=head1 NAME
-
-FS::part_event_condition_option - Object methods for part_event_condition_option records
-
-=head1 SYNOPSIS
-
- use FS::part_event_condition_option;
-
- $record = new FS::part_event_condition_option \%hash;
- $record = new FS::part_event_condition_option { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_event_condition_option object represents an event condition option.
-FS::part_event_condition_option inherits from FS::Record. The following fields
-are currently supported:
-
-=over 4
-
-=item optionnum - primary key
-
-=item eventconditionnum - Event condition (see L<FS::part_event_condition>)
-
-=item optionname - Option name
-
-=item optionvalue - Option value
-
-=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 { 'part_event_condition_option'; }
-
-=item insert [ HASHREF | OPTION => VALUE ... ]
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-If a list or hash reference of options is supplied,
-part_event_condition_option_option records are created (see
-L<FS::part_event_condition_option_option>).
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD [ HASHREF | OPTION => VALUE ... ]
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-If a list or hash reference of options is supplied,
-part_event_condition_option_option records are created or modified (see
-L<FS::part_event_condition_option_option>).
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=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('optionnum')
- || $self->ut_foreign_key('eventconditionnum',
- 'part_event_condition', 'eventconditionnum')
- || $self->ut_text('optionname')
- || $self->ut_textn('optionvalue')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-#this makes the nested options magically show up as perl refs
-#move it to a mixin class if we need nested options again
-sub optionvalue {
- my $self = shift;
- if ( scalar(@_) ) { #setting, no magic (here, insert takes care of it)
- $self->set('optionvalue', @_);
- } else { #getting, magic
- my $optionvalue = $self->get('optionvalue');
- if ( $optionvalue eq 'HASH' ) {
- return { $self->options };
- } else {
- $optionvalue;
- }
- }
-}
-
-=back
-
-=head1 SEE ALSO
-
-L<FS::part_event_condition>, L<FS::part_event_condition_option_option>,
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_event_condition_option_option.pm b/FS/FS/part_event_condition_option_option.pm
deleted file mode 100644
index 7396c22..0000000
--- a/FS/FS/part_event_condition_option_option.pm
+++ /dev/null
@@ -1,129 +0,0 @@
-package FS::part_event_condition_option_option;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::part_event_condition_option;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::part_event_condition_option_option - Object methods for part_event_condition_option_option records
-
-=head1 SYNOPSIS
-
- use FS::part_event_condition_option_option;
-
- $record = new FS::part_event_condition_option_option \%hash;
- $record = new FS::part_event_condition_option_option { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_event_condition_option_option object represents a nested event
-condition option. FS::part_event_condition_option_option inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item optionoptionnum - primary key
-
-=item optionnum - Parent option (see L<FS::part_event_option>)
-
-=item optionname - Option name
-
-=item optionvalue - Option value
-
-
-=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 { 'part_event_condition_option_option'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('optionoptionnum')
- || $self->ut_foreign_key('optionnum',
- 'part_event_condition_option', 'optionnum' )
- || $self->ut_text('optionname')
- || $self->ut_textn('optionvalue')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::part_event_condition_option>, L<FS::Record>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_event_option.pm b/FS/FS/part_event_option.pm
deleted file mode 100644
index 09b7756..0000000
--- a/FS/FS/part_event_option.pm
+++ /dev/null
@@ -1,214 +0,0 @@
-package FS::part_event_option;
-
-use strict;
-use vars qw( @ISA );
-use Scalar::Util qw( blessed );
-use FS::UID qw( dbh );
-use FS::Record qw( qsearch qsearchs );
-use FS::part_event;
-use FS::reason;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::part_event_option - Object methods for part_event_option records
-
-=head1 SYNOPSIS
-
- use FS::part_event_option;
-
- $record = new FS::part_event_option \%hash;
- $record = new FS::part_event_option { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_event_option object represents an event definition option (action
-option). FS::part_event_option inherits from FS::Record. The following fields
-are currently supported:
-
-=over 4
-
-=item optionnum - primary key
-
-=item eventpart - Event definition (see L<FS::part_event>)
-
-=item optionname - Option name
-
-=item optionvalue - Option value
-
-=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 { 'part_event_option'; }
-
-=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;
-
- if ( $self->optionname eq 'reasonnum' && $self->optionvalue eq 'HASH' ) {
-
- my $error = $self->insert_reason(@_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- }
-
- my $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
-
-# the delete method can be inherited from FS::Record
-
-=item replace [ OLD_RECORD ]
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- 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 $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
- ? shift
- : $self->replace_old;
-
- if ( $self->optionname eq 'reasonnum' ) {
- warn "reasonnum: ". $self->optionvalue;
- }
- if ( $self->optionname eq 'reasonnum' && $self->optionvalue eq 'HASH' ) {
-
- my $error = $self->insert_reason(@_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- }
-
- my $error = $self->SUPER::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 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('optionnum')
- || $self->ut_foreign_key('eventpart', 'part_event', 'eventpart' )
- || $self->ut_text('optionname')
- || $self->ut_textn('optionvalue')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-sub insert_reason {
- my( $self, $reason ) = @_;
-
- my $reason_obj = new FS::reason({
- 'reason_type' => $reason->{'typenum'},
- 'reason' => $reason->{'reason'},
- });
-
- $reason_obj->insert or $self->optionvalue( $reason_obj->reasonnum ) and '';
-
-}
-
-=back
-
-=head1 SEE ALSO
-
-L<FS::part_event>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm
deleted file mode 100644
index 6f5aedc..0000000
--- a/FS/FS/part_export.pm
+++ /dev/null
@@ -1,493 +0,0 @@
-package FS::part_export;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK $DEBUG %exports );
-use Exporter;
-use Tie::IxHash;
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::option_Common;
-use FS::part_svc;
-use FS::part_export_option;
-use FS::export_svc;
-
-#for export modules, though they should probably just use it themselves
-use FS::queue;
-
-@ISA = qw( FS::option_Common );
-@EXPORT_OK = qw(export_info);
-
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::part_export - Object methods for part_export records
-
-=head1 SYNOPSIS
-
- use FS::part_export;
-
- $record = new FS::part_export \%hash;
- $record = new FS::part_export { 'column' => 'value' };
-
- #($new_record, $options) = $template_recored->clone( $svcpart );
-
- $error = $record->insert( { 'option' => 'value' } );
- $error = $record->insert( \%options );
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_export object represents an export of Freeside data to an external
-provisioning system. FS::part_export inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item exportnum - primary key
-
-=item exportname - Descriptive name
-
-=item machine - Machine name
-
-=item exporttype - Export type
-
-=item nodomain - blank or "Y" : usernames are exported to this service with no domain
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new export. To add the export 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 { 'part_export'; }
-
-=cut
-
-#=item clone SVCPART
-#
-#An alternate constructor. Creates a new export by duplicating an existing
-#export. The given svcpart is assigned to the new export.
-#
-#Returns a list consisting of the new export object and a hashref of options.
-#
-#=cut
-#
-#sub clone {
-# my $self = shift;
-# my $class = ref($self);
-# my %hash = $self->hash;
-# $hash{'exportnum'} = '';
-# $hash{'svcpart'} = shift;
-# ( $class->new( \%hash ),
-# { map { $_->optionname => $_->optionvalue }
-# qsearch('part_export_option', { 'exportnum' => $self->exportnum } )
-# }
-# );
-#}
-
-=item insert HASHREF
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-If a hash reference of options is supplied, part_export_option records are
-created (see L<FS::part_export_option>).
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-#foreign keys would make this much less tedious... grr dumb mysql
-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;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- foreach my $export_svc ( $self->export_svc ) {
- my $error = $export_svc->delete;
- 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 export. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
- my $error =
- $self->ut_numbern('exportnum')
- || $self->ut_textn('exportname')
- || $self->ut_domain('machine')
- || $self->ut_alpha('exporttype')
- ;
- return $error if $error;
-
- $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
- $self->nodomain($1);
-
- $self->deprecated(1); #BLAH
-
- #check exporttype?
-
- $self->SUPER::check;
-}
-
-#=item part_svc
-#
-#Returns the service definition (see L<FS::part_svc>) for this export.
-#
-#=cut
-#
-#sub part_svc {
-# my $self = shift;
-# qsearchs('part_svc', { svcpart => $self->svcpart } );
-#}
-
-sub part_svc {
- use Carp;
- croak "FS::part_export::part_svc deprecated";
- #confess "FS::part_export::part_svc deprecated";
-}
-
-=item svc_x
-
-Returns a list of associated FS::svc_* records.
-
-=cut
-
-sub svc_x {
- my $self = shift;
- map { $_->svc_x } $self->cust_svc;
-}
-
-=item cust_svc
-
-Returns a list of associated FS::cust_svc records.
-
-=cut
-
-sub cust_svc {
- my $self = shift;
- map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
- grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
- $self->export_svc;
-}
-
-=item export_svc
-
-Returns a list of associated FS::export_svc records.
-
-=cut
-
-sub export_svc {
- my $self = shift;
- 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
-L<FS::part_export_option>).
-
-=cut
-
-sub part_export_option {
- my $self = shift;
- $self->option_objects;
-}
-
-=item options
-
-Returns a list of option names and values suitable for assigning to a hash.
-
-=item option OPTIONNAME
-
-Returns the option value for the given name, or the empty string.
-
-=item _rebless
-
-Reblesses the object into the FS::part_export::EXPORTTYPE class, where
-EXPORTTYPE is the object's I<exporttype> field. There should be better docs
-on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
-
-=cut
-
-sub _rebless {
- my $self = shift;
- my $exporttype = $self->exporttype;
- my $class = ref($self). "::$exporttype";
- eval "use $class;";
- #die $@ if $@;
- bless($self, $class) unless $@;
- $self;
-}
-
-#these should probably all go away, just let the subclasses define em
-
-=item export_insert SVC_OBJECT
-
-=cut
-
-sub export_insert {
- my $self = shift;
- #$self->rebless;
- $self->_export_insert(@_);
-}
-
-#sub AUTOLOAD {
-# my $self = shift;
-# $self->rebless;
-# my $method = $AUTOLOAD;
-# #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
-# $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
-# $self->$method(@_);
-#}
-
-=item export_replace NEW OLD
-
-=cut
-
-sub export_replace {
- my $self = shift;
- #$self->rebless;
- $self->_export_replace(@_);
-}
-
-=item export_delete
-
-=cut
-
-sub export_delete {
- my $self = shift;
- #$self->rebless;
- $self->_export_delete(@_);
-}
-
-=item export_suspend
-
-=cut
-
-sub export_suspend {
- my $self = shift;
- #$self->rebless;
- $self->_export_suspend(@_);
-}
-
-=item export_unsuspend
-
-=cut
-
-sub export_unsuspend {
- my $self = shift;
- #$self->rebless;
- $self->_export_unsuspend(@_);
-}
-
-#fallbacks providing useful error messages intead of infinite loops
-sub _export_insert {
- my $self = shift;
- return "_export_insert: unknown export type ". $self->exporttype;
-}
-
-sub _export_replace {
- my $self = shift;
- return "_export_replace: unknown export type ". $self->exporttype;
-}
-
-sub _export_delete {
- my $self = shift;
- return "_export_delete: unknown export type ". $self->exporttype;
-}
-
-#call svcdb-specific fallbacks
-
-sub _export_suspend {
- my $self = shift;
- #warn "warning: _export_suspened unimplemented for". ref($self);
- my $svc_x = shift;
- my $new = $svc_x->clone_suspended;
- $self->_export_replace( $new, $svc_x );
-}
-
-sub _export_unsuspend {
- my $self = shift;
- #warn "warning: _export_unsuspend unimplemented for ". ref($self);
- my $svc_x = shift;
- my $old = $svc_x->clone_kludge_unsuspend;
- $self->_export_replace( $svc_x, $old );
-}
-
-=item export_links SVC_OBJECT ARRAYREF
-
-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
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item export_info [ SVCDB ]
-
-Returns a hash reference of the exports for the given I<svcdb>, or if no
-I<svcdb> is specified, for all exports. The keys of the hash are
-I<exporttype>s and the values are again hash references containing information
-on the export:
-
- 'desc' => 'Description',
- 'options' => {
- 'option' => { label=>'Option Label' },
- 'option2' => { label=>'Another label' },
- },
- 'nodomain' => 'Y', #or ''
- 'notes' => 'Additional notes',
-
-=cut
-
-sub export_info {
- #warn $_[0];
- return $exports{$_[0]} || {} if @_;
- #{ map { %{$exports{$_}} } keys %exports };
- my $r = { map { %{$exports{$_}} } keys %exports };
-}
-
-#=item exporttype2svcdb EXPORTTYPE
-#
-#Returns the applicable I<svcdb> for an I<exporttype>.
-#
-#=cut
-#
-#sub exporttype2svcdb {
-# my $exporttype = $_[0];
-# foreach my $svcdb ( keys %exports ) {
-# return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
-# }
-# '';
-#}
-
-#false laziness w/part_pkg & cdr
-foreach my $INC ( @INC ) {
- foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
- warn "attempting to load export info from $file\n" if $DEBUG;
- $file =~ /\/(\w+)\.pm$/ or do {
- warn "unrecognized file in $INC/FS/part_export/: $file\n";
- next;
- };
- my $mod = $1;
- my $info = eval "use FS::part_export::$mod; ".
- "\\%FS::part_export::$mod\::info;";
- if ( $@ ) {
- die "error using FS::part_export::$mod (skipping): $@\n" if $@;
- next;
- }
- unless ( keys %$info ) {
- warn "no %info hash found in FS::part_export::$mod, skipping\n"
- unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck
- next;
- }
- warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
- no strict 'refs';
- foreach my $svc (
- ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
- ) {
- unless ( $svc ) {
- warn "blank svc for FS::part_export::$mod (skipping)\n";
- next;
- }
- $exports{$svc}->{$mod} = $info;
- }
- }
-}
-
-=back
-
-=head1 NEW EXPORT CLASSES
-
-A module should be added in FS/FS/part_export/ (an example may be found in
-eg/export_template.pm)
-
-=head1 BUGS
-
-Hmm... cust_export class (not necessarily a database table...) ... ?
-
-deprecated column...
-
-=head1 SEE ALSO
-
-L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
-L<FS::svc_domain>,
-L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_export/acct_freeside.pm b/FS/FS/part_export/acct_freeside.pm
deleted file mode 100644
index 3c287ca..0000000
--- a/FS/FS/part_export/acct_freeside.pm
+++ /dev/null
@@ -1,139 +0,0 @@
-package FS::part_export::acct_freeside;
-
-use vars qw( @ISA %info $DEBUG );
-use Data::Dumper;
-use Tie::IxHash;
-use FS::part_export;
-#use FS::Record qw( qsearch qsearchs );
-use Frontier::Client;
-
-@ISA = qw(FS::part_export);
-
-$DEBUG = 1;
-
-tie my %options, 'Tie::IxHash',
- 'xmlrpc_url' => { label => 'Full URL to target Freeside xmlrpc.cgi', },
- 'ss_username' => { label => 'Self-service username', },
- 'ss_domain' => { label => 'Self-service domain', },
- 'ss_password' => { label => 'Self-service password', },
- 'domsvc' => { label => 'Domain svcnum on target machine', },
- 'pkgnum' => { label => 'Customer package pkgnum on target machine', },
- 'svcpart' => { label => 'Service definition svcpart on target machine', },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to another Freeside server',
- 'options' => \%options,
- 'notes' => <<END
-Real-time export to another Freeside server via self-service.
-Requires installation of
-<a href="http://search.cpan.org/dist/Frontier-Client">Frontier::Client</a>
-from CPAN and setup of an appropriate bulk customer on the other Freeside server.
-END
-);
-
-sub _export_insert {
- my($self, $svc_acct) = (shift, shift);
-
- my $result = $self->_freeside_command('provision_acct',
- 'pkgnum' => $self->option('pkgnum'),
- 'svcpart' => $self->option('svcpart'),
- 'username' => $svc_acct->username,
- '_password' => $svc_acct->_password,
- '_password2' => $svc_acct->_password,
- 'domsvc' => $self->option('domsvc'),
- );
-
- $result->{error} || '';
-
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
-
- my $svcnum = $self->_freeside_find_svc( $old );
- return $svcnum unless $svcnum =~ /^(\d+)$/;
-
- #only pw change supported for now...
- my $result = $self->_freeside_command( 'myaccount_passwd',
- 'svcnum' => $svcnum,
- 'new_password' => $new->_password,
- 'new_password2' => $new->_password,
- );
-
- $result->{error} || '';
-}
-
-sub _export_delete {
- my( $self, $svc_acct ) = (shift, shift);
-
- my $svcnum = $self->_freeside_find_svc( $svc_acct );
- return $svcnum unless $svcnum =~ /^(\d+)$/;
-
- my $result = $self->_freeside_command( 'unprovision_svc', 'svcnum'=>$svcnum );
-
- $result->{'error'} || '';
-
-}
-
-sub _freeside_find_svc {
- my( $self, $svc_acct ) = ( shift, shift );
-
- my $list_svcs = $self->_freeside_command( 'list_svcs', 'svcdb'=>'svc_acct' );
- my @svc = grep { $svc_acct->username eq $_->{username}
- #&& compare domains
- } @{ $list_svcs->{svcs} };
-
- return 'multiple services found on target FS' if scalar(@svc) > 1;
- return 'no service found on target FS' if scalar(@svc) == 0; #shouldn't be fatal?
-
- $svc[0]->{'svcnum'};
-
-}
-
-sub _freeside_command {
- my( $self, $method, @args ) = @_;
-
- my %login = (
- 'username' => $self->option('ss_username'),
- 'domain' => $self->option('ss_domain'),
- 'password' => $self->option('ss_password'),
- );
- my $login_result = $self->_do_freeside_command( 'login', %login );
- return $login_result if $login_result->{error};
- my $session_id = $login_result->{session_id};
-
- #could reuse $session id for replace & delete where we have to find then delete..
-
- my %command = (
- session_id => $session_id,
- @args
- );
- my $result = $self->_do_freeside_command( $method, %command );
-
- $result;
-
-}
-
-sub _do_freeside_command {
- my( $self, $method, %args ) = @_;
-
- # a questionable choice... but it'll do for now.
- eval "use Frontier::Client;";
- die $@ if $@;
-
- #reuse?
- my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') );
-
- warn "sending FS selfservice $method: ". Dumper(\%args)
- if $DEBUG;
- my $result = $conn->call("FS.SelfService.XMLRPC.$method", \%args);
- warn "FS selfservice $method response: ". Dumper($result)
- if $DEBUG;
-
- $result;
-
-}
-
-1;
diff --git a/FS/FS/part_export/acct_http.pm b/FS/FS/part_export/acct_http.pm
deleted file mode 100644
index b4c64ac..0000000
--- a/FS/FS/part_export/acct_http.pm
+++ /dev/null
@@ -1,63 +0,0 @@
-package FS::part_export::acct_http;
-
-use vars qw( @ISA %info );
-use FS::part_export::http;
-use Tie::IxHash;
-
-@ISA = qw( FS::part_export::http );
-
-tie %options, 'Tie::IxHash',
- 'method' => { label =>'Method',
- type =>'select',
- #options =>[qw(POST GET)],
- options =>[qw(POST)],
- default =>'POST' },
- 'url' => { label => 'URL', default => 'http://', },
- 'insert_data' => {
- label => 'Insert data',
- type => 'textarea',
- default => join("\n",
- "action 'add'",
- "username \$svc_x->username",
- "password \$svc_x->_password",
- "prismid \$cust_main->agent_custid ? \$cust_main->agent_custid : \$cust_main->custnum ",
- "name \$cust_main->first.' '.\$cust_main->last",
- ),
- },
- 'delete_data' => {
- label => 'Delete data',
- type => 'textarea',
- default => join("\n",
- "action 'remove'",
- "username \$svc_x->username",
- ),
- },
- 'replace_data' => {
- label => 'Replace data',
- type => 'textarea',
- default => join("\n",
- "action 'update'",
- "username \$old->username",
- "password \$new->_password",
- ),
- },
- 'success_regexp' => {
- label => 'Success Regexp',
- default => '',
- },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Send an HTTP or HTTPS GET or POST request, for accounts.',
- 'options' => \%options,
- 'notes' => <<'END'
-Send an HTTP or HTTPS GET or POST to the specified URL on account addition,
-modification and deletion. For HTTPS support,
-<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a>
-or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a>
-is required.
-END
-);
-
-1;
diff --git a/FS/FS/part_export/acct_plesk.pm b/FS/FS/part_export/acct_plesk.pm
deleted file mode 100644
index d8d70a3..0000000
--- a/FS/FS/part_export/acct_plesk.pm
+++ /dev/null
@@ -1,121 +0,0 @@
-package FS::part_export::acct_plesk;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'URL' => { label=>'URL' },
- 'login' => { label=>'Login' },
- 'password' => { label=>'Password' },
- 'debug' => { label=>'Enable debugging',
- type=>'checkbox' },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to Plesk managed mail service',
- 'options'=> \%options,
- 'notes' => <<'END'
-Real-time export to
-<a href="http://www.swsoft.com/">Plesk</a> managed server.
-Requires installation of
-<a href="http://search.cpan.org/dist/Net-Plesk">Net::Plesk</a>
-from CPAN and proper <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration:acct_plesk.pm">configuration</a>.
-END
-);
-
-sub rebless { shift; }
-
-# experiment: want the status of these right away (don't want account to
-# create or whatever and then get error in the queue from dup username or
-# something), so no queueing
-
-sub _export_insert {
- my( $self, $svc_acct ) = (shift, shift);
-
- $self->_plesk_command( 'mail_add',
- $svc_acct->domain,
- $svc_acct->username,
- $svc_acct->_password,
- ) ||
- $self->_export_unsuspend($svc_acct);
-}
-
-sub _plesk_command {
- my( $self, $method, $domain, @args ) = @_;
-
- eval "use Net::Plesk;";
- return $@ if $@;
-
- local($Net::Plesk::DEBUG) = 1
- if $self->option('debug');
-
- my $plesk = new Net::Plesk (
- 'POST' => $self->option('URL'),
- ':HTTP_AUTH_LOGIN' => $self->option('login'),
- ':HTTP_AUTH_PASSWD' => $self->option('password'),
- );
-
- my $dresponse = $plesk->domain_get( $domain );
- return $dresponse->errortext unless $dresponse->is_success;
- my $domainID = $dresponse->id;
-
- my $response = $plesk->$method($dresponse->id, @args);
- return $response->errortext unless $response->is_success;
- '';
-
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
-
- return "can't change domain with Plesk"
- if $old->domain ne $new->domain;
- return "can't change username with Plesk"
- if $old->username ne $new->username;
- return '' unless $old->_password ne $new->_password;
-
- $self->_plesk_command( 'mail_set',
- $new->domain,
- $new->username,
- $new->_password,
- $old->cust_svc->cust_pkg->susp ? 0 : 1,
- );
-}
-
-sub _export_delete {
- my( $self, $svc_acct ) = (shift, shift);
-
- $self->_plesk_command( 'mail_remove',
- $svc_acct->domain,
- $svc_acct->username,
- );
-}
-
-sub _export_suspend {
- my( $self, $svc_acct ) = (shift, shift);
-
- $self->_plesk_command( 'mail_set',
- $svc_acct->domain,
- $svc_acct->username,
- $svc_acct->_password,
- 0,
- );
-}
-
-sub _export_unsuspend {
- my( $self, $svc_acct ) = (shift, shift);
-
- $self->_plesk_command( 'mail_set',
- $svc_acct->domain,
- $svc_acct->username,
- $svc_acct->_password,
- 1,
- );
-}
-
-1;
-
diff --git a/FS/FS/part_export/acct_sql.pm b/FS/FS/part_export/acct_sql.pm
deleted file mode 100644
index 9f1ae7b..0000000
--- a/FS/FS/part_export/acct_sql.pm
+++ /dev/null
@@ -1,310 +0,0 @@
-package FS::part_export::acct_sql;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-#use Digest::MD5 qw(md5_hex);
-use FS::Record; #qw(qsearchs);
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'datasrc' => { label => 'DBI data source' },
- 'username' => { label => 'Database username' },
- 'password' => { label => 'Database password' },
- 'table' => { label => 'Database table' },
- 'schema' => { label =>
- 'Database schema mapping to Freeside methods.',
- type => 'textarea',
- },
- 'static' => { label =>
- 'Database schema mapping to static values.',
- type => 'textarea',
- },
- 'primary_key' => { label => 'Database primary key' },
- 'crypt' => { label => 'Password encryption',
- type=>'select', options=>[qw(crypt md5)],
- default=>'crypt',
- },
-;
-
-tie my %vpopmail_map, 'Tie::IxHash',
- 'pw_name' => 'username',
- 'pw_domain' => 'domain',
- 'pw_passwd' => 'crypt_password',
- 'pw_uid' => 'uid',
- 'pw_gid' => 'gid',
- 'pw_gecos' => 'finger',
- 'pw_dir' => 'dir',
- #'pw_shell' => 'shell',
- 'pw_shell' => 'quota',
-;
-my $vpopmail_map = join('\n', map "$_ $vpopmail_map{$_}", keys %vpopmail_map );
-
-tie my %postfix_courierimap_mailbox_map, 'Tie::IxHash',
- 'username' => 'email',
- 'password' => '_password',
- 'crypt' => 'crypt_password',
- 'name' => 'finger',
- 'maildir' => 'virtual_maildir',
- 'domain' => 'domain',
- 'svcnum' => 'svcnum',
-;
-my $postfix_courierimap_mailbox_map =
- join('\n', map "$_ $postfix_courierimap_mailbox_map{$_}",
- keys %postfix_courierimap_mailbox_map );
-
-tie my %postfix_courierimap_alias_map, 'Tie::IxHash',
- 'address' => 'email',
- 'goto' => 'email',
- 'domain' => 'domain',
- 'svcnum' => 'svcnum',
-;
-my $postfix_courierimap_alias_map =
- join('\n', map "$_ $postfix_courierimap_alias_map{$_}",
- keys %postfix_courierimap_alias_map );
-
-tie my %postfix_native_mailbox_map, 'Tie::IxHash',
- 'userid' => 'email',
- 'uid' => 'uid',
- 'gid' => 'gid',
- 'password' => 'ldap_password',
- 'mail' => 'domain_slash_username',
-;
-my $postfix_native_mailbox_map =
- join('\n', map "$_ $postfix_native_mailbox_map{$_}",
- keys %postfix_native_mailbox_map );
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export of accounts to SQL databases '.
- '(vpopmail, Postfix+Courier IMAP, others?)',
- 'options' => \%options,
- 'nodomain' => '',
- 'notes' => <<END
-Export accounts (svc_acct records) to SQL databases. Currently has default
-configurations for vpopmail and Postfix+Courier IMAP but intended to be
-configurable for other schemas as well.
-
-<BR><BR>In contrast to sqlmail, this is intended to export just svc_acct
-records only, rather than a single export for svc_acct, svc_forward and
-svc_domain records, to export in "default" database schemas rather than
-configure the MTA or POP/IMAP server for a Freeside-specific schema, and
-to be configured for different mail server setups.
-
-<BR><BR>Use these buttons for some useful presets:
-<UL>
- <li><INPUT TYPE="button" VALUE="vpopmail" onClick='
- this.form.table.value = "vpopmail";
- this.form.schema.value = "$vpopmail_map";
- this.form.primary_key.value = "pw_name, pw_domain";
- '>
- <LI><INPUT TYPE="button" VALUE="postfix_courierimap_mailbox" onClick='
- this.form.table.value = "mailbox";
- this.form.schema.value = "$postfix_courierimap_mailbox_map";
- this.form.primary_key.value = "username";
- '>
- <LI><INPUT TYPE="button" VALUE="postfix_courierimap_alias" onClick='
- this.form.table.value = "alias";
- this.form.schema.value = "$postfix_courierimap_alias_map";
- this.form.primary_key.value = "address";
- '>
- <LI><INPUT TYPE="button" VALUE="postfix_native_mailbox" onClick='
- this.form.table.value = "users";
- this.form.schema.value = "$postfix_native_mailbox_map";
- this.form.primary_key.value = "userid";
- '>
-</UL>
-END
-);
-
-sub _schema_map { shift->_map('schema'); }
-sub _static_map { shift->_map('static'); }
-
-sub _map {
- my $self = shift;
- map { /^\s*(\S+)\s*(\S+)\s*$/ } split("\n", $self->option(shift) );
-}
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self, $svc_acct) = (shift, shift);
-
- my %schema = $self->_schema_map;
- my %static = $self->_static_map;
-
- my %record = (
-
- ( map { $_ => $static{$_} } keys %static ),
-
- ( map { my $value = $schema{$_};
- my @arg = ();
- push @arg, $self->option('crypt')
- if $value eq 'crypt_password' && $self->option('crypt');
- $_ => $svc_acct->$value(@arg);
- } keys %schema
- ),
-
- );
-
- my $err_or_queue =
- $self->acct_sql_queue(
- $svc_acct->svcnum,
- 'insert',
- $self->option('table'),
- %record
- );
- return $err_or_queue unless ref($err_or_queue);
-
- '';
-
-}
-
-sub _export_replace {
- my($self, $new, $old) = (shift, shift, shift);
-
- my %schema = $self->_schema_map;
- my %static = $self->_static_map;
-
- my @primary_key = ();
- if ( $self->option('primary_key') =~ /,/ ) {
- foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) {
- my $keymap = $schema{$key};
- push @primary_key, $old->$keymap();
- }
- } else {
- my $keymap = $schema{$self->option('primary_key')};
- push @primary_key, $old->$keymap();
- }
-
- my %record = (
-
- ( map { $_ => $static{$_} } keys %static ),
-
- ( map { my $value = $schema{$_};
- my @arg = ();
- push @arg, $self->option('crypt')
- if $value eq 'crypt_password' && $self->option('crypt');
- $_ => $new->$value(@arg);
- } keys %schema
- ),
-
- );
-
- my $err_or_queue = $self->acct_sql_queue(
- $new->svcnum,
- 'replace',
- $self->option('table'),
- $self->option('primary_key'), @primary_key,
- %record,
- );
- return $err_or_queue unless ref($err_or_queue);
- '';
-}
-
-sub _export_delete {
- my ( $self, $svc_acct ) = (shift, shift);
-
- my %schema = $self->_schema_map;
-
- my %primary_key = ();
- if ( $self->option('primary_key') =~ /,/ ) {
- foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) {
- my $keymap = $schema{$key};
- $primary_key{ $key } = $svc_acct->$keymap();
- }
- } else {
- my $keymap = $schema{$self->option('primary_key')};
- $primary_key{ $self->option('primary_key') } = $svc_acct->$keymap(),
- }
-
- my $err_or_queue = $self->acct_sql_queue(
- $svc_acct->svcnum,
- 'delete',
- $self->option('table'),
- %primary_key,
- #$self->option('primary_key') => $svc_acct->$keymap(),
- );
- return $err_or_queue unless ref($err_or_queue);
- '';
-}
-
-sub acct_sql_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::acct_sql::acct_sql_$method",
- };
- $queue->insert(
- $self->option('datasrc'),
- $self->option('username'),
- $self->option('password'),
- @_,
- ) or $queue;
-}
-
-sub acct_sql_insert { #subroutine, not method
- my $dbh = acct_sql_connect(shift, shift, shift);
- my( $table, %record ) = @_;
-
- my $sth = $dbh->prepare(
- "INSERT INTO $table ( ". join(", ", keys %record).
- " ) VALUES ( ". join(", ", map '?', keys %record ). " )"
- ) or die $dbh->errstr;
-
- $sth->execute( values(%record) )
- or die "can't insert into $table table: ". $sth->errstr;
-
- $dbh->disconnect;
-}
-
-sub acct_sql_delete { #subroutine, not method
- my $dbh = acct_sql_connect(shift, shift, shift);
- my( $table, %record ) = @_;
-
- my $sth = $dbh->prepare(
- "DELETE FROM $table WHERE ". join(' AND ', map "$_ = ? ", keys %record )
- ) or die $dbh->errstr;
-
- $sth->execute( map $record{$_}, keys %record )
- or die "can't delete from $table table: ". $sth->errstr;
-
- $dbh->disconnect;
-}
-
-sub acct_sql_replace { #subroutine, not method
- my $dbh = acct_sql_connect(shift, shift, shift);
-
- my( $table, $pkey ) = ( shift, shift );
-
- my %primary_key = ();
- if ( $pkey =~ /,/ ) {
- foreach my $key ( split(/\s*,\s*/, $pkey ) ) {
- $primary_key{$key} = shift;
- }
- } else {
- $primary_key{$pkey} = shift;
- }
-
- my %record = @_;
-
- my $sth = $dbh->prepare(
- "UPDATE $table".
- ' SET '. join(', ', map "$_ = ?", keys %record ).
- ' WHERE '. join(' AND ', map "$_ = ?", keys %primary_key )
- ) or die $dbh->errstr;
-
- $sth->execute( values(%record), values(%primary_key) );
-
- $dbh->disconnect;
-}
-
-sub acct_sql_connect {
- #my($datasrc, $username, $password) = @_;
- #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
- DBI->connect(@_) or die $DBI::errstr;
-}
-
-1;
-
diff --git a/FS/FS/part_export/amazon_ec2.pm b/FS/FS/part_export/amazon_ec2.pm
deleted file mode 100644
index 0e65ca0..0000000
--- a/FS/FS/part_export/amazon_ec2.pm
+++ /dev/null
@@ -1,169 +0,0 @@
-package FS::part_export::amazon_ec2;
-
-use base qw( FS::part_export );
-
-use vars qw(@ISA %info $replace_ok_kludge);
-use Tie::IxHash;
-use FS::Record qw( qsearchs );
-use FS::svc_external;
-
-tie my %options, 'Tie::IxHash',
- 'access_key' => { label => 'AWS access key', },
- 'secret_key' => { label => 'AWS secret key', },
- 'ami' => { label => 'AMI', 'default' => 'ami-ff46a796', },
- 'keyname' => { label => 'Keypair name', },
- #option to turn off (or on) ip address allocation
-;
-
-%info = (
- 'svc' => 'svc_external',
- 'desc' =>
- 'Export to Amazon EC2',
- 'options' => \%options,
- 'notes' => <<'END'
-Create instances in the Amazon EC2 (Elastic compute cloud). Install
-Net::Amazon::EC2 perl module. Advisable to set svc_external-skip_manual config
-option.
-END
-);
-
-$replace_ok_kludge = 0;
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self, $svc_external) = (shift, shift);
- $err_or_queue = $self->amazon_ec2_queue( $svc_external->svcnum, 'insert',
- $svc_external->svcnum,
- $self->option('ami'),
- $self->option('keyname'),
- );
- ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
- return '' if $replace_ok_kludge;
- return "can't change instance id or IP address";
- #$err_or_queue = $self->amazon_ec2_queue( $new->svcnum,
- # 'replace', $new->username, $new->_password );
- #ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-sub _export_delete {
- my( $self, $svc_external ) = (shift, shift);
- my( $instance_id, $ip ) = split(/:/, $svc_external->title );
- $err_or_queue = $self->amazon_ec2_queue( $svc_external->svcnum, 'delete',
- $instance_id,
- $ip,
- );
- 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->amazon_ec2_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->amazon_ec2_queue( $svc_something->svcnum,
-# 'unsuspend', $svc_something->username );
-# ref($err_or_queue) ? '' : $err_or_queue;
-#}
-
-sub export_links {
- my($self, $svc_external, $arrayref) = (shift, shift, shift);
- my( $instance_id, $ip ) = split(/:/, $svc_external->title );
-
- push @$arrayref, qq!<A HREF="http://$ip/">http://$ip/</A>!;
- '';
-}
-
-###
-
-#a good idea to queue anything that could fail or take any time
-sub amazon_ec2_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::amazon_ec2::amazon_ec2_$method",
- };
- $queue->insert( $self->option('access_key'),
- $self->option('secret_key'),
- @_
- )
- or $queue;
-}
-
-sub amazon_ec2_new {
- my( $access_key, $secret_key, @rest ) = @_;
-
- eval 'use Net::Amazon::EC2;';
- die $@ if $@;
-
- my $ec2 = new Net::Amazon::EC2 'AWSAccessKeyId' => $access_key,
- 'SecretAccessKey' => $secret_key;
-
- ( $ec2, @rest );
-}
-
-sub amazon_ec2_insert { #subroutine, not method
- my( $ec2, $svcnum, $ami, $keyname ) = amazon_ec2_new(@_);
-
- my $reservation_info = $ec2->run_instances( 'ImageId' => $ami,
- 'KeyName' => $keyname,
- 'MinCount' => 1,
- 'MaxCount' => 1,
- );
-
- my $instance_id = $reservation_info->instances_set->[0]->instance_id;
-
- my $ip = $ec2->allocate_address
- or die "can't allocate address";
- $ec2->associate_address('InstanceId' => $instance_id,
- 'PublicIp' => $ip,
- )
- or die "can't assocate IP address $ip with instance $instance_id";
-
- my $svc_external = qsearchs('svc_external', { 'svcnum' => $svcnum } )
- or die "can't find svc_external.svcnum $svcnum\n";
-
- $svc_external->title("$instance_id:$ip");
-
- local($replace_ok_kludge) = 1;
- my $error = $svc_external->replace;
- die $error if $error;
-
-}
-
-#sub amazon_ec2_replace { #subroutine, not method
-#}
-
-sub amazon_ec2_delete { #subroutine, not method
- my( $ec2, $id, $ip ) = amazon_ec2_new(@_);
-
- my $instance_id = sprintf('i-%x', $id);
- $ec2->disassociate_address('PublicIp'=>$ip)
- or die "can't dissassocate $ip";
-
- $ec2->release_address('PublicIp'=>$ip)
- or die "can't release $ip";
-
- my $result = $ec2->terminate_instances('InstanceId'=>$instance_id);
- #check for instance_id match or something?
-
-}
-
-#sub amazon_ec2_suspend { #subroutine, not method
-#}
-
-#sub amazon_ec2_unsuspend { #subroutine, not method
-#}
-
-1;
-
diff --git a/FS/FS/part_export/apache.pm b/FS/FS/part_export/apache.pm
deleted file mode 100644
index 35b00cc..0000000
--- a/FS/FS/part_export/apache.pm
+++ /dev/null
@@ -1,47 +0,0 @@
-package FS::part_export::apache;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export::null;
-
-@ISA = qw(FS::part_export::null);
-
-tie my %options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'httpd_conf' => { label=>'httpd.conf snippet location',
- default=>'/etc/apache/httpd-freeside.conf', },
- 'restart' => { label=>'Apache restart command',
- default=>'apachectl graceful',
- },
- 'template' => {
- label => 'Template',
- type => 'textarea',
- default => <<'END',
-<VirtualHost $domain> #generic
-#<VirtualHost ip.addr> #preferred, http://httpd.apache.org/docs/dns-caveats.html
-DocumentRoot /var/www/$zone
-ServerName $zone
-ServerAlias *.$zone
-#BandWidthModule On
-#LargeFileLimit 4096 12288
-#FrontpageEnable on
-</VirtualHost>
-
-END
- },
-;
-
-%info = (
- 'svc' => 'svc_www',
- 'desc' => 'Export an Apache httpd.conf file snippet.',
- 'options' => \%options,
- 'notes' => <<'END'
-Batch export of an httpd.conf snippet from a template. Typically used with
-something like <code>Include /etc/apache/httpd-freeside.conf</code> in
-httpd.conf. <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a>
-must be installed. Run bin/apache.export to export the files.
-END
-);
-
-1;
-
diff --git a/FS/FS/part_export/artera_turbo.pm b/FS/FS/part_export/artera_turbo.pm
deleted file mode 100644
index c006db9..0000000
--- a/FS/FS/part_export/artera_turbo.pm
+++ /dev/null
@@ -1,181 +0,0 @@
-package FS::part_export::artera_turbo;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::Record qw(qsearch);
-use FS::part_export;
-use FS::cust_svc;
-use FS::svc_external;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'rid' => { 'label' => 'Reseller ID (RID)' },
- 'username' => { 'label' => 'Reseller username', },
- 'password' => { 'label' => 'Reseller password', },
- 'pid' => { 'label' => 'Artera Product ID', },
- 'priceid' => { 'label' => 'Artera Price ID', },
- 'agent_aid' => { 'label' => 'Export agentnum values to Artera AID',
- 'type' => 'checkbox',
- },
- 'aid' => { 'label' => 'Artera Agent ID to use if not using agentnum values', },
- 'production' => { 'label' => 'Production mode (leave unchecked for staging)',
- 'type' => 'checkbox',
- },
- 'debug' => { 'label' => 'Enable debug logging',
- 'type' => 'checkbox',
- },
- 'enable_edit' => { 'label' => 'Enable local editing of Artera serial numbers and key codes (note that the changes will NOT be exported to Artera)',
- 'type' => 'checkbox',
- },
-;
-
-%info = (
- 'svc' => 'svc_external',
- #'svc' => [qw( svc_acct svc_forward )],
- 'desc' =>
- 'Real-time export to Artera Turbo Reseller API',
- 'options' => \%options,
- #'nodomain' => 'Y',
- 'notes' => <<'END'
-Real-time export to <a href="http://www.arteraturbo.com/">Artera Turbo</a>
-Reseller API. Requires installation of
-<a href="http://search.cpan.org/dist/Net-Artera">Net::Artera</a>
-from CPAN. You probably also want to:
-<UL>
- <LI>In the configuration UI section: set the <B>svc_external-skip_manual</B> and <B>svc_external-display_type</B> configuration values.
- <LI>In the message catalog: set <B>svc_external-id</B> to <I>Artera Serial Number</I> and set <B>svc_external-title</B> to <I>Artera Key Code</I>.
-</UL>
-END
-);
-
-sub rebless { shift; }
-
-sub _new_Artera {
- my $self = shift;
-
- my $artera = new Net::Artera (
- map { $_ => $self->option($_) }
- qw( rid username password production )
- );
-}
-
-
-sub _export_insert {
- my($self, $svc_external) = (shift, shift);
-
- # want the ASN (serial) and AKC (key code) right away
-
- eval "use Net::Artera;";
- return $@ if $@;
- $Net::Artera::DEBUG = 1 if $self->option('debug');
- my $artera = $self->_new_Artera;
-
- my $cust_pkg = $svc_external->cust_svc->cust_pkg;
- my $part_pkg = $cust_pkg->part_pkg;
- my @svc_acct = grep { $_->table eq 'svc_acct' }
- map { $_->svc_x }
- sort { my $svcpart = $part_pkg->svcpart('svc_acct');
- ($b->svcpart==$svcpart) cmp ($a->svcpart==$svcpart); }
- qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
- my $email = scalar(@svc_acct) ? $svc_acct[0]->email : '';
-
- my $cust_main = $cust_pkg->cust_main;
-
- my $result = $artera->newOrder(
- 'pid' => $self->option('pid'),
- 'priceid' => $self->option('priceid'),
- 'email' => $email,
- 'cname' => $cust_main->name,
- 'ref' => $svc_external->svcnum,
- 'aid' => ( $self->option('agent_aid')
- ? $cust_main->agentnum
- : $self->option('aid') ),
- 'add1' => $cust_main->address1,
- 'add2' => $cust_main->address2,
- 'add3' => $cust_main->city,
- 'add4' => $cust_main->state,
- 'zip' => $cust_main->zip,
- 'cid' => $cust_main->country,
- 'phone' => $cust_main->daytime || $cust_main->night,
- 'fax' => $cust_main->fax,
- );
-
- if ( $result->{'id'} == 1 ) {
- my $new = new FS::svc_external { $svc_external->hash };
- $new->id(sprintf('%010d', $result->{'ASN'}));
- $new->title( substr('0000000000'.uc($result->{'AKC'}), -10) );
- $new->replace($svc_external);
- } else {
- $result->{'message'} || 'No response from Artera';
- }
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
- return '' if $self->option('enable_edit');
- return "can't change serial number with Artera"
- if $old->id != $new->id && $old->id;
- return "can't change key code with Artera"
- if $old->title ne $new->title && $old->title;
- '';
-}
-
-sub _export_delete {
- my( $self, $svc_external ) = (shift, shift);
- $self->queue_statusChange(17, $svc_external);
-}
-
-sub _export_suspend {
- my( $self, $svc_external ) = (shift, shift);
- $self->queue_statusChange(16, $svc_external);
-}
-
-sub _export_unsuspend {
- my( $self, $svc_external ) = (shift, shift);
- $self->queue_statusChange(15, $svc_external);
-}
-
-sub queue_statusChange {
- my( $self, $status, $svc_external ) = @_;
-
- my $queue = new FS::queue {
- 'svcnum' => $svc_external->svcnum,
- 'job' => 'FS::part_export::artera_turbo::statusChange',
- };
- $queue->insert(
- ( map { $self->option($_) }
- qw( rid username password production ) ),
- $status,
- $svc_external->id,
- $svc_external->title,
- $self->option('debug'),
- );
-}
-
-sub statusChange {
- my( $rid, $username, $password, $prod, $status, $id, $title, $debug ) = @_;
-
- eval "use Net::Artera;";
- return $@ if $@;
- $Net::Artera::DEBUG = 1 if $debug;
-
- my $artera = new Net::Artera (
- 'rid' => $rid,
- 'username' => $username,
- 'password' => $password,
- 'production' => $prod,
- );
-
- my $result = $artera->statusChange(
- 'asn' => sprintf('%010d', $id),
- 'akc' => substr("0000000000$title", -10),
- 'statusid' => $status,
- );
-
- die $result->{'message'} unless $result->{'id'} == 1;
-
-}
-
-1;
-
diff --git a/FS/FS/part_export/bind.pm b/FS/FS/part_export/bind.pm
deleted file mode 100644
index 1ef7b65..0000000
--- a/FS/FS/part_export/bind.pm
+++ /dev/null
@@ -1,35 +0,0 @@
-package FS::part_export::bind;
-
-use vars qw(@ISA %info %options);
-use Tie::IxHash;
-use FS::part_export::null;
-
-@ISA = qw(FS::part_export::null);
-
-tie %options, 'Tie::IxHash',
- 'named_conf' => { label => 'named.conf location',
- default=> '/etc/bind/named.conf' },
- 'zonepath' => { label => 'path to zone files',
- default=> '/etc/bind/', },
- 'bind_release' => { label => 'ISC BIND Release',
- type => 'select',
- options => [qw(BIND8 BIND9)],
- default => 'BIND8' },
- 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.',
- default => '1D' },
- 'reload' => { label => 'Optional reload command. If not specified, defaults to "ndc" under BIND8 and "rndc" under BIND9.', },
-;
-
-%info = (
- 'svc' => 'svc_domain',
- 'desc' => 'Batch export to BIND named',
- 'options' => \%options,
- 'notes' => <<'END'
-Batch export of BIND zone and configuration files to a primary nameserver.
-<a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a>
-must be installed. Run bin/bind.export to export the files.
-END
-);
-
-1;
-
diff --git a/FS/FS/part_export/bind_slave.pm b/FS/FS/part_export/bind_slave.pm
deleted file mode 100644
index c89325f..0000000
--- a/FS/FS/part_export/bind_slave.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-package FS::part_export::bind_slave;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export::null;
-
-@ISA = qw(FS::part_export::null);
-
-tie my %options, 'Tie::IxHash',
- 'master' => { label=> 'Master IP address(s) (semicolon-separated)' },
- %FS::part_export::bind::options,
-;
-delete $options{'zonepath'};
-
-%info = (
- 'svc' => 'svc_domain',
- 'desc' =>'Batch export to slave BIND named',
- 'options' => \%options,
- 'notes' => <<'END'
-Batch export of BIND configuration file to a secondary nameserver. Zones are
-slaved from the listed masters.
-<a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a>
-must be installed. Run bin/bind.export to export the files.
-END
-);
-
-1;
-
diff --git a/FS/FS/part_export/bsdshell.pm b/FS/FS/part_export/bsdshell.pm
deleted file mode 100644
index 7b5feb2..0000000
--- a/FS/FS/part_export/bsdshell.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-package FS::part_export::bsdshell;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export::passwdfile;
-
-@ISA = qw(FS::part_export::passwdfile);
-
-tie my %options, 'Tie::IxHash', %FS::part_export::passwdfile::options;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' =>
- 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)',
- 'options' => \%options,
- 'nodomain' => 'Y',
- 'notes' => <<'END'
-MD5 crypt requires installation of
-<a href="http://search.cpan.org/dist/Crypt-PasswdMD5">Crypt::PasswdMD5</a>
-from CPAN. Run bin/bsdshell.export to export the files.
-END
-);
-
-1;
-
diff --git a/FS/FS/part_export/cardfortress.pm b/FS/FS/part_export/cardfortress.pm
deleted file mode 100644
index 4916a6e..0000000
--- a/FS/FS/part_export/cardfortress.pm
+++ /dev/null
@@ -1,64 +0,0 @@
-package FS::part_export::cardfortress;
-
-use strict;
-use base 'FS::part_export';
-use vars qw( %info );
-use String::ShellQuote;
-
-#tie my %options, 'Tie::IxHash';
-#;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'CardFortress',
- 'options' => {}, #\%options,
- 'nodomain' => 'Y',
- 'notes' => '',
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self, $svc_acct) = (shift, shift);
-
- eval "use Net::OpenSSH;";
- return $@ if $@;
-
- open my $def_in, '<', '/dev/null' or die "unable to open /dev/null";
- my $ssh = Net::OpenSSH->new( $self->machine,
- default_stdin_fh => $def_in );
-
- my $private_key = $ssh->capture(
- { 'stdin_data' => $svc_acct->_password. "\n" },
- '/usr/local/bin/merchant_create', map $svc_acct->$_, qw( username finger )
- );
- return $ssh->error if $ssh->error;
-
- $svc_acct->cf_privatekey($private_key);
-
- $svc_acct->replace;
-
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
-
- return 'username changes not yet supported'
- if $old->username ne $new->username;
-
- return 'password changes not yet supported'
- if $old->_password ne $new->_password;
-
- return 'Real name changes not yet supported'
- if $old->finger ne $new->finger;
-
- '';
-}
-
-sub _export_delete {
- #my( $self, $svc_x ) = (shift, shift);
-
- return 'deletion not yet supproted';
-}
-
-1;
diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm
deleted file mode 100644
index a3ec5e0..0000000
--- a/FS/FS/part_export/communigate_pro.pm
+++ /dev/null
@@ -1,1070 +0,0 @@
-package FS::part_export::communigate_pro;
-
-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 (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' => [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 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>
-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 {
- my($self, $svc_acct) = (shift, shift);
- $svc_acct->email;
-}
-
-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 %settings = (
- 'AccessModes' => [ split(' ', ( $svc_acct->cgp_accessmodes
- || $self->option('AccessModes') )
- )
- ],
- 'RealName' => $svc_acct->finger,
- 'Password' => $svc_acct->_password,
-
- 'PasswordRecovery' => ($svc_acct->password_recover ? 'YES':'NO'),
-
- 'RulesAllowed' => $svc_acct->cgp_rulesallowed,
- 'RPOPAllowed' =>($svc_acct->cgp_rpopallowed ?'YES':'NO'),
- 'MailToAll' =>($svc_acct->cgp_mailtoall ?'YES':'NO'),
- 'AddMailTrailer' =>($svc_acct->cgp_addmailtrailer ?'YES':'NO'),
-
- 'ArchiveMessagesAfter' => $svc_acct->cgp_archiveafter,
-
- map { $quotas{$_} => $svc_acct->$_() }
- grep $svc_acct->$_(), keys %quotas
- );
- #XXX phase 3: mailing lists
-
- my @options = ( 'CreateAccount',
- 'accountName' => $self->export_username($svc_acct),
- 'accountType' => ( $svc_acct->cgp_type
- || $self->option('accountType') ),
- 'settings' => \%settings
- );
-
- push @options, 'externalFlag' => $self->option('externalFlag')
- if $self->option('externalFlag');
-
- #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;
- $prefs{'Language'} = $svc_acct->cgp_language if $svc_acct->cgp_language;
- $prefs{'TimeZone'} = $svc_acct->cgp_timezone if $svc_acct->cgp_timezone;
- $prefs{'SkinName'} = $svc_acct->cgp_skinname if $svc_acct->cgp_skinname;
- $prefs{'ProntoSkinName'} = $svc_acct->cgp_prontoskinname if $svc_acct->cgp_prontoskinname;
- $prefs{'SendMDNMode'} = $svc_acct->cgp_sendmdnmode if $svc_acct->cgp_sendmdnmode;
- 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;
- }
-
- my $rule_error = $self->communigate_pro_queue(
- $svc_acct->svcnum,
- 'SetAccountMailRules',
- $self->export_username($svc_acct),
- $svc_acct->cgp_rule_arrayref,
- );
- warn "WARNING: error queueing SetAccountMailRules job: $rule_error"
- if $rule_error;
-
- my $rpop_error = $self->communigate_pro_queue(
- $svc_acct->svcnum,
- 'SetAccountRPOPs',
- $self->export_username($svc_acct),
- $svc_acct->cgp_rpop_hashref,
- );
- warn "WARNING: error queueing SetAccountMailRPOPs job: $rpop_error"
- if $rpop_error;
-
- '';
-
-}
-
-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;
- $settings{'TrailerText'} = $svc_domain->trailer
- if $svc_domain->trailer;
- $settings{'CertificateType'} = $svc_domain->cgp_certificatetype
- if $svc_domain->cgp_certificatetype;
-
- 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,
- 'RulesAllowed' => $svc_domain->acct_def_cgp_rulesallowed,
- 'RPOPAllowed' =>($svc_domain->acct_def_cgp_rpopallowed ?'YES':'NO'),
- 'MailToAll' =>($svc_domain->acct_def_cgp_mailtoall ?'YES':'NO'),
- 'AddMailTrailer' =>($svc_domain->acct_def_cgp_addmailtrailer ?'YES':'NO'),
- 'ArchiveMessagesAfter' => $svc_domain->acct_def_cgp_archiveafter,
- );
- 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,
- 'Language' => $svc_domain->acct_def_cgp_language,
- 'TimeZone' => $svc_domain->acct_def_cgp_timezone,
- 'SkinName' => $svc_domain->acct_def_cgp_skinname,
- 'ProntoSkinName' => $svc_domain->acct_def_cgp_prontoskinname,
- 'SendMDNMode' => $svc_domain->acct_def_cgp_sendmdnmode,
- );
- warn "WARNING: error queueing SetAccountDefaultPrefs job: $pref_err"
- if $pref_err;
-
- my $rule_error = $self->communigate_pro_queue(
- $svc_domain->svcnum,
- 'SetDomainMailRules',
- $svc_domain->domain,
- $svc_domain->cgp_rule_arrayref,
- );
- warn "WARNING: error queueing SetDomainMailRules job: $rule_error"
- if $rule_error;
-
- '';
-
-}
-
-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);
-
- 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;
- $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;
-
- $settings{'PasswordRecovery'} = ( $new->password_recover ? 'YES':'NO' )
- if $old->password_recover ne $new->password_recover;
-
- $settings{'RulesAllowed'} = $new->cgp_rulesallowed
- if $old->cgp_rulesallowed ne $new->cgp_rulesallowed;
- $settings{'RPOPAllowed'} = ( $new->cgp_rpopallowed ? 'YES':'NO' )
- if $old->cgp_rpopallowed ne $new->cgp_rpopallowed;
- $settings{'MailToAll'} = ( $new->cgp_mailtoall ? 'YES':'NO' )
- if $old->cgp_mailtoall ne $new->cgp_mailtoall;
- $settings{'AddMailTrailer'} = ( $new->cgp_addmailtrailer ? 'YES':'NO' )
- if $old->cgp_addmailtrailer ne $new->cgp_addmailtrailer;
- $settings{'ArchiveMessagesAfter'} = $new->cgp_archiveafter
- if $old->cgp_archiveafter ne $new->cgp_archiveafter;
-
- #XXX phase 3: mailing lists
-
- if ( keys %settings ) {
- my $error = $self->communigate_pro_queue(
- $new->svcnum,
- 'UpdateAccountSettings',
- $self->export_username($new),
- %settings,
- );
- return $error if $error;
- }
-
- #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;
- $prefs{'Language'} = $new->cgp_language
- if $old->cgp_language ne $new->cgp_language;
- $prefs{'TimeZone'} = $new->cgp_timezone
- if $old->cgp_timezone ne $new->cgp_timezone;
- $prefs{'SkinName'} = $new->cgp_skinname
- if $old->cgp_skinname ne $new->cgp_skinname;
- $prefs{'ProntoSkinName'} = $new->cgp_prontoskinname
- if $old->cgp_prontoskinname ne $new->cgp_prontoskinname;
- $prefs{'SendMDNMode'} = $new->cgp_sendmdnmode
- if $old->cgp_sendmdnmode ne $new->cgp_sendmdnmode;
- 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;
- }
-
- 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;
- }
-
- my $rule_error = $self->communigate_pro_queue(
- $new->svcnum,
- 'SetAccountMailRules',
- $self->export_username($new),
- $new->cgp_rule_arrayref,
- );
- warn "WARNING: error queueing SetAccountMailRules job: $rule_error"
- if $rule_error;
-
- my $rpop_error = $self->communigate_pro_queue(
- $new->svcnum,
- 'SetAccountRPOPs',
- $self->export_username($new),
- $new->cgp_rpop_hashref,
- );
- warn "WARNING: error queueing SetAccountMailRPOPs job: $rpop_error"
- if $rpop_error;
-
- '';
-
-}
-
-sub _export_replace_svc_domain {
- 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 ( $old->domain ne $new->domain ) {
- eval { $self->communigate_pro_runcommand(
- 'RenameDomain', $old->domain, $new->domain,
- ) };
- return $@ if $@;
- }
-
- my %settings = ();
- $settings{'AccountsLimit'} = $new->max_accounts
- if $old->max_accounts ne $new->max_accounts;
- $settings{'TrailerText'} = $new->trailer
- if $old->trailer ne $new->trailer;
- $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;
- $settings{'CertificateType'} = $new->cgp_certificatetype
- if $old->cgp_certificatetype ne $new->cgp_certificatetype;
-
- 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,
- 'RulesAllowed' => $new->acct_def_cgp_rulesallowed,
- 'RPOPAllowed' => ( $new->acct_def_cgp_rpopallowed ? 'YES' : 'NO' ),
- 'MailToAll' => ( $new->acct_def_cgp_mailtoall ? 'YES' : 'NO' ),
- 'AddMailTrailer' => ( $new->acct_def_cgp_addmailtrailer ? 'YES' : 'NO' ),
- 'ArchiveMessagesAfter' => $new->acct_def_cgp_archiveafter,
- );
- 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,
- 'Language' => $new->acct_def_cgp_language,
- 'TimeZone' => $new->acct_def_cgp_timezone,
- 'SkinName' => $new->acct_def_cgp_skinname,
- 'ProntoSkinName' => $new->acct_def_cgp_prontoskinname,
- 'SendMDNMode' => $new->acct_def_cgp_sendmdnmode,
- );
- warn "WARNING: error queueing SetAccountDefaultPrefs job: $pref_err"
- if $pref_err;
-
- my $rule_error = $self->communigate_pro_queue(
- $new->svcnum,
- 'SetDomainMailRules',
- $new->domain,
- $new->cgp_rule_arrayref,
- );
- warn "WARNING: error queueing SetDomainMailRules job: $rule_error"
- if $rule_error;
-
- '';
-}
-
-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);
-
- #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',
- $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 $@;
-
- my $rules = eval { $self->communigate_pro_runcommand(
- 'GetDomainMailRules',
- $svc_domain->domain
- ) };
- return $@ if $@;
-
- #aliases too
- my $aliases = eval { $self->communigate_pro_runcommand(
- 'GetDomainAliases',
- $svc_domain->domain
- ) };
- return $@ if $@;
-
- my %more = (
- ( map { ("Acct. Default $_" => $acct_defaults->{$_}); }
- keys(%$acct_defaults)
- ),
- ( map { ("Acct. Default $_" => $acct_defaultprefs->{$_}); } #diff label??
- keys(%$acct_defaultprefs)
- ),
- ( map _rule2string($_), @$rules ),
- 'Aliases' => join(', ', @$aliases),
- );
-
- %$effective_settings = ( %$effective_settings, %more );
- %$settings = ( %$settings, %more );
-
- #false laziness w/below
-
- my %defaults = map { $_ => 1 }
- grep !exists(${$settings}{$_}), keys %$effective_settings;
-
- foreach my $key ( grep ref($effective_settings->{$_}),
- keys %$effective_settings )
- {
- $effective_settings->{$key} = _pretty( $effective_settings->{$key} );
- }
-
- %{$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)
- );
-
- #mail rules
- my $rules = eval { $self->communigate_pro_runcommand(
- 'GetAccountMailRules',
- $svc_acct->email
- ) };
- return $@ if $@;
-
- %$effective_settings = ( %$effective_settings,
- map _rule2string($_), @$rules
- );
- %$settings = ( %$settings,
- map _rule2string($_), @$rules
- );
-
-# #rpops too
-# my $rpops = eval { $self->communigate_pro_runcommand(
-# 'GetAccountRPOPs',
-# $svc_acct->email
-# ) };
-# return $@ if $@;
-#
-# %$effective_settings = ( %$effective_settings,
-# map _rpop2string($_), %$rpops
-# );
-# %$settings = ( %$settings,
-# map _rpop2string($_), %rpops
-# );
-
- #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 )
- {
- $effective_settings->{$key} = _pretty( $effective_settings->{$key} );
- }
-
- %{$settingsref} = %$effective_settings;
- %{$defaultref} = %defaults;
-
- '';
-
-}
-
-sub _pretty {
- my $value = shift;
- if ( ref($value) eq 'ARRAY' ) {
- '['. join(' ', map { ref($_) ? _pretty($_) : $_ } @$value ). ']';
- } elsif ( ref($value) eq 'HASH' ) {
- '{'. join(', ',
- map { my $v = $value->{$_};
- "$_:". ( ref($v) ? _pretty($v) : $v );
- }
- keys %$value
- ). '}';
- } else {
- warn "serializing ". ref($value). " for table display not yet handled";
- }
-}
-
-sub export_getsettings_svc_forward {
- my($self, $svc_forward, $settingsref, $defaultref ) = @_;
-
- my $dest = eval { $self->communigate_pro_runcommand(
- 'GetForwarder',
- ($svc_forward->src || $svc_forward->srcsvc_acct->email),
- ) };
- return $@ if $@;
-
- my $settings = { 'Destination' => $dest };
-
- %{$settingsref} = %$settings;
- %{$defaultref} = ();
-
- '';
-}
-
-sub _rule2string {
- my $rule = shift;
- my($priority, $name, $conditions, $actions, $comment) = @$rule;
- $conditions = join(', ', map { my $a = $_; join(' ', @$a); } @$conditions);
- $actions = join(', ', map { my $a = $_; join(' ', @$a); } @$actions);
- ("Mail rule $name" => "$priority IF $conditions THEN $actions ($comment)");
-}
-
-#sub _rpop2string {
-# my $rpop = shift;
-# my($priority, $name, $conditions, $actions, $comment) = @$rule;
-# $conditions = join(', ', map { my $a = $_; join(' ', @$a); } @$conditions);
-# $actions = join(', ', map { my $a = $_; join(' ', @$a); } @$actions);
-# ("Mail rule $name" => "$priority IF $conditions THEN $actions ($comment)");
-#}
-
-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 $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',
- 'SetAccountRPOPs' => 'cp_Scalar_Hash',
- );
- 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",
- };
- my $error = $queue->insert(
- $self->machine,
- $self->option('port'),
- $self->option('login'),
- $self->option('password'),
- $method,
- @_,
- );
- $$jobnumref = $queue->jobnum unless $error;
-
- return $error;
-}
-
-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, $accountName, %args ) = @_;
- $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ];
- my @args = ( $accountName, \%args );
- communigate_pro_command( $machine, $port, $login, $password, $method, @args );
-}
-
-sub communigate_pro_command { #subroutine, not method
- my( $machine, $port, $login, $password, $method, @args ) = @_;
-
- eval "use CGP::CLI";
- die $@ if $@;
-
- my $cli = new CGP::CLI( {
- 'PeerAddr' => $machine,
- 'PeerPort' => $port,
- 'login' => $login,
- 'password' => $password,
- } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n";
-
- #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/communigate_pro_singledomain.pm b/FS/FS/part_export/communigate_pro_singledomain.pm
deleted file mode 100644
index e25043f..0000000
--- a/FS/FS/part_export/communigate_pro_singledomain.pm
+++ /dev/null
@@ -1,37 +0,0 @@
-package FS::part_export::communigate_pro_singledomain;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export::communigate_pro;
-
-@ISA = qw(FS::part_export::communigate_pro);
-
-tie my %options, 'Tie::IxHash', %FS::part_export::communigate_pro::options,
- 'domain' => { label=>'Domain', },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' =>
- 'Real-time export to a CommuniGate Pro mail server, one domain only',
- 'options' => \%options,
- 'nodomain' => 'Y',
- 'notes' => <<'END'
-Real time export to a
-<a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a>
-mail server. This is an unusual export to CommuniGate Pro that forces all
-accounts into a single domain. As CommuniGate Pro supports multiple domains,
-unless you have a specific reason for using this export, you probably want to
-use the communigate_pro export instead. The
-<a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a>
-must be installed as CGP::CLI.
-END
-);
-
-sub export_username {
- my($self, $svc_acct) = (shift, shift);
- $svc_acct->username. '@'. $self->option('domain');
-}
-
-1;
-
diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm
deleted file mode 100644
index 96fa437..0000000
--- a/FS/FS/part_export/cp.pm
+++ /dev/null
@@ -1,161 +0,0 @@
-package FS::part_export::cp;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'port' => { label=>'Port number' },
- 'username' => { label=>'Username' },
- 'password' => { label=>'Password' },
- 'domain' => { label=>'Domain' },
- 'workgroup' => { label=>'Default Workgroup' },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol',
- 'options'=> \%options,
- 'notes' => <<'END'
-Real-time export to
-<a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>.
-Requires installation of
-<a href="http://search.cpan.org/dist/Net-APP">Net::APP</a>
-from CPAN.
-END
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my( $self, $svc_acct ) = (shift, shift);
- $self->cp_queue( $svc_acct->svcnum, 'create_mailbox',
- 'Mailbox' => $svc_acct->username,
- 'Password' => $svc_acct->_password,
- 'Workgroup' => $self->option('workgroup'),
- 'Domain' => $svc_acct->domain,
- );
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
- return "can't change domain with Critical Path"
- if $old->domain ne $new->domain;
- return "can't change username with Critical Path" #CP no longer supports this
- if $old->username ne $new->username;
- return '' unless $old->_password ne $new->_password;
- $self->cp_queue( $new->svcnum, 'replace', $new->domain,
- $old->username, $new->username, $old->_password, $new->_password );
-}
-
-sub _export_delete {
- my( $self, $svc_acct ) = (shift, shift);
- $self->cp_queue( $svc_acct->svcnum, 'delete_mailbox',
- 'Mailbox' => $svc_acct->username,
- 'Domain' => $svc_acct->domain,
- );
-}
-
-sub _export_suspend {
- my( $self, $svc_acct ) = (shift, shift);
- $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status',
- 'Mailbox' => $svc_acct->username,
- 'Domain' => $svc_acct->domain,
- 'OTHER' => 'T',
- 'OTHER_SUSPEND' => 'T',
- );
-}
-
-sub _export_unsuspend {
- my( $self, $svc_acct ) = (shift, shift);
- $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status',
- 'Mailbox' => $svc_acct->username,
- 'Domain' => $svc_acct->domain,
- 'PAYMENT' => 'F',
- 'OTHER' => 'F',
- 'OTHER_SUSPEND' => 'F',
- 'OTHER_BOUNCE' => 'F',
- );
-}
-
-sub cp_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => 'FS::part_export::cp::cp_command',
- };
- $queue->insert(
- $self->machine,
- $self->option('port'),
- $self->option('username'),
- $self->option('password'),
- $self->option('domain'),
- $method,
- @_,
- );
-}
-
-sub cp_command { #subroutine, not method
- my($host, $port, $username, $password, $login_domain, $method, @args) = @_;
-
- #quelle hack
- if ( $method eq 'replace' ) {
-
- my( $domain, $old_username, $new_username, $old_password, $new_password)
- = @args;
-
- if ( $old_username ne $new_username ) {
- cp_command($host, $port, $username, $password, 'rename_mailbox',
- Domain => $domain,
- Old_Mailbox => $old_username,
- New_Mailbox => $new_username,
- );
- }
-
- #my $other = 'F';
- if ( $new_password =~ /^\*SUSPENDED\* (.*)$/ ) {
- $new_password = $1;
- # $other = 'T';
- }
- #cp_command($host, $port, $username, $password, $login_domain,
- # 'set_mailbox_status',
- # Domain => $domain,
- # Mailbox => $new_username,
- # Other => $other,
- # Other_Bounce => $other,
- #);
-
- if ( $old_password ne $new_password ) {
- cp_command($host, $port, $username, $password, $login_domain,
- 'change_mailbox',
- Domain => $domain,
- Mailbox => $new_username,
- Password => $new_password,
- );
- }
-
- return;
- }
- #eof quelle hack
-
- eval "use Net::APP;";
-
- my $app = new Net::APP (
- "$host:$port",
- User => $username,
- Password => $password,
- Domain => $login_domain,
- Timeout => 60,
- #Debug => 1,
- ) or die "$@\n";
-
- $app->$method( @args );
-
- die $app->message."\n" unless $app->ok;
-
-}
-
-1;
-
diff --git a/FS/FS/part_export/cpanel.pm b/FS/FS/part_export/cpanel.pm
deleted file mode 100644
index 0ad00df..0000000
--- a/FS/FS/part_export/cpanel.pm
+++ /dev/null
@@ -1,192 +0,0 @@
-package FS::part_export::cpanel;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'user' => { label=>'Remote access username' },
- 'accesshash' => { label=>'Remote access key', type=>'textarea' },
- 'debug' => { label=>'Enable debugging', type=>'checkbox' },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to Cpanel control panel.',
- 'options' => \%options,
- 'nodomain' => 'Y',
- 'notes' => 'Real time export to a the <a href="http://www.cpanel.net/">Cpanel</a> control panel software. Service definition names are exported as Cpanel packages. Requires installation of the Cpanel::Accounting perl module distributed with Cpanel.',
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self, $svc_acct) = (shift, shift);
- $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum, 'insert',
- $svc_acct->domain,
- $svc_acct->username,
- $svc_acct->_password,
- $svc_acct->cust_svc->part_svc->svc,
- );
- ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
- return "can't change username with cpanel"
- if $old->username ne $new->username;
- return "can't change password with cpanel"
- if $old->_passsword ne $new->_password;
- return "can't change domain with cpanel"
- if $old->domain ne $new->domain;
-
- '';
-
- ##return '' unless $old->_password ne $new->_password;
- #$err_or_queue = $self->cpanel_queue( $new->svcnum,
- # 'replace', $new->username, $new->_password );
- #ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-sub _export_delete {
- my( $self, $svc_acct ) = (shift, shift);
- $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum,
- 'delete', $svc_acct->username
- );
- ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-sub _export_suspend {
- my( $self, $svc_acct ) = (shift, shift);
- $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum,
- 'suspend', $svc_acct->username );
- ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-sub _export_unsuspend {
- my( $self, $svc_acct ) = (shift, shift);
- $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum,
- 'unsuspend', $svc_acct->username );
- ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-
-sub cpanel_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::cpanel::cpanel_$method",
- };
- $queue->insert(
- $self->machine,
- $self->option('user'),
- $self->option('accesshash'),
- $self->option('debug'),
- @_
- ) or $queue;
-}
-
-
-sub cpanel_insert { #subroutine, not method
- my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4);
-
-# my $whm = cpanel_connect($machine, $user, $accesshash, $debug);
-# warn " cpanel->createacct ". join(', ', @_). "\n"
-# if $debug;
-# my $response = $whm->createacct(@_);
-# die $whm->{'error'} if $whm->{'error'};
-# warn " cpanel response: $response\n"
-# if $debug;
-
- warn "cpanel_insert: attempting web interface to add POP"
- if $debug;
-
- my($domain, $username, $password, $svc) = @_;
-
- use LWP::UserAgent;
- use HTTP::Request::Common qw(POST);
-
- my $url =
- "http://$user:$accesshash\@$domain:2082/frontend/x/mail/addpop2.html";
-
- my $ua = LWP::UserAgent->new();
-
- #$req->authorization_basic($user, $accesshash);
-
- my $res = $ua->request(
- POST( $url,
- [
- 'email' => $username,
- 'domain' => $domain,
- 'password' => $password,
- 'quota' => 10, #?
- ]
- )
- );
-
- die "Error submitting data to $url: ". $res->status_line
- unless $res->is_success;
-
- die "Username in use"
- if $res->content =~ /exists/;
-
- die "Account not created: ". $res->content
- if $res->content =~ /failure/;
-
-}
-
-#sub cpanel_replace { #subroutine, not method
-#}
-
-sub cpanel_delete { #subroutine, not method
- my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4);
- my $whm = cpanel_connect($machine, $user, $accesshash, $debug);
- warn " cpanel->killacct ". join(', ', @_). "\n"
- if $debug;
- my $response = $whm->killacct(shift);
- die $whm->{'error'} if $whm->{'error'};
- warn " cpanel response: $response\n"
- if $debug;
-}
-
-sub cpanel_suspend { #subroutine, not method
- my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4);
- my $whm = cpanel_connect($machine, $user, $accesshash, $debug);
- warn " cpanel->suspend ". join(', ', @_). "\n"
- if $debug;
- my $response = $whm->suspend(shift);
- die $whm->{'error'} if $whm->{'error'};
- warn " cpanel response: $response\n"
- if $debug;
-}
-
-sub cpanel_unsuspend { #subroutine, not method
- my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4);
- my $whm = cpanel_connect($machine, $user, $accesshash, $debug);
- warn " cpanel->unsuspend ". join(', ', @_). "\n"
- if $debug;
- my $response = $whm->unsuspend(shift);
- die $whm->{'error'} if $whm->{'error'};
- warn " cpanel response: $response\n"
- if $debug;
-}
-
-sub cpanel_connect {
- my( $host, $user, $accesshash, $debug ) = @_;
-
- eval "use Cpanel::Accounting;";
- die $@ if $@;
-
- warn "creating new Cpanel::Accounting connection to $user@$host\n"
- if $debug;
-
- my $whm = new Cpanel::Accounting;
- $whm->{'host'} = $host;
- $whm->{'user'} = $user;
- $whm->{'accesshash'} = $accesshash;
- $whm->{'usessl'} = 1;
-
- $whm;
-}
diff --git a/FS/FS/part_export/cust_http.pm b/FS/FS/part_export/cust_http.pm
deleted file mode 100644
index e8b677b..0000000
--- a/FS/FS/part_export/cust_http.pm
+++ /dev/null
@@ -1,67 +0,0 @@
-package FS::part_export::cust_http;
-
-use vars qw( @ISA %info );
-use FS::part_export::http;
-use Tie::IxHash;
-
-@ISA = qw( FS::part_export::http );
-
-tie %options, 'Tie::IxHash',
- 'method' => { label =>'Method',
- type =>'select',
- #options =>[qw(POST GET)],
- options =>[qw(POST)],
- default =>'POST' },
- 'url' => { label => 'URL', default => 'http://', },
- 'insert_data' => {
- label => 'Insert data',
- type => 'textarea',
- default => join("\n",
- "action 'insert'",
- "custnum \$cust_main->custnum",
- "first \$cust_main->first",
- "last \$cust_main->get('last')",
- ( map "$_ \$cust_main->$_", qw( company address1 address2 city county state zip country daytime night fax last ) ),
- "email \$cust_main->invoicing_list_emailonly_scalar",
- ),
- },
- 'delete_data' => {
- label => 'Delete data',
- type => 'textarea',
- default => join("\n",
- "action 'delete'",
- "custnum \$cust_main->custnum",
- ),
- },
- 'replace_data' => {
- label => 'Replace data',
- type => 'textarea',
- default => join("\n",
- "action 'replace'",
- "custnum \$new_cust_main->custnum",
- "first \$new_cust_main->first",
- "last \$new_cust_main->get('last')",
- ( map "$_ \$cust_main->$_", qw( company address1 address2 city county state zip country daytime night fax last ) ),
- "email \$new_cust_main->invoicing_list_emailonly_scalar",
- ),
- },
- 'success_regexp' => {
- label => 'Success Regexp',
- default => '',
- },
-;
-
-%info = (
- 'svc' => 'cust_main',
- 'desc' => 'Send an HTTP or HTTPS GET or POST request, for customers.',
- 'options' => \%options,
- 'notes' => <<'END'
-Send an HTTP or HTTPS GET or POST to the specified URL on customer addition,
-modification and deletion. For HTTPS support,
-<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a>
-or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a>
-is required.
-END
-);
-
-1;
diff --git a/FS/FS/part_export/cyrus.pm b/FS/FS/part_export/cyrus.pm
deleted file mode 100644
index 84c9e5a..0000000
--- a/FS/FS/part_export/cyrus.pm
+++ /dev/null
@@ -1,120 +0,0 @@
-package FS::part_export::cyrus;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'server' => { label=>'IMAP server' },
- 'username' => { label=>'Admin username' },
- 'password' => { label=>'Admin password' },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to Cyrus IMAP server',
- 'options' => \%options,
- 'nodomain' => 'Y',
- 'notes' => <<'END'
-Integration with
-<a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>.
-Cyrus::IMAP::Admin should be installed locally and the connection to the
-server secured. <B>svc_acct.quota</B>, if available, is used to set the
-Cyrus quota.
-END
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self, $svc_acct) = (shift, shift);
- $self->cyrus_queue( $svc_acct->svcnum, 'insert',
- $svc_acct->username, $svc_acct->quota );
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
- return "can't change username using Cyrus"
- if $old->username ne $new->username;
- return '';
-# #return '' unless $old->_password ne $new->_password;
-# $self->cyrus_queue( $new->svcnum,
-# 'replace', $new->username, $new->_password );
-}
-
-sub _export_delete {
- my( $self, $svc_acct ) = (shift, shift);
- $self->cyrus_queue( $svc_acct->svcnum, 'delete',
- $svc_acct->username );
-}
-
-#a good idea to queue anything that could fail or take any time
-sub cyrus_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::cyrus::cyrus_$method",
- };
- $queue->insert(
- $self->option('server'),
- $self->option('username'),
- $self->option('password'),
- @_
- );
-}
-
-sub cyrus_insert { #subroutine, not method
- my $client = cyrus_connect(shift, shift, shift);
- my( $username, $quota ) = @_;
- my $rc = $client->create("user.$username");
- my $error = $client->error;
- die "creating user.$username: $error" if $error;
-
- $rc = $client->setacl("user.$username", $username => 'all' );
- $error = $client->error;
- die "setacl user.$username: $error" if $error;
-
- if ( $quota ) {
- $rc = $client->setquota("user.$username", 'STORAGE' => $quota );
- $error = $client->error;
- die "setquota user.$username: $error" if $error;
- }
-
-}
-
-sub cyrus_delete { #subroutine, not method
- my ( $server, $admin_username, $password_username, $username ) = @_;
- my $client = cyrus_connect($server, $admin_username, $password_username);
-
- my $rc = $client->setacl("user.$username", $admin_username => 'all' );
- my $error = $client->error;
- die $error if $error;
-
- $rc = $client->delete("user.$username");
- $error = $client->error;
- die $error if $error;
-}
-
-sub cyrus_connect {
-
- my( $server, $admin_username, $admin_password ) = @_;
-
- eval "use Cyrus::IMAP::Admin;";
-
- my $client = Cyrus::IMAP::Admin->new($server);
- $client->authenticate(
- -user => $admin_username,
- -mechanism => "login",
- -password => $admin_password,
- );
- $client;
-
-}
-
-#sub cyrus_replace { #subroutine, not method
-#}
-
-1;
-
diff --git a/FS/FS/part_export/dashcs_e911.pm b/FS/FS/part_export/dashcs_e911.pm
deleted file mode 100644
index 320d0a6..0000000
--- a/FS/FS/part_export/dashcs_e911.pm
+++ /dev/null
@@ -1,153 +0,0 @@
-package FS::part_export::dashcs_e911;
-
-use strict;
-use vars qw(@ISA %info $me $DEBUG);
-use Tie::IxHash;
-use FS::part_export;
-
-$DEBUG = 0;
-$me = '['.__PACKAGE__.']';
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'username' => { label=>'Dash username', },
- '_password' => { label=>'Dash password', },
- 'staging' => { label=>'Staging (test mode)', type=>'checkbox', },
-;
-
-%info = (
- 'svc' => 'svc_phone',
- 'desc' => 'Provision e911 services via Dash Carrier Services',
- 'notes' => 'Provision e911 services via Dash Carrier Services',
- 'options' => \%options,
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self, $svc_phone) = (shift, shift);
- return 'invalid phonenum' unless $svc_phone->phonenum;
-
- my $opts = { map{ $_ => $self->option($_) } keys %options };
- $opts->{wantreturn} = 1;
-
- my %location_hash = $svc_phone->location_hash;
- my $location = {
- 'address1' => $location_hash{address1},
- 'address2' => $location_hash{address2},
- 'community' => $location_hash{city},
- 'state' => $location_hash{state},
- 'postalcode' => $location_hash{zip},
- };
-
- my $error_or_ref =
- dash_command($opts, 'validateLocation', { 'location' => $location } );
- return $error_or_ref unless ref($error_or_ref);
-
- my $status = $error_or_ref->get_Location->get_status; # hate
- return $status->get_description unless $status->get_code eq 'GEOCODED';
-
- my $cust_pkg = $svc_phone->cust_svc->cust_pkg;
- my $cust_main = $cust_pkg->cust_main if $cust_pkg;
- my $caller_name = $cust_main ? $cust_main->name_short : 'unknown';
-
- my $arg = {
- 'uri' => {
- 'uri' => 'tel:'. $svc_phone->countrycode. $svc_phone->phonenum,
- 'callername' => $caller_name,
- },
- 'location' => $location,
- };
-
- $error_or_ref = dash_command($opts, 'addLocation', $arg );
- return $error_or_ref unless ref($error_or_ref);
-
- my $id = $error_or_ref->get_Location->get_locationid;
- $self->_export_command('provisionLocation', { 'locationid' => $id });
-}
-
-sub _export_delete {
- my($self, $svc_phone) = (shift, shift);
- return '' unless $svc_phone->phonenum;
-
- my $arg = { 'uri' => 'tel:'. $svc_phone->countrycode. $svc_phone->phonenum };
- $self->_export_queue('removeURI', $arg);
-}
-
-sub _export_suspend {
- my($self) = shift;
- '';
-}
-
-sub _export_unsuspend {
- my($self) = shift;
- '';
-}
-
-sub _export_command {
- my $self = shift;
-
- my $opts = { map{ $_ => $self->option($_) } keys %options };
-
- dash_command($opts, @_);
-
-}
-
-sub _export_replace {
- my($self, $new, $old ) = (shift, shift, shift);
-
- # this could succeed in unprovision but fail to provision
- my $arg = { 'uri' => 'tel:'. $old->countrycode. $old->phonenum };
- $self->_export_command('removeURI', $arg) || $self->_export_insert($new);
-}
-
-#a good idea to queue anything that could fail or take any time
-sub _export_queue {
- my $self = shift;
-
- my $opts = { map{ $_ => $self->option($_) } keys %options };
-
- my $queue = new FS::queue {
- 'job' => "FS::part_export::dashcs_e911::dash_command",
- };
- $queue->insert( $opts, @_ );
-}
-
-sub dash_command {
- my ( $opt, $method, $arg ) = (shift, shift, shift);
-
- warn "$me: dash_command called with method $method\n" if $DEBUG;
-
- my @module = qw(
- Net::DashCS::Interfaces::EmergencyProvisioningService::EmergencyProvisioningPort
- SOAP::Lite
- );
-
- foreach my $module ( @module ) {
- eval "use $module;";
- die $@ if $@;
- }
-
- local *SOAP::Transport::HTTP::Client::get_basic_credentials = sub {
- return ($opt->{'username'}, $opt->{'_password'});
- };
-
- my $service = new Net::DashCS::Interfaces::EmergencyProvisioningService::EmergencyProvisioningPort(
- { deserializer_args => { strict => 0 } }
- );
-
- $service->set_proxy('https://staging-service.dashcs.com/dash-api/soap/emergencyprovisioning/v1')
- if $opt->{'staging'};
-
- my $result = $service->$method($arg);
-
- if (not $result) {
- warn "returning fault: ". $result->get_faultstring if $DEBUG;
- return ''.$result->get_faultstring;
- }
-
- warn "returning ok: $result\n" if $DEBUG;
- return $result if $opt->{wantreturn};
- '';
-}
diff --git a/FS/FS/part_export/domain_shellcommands.pm b/FS/FS/part_export/domain_shellcommands.pm
deleted file mode 100644
index 582e292..0000000
--- a/FS/FS/part_export/domain_shellcommands.pm
+++ /dev/null
@@ -1,165 +0,0 @@
-package FS::part_export::domain_shellcommands;
-
-use strict;
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'useradd' => { label=>'Insert command',
- default=>'',
- },
- 'userdel' => { label=>'Delete command',
- default=>'',
- },
- 'usermod' => { label=>'Modify command',
- default=>'',
- },
-;
-
-%info = (
- 'svc' => 'svc_domain',
- 'desc' => 'Run remote commands via SSH, for domains (qmail, ISPMan).',
- 'options' => \%options,
- 'notes' => <<'END'
-Run remote commands via SSH, for domains. You will need to
-<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>
- <INPUT TYPE="button" VALUE="qmail catchall .qmail-domain-default maintenance" onClick='
- this.form.useradd.value = "[ \"$uid\" -a \"$gid\" -a \"$dir\" -a \"$qdomain\" ] && [ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }";
- this.form.userdel.value = "";
- this.form.usermod.value = "";
- '>
- <LI>
- <INPUT TYPE="button" VALUE="ISPMan CLI" onClick='
- this.form.useradd.value = "/usr/local/ispman/bin/ispman.addDomain -d $domain changeme";
- this.form.userdel.value = "/usr/local/ispman/bin/ispman.deleteDomain -d $domain";
- this.form.usermod.value = "";
- '>
-</UL>
-The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations):
-<UL>
- <LI><code>$domain</code>
- <LI><code>$qdomain</code> - domain with periods replaced by colons
- <LI><code>$uid</code> - of catchall account
- <LI><code>$gid</code> - of catchall account
- <LI><code>$dir</code> - home directory of catchall account
- <LI>All other fields in
- <a href="../docs/schema.html#svc_domain">svc_domain</a> are also available.
-</UL>
-END
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self) = shift;
- $self->_export_command('useradd', @_);
-}
-
-sub _export_delete {
- my($self) = shift;
- $self->_export_command('userdel', @_);
-}
-
-sub _export_command {
- my ( $self, $action, $svc_domain) = (shift, shift, shift);
- my $command = $self->option($action);
- return '' if $command =~ /^\s*$/;
-
- #set variable for the command
- no strict 'vars';
- {
- no strict 'refs';
- ${$_} = $svc_domain->getfield($_) foreach $svc_domain->fields;
- }
- ( $qdomain = $domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES
-
- if ( $svc_domain->catchall ) {
- no strict 'refs';
- my $svc_acct = $svc_domain->catchall_svc_acct;
- ${$_} = $svc_acct->getfield($_) foreach qw(uid gid dir);
- } else {
- no strict 'refs';
- ${$_} = '' foreach qw(uid gid dir);
- }
-
- #done setting variables for the command
-
- $self->shellcommands_queue( $svc_domain->svcnum,
- user => $self->option('user')||'root',
- host => $self->machine,
- command => eval(qq("$command")),
- );
-}
-
-sub _export_replace {
- my($self, $new, $old ) = (shift, shift, shift);
- my $command = $self->option('usermod');
-
- #set variable for the command
- no strict 'vars';
- {
- no strict 'refs';
- ${"old_$_"} = $old->getfield($_) foreach $old->fields;
- ${"new_$_"} = $new->getfield($_) foreach $new->fields;
- }
- ( $old_qdomain = $old_domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES
- ( $new_qdomain = $new_domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES
-
- {
- no strict 'refs';
-
- if ( $old->catchall ) {
- my $svc_acct = $old->catchall_svc_acct;
- ${"old_$_"} = $svc_acct->getfield($_) foreach qw(uid gid dir);
- } else {
- ${"old_$_"} = '' foreach qw(uid gid dir);
- }
- if ( $new->catchall ) {
- my $svc_acct = $new->catchall_svc_acct;
- ${"new_$_"} = $svc_acct->getfield($_) foreach qw(uid gid dir);
- } else {
- ${"new_$_"} = '' foreach qw(uid gid dir);
- }
-
- }
-
- #done setting variables for the command
-
- $self->shellcommands_queue( $new->svcnum,
- user => $self->option('user')||'root',
- host => $self->machine,
- command => eval(qq("$command")),
- );
-}
-
-#a good idea to queue anything that could fail or take any time
-sub shellcommands_queue {
- my( $self, $svcnum ) = (shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::domain_shellcommands::ssh_cmd",
- };
- $queue->insert( @_ );
-}
-
-sub ssh_cmd { #subroutine, not method
- use Net::SSH '0.08';
- &Net::SSH::ssh_cmd( { @_ } );
-}
-
-#sub shellcommands_insert { #subroutine, not method
-#}
-#sub shellcommands_replace { #subroutine, not method
-#}
-#sub shellcommands_delete { #subroutine, not method
-#}
-
-1;
-
diff --git a/FS/FS/part_export/domain_sql.pm b/FS/FS/part_export/domain_sql.pm
deleted file mode 100644
index 3010338..0000000
--- a/FS/FS/part_export/domain_sql.pm
+++ /dev/null
@@ -1,241 +0,0 @@
-package FS::part_export::domain_sql;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-#quite a bit of false laziness w/acct_sql - some stuff should be generalized
-#out to a "dababase base class"
-
-tie my %options, 'Tie::IxHash',
- 'datasrc' => { label => 'DBI data source' },
- 'username' => { label => 'Database username' },
- 'password' => { label => 'Database password' },
- 'table' => { label => 'Database table' },
- 'schema' => { label =>
- 'Database schema mapping to Freeside methods.',
- type => 'textarea',
- },
- 'static' => { label =>
- 'Database schema mapping to static values.',
- type => 'textarea',
- },
- 'primary_key' => { label => 'Database primary key' },
-;
-
-tie my %postfix_transport_map, 'Tie::IxHash',
- 'domain' => 'domain'
-;
-my $postfix_transport_map =
- join('\n', map "$_ $postfix_transport_map{$_}",
- keys %postfix_transport_map );
-tie my %postfix_transport_static, 'Tie::IxHash',
- 'transport' => 'virtual:',
-;
-my $postfix_transport_static =
- join('\n', map "$_ $postfix_transport_static{$_}",
- keys %postfix_transport_static );
-
-%info = (
- 'svc' => 'svc_domain',
- 'desc' => 'Real time export of domains to SQL databases '.
- '(postfix, others?)',
- 'options' => \%options,
- 'notes' => <<END
-Export domains (svc_domain records) to SQL databases. Currently this is a
-simple export with a default for Postfix, but it can be extended for other
-uses.
-
-<BR><BR>Use these buttons for useful presets:
-<UL>
- <LI><INPUT TYPE="button" VALUE="postfix_transport" onClick='
- this.form.table.value = "transport";
- this.form.schema.value = "$postfix_transport_map";
- this.form.static.value = "$postfix_transport_static";
- this.form.primary_key.value = "domain";
- '>
-</UL>
-END
-);
-
-sub _schema_map { shift->_map('schema'); }
-sub _static_map { shift->_map('static'); }
-
-sub _map {
- my $self = shift;
- map { /^\s*(\S+)\s*(\S+)\s*$/ } split("\n", $self->option(shift) );
-}
-
-sub _export_insert {
- my($self, $svc_domain) = (shift, shift);
-
- my %schema = $self->_schema_map;
- my %static = $self->_static_map;
-
- my %record = ( ( map { $_ => $static{$_} } keys %static ),
- ( map { my $method = $schema{$_};
- $_ => $svc_domain->$method();
- }
- keys %schema
- )
- );
-
- my $err_or_queue =
- $self->domain_sql_queue(
- $svc_domain->svcnum,
- 'insert',
- $self->option('table'),
- %record
- );
- return $err_or_queue unless ref($err_or_queue);
-
- '';
-}
-
-sub _export_replace {
- my($self, $new, $old) = (shift, shift, shift);
-
- my %schema = $self->_schema_map;
- my %static = $self->_static_map;
- #my %map = (%schema, %static);
-
- my @primary_key = ();
- if ( $self->option('primary_key') =~ /,/ ) {
- foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) {
- my $keymap = $schema{$key};
- push @primary_key, $old->$keymap();
- }
- } else {
- my %map = (%schema, %static);
- my $keymap = $map{$self->option('primary_key')};
- push @primary_key, $old->$keymap();
- }
-
- my %record = ( ( map { $_ => $static{$_} } keys %static ),
- ( map { my $method = $schema{$_};
- $_ => $new->$method();
- }
- keys %schema
- )
- );
-
- my $err_or_queue = $self->domain_sql_queue(
- $new->svcnum,
- 'replace',
- $self->option('table'),
- $self->option('primary_key'), @primary_key,
- %record,
- );
- return $err_or_queue unless ref($err_or_queue);
- '';
-}
-
-sub _export_delete {
- my ( $self, $svc_domain ) = (shift, shift);
-
- my %schema = $self->_schema_map;
- my %static = $self->_static_map;
- my %map = (%schema, %static);
-
- my %primary_key = ();
- if ( $self->option('primary_key') =~ /,/ ) {
- foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) {
- my $keymap = $map{$key};
- $primary_key{ $key } = $svc_domain->$keymap();
- }
- } else {
- my $keymap = $map{$self->option('primary_key')};
- $primary_key{ $self->option('primary_key') } = $svc_domain->$keymap(),
- }
-
- my $err_or_queue = $self->domain_sql_queue(
- $svc_domain->svcnum,
- 'delete',
- $self->option('table'),
- %primary_key,
- #$self->option('primary_key') => $svc_domain->$keymap(),
- );
- return $err_or_queue unless ref($err_or_queue);
- '';
-}
-
-sub domain_sql_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::domain_sql::domain_sql_$method",
- };
- $queue->insert(
- $self->option('datasrc'),
- $self->option('username'),
- $self->option('password'),
- @_,
- ) or $queue;
-}
-
-sub domain_sql_insert { #subroutine, not method
- my $dbh = domain_sql_connect(shift, shift, shift);
- my( $table, %record ) = @_;
-
- my $sth = $dbh->prepare(
- "INSERT INTO $table ( ". join(", ", keys %record).
- " ) VALUES ( ". join(", ", map '?', keys %record ). " )"
- ) or die $dbh->errstr;
-
- $sth->execute( values(%record) )
- or die "can't insert into $table table: ". $sth->errstr;
-
- $dbh->disconnect;
-}
-
-sub domain_sql_delete { #subroutine, not method
- my $dbh = domain_sql_connect(shift, shift, shift);
- my( $table, %record ) = @_;
-
- my $sth = $dbh->prepare(
- "DELETE FROM $table WHERE ". join(' AND ', map "$_ = ? ", keys %record )
- ) or die $dbh->errstr;
-
- $sth->execute( map $record{$_}, keys %record )
- or die "can't delete from $table table: ". $sth->errstr;
-
- $dbh->disconnect;
-}
-
-sub domain_sql_replace { #subroutine, not method
- my $dbh = domain_sql_connect(shift, shift, shift);
-
- my( $table, $pkey ) = ( shift, shift );
-
- my %primary_key = ();
- if ( $pkey =~ /,/ ) {
- foreach my $key ( split(/\s*,\s*/, $pkey ) ) {
- $primary_key{$key} = shift;
- }
- } else {
- $primary_key{$pkey} = shift;
- }
-
- my %record = @_;
-
- my $sth = $dbh->prepare(
- "UPDATE $table".
- ' SET '. join(', ', map "$_ = ?", keys %record ).
- ' WHERE '. join(' AND ', map "$_ = ?", keys %primary_key )
- ) or die $dbh->errstr;
-
- $sth->execute( values(%record), values(%primary_key) );
-
- $dbh->disconnect;
-}
-
-sub domain_sql_connect {
- #my($datasrc, $username, $password) = @_;
- #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
- DBI->connect(@_) or die $DBI::errstr;
-}
-
-1;
-
diff --git a/FS/FS/part_export/domreg_net_dri.pm b/FS/FS/part_export/domreg_net_dri.pm
deleted file mode 100644
index bf01602..0000000
--- a/FS/FS/part_export/domreg_net_dri.pm
+++ /dev/null
@@ -1,614 +0,0 @@
-package FS::part_export::domreg_net_dri;
-
-use vars qw(@ISA %info %options $conf);
-use Tie::IxHash;
-use FS::part_export::null;
-
-=head1 NAME
-
-FS::part_export::domreg_net_dri - Register or transfer domains with Net::DRI
-
-=head1 DESCRIPTION
-
-This module handles registering and transferring domains with select registrars or registries supported
-by L<Net::DRI>.
-
-As a part_export, this module can be designated for use with svc_domain services. When the svc_domain object
-is inserted into the Freeside database, registration or transferring of the domain may be initiated, depending
-on the setting of the svc_domain's action field. Further operations can be performed from the View Domain screen.
-
-Logging information is written to the Freeside log folder.
-
-For correct operation you must add name/value pairs to the protcol and transport options fields. The setttings
-depend on the domain registry driver (DRD) selected.
-
-=over 4
-
-=item N - Register the domain
-
-=item M - Transfer the domain
-
-=item I - Ignore the domain for registration purposes
-
-=back
-
-=cut
-
-@ISA = qw(FS::part_export::null);
-
-my @tldlist = qw/com net org biz info name mobi at be ca cc ch cn de dk es eu fr it mx nl tv uk us/;
-
-my $opensrs_protocol_opts=<<'END';
-username=
-password=
-auto_renew=0
-affiliate_id=
-reseller_id=
-END
-
-my $opensrs_transport_opts=<<'END';
-client_login=
-client_password=
-END
-
-tie %options, 'Tie::IxHash',
- 'drd' => { label => 'Domain Registry Driver (DRD)',
- type => 'select',
- options => [ qw/BookMyName CentralNic Gandi OpenSRS OVH VNDS/ ],
- default => 'OpenSRS' },
- 'log_level' => { label => 'Logging',
- type => 'select',
- options => [ qw/debug info notice warning error critical alert emergency/ ],
- default => 'warning' },
- 'protocol_opts' => {
- label => 'Protocol Options',
- type => 'textarea',
- default => $opensrs_protocol_opts,
- },
- 'transport_opts' => {
- label => 'Transport Options',
- type => 'textarea',
- default => $opensrs_transport_opts,
- },
-# 'register' => { label => 'Use for registration',
-# type => 'checkbox',
-# default => '1' },
-# 'transfer' => { label => 'Use for transfer',
-# type => 'checkbox',
-# default => '1' },
-# 'delete' => { label => 'Use for deletion',
-# type => 'checkbox',
-# default => '1' },
-# 'renew' => { label => 'Use for renewals',
-# type => 'checkbox',
-# default => '1' },
- 'tlds' => { label => 'Use this export for these top-level domains (TLDs)',
- type => 'select',
- multi => 1,
- size => scalar(@tldlist),
- options => [ @tldlist ],
- default => 'com net org' },
-;
-
-my $opensrs_protocol_defaults = $opensrs_protocol_opts;
-$opensrs_protocol_defaults =~ s|\n|\\n|g;
-
-my $opensrs_transport_defaults = $opensrs_transport_opts;
-$opensrs_transport_defaults =~ s|\n|\\n|g;
-
-%info = (
- 'svc' => 'svc_domain',
- 'desc' => 'Domain registration via Net::DRI',
- 'options' => \%options,
- 'notes' => <<"END"
-Registers and transfers domains via a Net::DRI registrar or registry.
-<a href="http://search.cpan.org/search?dist=Net-DRI">Net::DRI</a>
-must be installed. You must have an account at the selected registrar/registry.
-<BR />
-Some top-level domains have additional business rules not supported by this export. These TLDs cannot be registered or transfered with this export.
-<BR><BR>Use these buttons for some useful presets:
-<UL>
- <LI>
- <INPUT TYPE="button" VALUE="OpenSRS Live System (rr-n1-tor.opensrs.net)" onClick='
- document.dummy.machine.value = "rr-n1-tor.opensrs.net";
- this.form.machine.value = "rr-n1-tor.opensrs.net";
- '>
- <LI>
- <INPUT TYPE="button" VALUE="OpenSRS Test System (horizon.opensrs.net)" onClick='
- document.dummy.machine.value = "horizon.opensrs.net";
- this.form.machine.value = "horizon.opensrs.net";
- '>
- <LI>
- <INPUT TYPE="button" VALUE="OpenSRS protocol/transport options" onClick='
- this.form.protocol_opts.value = "$opensrs_protocol_defaults";
- this.form.transport_opts.value = "$opensrs_transport_defaults";
- '>
-</UL>
-END
-);
-
-install_callback FS::UID sub {
- $conf = new FS::Conf;
-};
-
-#sub rebless { shift; }
-
-# experiment: want the status of these right away, so no queueing
-
-sub _export_insert {
- my( $self, $svc_domain ) = ( shift, shift );
-
- return if $svc_domain->action eq 'I'; # Ignoring registration, just doing DNS
-
- if ($svc_domain->action eq 'N') {
- return $self->register( $svc_domain );
- } elsif ($svc_domain->action eq 'M') {
- return $self->transfer( $svc_domain );
- }
- return "Unknown domain action " . $svc_domain->action;
-}
-
-=item get_portfolio_credentials
-
-Returns, in list context, the user name and password for the domain portfolio.
-
-This is currently specified via the username and password keys in the protocol options.
-
-=cut
-
-sub get_portfolio_credentials {
- my $self = shift;
-
- my %opts = $self->get_protocol_options();
- return ($opts{username}, $opts{password});
-}
-
-=item format_tel
-
-Reformats a phone number according to registry rules. Currently Freeside stores phone numbers
-in NANPA format and most registries prefer "+CCC.NPANPXNNNN"
-
-=cut
-
-sub format_tel {
- my $tel = shift;
-
- #if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})\s*(x\s*(\d+))?$/) {
- if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})$/) {
- $tel = "+1.$1$2$3"; # TBD: other country codes
-# if $tel .= "$4" if $4;
- }
- return $tel;
-}
-
-sub gen_contact_set {
- my ($self, $dri, $cust_main) = @_;
-
- my @invoicing_list = $cust_main->invoicing_list_emailonly;
- if ( $conf->exists('emailinvoiceautoalways')
- || $conf->exists('emailinvoiceauto') && ! @invoicing_list
- || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
- push @invoicing_list, $cust_main->all_emails;
- }
-
- my $email = ($conf->exists('business-onlinepayment-email-override'))
- ? $conf->config('business-onlinepayment-email-override')
- : $invoicing_list[0];
-
- my $cs=$dri->local_object('contactset');
- my $co=$dri->local_object('contact');
-
- my ($user, $pass) = $self->get_portfolio_credentials();
-
- $co->srid($user); # Portfolio user name for OpenSRS?
- $co->auth($pass); # Portfolio password for OpenSRS?
-
- $co->firstname($cust_main->first);
- $co->name($cust_main->last);
- $co->org($cust_main->company || '-');
- $co->street([$cust_main->address1, $cust_main->address2]);
- $co->city($cust_main->city);
- $co->sp($cust_main->state);
- $co->pc($cust_main->zip);
- $co->cc($cust_main->country);
- $co->voice(format_tel($cust_main->daytime()));
- $co->email($email);
-
- $cs->set($co, 'registrant');
- $cs->set($co, 'admin');
- $cs->set($co, 'billing');
-
- return $cs;
-}
-
-=item validate_contact_set
-
-Attempts to validate contact data for the domain based on OpenSRS rules.
-
-Returns undef if the contact data is acceptable, an error message if the contact
-data lacks one or more required fields.
-
-=cut
-
-sub validate_contact_set {
- my $c = shift;
-
- my %fields = (
- firstname => "first name",
- name => "last name",
- street => "street address",
- city => "city",
- sp => "state",
- pc => "ZIP/postal code",
- cc => "country",
- email => "email address",
- voice => "phone number",
- );
- my @err = ();
- foreach my $which (qw/registrant admin billing/) {
- my $co = $c->get($which);
- foreach (keys %fields) {
- if (!$co->$_()) {
- push @err, $fields{$_};
- }
- }
- }
- if (scalar(@err) > 0) {
- return "Contact information needs: " . join(', ', @err);
- }
- undef;
-}
-
-#sub _export_replace {
-# my( $self, $new, $old ) = (shift, shift, shift);
-#
-# return '';
-#
-#}
-
-## Domain registration exports do nothing on delete. You're just removing the domain from Freeside, not the registry
-#sub _export_delete {
-# my( $self, $www ) = ( shift, shift );
-#
-# return '';
-#}
-
-=item split_textarea_options
-
-Split textarea contents into lines, split lines on =, and then trim the results;
-
-=cut
-
-sub split_textarea_options {
- my ($self, $optname) = @_;
- my %opts = map {
- my ($key, $value) = split /=/, $_;
- $key =~ s/^\s*//;
- $key =~ s/\s*$//;
- $value =~ s/^\s*//;
- $value =~ s/\s*$//;
- $key => $value } split /\n/, $self->option($optname);
- %opts;
-}
-
-=item get_protocol_options
-
-Return a hash of protocol options
-
-=cut
-
-sub get_protocol_options {
- my $self = shift;
- my %opts = $self->split_textarea_options('protocol_opts');
- if ($self->machine =~ /opensrs\.net/) {
- my %topts = $self->get_transport_options;
- $opts{reseller_id} = $topts{client_login};
- }
- %opts;
-}
-
-=item get_transport_options
-
-Return a hash of transport options
-
-=cut
-
-sub get_transport_options {
- my $self = shift;
- my %opts = $self->split_textarea_options('transport_opts');
- $opts{remote_url} = "https://" . $self->machine . ":55443/resellers" if $self->machine =~ /opensrs\.net/;
- %opts;
-}
-
-=item is_supported_domain
-
-Return undef if the domain name uses a TLD or SLD that is supported by this registrar.
-Otherwise return an error message explaining what's wrong.
-
-=cut
-
-sub is_supported_domain {
- my $self = shift;
- my $svc_domain = shift;
-
- # Get the TLD of the new domain
- my @bits = split /\./, $svc_domain->domain;
-
- return "Can't register subdomains: " . $svc_domain->domain if scalar(@bits) != 2;
-
- my $tld = pop @bits;
-
- # See if it's one this export supports
- my @tlds = split /\s+/, $self->option('tlds');
- @tlds = map { s/\.//; $_ } @tlds;
- return "Can't register top-level domain $tld, restricted to: " . $self->option('tlds') if ! grep { $_ eq $tld } @tlds;
- return undef;
-}
-
-=item get_dri
-
-=cut
-
-sub get_dri {
- my $self = shift;
- my $dri;
-
-# return $self->{dri} if $self->{dri}; #!!!TBD!!! connection caching.
-
- eval "use Net::DRI 0.95;";
- return $@ if $@;
-
-# $dri=Net::DRI->new(...) to create the global object. Save the result,
-
- eval {
- #$dri = Net::DRI::TrapExceptions->new(10);
- $dri = Net::DRI->new({logging => [ 'files', { output_directory => '%%%FREESIDE_LOG%%%' } ]}); #!!!TBD!!!
- $dri->logging->level( $self->option('log_level') );
- $dri->add_registry( $self->option('drd') );
- my $protocol;
- $protocol = 'xcp' if $self->option('drd') eq 'OpenSRS';
-
- $dri->target( $self->option('drd') )->add_current_profile($self->option('drd') . '1',
-# 'Net::DRI::Protocol::' . $self->option('protocol_type'),
-# $self->option('protocol_type'),
-# 'xcp', #TBD!!!!
- $protocol, # Implies transport
-# 'Net::DRI::Transport::' . $self->option('transport_type'),
- { $self->get_transport_options() },
-# [ $self->get_protocol_options() ]
- );
- };
- return $@ if $@;
-
- $self->{dri} = $dri;
- return $dri;
-}
-
-=item get_status
-
-Returns a reference to a hashref containing information on the domain's status. The keys
-defined depend on the status.
-
-'unregistered' means the domain is not registered.
-
-Otherwise, if the domain is in an asynchronous operation such as a transfer, returns the state
-of that operation.
-
-Otherwise returns a value indicating if the domain can be managed through our reseller account.
-
-=cut
-
-sub get_status {
- my ( $self, $svc_domain ) = @_;
- my $rc;
- my $rslt = {};
-
- my $dri = $self->get_dri;
-
- if (UNIVERSAL::isa($dri, 'Net::DRI::Exception')) {
- $rslt->{'message'} = $dri->as_string;
- return $rslt;
- }
- eval {
- $rc = $dri->domain_check( $svc_domain->domain );
- if (!$rc->is_success()) {
- # Problem accessing the registry/registrar
- $rslt->{'message'} = $rc->message;
- } elsif (!$dri->get_info('exist')) {
- # Domain is not registered
- $rslt->{'unregistered'} = 1;
- } else {
- $rc = $dri->domain_transfer_query( $svc_domain->domain );
- if ($rc->is_success() && $dri->get_info('status')) {
- # Transfer in progress
- $rslt->{status} = $dri->get_info('status');
- $rslt->{contact_email} = $dri->get_info('request_address');
- $rslt->{last_update_time} = $dri->get_info('unixtime');
- } elsif ($dri->get_info('reason')) {
- $rslt->{'reason'} = $dri->get_info('reason');
- # Domain is not being transferred...
- $rc = $dri->domain_info( $svc_domain->domain, { $self->get_protocol_options() } );
- if ($rc->is_success() && $dri->get_info('exDate')) {
- $rslt->{'expdate'} = $dri->get_info('exDate');
- }
- } else {
- $rslt->{status} = 'Unknown';
- }
- }
- };
-# rslt->{'message'} = $@->as_string if $@;
- if ($@) {
- $rslt->{'message'} = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->as_string : $@->message;
- }
-
- return $rslt; # Success
-}
-
-=item register
-
-Attempts to register the domain through the reseller account associated with this export.
-
-Like most export functions, returns an error message on failure or undef on success.
-
-=cut
-
-sub register {
- my ( $self, $svc_domain, $years ) = @_;
-
- my $err = $self->is_supported_domain( $svc_domain );
- return $err if $err;
-
- my $dri = $self->get_dri;
- return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception'));
-
- eval { # All $dri methods can throw an exception.
-
-# Call methods
- my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
-
- my $cs = $self->gen_contact_set($dri, $cust_main);
-
- $err = validate_contact_set($cs);
- return $err if $err;
-
-# !!!TBD!!! add custom name servers when supported; add ns => $ns to hash passed to domain_create
-
- $res = $dri->domain_create($svc_domain->domain, { $self->get_protocol_options(), pure_create => 1, contact => $cs, duration => DateTime::Duration->new(years => $years) });
- $err = $res->is_success ? '' : $res->message;
- };
- if ($@) {
- $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message;
- }
-
- return $err;
-}
-
-=item transfer
-
-Attempts to transfer the domain into the reseller account associated with this export.
-
-Like most export functions, returns an error message on failure or undef on success.
-
-=cut
-
-sub transfer {
- my ( $self, $svc_domain ) = @_;
-
- my $err = $self->is_supported_domain( $svc_domain );
- return $err if $err;
-
-# $dri=Net::DRI->new(...) to create the global object. Save the result,
- my $dri = $self->get_dri;
- return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception'));
-
- eval { # All $dri methods can throw an exception
-
-# Call methods
- my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
-
- my $cs = $self->gen_contact_set($dri, $cust_main);
-
- $err = validate_contact_set($cs);
- return $err if $err;
-
-# !!!TBD!!! add custom name servers when supported; add ns => $ns to hash passed to domain_transfer_start
-
- $res = $dri->domain_transfer_start($svc_domain->domain, { $self->get_protocol_options(), contact => $cs });
- $err = $res->is_success ? '' : $res->message;
- };
- if ($@) {
- $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message;
- }
-
- return $err;
-}
-
-=item renew
-
-Attempts to renew the domain for the specified number of years.
-
-Like most export functions, returns an error message on failure or undef on success.
-
-=cut
-
-sub renew {
- my ( $self, $svc_domain, $years ) = @_;
-
- my $err = $self->is_supported_domain( $svc_domain );
- return $err if $err;
-
- my $dri = $self->get_dri;
- return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception'));
-
- eval { # All $dri methods can throw an exception
- my $expdate;
- my $res = $dri->domain_info( $svc_domain->domain, { $self->get_protocol_options() } );
- if ($res->is_success() && $dri->get_info('exDate')) {
- $expdate = $dri->get_info('exDate');
-
-# return "Domain renewal not enabled" if !$self->option('renew');
- $res = $dri->domain_renew( $svc_domain->domain, { $self->get_protocol_options(), duration => DateTime::Duration->new(years => $years), current_expiration => $expdate });
- }
- $err = $res->is_success ? '' : $res->message;
- };
- if ($@) {
- $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message;
- }
-
- return $err;
-}
-
-=item revoke
-
-Attempts to revoke the domain registration. Only succeeds if invoked during the DRI
-grace period immediately after registration.
-
-Like most export functions, returns an error message on failure or undef on success.
-
-=cut
-
-sub revoke {
- my ( $self, $svc_domain ) = @_;
-
- my $err = $self->is_supported_domain( $svc_domain );
- return $err if $err;
-
- my $dri = $self->get_dri;
- return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception'));
-
- eval { # All $dri methods can throw an exception
-
-# return "Domain registration revocation not enabled" if !$self->option('revoke');
- my $res = $dri->domain_delete( $svc_domain->domain, { $self->get_protocol_options(), domain => $svc_domain->domain, pure_delete => 1 });
- $err = $res->is_success ? '' : $res->message;
- };
- if ($@) {
- $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message;
- }
-
- return $err;
-}
-
-=item registrar
-
-Should return a full-blown object representing the Net::DRI DRD, but current just returns a hashref
-containing the registrar name.
-
-=cut
-
-sub registrar {
- my $self = shift;
- return {
- name => $self->option('drd'),
- };
-}
-
-=head1 SEE ALSO
-
-L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>,
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm
deleted file mode 100644
index 76f0059..0000000
--- a/FS/FS/part_export/domreg_opensrs.pm
+++ /dev/null
@@ -1,616 +0,0 @@
-package FS::part_export::domreg_opensrs;
-
-use vars qw(@ISA %info %options $conf $me $DEBUG);
-use Tie::IxHash;
-use DateTime;
-use FS::Record qw(qsearchs qsearch);
-use FS::Conf;
-use FS::part_export::null;
-use FS::svc_domain;
-use FS::part_pkg;
-
-=head1 NAME
-
-FS::part_export::domreg_opensrs - Register or transfer domains with Tucows OpenSRS
-
-=head1 DESCRIPTION
-
-This module handles registering and transferring domains using a registration service provider (RSP) account
-at Tucows OpenSRS, an ICANN-approved domain registrar.
-
-As a part_export, this module can be designated for use with svc_domain services. When the svc_domain object
-is inserted into the Freeside database, registration or transferring of the domain may be initiated, depending
-on the setting of the svc_domain's action field.
-
-=over 4
-
-=item N - Register the domain
-
-=item M - Transfer the domain
-
-=item I - Ignore the domain for registration purposes
-
-=back
-
-This export uses Net::OpenSRS. Registration and transfer attempts will fail unless Net::OpenSRS is installed
-and LWP::UserAgent is able to make HTTPS posts. You can turn on debugging messages and use the OpenSRS test
-gateway when setting up this export.
-
-=cut
-
-@ISA = qw(FS::part_export::null);
-$me = '[' . __PACKAGE__ . ']';
-$DEBUG = 0;
-
-my @tldlist = qw/com net org biz info name mobi at be ca cc ch cn de dk es eu fr it mx nl tv uk us/;
-
-tie %options, 'Tie::IxHash',
- 'username' => { label => 'Reseller user name at OpenSRS',
- },
- 'privatekey' => { label => 'Private key',
- },
- 'password' => { label => 'Password for management account',
- },
- 'masterdomain' => { label => 'Master domain at OpenSRS',
- },
- 'wait_for_pay' => { label => 'Do not provision until payment is received',
- type => 'checkbox',
- default => '0',
- },
- 'debug_level' => { label => 'Net::OpenSRS debug level',
- type => 'select',
- options => [ 0, 1, 2, 3 ],
- default => 0 },
-# 'register' => { label => 'Use for registration',
-# type => 'checkbox',
-# default => '1' },
-# 'transfer' => { label => 'Use for transfer',
-# type => 'checkbox',
-# default => '1' },
- 'tlds' => { label => 'Use this export for these top-level domains (TLDs)',
- type => 'select',
- multi => 1,
- size => scalar(@tldlist),
- options => [ @tldlist ],
- default => 'com net org' },
-;
-
-%info = (
- 'svc' => 'svc_domain',
- 'desc' => 'Domain registration via Tucows OpenSRS',
- 'options' => \%options,
- 'notes' => <<'END'
-Registers and transfers domains via the <a href="http://opensrs.com/">Tucows OpenSRS</a> registrar (using <a href="http://search.cpan.org/dist/Net-OpenSRS">Net::OpenSRS</a>).
-All of the Net::OpenSRS restrictions apply:
-<UL>
- <LI>You must have a reseller account with Tucows.
- <LI>You must add the public IP address of the Freeside server to the 'Script API allow' list in the OpenSRS web interface.
- <LI>You must generate an API access key in the OpenSRS web interface and enter it below.
- <LI>All domains are managed using the same user name and password, but you can create sub-accounts for clients.
- <LI>The user name must be the same as your OpenSRS reseller ID.
- <LI>You must enter a master domain that all other domains are associated with. That domain must be registered through your OpenSRS account.
-</UL>
-Some top-level domains offered by OpenSRS have additional business rules not supported by this export. These TLDs cannot be registered or transfered with this export.
-<BR><BR>Use these buttons for some useful presets:
-<UL>
- <LI>
- <INPUT TYPE="button" VALUE="OpenSRS Live System (rr-n1-tor.opensrs.net)" onClick='
- document.dummy.machine.value = "rr-n1-tor.opensrs.net";
- this.form.machine.value = "rr-n1-tor.opensrs.net";
- '>
- <LI>
- <INPUT TYPE="button" VALUE="OpenSRS Test System (horizon.opensrs.net)" onClick='
- document.dummy.machine.value = "horizon.opensrs.net";
- this.form.machine.value = "horizon.opensrs.net";
- '>
-</UL>
-END
-);
-
-install_callback FS::UID sub {
- $conf = new FS::Conf;
-};
-
-=head1 METHODS
-
-=over 4
-
-=item format_tel
-
-Reformats a phone number according to registry rules. Currently Freeside stores phone numbers
-in NANPA format and the registry prefers "+CCC.NPANPXNNNN"
-
-=cut
-
-sub format_tel {
- my $tel = shift;
-
- #if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})( x(\d+))?$/) {
- if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})$/) {
- $tel = "+1.$1$2$3";
-# if $tel .= "$4" if $4;
- }
- return $tel;
-}
-
-=item gen_contact_info
-
-Generates contact data for the domain based on the customer data.
-
-Currently relies on Net::OpenSRS to format the telephone number for OpenSRS.
-
-=cut
-
-sub gen_contact_info
-{
- my ($co)=@_;
-
- my @invoicing_list = $co->invoicing_list_emailonly;
- if ( $conf->exists('emailinvoiceautoalways')
- || $conf->exists('emailinvoiceauto') && ! @invoicing_list
- || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
- push @invoicing_list, $co->all_emails;
- }
-
- my $email = ($conf->exists('business-onlinepayment-email-override'))
- ? $conf->config('business-onlinepayment-email-override')
- : $invoicing_list[0];
-
- my $c = {
- firstname => $co->first,
- lastname => $co->last,
- company => $co->company,
- address => $co->address1,
- city => $co->city(),
- state => $co->state(),
- zip => $co->zip(),
- country => uc($co->country()),
- email => $email,
- #phone => format_tel($co->daytime()),
- phone => $co->daytime() || $co->night,
- };
- return $c;
-}
-
-=item validate_contact_info
-
-Attempts to validate contact data for the domain based on OpenSRS rules.
-
-Returns undef if the contact data is acceptable, an error message if the contact
-data lacks one or more required fields.
-
-=cut
-
-sub validate_contact_info {
- my $c = shift;
-
- my %fields = (
- firstname => "first name",
- lastname => "last name",
- address => "street address",
- city => "city",
- state => "state",
- zip => "ZIP/postal code",
- country => "country",
- email => "email address",
- phone => "phone number",
- );
- my @err = ();
- foreach (keys %fields) {
- if (!defined($c->{$_}) || !$c->{$_}) {
- push @err, $fields{$_};
- }
- }
- if (scalar(@err) > 0) {
- return "Contact information needs: " . join(', ', @err);
- }
- undef;
-}
-
-=item testmode
-
-Returns the Net::OpenSRS-required test mode string based on whether the export
-is configured to use the live or the test gateway.
-
-=cut
-
-sub testmode {
- my $self = shift;
-
- return 'live' if $self->machine eq "rr-n1-tor.opensrs.net";
- return 'test' if $self->machine eq "horizon.opensrs.net";
- undef;
-
-}
-
-=item _export_insert
-
-Attempts to "export" the domain, i.e. register or transfer it if the user selected
-that option when editing the domain.
-
-Returns an error message on failure or undef on success.
-
-May also return an error message if it cannot load the required Perl module Net::OpenSRS,
-or if the domain is not registerable, or if insufficient data is provided in the customer
-record to generate the required contact information to register or transfer the domain.
-
-=cut
-
-sub _export_insert {
- my( $self, $svc_domain ) = ( shift, shift );
-
- return if $svc_domain->action eq 'I'; # Ignoring registration, just doing DNS
-
- if ($svc_domain->action eq 'N') {
- return $self->register( $svc_domain );
- } elsif ($svc_domain->action eq 'M') {
- return $self->transfer( $svc_domain );
- }
- return "Unknown domain action " . $svc_domain->action;
-}
-
-sub _export_insert_on_payment {
- my( $self, $svc_domain ) = ( shift, shift );
- warn "$me:_export_insert_on_payment called\n" if $DEBUG;
- return '' unless $self->option('wait_for_pay');
-
- my $queue = new FS::queue {
- 'svcnum' => $svc_domain->svcnum,
- 'job' => 'FS::part_export::domreg_opensrs::renew_through',
- };
- $queue->insert( $self, $svc_domain ); #_export_insert with 'R' action?
-}
-
-## Domain registration exports do nothing on replace. Mainly because we haven't decided what they should do.
-#sub _export_replace {
-# my( $self, $new, $old ) = (shift, shift, shift);
-#
-# return '';
-#
-#}
-
-## Domain registration exports do nothing on delete. You're just removing the domain from Freeside, not the registry
-#sub _export_delete {
-# my( $self, $svc_domain ) = ( shift, shift );
-#
-# return '';
-#}
-
-=item is_supported_domain
-
-Return undef if the domain name uses a TLD or SLD that is supported by this registrar.
-Otherwise return an error message explaining what's wrong.
-
-=cut
-
-sub is_supported_domain {
- my $self = shift;
- my $svc_domain = shift;
-
- # Get the TLD of the new domain
- my @bits = split /\./, $svc_domain->domain;
-
- return "Can't register subdomains: " . $svc_domain->domain if scalar(@bits) != 2;
-
- my $tld = pop @bits;
-
- # See if it's one this export supports
- my @tlds = split /\s+/, $self->option('tlds');
- @tlds = map { s/\.//; $_ } @tlds;
- return "Can't register top-level domain $tld, restricted to: " . $self->option('tlds') if ! grep { $_ eq $tld } @tlds;
- return undef;
-}
-
-=item get_srs
-
-=cut
-
-sub get_srs {
- my $self = shift;
-
- my $srs = Net::OpenSRS->new();
-
- $srs->debug_level( $self->option('debug_level') ); # Output should be in the Apache error log
-
- $srs->environment( $self->testmode() );
- $srs->set_key( $self->option('privatekey') );
-
- $srs->set_manage_auth( $self->option('username'), $self->option('password') );
- return $srs;
-}
-
-=item get_status
-
-Returns a reference to a hashref containing information on the domain's status. The keys
-defined depend on the status.
-
-'unregistered' means the domain is not registered.
-
-Otherwise, if the domain is in an asynchronous operation such as a transfer, returns the state
-of that operation.
-
-Otherwise returns a value indicating if the domain can be managed through our reseller account.
-
-=cut
-
-sub get_status {
- my ( $self, $svc_domain ) = @_;
- my $rslt = {};
-
- eval "use Net::OpenSRS;";
- return $@ if $@;
-
- my $srs = $self->get_srs;
-
- if ($srs->is_available( $svc_domain->domain )) {
- $rslt->{'unregistered'} = 1;
- } else {
- $rslt = $srs->check_transfer( $svc_domain->domain );
- if (defined($rslt->{'reason'})) {
- my $rv = $srs->make_request(
- {
- action => 'belongs_to_rsp',
- object => 'domain',
- attributes => {
- domain => $svc_domain->domain
- }
- }
- );
- if ($rv) {
- $self->_set_response;
- if ( $rv->{attributes}->{'domain_expdate'} ) {
- $rslt->{'expdate'} = $rv->{attributes}->{'domain_expdate'};
- }
- }
- }
- }
-
- return $rslt; # Success
-}
-
-=item register
-
-Attempts to register the domain through the reseller account associated with this export.
-
-Like most export functions, returns an error message on failure or undef on success.
-
-=cut
-
-sub register {
- my ( $self, $svc_domain, $years ) = @_;
-
- $years = 1 unless $years; #default to 1 year since we don't seem to pass it
-
- return "Net::OpenSRS does not support period other than 1 year" if $years != 1;
-
- eval "use Net::OpenSRS;";
- return $@ if $@;
-
- my $err = $self->is_supported_domain( $svc_domain );
- return $err if $err;
-
- my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
-
- my $c = gen_contact_info($cust_main);
-
- $err = validate_contact_info($c);
- return $err if $err;
-
- my $srs = $self->get_srs;
-
-# cookie not required for registration
-# my $cookie = $srs->get_cookie( $self->option('masterdomain') );
-# if (!$cookie) {
-# return "Unable to get cookie at OpenSRS: " . $srs->last_response();
-# }
-
-# return "Domain registration not enabled" if !$self->option('register');
- return $srs->last_response() if !$srs->register_domain( $svc_domain->domain, $c);
-
- return ''; # Should only get here if register succeeded
-}
-
-=item transfer
-
-Attempts to transfer the domain into the reseller account associated with this export.
-
-Like most export functions, returns an error message on failure or undef on success.
-
-=cut
-
-sub transfer {
- my ( $self, $svc_domain ) = @_;
-
- eval "use Net::OpenSRS;";
- return $@ if $@;
-
- my $err = $self->is_supported_domain( $svc_domain );
- return $err if $err;
-
- my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
-
- my $c = gen_contact_info($cust_main);
-
- $err = validate_contact_info($c);
- return $err if $err;
-
- my $srs = $self->get_srs;
-
- my $cookie = $srs->get_cookie( $self->option('masterdomain') );
- if (!$cookie) {
- return "Unable to get cookie at OpenSRS: " . $srs->last_response();
- }
-
-# return "Domain transfer not enabled" if !$self->option('transfer');
- return $srs->last_response() if !$srs->transfer_domain( $svc_domain->domain, $c);
-
- return ''; # Should only get here if transfer succeeded
-}
-
-=item renew
-
-Attempts to renew the domain for the specified number of years.
-
-Like most export functions, returns an error message on failure or undef on success.
-
-=cut
-
-sub renew {
- my ( $self, $svc_domain, $years ) = @_;
-
- eval "use Net::OpenSRS;";
- return $@ if $@;
-
- my $err = $self->is_supported_domain( $svc_domain );
- return $err if $err;
-
- my $srs = $self->get_srs;
-
- my $cookie = $srs->get_cookie( $self->option('masterdomain') );
- if (!$cookie) {
- return "Unable to get cookie at OpenSRS: " . $srs->last_response();
- }
-
-# return "Domain renewal not enabled" if !$self->option('renew');
- return $srs->last_response() if !$srs->renew_domain( $svc_domain->domain, $years );
-
- return ''; # Should only get here if renewal succeeded
-}
-
-=item renew_through [ EPOCH_DATE ]
-
-Attempts to renew the domain through the specified date. If no date is
-provided it is gleaned from the associated cust_pkg bill date
-
-Like some export functions, dies on failure or returns undef on success.
-It is always called from the queue.
-
-=cut
-
-sub renew_through {
- my ( $self, $svc_domain, $date ) = @_;
-
- warn "$me: renew_through called\n" if $DEBUG;
- eval "use Net::OpenSRS;";
- die $@ if $@;
-
- unless ( $date ) {
- my $cust_pkg = $svc_domain->cust_svc->cust_pkg;
- die "Can't renew: no date specified and domain is not in a package."
- unless $cust_pkg;
- $date = $cust_pkg->bill;
- }
-
- my $err = $self->is_supported_domain( $svc_domain );
- die $err if $err;
-
- warn "$me: checking status\n" if $DEBUG;
- my $rv = $self->get_status($svc_domain);
- die "Domain ". $svc_domain->domain. " is not renewable"
- unless $rv->{expdate};
-
- die "Can't parse expiration date for ". $svc_domain->domain
- unless $rv->{expdate} =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/;
-
- my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6);
- my $exp = DateTime->new( year => $year,
- month => $month,
- day => $day,
- hour => $hour,
- minute => $minute,
- second => $second,
- time_zone => 'America/New_York',#timezone of opensrs
- );
-
- my $bill = DateTime->
- from_epoch( 'epoch' => $date,
- 'time_zone' => DateTime::TimeZone->new( name => 'local' ),
- );
-
- my $years = 0;
- while ( DateTime->compare( $bill, $exp ) > 0 ) {
- $years++;
- $exp->add( 'years' => 1 );
-
- die "Can't renew ". $svc_domain->domain. " for more than 10 years."
- if $years > 10; #no infinite loop
- }
-
- return '' unless $years;
-
- warn "$me: renewing ". $svc_domain->domain. " for $years years\n" if $DEBUG;
- my $srs = $self->get_srs;
- $rv = $srs->make_request(
- {
- action => 'renew',
- object => 'domain',
- attributes => {
- domain => $svc_domain->domain,
- auto_renew => 0,
- handle => 'process',
- period => $years,
- currentexpirationyear => $year,
- }
- }
- );
- die $rv->{response_text} unless $rv->{is_success};
-
- return ''; # Should only get here if renewal succeeded
-}
-
-=item revoke
-
-Attempts to revoke the domain registration. Only succeeds if invoked during the OpenSRS
-grace period immediately after registration.
-
-Like most export functions, returns an error message on failure or undef on success.
-
-=cut
-
-sub revoke {
- my ( $self, $svc_domain ) = @_;
-
- eval "use Net::OpenSRS;";
- return $@ if $@;
-
- my $err = $self->is_supported_domain( $svc_domain );
- return $err if $err;
-
- my $srs = $self->get_srs;
-
- my $cookie = $srs->get_cookie( $self->option('masterdomain') );
- if (!$cookie) {
- return "Unable to get cookie at OpenSRS: " . $srs->last_response();
- }
-
-# return "Domain registration revocation not enabled" if !$self->option('revoke');
- return $srs->last_response() if !$srs->revoke_domain( $svc_domain->domain);
-
- return ''; # Should only get here if transfer succeeded
-}
-
-=item registrar
-
-Should return a full-blown object representing OpenSRS, but current just returns a hashref
-containing the registrar name.
-
-=cut
-
-sub registrar {
- return {
- name => 'OpenSRS',
- };
-}
-
-=back
-
-=head1 SEE ALSO
-
-L<Net::OpenSRS>, L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>,
-L<FS::Record>, schema.html from the base documentation.
-
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_export/everyone_net.pm b/FS/FS/part_export/everyone_net.pm
deleted file mode 100644
index e04318e..0000000
--- a/FS/FS/part_export/everyone_net.pm
+++ /dev/null
@@ -1,132 +0,0 @@
-package FS::part_export::everyone_net;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'clientID' => { label=>'clientID' },
- 'password' => { label=>'Password' },
- #'workgroup' => { label=>'Default Workgroup' },
- 'debug' => { label=>'Enable debugging',
- type=>'checkbox' },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to Everyone.net outsourced mail service',
- 'options'=> \%options,
- 'notes' => <<'END'
-Real-time export to
-<a href="http://www.cp.net/">Everyone.net</a> via the XRC Remote API.
-Requires installation of
-<a href="http://search.cpan.org/dist/Net-XRC">Net::XRC</a>
-from CPAN.
-END
-);
-
-sub rebless { shift; }
-
-# experiement: want the status of these right away (don't want account to
-# create or whatever and then get error in the queue from dup username or
-# something), so no queueing
-
-sub _export_insert {
- my( $self, $svc_acct ) = (shift, shift);
-
- eval "use Net::XRC qw(:types);";
- return $@ if $@;
-
- $self->_xrc_command( 'createUser',
- $svc_acct->domain,
- [],
- string($svc_acct->username),
- string($svc_acct->_password),
- );
-}
-
-sub _xrc_command {
- my( $self, $method, $domain, @args ) = @_;
-
- eval "use Net::XRC qw(:types);";
- return $@ if $@;
-
- local($Net::XRC::DEBUG) = 1
- if $self->option('debug');
-
- my $xrc = new Net::XRC (
- 'clientID' => $self->option('clientID'),
- 'password' => $self->option('password'),
- );
-
- my $dresponse = $xrc->lookupMXReadyClientIDByEmailDomain( string($domain) );
- return $dresponse->error unless $dresponse->is_success;
- my $clientID = $dresponse->content;
- return "clientID for domain $domain not found"
- if $clientID == -1;
-
- my $response = $xrc->$method($clientID, @args);
- return $response->error unless $response->is_success;
- '';
-
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
-
- eval "use Net::XRC qw(:types);";
- return $@ if $@;
-
- return "can't change domain with Everyone.net"
- if $old->domain ne $new->domain;
- return "can't change username with Everyone.net"
- if $old->username ne $new->username;
- return '' unless $old->_password ne $new->_password;
-
- $self->_xrc_command( 'setUserPassword',
- $new->domain,
- string($new->username),
- string($new->_password),
- );
-}
-
-sub _export_delete {
- my( $self, $svc_acct ) = (shift, shift);
-
- eval "use Net::XRC qw(:types);";
- return $@ if $@;
-
- $self->_xrc_command( 'deleteUser',
- $svc_acct->domain,
- string($svc_acct->username),
- );
-}
-
-sub _export_suspend {
- my( $self, $svc_acct ) = (shift, shift);
-
- eval "use Net::XRC qw(:types);";
- return $@ if $@;
-
- $self->_xrc_command( 'suspendUser',
- $svc_acct->domain,
- string($svc_acct->username),
- );
-}
-
-sub _export_unsuspend {
- my( $self, $svc_acct ) = (shift, shift);
-
- eval "use Net::XRC qw(:types);";
- return $@ if $@;
-
- $self->_xrc_command( 'unsuspendUser',
- $svc_acct->domain,
- string($svc_acct->username),
- );
-}
-
-1;
-
diff --git a/FS/FS/part_export/forward_shellcommands.pm b/FS/FS/part_export/forward_shellcommands.pm
deleted file mode 100644
index 0f79ede..0000000
--- a/FS/FS/part_export/forward_shellcommands.pm
+++ /dev/null
@@ -1,182 +0,0 @@
-package FS::part_export::forward_shellcommands;
-
-use strict;
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'useradd' => { label=>'Insert command',
- default=>'',
- },
- 'userdel' => { label=>'Delete command',
- default=>'',
- },
- 'usermod' => { label=>'Modify command',
- default=>'',
- },
-;
-
-%info = (
- 'svc' => 'svc_forward',
- 'desc' => 'Run remote commands via SSH, for forwards',
- 'options' => \%options,
- 'notes' => <<'END'
-Run remote commands via SSH, for forwards. You will need to
-<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>
- <INPUT TYPE="button" VALUE="text vpopmail maintenance" onClick='
- this.form.useradd.value = "[ -d /home/vpopmail/domains/$domain/$username ] && { echo \"$destination\" > /home/vpopmail/domains/$domain/$username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$domain/$username/.qmail; }";
- this.form.userdel.value = "rm /home/vpopmail/domains/$domain/$username/.qmail";
- this.form.usermod.value = "mv /home/vpopmail/domains/$old_domain/$old_username/.qmail /home/vpopmail/domains/$new_domain/$new_username; [ \"$old_destination\" != \"$new_destination\" ] && { echo \"$new_destination\" > /home/vpopmail/domains/$new_domain/$new_username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$new_domain/$new_username/.qmail; }";
- '>
- <LI>
- <INPUT TYPE="button" VALUE="ISPMan CLI" onClick='
- this.form.useradd.value = "";
- this.form.userdel.value = "";
- this.form.usermod.value = "";
- '>
-</UL>
-The following variables are available for interpolation (prefixed with
-<code>new_</code> or <code>old_</code> for replace operations):
-<UL>
- <LI><code>$username</code> - username of forward source
- <LI><code>$domain</code> - domain of forward source
- <LI><code>$source</code> - forward source ($username@$domain)
- <LI><code>$destination</code> - forward destination
- <LI>All other fields in <a href="../docs/schema.html#svc_forward">svc_forward</a> are also available.
-</UL>
-END
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self) = shift;
- $self->_export_command('useradd', @_);
-}
-
-sub _export_delete {
- my($self) = shift;
- $self->_export_command('userdel', @_);
-}
-
-sub _export_command {
- my ( $self, $action, $svc_forward ) = (shift, shift, shift);
- my $command = $self->option($action);
- return '' if $command =~ /^\s*$/;
-
- #set variable for the command
- no strict 'vars';
- {
- no strict 'refs';
- ${$_} = $svc_forward->getfield($_) foreach $svc_forward->fields;
- }
-
- if ( $svc_forward->srcsvc ) {
- my $srcsvc_acct = $svc_forward->srcsvc_acct;
- $username = $srcsvc_acct->username;
- $domain = $srcsvc_acct->domain;
- $source = $srcsvc_acct->email;
- } else {
- $source = $svc_forward->src;
- ( $username, $domain ) = split(/\@/, $source);
- }
-
- if ($svc_forward->dstsvc) {
- $destination = $svc_forward->dstsvc_acct->email;
- } else {
- $destination = $svc_forward->dst;
- }
-
- #done setting variables for the command
-
- $self->shellcommands_queue( $svc_forward->svcnum,
- user => $self->option('user')||'root',
- host => $self->machine,
- command => eval(qq("$command")),
- );
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
- my $command = $self->option('usermod');
-
- #set variable for the command
- no strict 'vars';
- {
- no strict 'refs';
- ${"old_$_"} = $old->getfield($_) foreach $old->fields;
- ${"new_$_"} = $new->getfield($_) foreach $new->fields;
- }
-
- if ( $old->srcsvc ) {
- my $srcsvc_acct = $old->srcsvc_acct;
- $old_username = $srcsvc_acct->username;
- $old_domain = $srcsvc_acct->domain;
- $old_source = $srcsvc_acct->email;
- } else {
- $old_source = $old->src;
- ( $old_username, $old_domain ) = split(/\@/, $old_source);
- }
-
- if ( $old->dstsvc ) {
- $old_destination = $old->dstsvc_acct->email;
- } else {
- $old_destination = $old->dst;
- }
-
- if ( $new->srcsvc ) {
- my $srcsvc_acct = $new->srcsvc_acct;
- $new_username = $srcsvc_acct->username;
- $new_domain = $srcsvc_acct->domain;
- $new_source = $srcsvc_acct->email;
- } else {
- $new_source = $new->src;
- ( $new_username, $new_domain ) = split(/\@/, $new_source);
- }
-
- if ( $new->dstsvc ) {
- $new_destination = $new->dstsvc_acct->email;
- } else {
- $new_destination = $new->dst;
- }
-
- #done setting variables for the command
-
- $self->shellcommands_queue( $new->svcnum,
- user => $self->option('user')||'root',
- host => $self->machine,
- command => eval(qq("$command")),
- );
-}
-
-#a good idea to queue anything that could fail or take any time
-sub shellcommands_queue {
- my( $self, $svcnum ) = (shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::forward_shellcommands::ssh_cmd",
- };
- $queue->insert( @_ );
-}
-
-sub ssh_cmd { #subroutine, not method
- use Net::SSH '0.08';
- &Net::SSH::ssh_cmd( { @_ } );
-}
-
-#sub shellcommands_insert { #subroutine, not method
-#}
-#sub shellcommands_replace { #subroutine, not method
-#}
-#sub shellcommands_delete { #subroutine, not method
-#}
-
-1;
-
diff --git a/FS/FS/part_export/globalpops_voip.pm b/FS/FS/part_export/globalpops_voip.pm
deleted file mode 100644
index 67b48bb..0000000
--- a/FS/FS/part_export/globalpops_voip.pm
+++ /dev/null
@@ -1,370 +0,0 @@
-package FS::part_export::globalpops_voip;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::Record qw(qsearch dbh);
-use FS::part_export;
-use FS::phone_avail;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'login' => { label=>'GlobalPOPs Media Services API login' },
- 'password' => { label=>'GlobalPOPs Media Services API password' },
- 'endpointgroup' => { label=>'GlobalPOPs endpoint group number' },
- 'dry_run' => { label=>"Test mode - don't actually provision" },
-;
-
-%info = (
- 'svc' => 'svc_phone',
- 'desc' => 'Provision phone numbers to GlobalPOPs VoIP',
- 'options' => \%options,
- 'notes' => <<'END'
-Requires installation of
-<a href="http://search.cpan.org/dist/Net-GlobalPOPs-MediaServicesAPI">Net::GlobalPOPs::MediaServicesAPI</a>
-from CPAN.
-END
-);
-
-sub rebless { shift; }
-
-sub get_dids {
- my $self = shift;
- my %opt = ref($_[0]) ? %{$_[0]} : @_;
-
- my %getdids = ();
- # 'orderby' => 'npa', #but it doesn't seem to work :/
-
- if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers
- %getdids = ( 'npa' => $opt{'areacode'},
- 'nxx' => $opt{'exchange'},
- );
- } elsif ( $opt{'areacode'} ) { #return city (npa-nxx-XXXX)
- %getdids = ( 'npa' => $opt{'areacode'} );
- } elsif ( $opt{'state'} ) {
-
- my @avail = qsearch({
- 'table' => 'phone_avail',
- 'hashref' => { 'exportnum' => $self->exportnum,
- 'countrycode' => '1', #don't hardcode me when gp goes int'l
- 'state' => $opt{'state'},
- },
- 'order_by' => 'ORDER BY npa',
- });
-
- return [ map $_->npa, @avail ] if @avail; #return cached area codes instead
-
- #otherwise, search for em
- %getdids = ( 'state' => $opt{'state'} );
-
- }
-
- my $dids = $self->gp_command('getDIDs', %getdids);
-
- #use Data::Dumper;
- #warn Dumper($dids);
-
- my $search = $dids->{'search'};
-
- if ( $search->{'statuscode'} == 302200 ) {
- return [];
- } elsif ( $search->{'statuscode'} != 100 ) {
- die "Error running globalpop getDIDs: ".
- $search->{'statuscode'}. ': '. $search->{'status'}; #die??
- }
-
- my @return = ();
-
- #my $latas = $search->{state}{lata};
- my %latas;
- if ( grep $search->{state}{lata}{$_}, qw(name rate_center) ) {
- %latas = map $search->{state}{lata}{$_},
- qw(name rate_center);
- } else {
- %latas = %{ $search->{state}{lata} };
- }
-
- foreach my $lata ( keys %latas ) {
-
- #warn "LATA $lata";
-
- #my $l = $latas{$lata};
- #$l = $l->{rate_center} if exists $l->{rate_center};
-
- my $lata_dids = $self->gp_command('getDIDs', %getdids, 'lata'=>$lata);
- my $lata_search = $lata_dids->{'search'};
- unless ( $lata_search->{'statuscode'} == 100 ) {
- die "Error running globalpop getDIDs: ". $lata_search->{'status'}; #die??
- }
-
- my $l = $lata_search->{state}{lata}{'rate_center'};
-
- #use Data::Dumper;
- #warn Dumper($l);
-
- my %rate_center;
- if ( grep $l->{$_}, qw(name friendlyname) ) {
- %rate_center = map $l->{$_},
- qw(name friendlyname);
- } else {
- %rate_center = %$l;
- }
-
- foreach my $rate_center ( keys %rate_center ) {
-
- #warn "rate center $rate_center";
-
- my $rc = $rate_center{$rate_center};
- $rc = $rc->{friendlyname} if exists $rc->{friendlyname};
-
- my @r = ();
- if ( exists($rc->{npa}) ) {
- @r = ($rc);
- } else {
- @r = map { { 'name'=>$_, %{ $rc->{$_} } }; } keys %$rc
- }
-
- foreach my $r (@r) {
-
- my @npa = ();
- if ( exists($r->{npa}{name}) ) {
- @npa = ($r->{npa})
- } else {
- @npa = map { { 'name'=>$_, %{ $r->{npa}{$_} } } } keys %{ $r->{npa} };
- }
-
- foreach my $npa (@npa) {
-
- if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers
-
- #warn Dumper($npa);
-
- my $tn = $npa->{nxx}{tn} || $npa->{nxx}{$opt{'exchange'}}{tn};
-
- my @tn = ref($tn) ? @$tn : ($tn);
- #push @return, @tn;
- push @return, map {
- if ( /^\s*(\d{3})(\d{3})(\d{4})\s*$/ ) {
- "$1-$2-$3";
- } else {
- $_;
- }
- }
- @tn;
-
- } elsif ( $opt{'areacode'} ) { #return city (npa-nxx-XXXX)
-
- if ( $npa->{nxx}{name} ) {
- @nxx = ( $npa->{nxx}{name} );
- } else {
- @nxx = keys %{ $npa->{nxx} };
- }
-
- push @return, map { $r->{name}. ' ('. $npa->{name}. "-$_-XXXX)"; }
- @nxx;
-
- } elsif ( $opt{'state'} ) { #and not other things, then return areacode
- #my $ac = $npa->{name};
- #use Data::Dumper;
- #warn Dumper($r) unless length($ac) == 3;
-
- push @return, $npa->{name}
- unless grep { $_ eq $npa->{name} } @return;
-
- } else {
- warn "WARNING: returning nothing for get_dids without known options"; #?
- }
-
- } #foreach my $npa
-
- } #foreach my $r
-
- } #foreach my $rate_center
-
- } #foreach my $lata
-
- if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers
- @return = sort { $a cmp $b } @return; #string comparison actually dwiw
- } elsif ( $opt{'areacode'} ) { #return city (npa-nxx-XXXX)
- @return = sort { lc($a) cmp lc($b) } @return;
- } elsif ( $opt{'state'} ) { #and not other things, then return areacode
-
- #populate cache
-
- 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 $errmsg = 'WARNING: error populating phone availability cache: ';
- my $error = '';
- foreach my $return (@return) {
- my $phone_avail = new FS::phone_avail {
- 'exportnum' => $self->exportnum,
- 'countrycode' => '1', #don't hardcode me when gp goes int'l
- 'state' => $opt{'state'},
- 'npa' => $return,
- };
- $error = $phone_avail->insert();
- if ( $error ) {
- warn $errmsg.$error;
- last;
- }
- }
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- } else {
- $dbh->commit or warn $errmsg.$dbh->errstr if $oldAutoCommit;
- }
-
- #end populate cache
-
- #@return = sort { (split(' ', $a))[0] <=> (split(' ', $b))[0] } @return;
- @return = sort { $a <=> $b } @return;
- } else {
- warn "WARNING: returning nothing for get_dids without known options"; #?
- }
-
- \@return;
-
-}
-
-sub gp_command {
- my( $self, $command, @args ) = @_;
-
- eval "use Net::GlobalPOPs::MediaServicesAPI;";
- die $@ if $@;
-
- my $gp = Net::GlobalPOPs::MediaServicesAPI->new(
- 'login' => $self->option('login'),
- 'password' => $self->option('password'),
- #'debug' => $debug,
- );
-
- $gp->$command(@args);
-}
-
-
-sub _export_insert {
- my( $self, $svc_phone ) = (shift, shift);
-
- return '' if $self->option('dry_run');
-
- #we want to provision and catch errors now, not queue
-
- my $r = $self->gp_command('reserveDID',
- 'did' => $svc_phone->phonenum,
- 'minutes' => 1,
- 'endpointgroup' => $self->option('endpointgroup'),
- );
-
- my $rdid = $r->{did};
-
- if ( $rdid->{'statuscode'} != 100 ) {
- return "Error running globalpop reserveDID: ".
- $rdid->{'statuscode'}. ': '. $rdid->{'status'};
- }
-
- my $a = $self->gp_command('assignDID',
- 'did' => $svc_phone->phonenum,
- 'endpointgroup' => $self->option('endpointgroup'),
- #'rewrite'
- #'cnam'
- );
-
- my $adid = $a->{did};
-
- if ( $adid->{'statuscode'} != 100 ) {
- return "Error running globalpop assignDID: ".
- $adid->{'statuscode'}. ': '. $adid->{'status'};
- }
-
- '';
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
-
- #hmm, what's to change?
- '';
-}
-
-sub _export_delete {
- my( $self, $svc_phone ) = (shift, shift);
-
- return '' if $self->option('dry_run');
-
- #probably okay to queue the deletion...?
- #but hell, let's do it inline anyway, who wants phone numbers hanging around
-
- my $r = $self->gp_command('releaseDID',
- 'did' => $svc_phone->phonenum,
- );
-
- my $rdid = $r->{did};
-
- if ( $rdid->{'statuscode'} != 100 ) {
- return "Error running globalpop releaseDID: ".
- $rdid->{'statuscode'}. ': '. $rdid->{'status'};
- }
-
- '';
-}
-
-sub _export_suspend {
- my( $self, $svc_phone ) = (shift, shift);
- #nop for now
- '';
-}
-
-sub _export_unsuspend {
- my( $self, $svc_phone ) = (shift, shift);
- #nop for now
- '';
-}
-
-#hmm, might forgo queueing entirely for most things, data is too much of a pita
-#sub globalpops_voip_queue {
-# my( $self, $svcnum, $method ) = (shift, shift, shift);
-# my $queue = new FS::queue {
-# 'svcnum' => $svcnum,
-# 'job' => 'FS::part_export::globalpops_voip::globalpops_voip_command',
-# };
-# $queue->insert(
-# $self->option('login'),
-# $self->option('password'),
-# $method,
-# @_,
-# );
-#}
-
-sub globalpops_voip_command {
- my($login, $password, $method, @args) = @_;
-
- eval "use Net::GlobalPOPs::MediaServicesAPI;";
- die $@ if $@;
-
- my $gp = new Net::GlobalPOPs
- 'login' => $login,
- 'password' => $password,
- #'debug' => 1,
- ;
-
- my $return = $gp->$method( @args );
-
- #$return->{'status'}
- #$return->{'statuscode'}
-
- die $return->{'status'} if $return->{'statuscode'};
-
-}
-
-1;
-
diff --git a/FS/FS/part_export/grandstream.pm b/FS/FS/part_export/grandstream.pm
deleted file mode 100644
index 5c6f1ed..0000000
--- a/FS/FS/part_export/grandstream.pm
+++ /dev/null
@@ -1,257 +0,0 @@
-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/http.pm b/FS/FS/part_export/http.pm
deleted file mode 100644
index 3749224..0000000
--- a/FS/FS/part_export/http.pm
+++ /dev/null
@@ -1,151 +0,0 @@
-package FS::part_export::http;
-
-use base qw( FS::part_export );
-use vars qw( %options %info );
-use Tie::IxHash;
-
-tie %options, 'Tie::IxHash',
- 'method' => { label =>'Method',
- type =>'select',
- #options =>[qw(POST GET)],
- options =>[qw(POST)],
- default =>'POST' },
- 'url' => { label => 'URL', default => 'http://', },
- 'insert_data' => {
- label => 'Insert data',
- type => 'textarea',
- default => join("\n",
- 'DomainName $svc_x->domain',
- 'Email ( grep { $_ !~ /^(POST|FAX)$/ } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]',
- 'test 1',
- 'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i',
- ),
- },
- 'delete_data' => {
- label => 'Delete data',
- type => 'textarea',
- default => join("\n",
- ),
- },
- 'replace_data' => {
- label => 'Replace data',
- type => 'textarea',
- default => join("\n",
- ),
- },
- 'success_regexp' => {
- label => 'Success Regexp',
- default => '',
- },
-;
-
-%info = (
- 'svc' => 'svc_domain',
- 'desc' => 'Send an HTTP or HTTPS GET or POST request',
- 'options' => \%options,
- 'notes' => <<'END'
-Send an HTTP or HTTPS GET or POST to the specified URL. For HTTPS support,
-<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a>
-or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a>
-is required.
-END
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my $self = shift;
- $self->_export_command('insert', @_);
-}
-
-sub _export_delete {
- my $self = shift;
- $self->_export_command('delete', @_);
-}
-
-sub _export_command {
- my( $self, $action, $svc_x ) = ( shift, shift, shift );
-
- return unless $self->option("${action}_data");
-
- my $cust_main = $svc_x->table eq 'cust_main'
- ? $svc_x
- : $svc_x->cust_svc->cust_pkg->cust_main;
-
- $self->http_queue( $svc_x->svcnum,
- $self->option('method'),
- $self->option('url'),
- $self->option('success_regexp'),
- map {
- /^\s*(\S+)\s+(.*)$/ or /()()/;
- my( $field, $value_expression ) = ( $1, $2 );
- my $value = eval $value_expression;
- die $@ if $@;
- ( $field, $value );
- } split(/\n/, $self->option("${action}_data") )
- );
-
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = ( shift, shift, shift );
-
- return unless $self->option('replace_data');
-
- my $new_cust_main = $new->table eq 'cust_main'
- ? $new
- : $new->cust_svc->cust_pkg->cust_main;
- my $cust_main = $new_cust_main; #so folks can use $new_cust_main or $cust_main
-
- $self->http_queue( $new->svcnum,
- $self->option('method'),
- $self->option('url'),
- $self->option('success_regexp'),
- map {
- /^\s*(\S+)\s+(.*)$/ or /()()/;
- my( $field, $value_expression ) = ( $1, $2 );
- my $value = eval $value_expression;
- die $@ if $@;
- ( $field, $value );
- } split(/\n/, $self->option('replace_data') )
- );
-
-}
-
-sub http_queue {
- my($self, $svcnum) = (shift, shift);
- my $queue = new FS::queue { 'job' => "FS::part_export::http::http" };
- $queue->svcnum($svcnum) if $svcnum;
- $queue->insert( @_ );
-}
-
-sub http {
- my($method, $url, $success_regexp, @data) = @_;
-
- $method = lc($method);
-
- eval "use LWP::UserAgent;";
- die "using LWP::UserAgent: $@" if $@;
- eval "use HTTP::Request::Common;";
- die "using HTTP::Request::Common: $@" if $@;
-
- my $ua = LWP::UserAgent->new;
-
- #my $response = $ua->$method(
- # $url, \%data,
- # 'Content-Type'=>'application/x-www-form-urlencoded'
- #);
- my $req = HTTP::Request::Common::POST( $url, \@data );
- my $response = $ua->request($req);
-
- die $response->error_as_HTML if $response->is_error;
-
- if(length($success_regexp) > 1) {
- my $response_content = $response->content;
- die $response_content unless $response_content =~ /$success_regexp/;
- }
-
-}
-
-1;
-
diff --git a/FS/FS/part_export/ikano.pm b/FS/FS/part_export/ikano.pm
deleted file mode 100644
index fe645e4..0000000
--- a/FS/FS/part_export/ikano.pm
+++ /dev/null
@@ -1,697 +0,0 @@
-package FS::part_export::ikano;
-
-use strict;
-use warnings;
-use vars qw(@ISA %info %loopType $me);
-use Tie::IxHash;
-use Date::Format qw( time2str );
-use Date::Parse qw( str2time );
-use FS::Record qw(qsearch qsearchs dbh);
-use FS::part_export;
-use FS::svc_dsl;
-use Data::Dumper;
-
-@ISA = qw(FS::part_export);
-$me= '[' . __PACKAGE__ . ']';
-
-tie my %options, 'Tie::IxHash',
- 'keyid' => { label=>'Ikano keyid' },
- 'username' => { label=>'Ikano username',
- default => 'admin',
- },
- 'password' => { label=>'Ikano password' },
- 'check_networks' => { label => 'Check Networks',
- default => 'ATT,BELLCA',
- },
- 'debug' => { label => 'Debug Mode', type => 'checkbox' },
-;
-
-%info = (
- 'svc' => 'svc_dsl',
- 'desc' => 'Provision DSL to Ikano',
- 'options' => \%options,
- 'notes' => <<'END'
-Requires installation of
-<a href="http://search.cpan.org/dist/Net-Ikano">Net::Ikano</a> from CPAN.
-END
-);
-
-%loopType = ( '' => 'Line-share', '0' => 'Standalone' );
-
-sub rebless { shift; }
-
-sub external_pkg_map { 1; }
-
-sub dsl_pull {
-# we distinguish between invalid new data (return error) versus data that
-# has legitimately changed (may eventually execute hooks; now just update)
-# if we do add hooks later, we should work on a copy of svc_dsl and pass
-# the old and new svc_dsl to the hooks so they know what changed
-#
-# current assumptions of what won't change (from their side):
-# vendor_order_id, vendor_qual_id, vendor_order_type, pushed, monitored,
-# last_pull, address (from qual), contact info, ProductCustomId
- my($self, $svc_dsl, $threshold) = (shift, shift, shift);
- my $result = $self->valid_order($svc_dsl,'pull');
- return $result unless $result eq '';
-
- my $now = time;
- if($now - $svc_dsl->last_pull < $threshold) {
- warn "$me skipping pull since threshold not reached (svcnum="
- . $svc_dsl->svcnum . ",now=$now,threshold=$threshold,last_pull="
- . $svc_dsl->last_pull .")" if $self->option('debug');
- return '';
- }
-
- $result = $self->ikano_command('ORDERSTATUS',
- { OrderId => $svc_dsl->vendor_order_id } );
- return $result unless ref($result); # scalar (string) is an error
-
- # now we're getting an OrderResponse which should have one Order in it
- warn "$me pull OrderResponse hash:\n".Dumper($result)
- if $self->option('debug');
-
- return 'Invalid order response' unless defined $result->{'Order'};
- $result = $result->{'Order'};
-
- return 'No order id or status returned'
- unless defined $result->{'Status'} && defined $result->{'OrderId'};
-
- 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;
-
- # 1. status
- my $order_status = grep($_ eq $result->{'Status'}, @Net::Ikano::orderStatus)
- ? $result->{'Status'} : '';
- return 'Invalid new status' if $order_status eq '';
- $svc_dsl->vendor_order_status($order_status)
- if($svc_dsl->vendor_order_status ne $order_status);
- $svc_dsl->monitored('')
- if ($order_status eq 'CANCELLED' || $order_status eq 'COMPLETED');
-
- # 2. fields we don't care much about
- my %justUpdate = ( 'first' => 'FirstName',
- 'last' => 'LastName',
- 'company' => 'CompanyName',
- 'username' => 'Username',
- 'password' => 'Password' );
-
- my($fsf, $ikanof);
- while (($fsf, $ikanof) = each %justUpdate) {
- $svc_dsl->$fsf($result->{$ikanof})
- if $result->{$ikanof} ne $svc_dsl->$fsf;
- }
-
- # let's look inside the <Product> response element
- my @product = $result->{'Product'};
- return 'Invalid number of products on order' if scalar(@product) != 1;
- my $product = $result->{'Product'}[0];
-
- # 3. phonenum
- if($svc_dsl->loop_type eq '') { # line-share
-# TN may change only if sub changes it and New or Change order in Completed status
- my $tn = $product->{'PhoneNumber'};
- if($tn ne $svc_dsl->phonenum) {
- if( ($svc_dsl->vendor_order_type eq 'NEW'
- || $svc_dsl->vendor_order_type eq 'CHANGE')
- && $svc_dsl->vendor_order_status eq 'COMPLETED' ) {
- $svc_dsl->phonenum($tn);
- }
- else { return 'TN has changed in an invalid state'; }
- }
- }
- elsif($svc_dsl->loop_type eq '0') { # dry loop
-# TN may change only if it's assigned while a New or Change order is in progress
- return 'Invalid PhoneNumber value for a dry loop'
- if $product->{'PhoneNumber'} ne 'STANDALONE';
- my $tn = $product->{'VirtualPhoneNumber'};
- if($tn ne $svc_dsl->phonenum) {
- if( ($svc_dsl->vendor_order_type eq 'NEW'
- || $svc_dsl->vendor_order_type eq 'CHANGE')
- && $svc_dsl->vendor_order_status ne 'COMPLETED'
- && $svc_dsl->vendor_order_status ne 'CANCELLED') {
- $svc_dsl->phonenum($tn);
- }
- else { return 'TN has changed in an invalid state'; }
- }
- }
-
- # 4. desired_due_date - may change if manually changed
- if($svc_dsl->vendor_order_type eq 'NEW'
- || $svc_dsl->vendor_order_type eq 'CHANGE'){
- my $f = str2time($product->{'DateToOrder'});
- return 'Invalid DateToOrder' unless $f;
- $svc_dsl->desired_due_date($f) if $svc_dsl->desired_due_date ne $f;
- # XXX: optionally sync back to start_date or whatever...
- }
- elsif($svc_dsl->vendor_order_type eq 'CANCEL'){
- my $f = str2time($product->{'DateToDisconnect'});
- return 'Invalid DateToDisconnect' unless $f;
- $svc_dsl->desired_due_date($f) if $svc_dsl->desired_due_date ne $f;
- # XXX: optionally sync back to expire or whatever...
- }
-
- # 5. due_date
- if($svc_dsl->vendor_order_type eq 'NEW'
- || $svc_dsl->vendor_order_type eq 'CHANGE') {
- my $f = str2time($product->{'ActivationDate'});
- if($svc_dsl->vendor_order_status ne 'NEW'
- && $svc_dsl->vendor_order_status ne 'CANCELLED') {
- return 'Invalid ActivationDate' unless $f;
- $svc_dsl->due_date($f) if $svc_dsl->due_date ne $f;
- }
- }
- # Ikano API does not implement the proper disconnect date,
- # so we can't do anything about it
-
- # 6. staticips - for now just comma-separate them
- my $tstatics = $result->{'StaticIps'};
- my @istatics = defined $tstatics ? @$tstatics : ();
- my $ostatics = $svc_dsl->staticips;
- my @ostatics = split(',',$ostatics);
- # more horrible search/sync code below...
- my $staticsChanged = 0;
- foreach my $istatic ( @istatics ) { # they have, we don't
- unless ( grep($_ eq $istatic, @ostatics) ) {
- push @ostatics, $istatic;
- $staticsChanged = 1;
- }
- }
- for(my $i=0; $i < scalar(@ostatics); $i++) {
- unless ( grep($_ eq $ostatics[$i], @istatics) ) {
- splice(@ostatics,$i,1);
- $i--;
- $staticsChanged = 1;
- }
- }
- $svc_dsl->staticips(join(',',@ostatics)) if $staticsChanged;
-
- # 7. notes - put them into the common format and compare
- my $tnotes = $result->{'OrderNotes'};
- my @tnotes = defined $tnotes ? @$tnotes : ();
- my @inotes = (); # all Ikano OrderNotes as FS::dsl_note objects
- my $notesChanged = 0;
- foreach my $tnote ( @tnotes ) {
- my $inote = $self->ikano2fsnote($tnote,$svc_dsl->svcnum);
- return 'Cannot parse note' unless ref($inote);
- push @inotes, $inote;
- }
- my @onotes = $svc_dsl->notes;
- # assume notes we already have don't change & no notes added from our side
- # so using the horrible code below just find what we're missing and add it
- my $error;
- foreach my $inote ( @inotes ) {
- my $found = 0;
- foreach my $onote ( @onotes ) {
- if($onote->date == $inote->date && $onote->note eq $inote->note) {
- $found = 1;
- last;
- }
- }
- $error = $inote->insert unless ( $found );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Cannot add note: $error";
- }
- }
-
- $svc_dsl->last_pull((time));
- local $FS::svc_Common::noexport_hack = 1;
- $error = $svc_dsl->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Cannot update DSL data: $error";
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-sub ikano2fsnote {
- my($self,$n,$svcnum) = (shift,shift,shift);
- my @ikanoRequired = qw( HighPriority StaffId Date Text CompanyStaffId );
- return '' unless defined $n->{'HighPriority'}
- && defined $n->{'StaffId'}
- && defined $n->{'CompanyStaffId'}
- && defined $n->{'Date'}
- && defined $n->{'Text'}
- ;
- my $by = 'Unknown';
- $by = "Ikano" if $n->{'CompanyStaffId'} == -1 && $n->{'StaffId'} != -1;
- $by = "Us" if $n->{'StaffId'} == -1 && $n->{'CompanyStaffId'} != -1;
-
- new FS::dsl_note( {
- 'svcnum' => $svcnum,
- 'author' => $by,
- 'priority' => $n->{'HighPriority'} eq 'false' ? 'N' : 'H',
- '_date' => int(str2time($n->{'Date'})),
- 'note' => $n->{'Text'},
- } );
-}
-
-sub qual {
- my($self,$qual) = (shift,shift);
-# address always required for Ikano qual, TN optional (assume dry if not given)
-
- my %location_hash = $qual->location;
- return 'No address provided' unless %location_hash;
- my $svctn = $qual->phonenum;
-
- my $result = $self->ikano_command('PREQUAL',
- { AddressLine1 => $location_hash{address1},
- AddressUnitType => $location_hash{location_type},
- AddressUnitValue => $location_hash{location_number},
- AddressCity => $location_hash{city},
- AddressState => $location_hash{state},
- ZipCode => $location_hash{zip},
- Country => $location_hash{country},
- LocationType => $location_hash{location_kind},
- PhoneNumber => length($svctn) > 1 ? $svctn : "STANDALONE",
- RequestClientIP => '127.0.0.1',
- CheckNetworks => $self->option('check_networks'),
- } );
- return $result unless ref($result); # error case
- return 'Invalid prequal response' unless defined $result->{'PrequalId'};
-
- my $qoptions = {};
- # lame data structure traversal...
- # don't spend much time here, just get TermsId and ProductCustomId
- my $networks = $result->{'Network'};
- my @networks = defined $networks ? @$networks : ();
- my $netcount = 0;
- foreach my $network ( @networks ) {
- my $productgroups = $network->{'ProductGroup'};
- my @productgroups = defined $productgroups ? @$productgroups : ();
- my $pgcount = 0;
- foreach my $productgroup ( @productgroups ) {
- my $prefix = "ikano_Network_$netcount"."_ProductGroup_$pgcount"."_";
- $qoptions->{$prefix."TermsId"} = $productgroup->{'TermsId'};
- my $products = $productgroup->{'Product'};
- my @products = defined $products ? @$products : ();
- my $prodcount = 0;
- foreach my $product ( @products ) {
- $qoptions->{$prefix."Product_$prodcount"."_ProductCustomId"} = $product->{'ProductCustomId'};
- $prodcount++;
- }
- $pgcount++;
- }
- $netcount++;
- }
-
- { 'vendor_qual_id' => $result->{'PrequalId'},
- 'status' => scalar(@networks) ? 'Q' : 'D',
- 'options' => $qoptions,
- };
-}
-
-sub qual_html {
- my($self,$qual) = (shift,shift);
-
- my %qual_options = $qual->options;
- my @externalids = ();
- my( $optionname, $optionvalue );
- while (($optionname, $optionvalue) = each %qual_options) {
- push @externalids, $optionvalue
- if ( $optionname =~ /^ikano_Network_(\d+)_ProductGroup_(\d+)_Product_(\d+)_ProductCustomId$/
- && $optionvalue ne '' );
- }
-
- # XXX: eventually perhaps this should return both the packages a link to
- # order each package and go to the svc prov with the prequal id filled in
- # but only if cust, not prospect!
- my $list = "<B>Qualifying Packages:</B><UL>";
- my @part_pkgs = qsearch( 'part_pkg', { 'disabled' => '' } );
- foreach my $part_pkg ( @part_pkgs ) {
- my %vendor_pkg_ids = $part_pkg->vendor_pkg_ids;
- my $externalid = $vendor_pkg_ids{$self->exportnum}
- if defined $vendor_pkg_ids{$self->exportnum};
- if ( $externalid ) {
- $list .= "<LI>".$part_pkg->pkgpart.": ".$part_pkg->pkg." - "
- .$part_pkg->comment."</LI>"
- if grep( $_ eq $externalid, @externalids );
- }
- }
- $list .= "</UL>";
- $list;
-}
-
-sub notes_html {
- my($self,$svc_dsl) = (shift,shift);
- my $conf = new FS::Conf;
- my $date_format = $conf->config('date_format') || '%m/%d/%Y';
- my @notes = $svc_dsl->notes;
- my $html = '<TABLE border="1" cellspacing="2" cellpadding="2" id="dsl_notes">
- <TR><TH>Date</TH><TH>By</TH><TH>Priority</TH><TH>Note</TH></TR>';
- foreach my $note ( @notes ) {
- $html .= "<TR>
- <TD>".time2str("$date_format %H:%M",$note->date)."</TD>
- <TD>".$note->by."</TD>
- <TD>". ($note->priority eq 'N' ? 'Normal' : 'High') ."</TD>
- <TD>".$note->note."</TD></TR>";
- }
- $html .= '</TABLE>';
- $html;
-}
-
-sub loop_type_long { # sub, not a method
- my($svc_dsl) = (shift);
- return $loopType{$svc_dsl->loop_type};
-}
-
-sub ikano_command {
- my( $self, $command, $args ) = @_;
-
- $self->loadmod;
-
- my $ikano = Net::Ikano->new(
- 'keyid' => $self->option('keyid'),
- 'username' => $self->option('username'),
- 'password' => $self->option('password'),
- 'debug' => $self->option('debug'),
- );
-
- $ikano->$command($args);
-}
-
-sub loadmod {
- eval "use Net::Ikano;";
- die $@ if $@;
-}
-
-sub valid_order {
- my( $self, $svc_dsl, $action ) = (shift, shift, shift);
-
- $self->loadmod;
-
- warn "$me valid_order action=$action svc_dsl:\n". Dumper($svc_dsl)
- if $self->option('debug');
-
- # common to all order types/status/loop_type
- my $error = !($svc_dsl->desired_due_date
- && grep($_ eq $svc_dsl->vendor_order_type, Net::Ikano->orderTypes)
- && $svc_dsl->first
- && $svc_dsl->last
- && defined $svc_dsl->loop_type
- && $svc_dsl->vendor_qual_id
- );
- return 'Missing or invalid order data' if $error;
-
- my %vendor_pkg_ids = $svc_dsl->cust_svc->cust_pkg->part_pkg->vendor_pkg_ids;
- return 'Package does not have an external id configured'
- unless defined $vendor_pkg_ids{$self->exportnum};
-
- return 'No valid qualification for this order'
- unless qsearch( 'qual', { 'vendor_qual_id' => $svc_dsl->vendor_qual_id });
-
- # now go by order type
- # weird ifs & long lines for readability and ease of understanding - don't change
- if($svc_dsl->vendor_order_type eq 'NEW') {
- if($svc_dsl->pushed) {
- $error = !( ($action eq 'pull' || $action eq 'statuschg'
- || $action eq 'delete' || $action eq 'expire')
- && length($svc_dsl->vendor_order_id) > 0
- && length($svc_dsl->vendor_order_status) > 0
- );
- return 'Invalid order data' if $error;
-
- return 'Phone number required for status change'
- if ($action eq 'statuschg' && length($svc_dsl->phonenum) < 1);
- }
- else { # unpushed New order - cannot do anything other than push it
- $error = !($action eq 'insert'
- && length($svc_dsl->vendor_order_id) < 1
- && length($svc_dsl->vendor_order_status) < 1
- && ( ($svc_dsl->phonenum eq '' && $svc_dsl->loop_type eq '0') # dry
- || ($svc_dsl->phonenum ne '' && $svc_dsl->loop_type eq '') # line-share
- )
- );
- return 'Invalid order data' if $error;
- }
- }
- elsif($svc_dsl->vendor_order_type eq 'CANCEL') {
- }
- elsif($svc_dsl->vendor_order_type eq 'CHANGE') {
- }
-
- '';
-}
-
-sub qual2termsid {
- my ($self,$vendor_qual_id,$ProductCustomId) = (shift,shift,shift);
- my $qual = qsearchs( 'qual', { 'vendor_qual_id' => $vendor_qual_id });
- return '' unless $qual;
- my %qual_options = $qual->options;
- my( $optionname, $optionvalue );
- while (($optionname, $optionvalue) = each %qual_options) {
- if ( $optionname =~ /^ikano_Network_(\d+)_ProductGroup_(\d+)_Product_(\d+)_ProductCustomId$/
- && $optionvalue eq $ProductCustomId ) {
- my $network = $1;
- my $productgroup = $2;
- return $qual->option("ikano_Network_".$network."_ProductGroup_".$productgroup."_TermsId");
- }
- }
- '';
-}
-
-sub _export_insert {
- my( $self, $svc_dsl ) = (shift, shift);
-
- my $result = $self->valid_order($svc_dsl,'insert');
- return $result unless $result eq '';
-
- my $isp_chg = $svc_dsl->isp_chg eq 'Y' ? 'YES' : 'NO';
- my $contactTN = $svc_dsl->cust_svc->cust_pkg->cust_main->daytime;
- $contactTN =~ s/[^0-9]//g;
-
- my %vendor_pkg_ids = $svc_dsl->cust_svc->cust_pkg->part_pkg->vendor_pkg_ids;
- my $ProductCustomId = $vendor_pkg_ids{$self->exportnum};
-
- my $args = {
- orderType => 'NEW',
- ProductCustomId => $ProductCustomId,
- TermsId => $self->qual2termsid($svc_dsl->vendor_qual_id,$ProductCustomId),
- DSLPhoneNumber => $svc_dsl->loop_type eq '0' ? 'STANDALONE'
- : $svc_dsl->phonenum,
- Password => $svc_dsl->password,
- PrequalId => $svc_dsl->vendor_qual_id,
- CompanyName => $svc_dsl->company,
- FirstName => $svc_dsl->first,
- LastName => $svc_dsl->last,
- MiddleName => '',
- ContactMethod => 'PHONE',
- ContactPhoneNumber => $contactTN,
- ContactEmail => 'x@x.xx',
- ContactFax => '',
- DateToOrder => time2str("%Y-%m-%d",$svc_dsl->desired_due_date),
- RequestClientIP => '127.0.0.1',
- IspChange => $isp_chg,
- IspPrevious => $isp_chg eq 'YES' ? $svc_dsl->isp_prev : '',
- CurrentProvider => $isp_chg eq 'NO' ? $svc_dsl->isp_prev : '',
- };
-
- $result = $self->ikano_command('ORDER',$args);
- return $result unless ref($result); # scalar (string) is an error
-
- # now we're getting an OrderResponse which should have one Order in it
- warn "$me _export_insert OrderResponse hash:\n".Dumper($result)
- if $self->option('debug');
-
- return 'Invalid order response' unless defined $result->{'Order'};
- $result = $result->{'Order'};
-
- return 'No/invalid order id or status returned'
- unless defined $result->{'Status'} && defined $result->{'OrderId'}
- && grep($_ eq $result->{'Status'}, @Net::Ikano::orderStatus);
-
- $svc_dsl->pushed(time);
- $svc_dsl->last_pull((time)+1);
- $svc_dsl->vendor_order_id($result->{'OrderId'});
- $svc_dsl->vendor_order_status($result->{'Status'});
- $svc_dsl->username($result->{'Username'});
- local $FS::svc_Common::noexport_hack = 1;
- $result = $svc_dsl->replace;
- return "Error setting DSL fields: $result" if $result;
- '';
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
-# XXX only supports password changes now, but should return error if
-# another change is attempted?
-
- if($new->password ne $old->password) {
- my $result = $self->valid_order($new,'statuschg');
- return $result unless $result eq '';
-
- $result = $self->ikano_command('PASSWORDCHANGE',
- { DSLPhoneNumber => $new->phonenum,
- NewPassword => $new->password,
- } );
- return $result unless ref($result); # scalar (string) is an error
-
- return 'Error changing password' unless defined $result->{'Password'}
- && $result->{'Password'} eq $new->password;
- }
-
- '';
-}
-
-sub _export_delete {
- my( $self, $svc_dsl ) = (shift, shift);
-
- my $result = $self->valid_order($svc_dsl,'delete');
- return $result unless $result eq '';
-
- # for now allow an immediate cancel only on New orders in New/Pending status
- #XXX: add support for Change and Cancel orders in New/Pending status later
-
- if($svc_dsl->vendor_order_type eq 'NEW') {
- if($svc_dsl->vendor_order_status eq 'NEW'
- || $svc_dsl->vendor_order_status eq 'PENDING') {
- my $result = $self->ikano_command('CANCEL',
- { OrderId => $svc_dsl->vendor_order_id, } );
- return $result unless ref($result); # scalar (string) is an error
- return 'Unable to cancel order' unless $result->{'Order'};
- $result = $result->{'Order'};
- return 'Invalid cancellation response'
- unless $result->{'Status'} eq 'CANCELLED'
- && $result->{'OrderId'} eq $svc_dsl->vendor_order_id;
-
- # we're supposed to do a pull, but it will break everything, so don't
- # this is very wrong...
- }
- else {
- return "Cannot cancel a NEW order unless it's in NEW or PENDING status";
- }
- }
- elsif($svc_dsl->vendor_order_type eq 'CANCEL') {
- return 'Cannot cancel a CANCEL order unless expire was set'
- unless $svc_dsl->cust_svc->cust_pkg->expire > 0;
- }
- else {
- return 'Canceling orders other than NEW orders is not currently implemented';
- }
-
- '';
-}
-
-sub export_expire {
- my($self, $svc_dsl, $date) = (shift, shift, shift);
-
- my $result = $self->valid_order($svc_dsl,'expire');
- return $result unless $result eq '';
-
- # for now allow a proper cancel only on New orders in Completed status
- #XXX: add support for some other cases in future
-
- if($svc_dsl->vendor_order_type eq 'NEW'
- && $svc_dsl->vendor_order_status eq 'COMPLETED') {
-
- my $contactTN = $svc_dsl->cust_svc->cust_pkg->cust_main->daytime;
- $contactTN =~ s/[^0-9]//g;
-
- my %vendor_pkg_ids = $svc_dsl->cust_svc->cust_pkg->part_pkg->vendor_pkg_ids;
- my $ProductCustomId = $vendor_pkg_ids{$self->exportnum};
-
- # we are now a cancel order
- $svc_dsl->desired_due_date($date);
- $svc_dsl->vendor_order_type('CANCEL');
-
- my $args = {
- orderType => 'CANCEL',
- ProductCustomId => $ProductCustomId,
- TermsId => $self->qual2termsid($svc_dsl->vendor_qual_id,$ProductCustomId),
- DSLPhoneNumber => $svc_dsl->loop_type eq '0' ? 'STANDALONE'
- : $svc_dsl->phonenum,
- Password => $svc_dsl->password,
- PrequalId => $svc_dsl->vendor_qual_id,
- CompanyName => $svc_dsl->company,
- FirstName => $svc_dsl->first,
- LastName => $svc_dsl->last,
- MiddleName => '',
- ContactMethod => 'PHONE',
- ContactPhoneNumber => $contactTN,
- ContactEmail => 'x@x.xx',
- ContactFax => '',
- DateToOrder => time2str("%Y-%m-%d",$date),
- RequestClientIP => '127.0.0.1',
- IspChange => 'NO',
- IspPrevious => '',
- CurrentProvider => '',
- };
-
- $args->{'VirtualPhoneNumber'} = $svc_dsl->phonenum
- if $svc_dsl->loop_type eq '0';
-
- $result = $self->ikano_command('ORDER',$args);
- return $result unless ref($result); # scalar (string) is an error
-
- # now we're getting an OrderResponse which should have one Order in it
- warn "$me _export_insert OrderResponse hash:\n".Dumper($result)
- if $self->option('debug');
-
- return 'Invalid order response' unless defined $result->{'Order'};
- $result = $result->{'Order'};
-
- return 'No/invalid order id or status returned'
- unless defined $result->{'Status'} && defined $result->{'OrderId'}
- && grep($_ eq $result->{'Status'}, @Net::Ikano::orderStatus);
-
- $svc_dsl->pushed(time);
- $svc_dsl->last_pull((time)+1);
- $svc_dsl->vendor_order_id($result->{'OrderId'});
- $svc_dsl->vendor_order_status($result->{'Status'});
- $svc_dsl->monitored('Y');
- local $FS::svc_Common::noexport_hack = 1;
- $result = $svc_dsl->replace;
- return "Error setting DSL fields: $result" if $result;
- }
- else {
- return "Cancelling anything other than NEW orders in COMPLETED status is "
- . "not currently implemented";
- }
- '';
-}
-
-sub statuschg {
- my( $self, $svc_dsl, $type ) = (shift, shift, shift);
-
- my $result = $self->valid_order($svc_dsl,'statuschg');
- return $result unless $result eq '';
-
- # get the DSLServiceId
- $result = $self->ikano_command('CUSTOMERLOOKUP',
- { PhoneNumber => $svc_dsl->phonenum } );
- return $result unless ref($result); # scalar (string) is an error
- return 'No DSLServiceId found' unless defined $result->{'DSLServiceId'};
- my $DSLServiceId = $result->{'DSLServiceId'};
-
- $result = $self->ikano_command('ACCOUNTSTATUSCHANGE',
- { DSLPhoneNumber => $svc_dsl->phonenum,
- DSLServiceId => $DSLServiceId,
- type => $type,
- } );
- return $result unless ref($result); # scalar (string) is an error
- '';
-}
-
-sub _export_suspend {
- my( $self, $svc_dsl ) = (shift, shift);
- $self->statuschg($svc_dsl,"SUSPEND");
-}
-
-sub _export_unsuspend {
- my( $self, $svc_dsl ) = (shift, shift);
- $self->statuschg($svc_dsl,"UNSUSPEND");
-}
-
-1;
diff --git a/FS/FS/part_export/indosoft.pm b/FS/FS/part_export/indosoft.pm
deleted file mode 100644
index b573401..0000000
--- a/FS/FS/part_export/indosoft.pm
+++ /dev/null
@@ -1,219 +0,0 @@
-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/infostreet.pm b/FS/FS/part_export/infostreet.pm
deleted file mode 100644
index ef16c7c..0000000
--- a/FS/FS/part_export/infostreet.pm
+++ /dev/null
@@ -1,277 +0,0 @@
-package FS::part_export::infostreet;
-
-use vars qw(@ISA %info %infostreet2cust_main $DEBUG);
-use Tie::IxHash;
-use FS::UID qw(dbh);
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'url' => { label=>'XML-RPC Access URL', },
- 'login' => { label=>'InfoStreet login', },
- 'password' => { label=>'InfoStreet password', },
- 'groupID' => { label=>'InfoStreet groupID', },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to InfoStreet streetSmartAPI',
- 'options' => \%options,
- 'nodomain' => 'Y',
- 'notes' => <<'END'
-Real-time export to
-<a href="http://www.infostreet.com/">InfoStreet</a> streetSmartAPI.
-Requires installation of
-<a href="http://search.cpan.org/dist/Frontier-Client">Frontier::Client</a> from CPAN.
-END
-);
-
-$DEBUG = 0;
-
-%infostreet2cust_main = (
- 'firstName' => 'first',
- 'lastName' => 'last',
- 'address1' => 'address1',
- 'address2' => 'address2',
- 'city' => 'city',
- 'state' => 'state',
- 'zipCode' => 'zip',
- 'country' => 'country',
- 'phoneNumber' => 'daytime',
- 'faxNumber' => 'night', #noment-request...
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my( $self, $svc_acct ) = (shift, shift);
- my $cust_main = $svc_acct->cust_svc->cust_pkg->cust_main;
-
- 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 $err_or_queue = $self->infostreet_err_or_queue( $svc_acct->svcnum,
- 'createUser', $svc_acct->username, $svc_acct->_password );
- return $err_or_queue unless ref($err_or_queue);
- my $jobnum = $err_or_queue->jobnum;
-
- my %contact_info = ( map {
- $_ => $cust_main->getfield( $infostreet2cust_main{$_} );
- } keys %infostreet2cust_main );
-
- my @emails = grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list;
- $contact_info{'email'} = $emails[0] if @emails;
-
- #this one is kinda noment-specific
- $contact_info{'organization'} = $cust_main->agent->agent;
-
- $err_or_queue = $self->infostreet_queueContact( $svc_acct->svcnum,
- $svc_acct->username, %contact_info );
- return $err_or_queue unless ref($err_or_queue);
-
- # If a quota has been specified set the quota because it is not the default
- $err_or_queue = $self->infostreet_queueSetQuota( $svc_acct->svcnum,
- $svc_acct->username, $svc_acct->quota ) if $svc_acct->quota;
- return $err_or_queue unless ref($err_or_queue);
-
- my $error = $err_or_queue->depend_insert( $jobnum );
- return $error if $error;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
- return "can't change username with InfoStreet"
- if $old->username ne $new->username;
-
- # If the quota has changed then do the export to setQuota
- my $err_or_queue = $self->infostreet_queueSetQuota( $new->svcnum, $new->username, $new->quota )
- if ( $old->quota != $new->quota );
- return $err_or_queue unless ref($err_or_queue);
-
-
- return '' unless $old->_password ne $new->_password;
- $self->infostreet_queue( $new->svcnum,
- 'passwd', $new->username, $new->_password );
-}
-
-sub _export_delete {
- my( $self, $svc_acct ) = (shift, shift);
- $self->infostreet_queue( $svc_acct->svcnum,
- 'purgeAccount,releaseUsername', $svc_acct->username );
-}
-
-sub _export_suspend {
- my( $self, $svc_acct ) = (shift, shift);
- $self->infostreet_queue( $svc_acct->svcnum,
- 'setStatus', $svc_acct->username, 'DISABLED' );
-}
-
-sub _export_unsuspend {
- my( $self, $svc_acct ) = (shift, shift);
- $self->infostreet_queue( $svc_acct->svcnum,
- 'setStatus', $svc_acct->username, 'ACTIVE' );
-}
-
-sub infostreet_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => 'FS::part_export::infostreet::infostreet_command',
- };
- $queue->insert(
- $self->option('url'),
- $self->option('login'),
- $self->option('password'),
- $self->option('groupID'),
- $method,
- @_,
- );
-}
-
-#ick false laziness
-sub infostreet_err_or_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => 'FS::part_export::infostreet::infostreet_command',
- };
- $queue->insert(
- $self->option('url'),
- $self->option('login'),
- $self->option('password'),
- $self->option('groupID'),
- $method,
- @_,
- ) or $queue;
-}
-
-sub infostreet_queueContact {
- my( $self, $svcnum ) = (shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => 'FS::part_export::infostreet::infostreet_setContact',
- };
- $queue->insert(
- $self->option('url'),
- $self->option('login'),
- $self->option('password'),
- $self->option('groupID'),
- @_,
- ) or $queue;
-}
-
-sub infostreet_setContact {
- my($url, $is_username, $is_password, $groupID, $username, %contact_info) = @_;
- my $accountID = infostreet_command($url, $is_username, $is_password, $groupID,
- 'getAccountID', $username);
- foreach my $field ( keys %contact_info ) {
- infostreet_command($url, $is_username, $is_password, $groupID,
- 'setContactField', [ 'int'=>$accountID ], $field, $contact_info{$field} );
- }
-
-}
-
-sub infostreet_queueSetQuota {
-
- my( $self, $svcnum) = (shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => 'FS::part_export::infostreet::infostreet_setQuota',
- };
-
- $queue->insert(
- $self->option('url'),
- $self->option('login'),
- $self->option('password'),
- $self->option('groupID'),
- @_,
- ) or $queue;
-
-}
-
-sub infostreet_setQuota {
- my($url, $is_username, $is_password, $groupID, $username, $quota) = @_;
- infostreet_command($url, $is_username, $is_password, $groupID, 'setQuota', $username, [ 'int'=> $quota ] );
-}
-
-
-sub infostreet_command { #subroutine, not method
- my($url, $username, $password, $groupID, $method, @args) = @_;
-
- warn "[FS::part_export::infostreet] $method ".join(' ', @args)."\n" if $DEBUG;
-
- #quelle hack
- if ( $method =~ /,/ ) {
- foreach my $part ( split(/,\s*/, $method) ) {
- infostreet_command($url, $username, $password, $groupID, $part, @args);
- }
- return;
- }
-
- eval "use Frontier::Client;";
- die $@ if $@;
-
- eval 'sub Frontier::RPC2::String::repr {
- my $self = shift;
- my $value = $$self;
- $value =~ s/([&<>\"])/$Frontier::RPC2::char_entities{$1}/ge;
- $value;
- }';
- die $@ if $@;
-
- my $conn = Frontier::Client->new( url => $url );
- my $key_result = $conn->call( 'authenticate', $username, $password, $groupID);
- my %key_result = _infostreet_parse($key_result);
- die $key_result{error} unless $key_result{success};
- my $key = $key_result{data};
-
- #my $result = $conn->call($method, $key, @args);
- my $result = $conn->call( $method, $key,
- map {
- if ( ref($_) ) {
- my( $type, $value) = @{$_};
- $conn->$type($value);
- } else {
- $conn->string($_);
- }
- } @args );
- my %result = _infostreet_parse($result);
- die $result{error} unless $result{success};
-
- $result->{data};
-
-}
-
-#sub infostreet_command_byid { #subroutine, not method;
-# my($url, $username, $password, $groupID, $method, @args ) = @_;
-#
-# infostreet_command
-#
-#}
-
-sub _infostreet_parse { #subroutine, not method
- my $arg = shift;
- map {
- my $value = $arg->{$_};
- #warn ref($value);
- $value = $value->value()
- if ref($value) && $value->isa('Frontier::RPC2::DataType');
- $_=>$value;
- } keys %$arg;
-}
-
-1;
-
diff --git a/FS/FS/part_export/internal_diddb.pm b/FS/FS/part_export/internal_diddb.pm
deleted file mode 100644
index a330cb0..0000000
--- a/FS/FS/part_export/internal_diddb.pm
+++ /dev/null
@@ -1,134 +0,0 @@
-package FS::part_export::internal_diddb;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::Record qw(qsearch qsearchs);
-use FS::part_export;
-use FS::phone_avail;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'countrycode' => { label => 'Country code', 'default' => '1', },
-;
-
-%info = (
- 'svc' => 'svc_phone',
- 'desc' => 'Provision phone numbers from the internal DID database',
- 'notes' => 'After adding the export, DIDs may be imported under Tools -> Importing -> Import phone numbers (DIDs)',
- 'options' => \%options,
-);
-
-sub rebless { shift; }
-
-sub get_dids {
- my $self = shift;
- my %opt = ref($_[0]) ? %{$_[0]} : @_;
-
- my %hash = ( 'countrycode' => ( $self->option('countrycode') || '1' ),
- 'exportnum' => $self->exportnum,
- 'svcnum' => '',
- );
-
- if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers
-
- $hash{npa} = $opt{areacode};
- $hash{nxx} = $opt{exchange};
-
- return [ map { $_->npa. '-'. $_->nxx. '-'. $_->station }
- qsearch({ 'table' => 'phone_avail',
- 'hashref' => \%hash,
- 'order_by' => 'ORDER BY station',
- })
- ];
-
- } elsif ( $opt{'areacode'} ) { #return city (npa-nxx-XXXX)
-
- $hash{npa} = $opt{areacode};
-
- return [ map { '('. $_->npa. '-'. $_->nxx. '-XXXX)' }
- qsearch({ 'select' => 'DISTINCT npa, nxx',
- 'table' => 'phone_avail',
- 'hashref' => \%hash,
- 'order_by' => 'ORDER BY nxx',
- })
- ];
-
- } elsif ( $opt{'state'} ) { #return aracodes
-
- $hash{state} = $opt{state};
-
- return [ map { $_->npa }
- qsearch({ 'select' => 'DISTINCT npa',
- 'table' => 'phone_avail',
- 'hashref' => \%hash,
- 'order_by' => 'ORDER BY npa',
- })
- ];
-
- } else {
- die "FS::part_export::internal_diddb::get_dids called without options\n";
- }
-
-}
-
-sub _export_insert { #link phone_avail to svcnum
- my( $self, $svc_phone ) = (shift, shift);
-
- $svc_phone->phonenum =~ /^(\d{3})(\d{3})(\d+)$/
- or return "unparsable phone number: ". $svc_phone->phonenum;
- my( $npa, $nxx, $station ) = ($1, $2, $3);
-
- my $phone_avail = qsearchs('phone_avail', {
- 'countrycode' => ( $self->option('countrycode') || '1' ),
- 'exportnum' => $self->exportnum,
- 'svcnum' => '',
- 'npa' => $npa,
- 'nxx' => $nxx,
- 'station' => $station,
- });
-
- return "number not available: ". $svc_phone->phonenum
- unless $phone_avail;
-
- $phone_avail->svcnum($svc_phone->svcnum);
-
- $phone_avail->replace;
-
-}
-
-sub _export_delete { #unlink phone_avail from svcnum
- my( $self, $svc_phone ) = (shift, shift);
-
- $svc_phone->phonenum =~ /^(\d{3})(\d{3})(\d+)$/
- or return "unparsable phone number: ". $svc_phone->phonenum;
- my( $npa, $nxx, $station ) = ($1, $2, $3);
-
- my $phone_avail = qsearchs('phone_avail', {
- 'countrycode' => ( $self->option('countrycode') || '1'),
- 'exportnum' => $self->exportnum,
- 'svcnum' => $svc_phone->svcnum,
- #these too?
- 'npa' => $npa,
- 'nxx' => $nxx,
- 'station' => $station,
- });
-
- unless ( $phone_avail ) {
- warn "WARNING: can't find number to return to availability: ".
- $svc_phone->phonenum;
- return;
- }
-
- $phone_avail->svcnum('');
-
- $phone_avail->replace;
-
-}
-
-sub _export_replace { ''; }
-sub _export_suspend { ''; }
-sub _export_unsuspend { ''; }
-
-1;
-
diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm
deleted file mode 100644
index 8385320..0000000
--- a/FS/FS/part_export/ldap.pm
+++ /dev/null
@@ -1,264 +0,0 @@
-package FS::part_export::ldap;
-
-use vars qw(@ISA %info @saltset);
-use Tie::IxHash;
-use FS::Record qw( dbh );
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'dn' => { label=>'Root DN' },
- 'password' => { label=>'Root DN password' },
- 'userdn' => { label=>'User DN' },
- 'key_attrib' => { label=>'Key attribute name',
- default=>'uid' },
- 'attributes' => { label=>'Attributes',
- type=>'textarea',
- default=>join("\n",
- 'uid $username',
- 'mail $username\@$domain',
- 'uidno $uid',
- 'gidno $gid',
- 'cn $first',
- 'sn $last',
- 'mailquota $quota',
- 'vmail',
- 'location',
- 'mailtag',
- 'mailhost',
- 'mailmessagestore $dir',
- 'userpassword $crypt_password',
- 'hint',
- 'answer $sec_phrase',
- 'objectclass top,person,inetOrgPerson',
- ),
- },
- 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to LDAP',
- 'options' => \%options,
- 'notes' => <<'END'
-Real-time export to arbitrary LDAP attributes. Requires installation of
-<a href="http://search.cpan.org/dist/Net-LDAP">Net::LDAP</a> from CPAN.
-END
-);
-
-@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-
-sub rebless { shift; }
-
-sub svc_context_eval {
- # This should possibly be in svc_Common?
- # Except the only places we use it are here and in shellcommands,
- # and it's not even the same version.
- my $svc_acct = shift;
- no strict 'refs';
- ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields;
- ${$_} = $svc_acct->$_() foreach qw( domain ldap_password );
- my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
- if ( $cust_pkg ) {
- my $cust_main = $cust_pkg->cust_main;
- ${$_} = $cust_main->getfield($_) foreach qw(first last);
- }
- # DEPRECATED, probably fails for non-plain password encoding
- $crypt_password = ''; #surpress "used only once" warnings
- $crypt_password = '{crypt}'. crypt( $svc_acct->_password,
- $saltset[int(rand(64))].$saltset[int(rand(64))] );
-
- return map { eval(qq("$_")) } @_ ;
-}
-
-sub key_attrib {
- my $self = shift;
- return $self->option('key_attrib') if $self->option('key_attrib');
- # otherwise, guess that it's the one that's set to $username
- foreach ( split("\n",$self->option('attributes')) ) {
- /^\s*(\w+)\s+\$username\s*$/ && return $1;
- }
- # can't recover from that, but we can fail in a more obvious way
- # than the old code did...
- die "no key_attrib set in LDAP export\n";
-}
-
-sub ldap_attrib {
- # Convert the svc_acct to its LDAP attribute set.
- my($self, $svc_acct) = (shift, shift);
- my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/;
- ( $1 => $2 ); }
- grep { /^\s*(\w+)\s+(.*\S)\s*$/ }
- split("\n", $self->option('attributes'));
-
- my @vals = svc_context_eval($svc_acct, values(%attrib));
- @attrib{keys(%attrib)} = @vals;
-
- if ( $self->option('radius') ) {
- foreach my $table (qw(reply check)) {
- my $method = "radius_$table";
- my %radius = $svc_acct->$method();
- foreach my $radius ( keys %radius ) {
- ( my $ldap = $radius ) =~ s/\-//g;
- $attrib{$ldap} = $radius{$radius};
- }
- }
- }
- return %attrib;
-}
-
-sub _export_insert {
- my($self, $svc_acct) = (shift, shift);
-
- my $err_or_queue = $self->ldap_queue(
- $svc_acct->svcnum,
- 'insert',
- $self->key_attrib,
- $self->ldap_attrib($svc_acct),
- );
- return $err_or_queue unless ref($err_or_queue);
-
- '';
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, 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 $jobnum = '';
-
- # the Lazy way: nuke the entry and recreate it.
- # any reason this shouldn't work? Freeside _has_ to have
- # write access to these entries and their parent DN.
- my $key = $self->key_attrib;
- my %attrib = $self->ldap_attrib($old);
- my $err_or_queue = $self->ldap_queue(
- $old->svcnum,
- 'delete',
- $key,
- $attrib{$key}
- );
- if( !ref($err_or_queue) ) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
- $jobnum = $err_or_queue->jobnum;
- $err_or_queue = $self->ldap_queue(
- $new->svcnum,
- 'insert',
- $key,
- $self->ldap_attrib($new)
- );
- if( !ref($err_or_queue) ) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
- $err_or_queue = $err_or_queue->depend_insert($jobnum);
- if( $err_or_queue ) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-sub _export_delete {
- my( $self, $svc_acct ) = (shift, shift);
-
- my $key = $self->key_attrib;
- my ( $val ) = map { /^\s*$key\s+(.*\S)\s*$/ ? $1 : () }
- split("\n", $self->option('attributes'));
- ( $val ) = svc_context_eval($svc_acct, $val);
- my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'delete',
- $key, $val );
- ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-sub ldap_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::ldap::ldap_$method",
- };
- $queue->insert(
- $self->machine,
- $self->option('dn'),
- $self->option('password'),
- $self->option('userdn'),
- @_,
- ) or $queue;
-}
-
-sub ldap_insert { #subroutine, not method
- my $ldap = ldap_connect(shift, shift, shift);
- my( $userdn, $key_attrib, %attrib ) = @_;
-
- $userdn = "$key_attrib=$attrib{$key_attrib}, $userdn";
- #icky hack, but should be unsurprising to the LDAPers
- foreach my $key ( grep { $attrib{$_} =~ /,/ } keys %attrib ) {
- $attrib{$key} = [ split(/,/, $attrib{$key}) ];
- }
-
- my $status = $ldap->add( $userdn, attrs => [ %attrib ] );
- die 'LDAP error: '. $status->error. "\n" if $status->is_error;
-
- $ldap->unbind;
-}
-
-sub ldap_delete {
- my $ldap = ldap_connect(shift, shift, shift);
-
- my $entry = ldap_fetch($ldap, @_);
- if($entry) {
- my $status = $ldap->delete($entry);
- die 'LDAP error: '.$status->error."\n" if $status->is_error;
- }
- $ldap->unbind;
- # should failing to find the entry be fatal?
- # if it is, it will block unprovisioning the service, which is a pain.
-}
-
-sub ldap_fetch {
- # avoid needless duplication in delete and modify
- my( $ldap, $userdn, %key_data ) = @_;
- my $filter = join('', map { "($_=$key_data{$_})" } keys(%key_data));
-
- my $status = $ldap->search( base => $userdn,
- scope => 'one',
- filter => $filter );
- die 'LDAP error: '.$status->error."\n" if $status->is_error;
- my ($entry) = $status->entries;
- warn "Entry '$filter' not found in LDAP\n" if !$entry;
- return $entry;
-}
-
-sub ldap_connect {
- my( $machine, $dn, $password ) = @_;
- my %bind_options;
- $bind_options{password} = $password if length($password);
-
- eval "use Net::LDAP";
- die $@ if $@;
-
- my $ldap = Net::LDAP->new($machine) or die $@;
- my $status = $ldap->bind( $dn, %bind_options );
- die 'LDAP error: '. $status->error. "\n" if $status->is_error;
-
- $ldap;
-}
-
-1;
-
diff --git a/FS/FS/part_export/nas_wrapper.pm b/FS/FS/part_export/nas_wrapper.pm
deleted file mode 100644
index 2499ba3..0000000
--- a/FS/FS/part_export/nas_wrapper.pm
+++ /dev/null
@@ -1,311 +0,0 @@
-package FS::part_export::nas_wrapper;
-
-=head1 FS::part_export::nas_wrapper
-
-This is a meta-export that triggers other exports for FS::svc_broadband objects
-based on a set of configurable conditions. These conditions are defined by the
-following FS::router virtual fields:
-
-=over 4
-
-=item nas_conf - Per-router meta-export configuration. See L</"nas_conf Syntax">.
-
-=back
-
-=head2 nas_conf Syntax
-
-export_name|routernum[,routernum]|[field,condition[,field,condition]][||...]
-
-=over 4
-
-=item export_name - Name or exportnum of the export to be executed. In order to specify export options you must use the exportnum form. (ex. 'router' for FS::part_export::router).
-
-=item routernum - FS::router routernum corresponding to the desired FS::router for which this export will be run.
-
-=item field - FS::svc_broadband field (real or virtual). The following condition (regex) will be matched against the value of this field.
-
-=item condition - A regular expression to be match against the value of the previously listed FS::svc_broadband field.
-
-=back
-
-If multiple routernum's are specified, then the export will be triggered for each router listed. If multiple field/condition pairs are present, then the results of the matches will be and'd. Note that if a false match is found, the rest of the matches may not be checked.
-
-You can specify multiple export/router/condition sets by concatenating them with '||'.
-
-=cut
-
-use strict;
-use vars qw(@ISA %info $me $DEBUG);
-
-use FS::Record qw(qsearchs);
-use FS::part_export;
-
-use Tie::IxHash;
-use Data::Dumper qw(Dumper);
-
-@ISA = qw(FS::part_export);
-$me = '[' . __PACKAGE__ . ']';
-$DEBUG = 0;
-
-%info = (
- 'svc' => 'svc_broadband',
- 'desc' => 'A meta-export that triggers other svc_broadband exports.',
- 'options' => {},
- 'notes' => '',
-);
-
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self) = shift;
- $self->_export_command('insert', @_);
-}
-
-sub _export_delete {
- my($self) = shift;
- $self->_export_command('delete', @_);
-}
-
-sub _export_suspend {
- my($self) = shift;
- $self->_export_command('suspend', @_);
-}
-
-sub _export_unsuspend {
- my($self) = shift;
- $self->_export_command('unsuspend', @_);
-}
-
-sub _export_replace {
- my($self) = shift;
- $self->_export_command('replace', @_);
-}
-
-sub _export_command {
- my ( $self, $action, $svc_broadband) = (shift, shift, shift);
-
- my ($new, $old);
- if ($action eq 'replace') {
- $new = $svc_broadband;
- $old = shift;
- }
-
- my $router = $svc_broadband->addr_block->router;
-
- return '' unless grep(/^nas_conf$/, $router->fields);
- my $nas_conf = $router->nas_conf;
-
- my $child_exports = &_parse_nas_conf($nas_conf);
-
- my $error = '';
-
- my $queue_child_exports = {};
-
- # Similar to FS::svc_Common::replace, calling insert, delete, and replace
- # exports where necessary depending on which conditions match.
- if ($action eq 'replace') {
-
- my @new_child_exports = ();
- my @old_child_exports = ();
-
- # Find all the matching "new" child exports.
- foreach my $child_export (@$child_exports) {
- my $match = &_test_child_export_conditions(
- $child_export->{'conditions'},
- $new,
- );
-
- if ($match) {
- push @new_child_exports, $child_export;
- }
- }
-
- # Find all the matching "old" child exports.
- foreach my $child_export (@$child_exports) {
- my $match = &_test_child_export_conditions(
- $child_export->{'conditions'},
- $old,
- );
-
- if ($match) {
- push @old_child_exports, $child_export;
- }
- }
-
- # Insert exports for new.
- push @{$queue_child_exports->{'insert'}}, (
- map {
- my $new_child_export = $_;
- if (! grep { $new_child_export eq $_ } @old_child_exports) {
- $new_child_export->{'args'} = [ $new ];
- $new_child_export;
- } else {
- ();
- }
- } @new_child_exports
- );
-
- # Replace exports for new and old.
- push @{$queue_child_exports->{'replace'}}, (
- map {
- my $new_child_export = $_;
- if (grep { $new_child_export eq $_ } @old_child_exports) {
- $new_child_export->{'args'} = [ $new, $old ];
- $new_child_export;
- } else {
- ();
- }
- } @new_child_exports
- );
-
- # Delete exports for old.
- push @{$queue_child_exports->{'delete'}}, (
- grep {
- my $old_child_export = $_;
- if (! grep { $old_child_export eq $_ } @new_child_exports) {
- $old_child_export->{'args'} = [ $old ];
- $old_child_export;
- } else {
- ();
- }
- } @old_child_exports
- );
-
- } else {
-
- foreach my $child_export (@$child_exports) {
- my $match = &_test_child_export_conditions(
- $child_export->{'conditions'},
- $svc_broadband,
- );
-
- if ($match) {
- $child_export->{'args'} = [ $svc_broadband ];
- push @{$queue_child_exports->{$action}}, $child_export;
- }
- }
-
- }
-
- warn "[debug]$me Dispatching child exports... "
- . &Dumper($queue_child_exports) if $DEBUG;
-
- # Actually call the child exports now, with their preset action and arguments.
- foreach my $_action (keys(%$queue_child_exports)) {
-
- foreach my $_child_export (@{$queue_child_exports->{$_action}}) {
- $error = &_dispatch_child_export(
- $_child_export,
- $_action,
- @{$_child_export->{'args'}},
- @_,
- );
-
- # Bail if there's an error queueing one of the exports.
- # This will all get rolled-back.
- return $error if $error;
- }
-
- }
-
- return '';
-
-}
-
-
-sub _parse_nas_conf {
-
- my $nas_conf = shift;
- my @child_exports = ();
-
- foreach my $cond_set ($nas_conf =~ m/(.*?[^\\])(?:\|\||$)/g) {
-
- warn "[debug]$me cond_set is '$cond_set'" if $DEBUG;
-
- my @args = $cond_set =~ m/(.*?[^\\])(?:\||$)/g;
-
- my %child_export = (
- 'export' => $args[0],
- 'routernum' => [ split(/,\s*/, $args[1]) ],
- 'conditions' => { @args[2..$#args] },
- );
-
- warn "[debug]$me " . Dumper(\%child_export) if $DEBUG;
-
- push @child_exports, { %child_export };
-
- }
-
- return \@child_exports;
-
-}
-
-sub _dispatch_child_export {
-
- my ($child_export, $action, @args) = (shift, shift, @_);
-
- my $child_export_name = $child_export->{'export'};
- my @routernums = @{$child_export->{'routernum'}};
-
- my $error = '';
-
- # And the real hack begins...
-
- my $child_part_export;
- if ($child_export_name =~ /^(\d+)$/) {
- my $exportnum = $1;
- $child_part_export = qsearchs('part_export', { exportnum => $exportnum });
- unless ($child_part_export) {
- return "No such FS::part_export with exportnum '$exportnum'";
- }
-
- $child_export_name = $child_part_export->exporttype;
- } else {
- $child_part_export = new FS::part_export {
- 'exporttype' => $child_export_name,
- 'machine' => 'bogus',
- };
- }
-
- warn "[debug]$me running export '$child_export_name' for routernum(s) '"
- . join(',', @routernums) . "'" if $DEBUG;
-
- my $cmd_method = "_export_$action";
-
- foreach my $routernum (@routernums) {
- $error ||= $child_part_export->$cmd_method(
- @args,
- 'routernum' => $routernum,
- );
- last if $error;
- }
-
- warn "[debug]$me export '$child_export_name' returned '$error'"
- if $DEBUG;
-
- return $error;
-
-}
-
-sub _test_child_export_conditions {
-
- my ($conditions, $svc_broadband) = (shift, shift);
-
- my $match = 1;
- foreach my $cond_field (keys %$conditions) {
- my $cond_regex = $conditions->{$cond_field};
- warn "[debug]$me Condition: $cond_field =~ /$cond_regex/" if $DEBUG;
- unless ($svc_broadband->get($cond_field) =~ /$cond_regex/) {
- $match = 0;
- last;
- }
- }
-
- return $match;
-
-}
-
-
-1;
-
diff --git a/FS/FS/part_export/netsapiens.pm b/FS/FS/part_export/netsapiens.pm
deleted file mode 100644
index 83f0f01..0000000
--- a/FS/FS/part_export/netsapiens.pm
+++ /dev/null
@@ -1,312 +0,0 @@
-package FS::part_export::netsapiens;
-
-use vars qw(@ISA $me %info);
-use URI;
-use MIME::Base64;
-use Tie::IxHash;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-$me = '[FS::part_export::netsapiens]';
-
-tie my %options, 'Tie::IxHash',
- 'login' => { label=>'NetSapiens tac2 User API username' },
- 'password' => { label=>'NetSapiens tac2 User API password' },
- 'url' => { label=>'NetSapiens tac2 User URL' },
- 'device_login' => { label=>'NetSapiens tac2 Device API username' },
- 'device_password' => { label=>'NetSapiens tac2 Device API password' },
- 'device_url' => { label=>'NetSapiens tac2 Device URL' },
- 'domain' => { label=>'NetSapiens Domain' },
- 'debug' => { label=>'Enable debugging', type=>'checkbox' },
-;
-
-%info = (
- 'svc' => [ 'svc_phone', ], # 'part_device',
- 'desc' => 'Provision phone numbers to NetSapiens',
- 'options' => \%options,
- 'notes' => <<'END'
-Requires installation of
-<a href="http://search.cpan.org/dist/REST-Client">REST::Client</a>
-from CPAN.
-END
-);
-
-sub rebless { shift; }
-
-sub ns_command {
- my $self = shift;
- $self->_ns_command('', @_);
-}
-
-sub ns_device_command {
- my $self = shift;
- $self->_ns_command('device_', @_);
-}
-
-sub _ns_command {
- my( $self, $prefix, $method, $command ) = splice(@_,0,4);
-
- eval 'use REST::Client';
- die $@ if $@;
-
- my $ns = new REST::Client 'host'=>$self->option($prefix.'url');
-
- my @args = ( $command );
-
- if ( $method eq 'PUT' ) {
- my $content = $ns->buildQuery( { @_ } );
- $content =~ s/^\?//;
- push @args, $content;
- } elsif ( $method eq 'GET' ) {
- $args[0] .= $ns->buildQuery( { @_ } );
- }
-
- warn "$me $method ". $self->option($prefix.'url'). join(', ', @args). "\n"
- if $self->option('debug');
-
- my $auth = encode_base64( $self->option($prefix.'login'). ':'.
- $self->option($prefix.'password') );
- push @args, { 'Authorization' => "Basic $auth" };
-
- $ns->$method( @args );
- $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->ns_domain($svc_phone);
- my $phonenum = $svc_phone->phonenum;
-
- "/domains_config/$domain/subscriber_config/$phonenum";
-}
-
-sub ns_registrar {
- my($self, $svc_phone) = (shift, shift);
-
- $self->ns_subscriber($svc_phone).
- '/registrar_config/'. $self->ns_devicename($svc_phone);
-}
-
-sub ns_devicename {
- my( $self, $svc_phone ) = (shift, shift);
-
- my $domain = $self->ns_domain($svc_phone);
- #my $countrycode = $svc_phone->countrycode;
- my $phonenum = $svc_phone->phonenum;
-
- #"sip:$countrycode$phonenum\@$domain";
- "sip:$phonenum\@$domain";
-}
-
-sub ns_dialplan {
- my($self, $svc_phone) = (shift, shift);
-
- #my $countrycode = $svc_phone->countrycode;
- my $phonenum = $svc_phone->phonenum;
-
- #"/dialplans/DID+Table/dialplan_config/sip:$countrycode$phonenum\@*"
- "/dialplans/DID+Table/dialplan_config/sip:$phonenum\@*"
-}
-
-sub ns_device {
- my($self, $svc_phone, $phone_device ) = (shift, shift, shift);
-
- #my $countrycode = $svc_phone->countrycode;
- #my $phonenum = $svc_phone->phonenum;
-
- "/phones_config/". lc($phone_device->mac_addr);
-}
-
-sub ns_create_or_update {
- my($self, $svc_phone, $dial_policy) = (shift, shift, shift);
-
- my $domain = $self->ns_domain($svc_phone);
- #my $countrycode = $svc_phone->countrycode;
- my $phonenum = $svc_phone->phonenum;
-
- my( $firstname, $lastname );
- if ( $svc_phone->phone_name =~ /^\s*(\S+)\s+(\S.*\S)\s*$/ ) {
- $firstname = $1;
- $lastname = $2;
- } else {
- #deal w/unaudited netsapiens services?
- my $cust_main = $svc_phone->cust_svc->cust_pkg->cust_main;
- $firstname = $cust_main->get('first');
- $lastname = $cust_main->get('last');
- }
-
- # Piece 1 (already done) - User creation
-
- my $ns = $self->ns_command( 'PUT', $self->ns_subscriber($svc_phone),
- 'subscriber_login' => $phonenum.'@'.$domain,
- 'firstname' => $firstname,
- 'lastname' => $lastname,
- 'subscriber_pin' => $svc_phone->pin,
- 'dial_plan' => 'Default', #config?
- 'dial_policy' => $dial_policy,
- );
-
- if ( $ns->responseCode !~ /^2/ ) {
- return $ns->responseCode. ' '.
- join(', ', $self->ns_parse_response( $ns->responseContent ) );
- }
-
- #Piece 2 - sip device creation
-
- my $ns2 = $self->ns_command( 'PUT', $self->ns_registrar($svc_phone),
- 'termination_match' => $self->ns_devicename($svc_phone)
- );
-
- if ( $ns2->responseCode !~ /^2/ ) {
- return $ns2->responseCode. ' '.
- join(', ', $self->ns_parse_response( $ns2->responseContent ) );
- }
-
- #Piece 3 - DID mapping to user
-
- my $ns3 = $self->ns_command( 'PUT', $self->ns_dialplan($svc_phone),
- 'to_user' => $phonenum,
- 'to_host' => $domain,
- );
-
- if ( $ns3->responseCode !~ /^2/ ) {
- return $ns3->responseCode. ' '.
- join(', ', $self->ns_parse_response( $ns3->responseContent ) );
- }
-
- '';
-}
-
-sub ns_delete {
- my($self, $svc_phone) = (shift, shift);
-
- my $ns = $self->ns_command( 'DELETE', $self->ns_subscriber($svc_phone) );
-
- #delete other things?
-
- if ( $ns->responseCode !~ /^2/ ) {
- return $ns->responseCode. ' '.
- join(', ', $self->ns_parse_response( $ns->responseContent ) );
- }
-
- '';
-
-}
-
-sub ns_parse_response {
- my( $self, $content ) = ( shift, shift );
-
- #try to screen-scrape something useful
- tie my %hash, Tie::IxHash;
- while ( $content =~ s/^.*?<p>\s*<b>(.+?)<\/b>\s*(.+?)\s*<\/p>//is ) {
- ( $hash{$1} = $2 ) =~ s/^\s*<(\w+)>(.+?)<\/\1>/$2/is;
- }
-
- %hash;
-}
-
-sub _export_insert {
- my($self, $svc_phone) = (shift, shift);
- $self->ns_create_or_update($svc_phone, 'Permit All');
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
- return "can't change phonenum with NetSapiens (unprovision and reprovision?)"
- if $old->phonenum ne $new->phonenum;
- $self->_export_insert($new);
-}
-
-sub _export_delete {
- my( $self, $svc_phone ) = (shift, shift);
-
- $self->ns_delete($svc_phone);
-}
-
-sub _export_suspend {
- my( $self, $svc_phone ) = (shift, shift);
- $self->ns_create_or_update($svc_phone, 'Deny');
-}
-
-sub _export_unsuspend {
- my( $self, $svc_phone ) = (shift, shift);
- #$self->ns_create_or_update($svc_phone, 'Permit All');
- $self->_export_insert($svc_phone);
-}
-
-sub export_device_insert {
- my( $self, $svc_phone, $phone_device ) = (shift, shift, shift);
-
- my $domain = $self->ns_domain($svc_phone);
- my $countrycode = $svc_phone->countrycode;
- my $phonenum = $svc_phone->phonenum;
-
- my $device = $self->ns_devicename($svc_phone);
-
- my $ns = $self->ns_device_command(
- 'PUT', $self->ns_device($svc_phone, $phone_device),
- 'line1_enable' => 'yes',
- 'device1' => $self->ns_devicename($svc_phone),
- 'line1_ext' => $phonenum,
-,
- #'line2_enable' => 'yes',
- #'device2' =>
- #'line2_ext' =>
-
- #'notes' =>
- 'server' => 'SiPbx',
- 'domain' => $domain,
-
- 'brand' => $phone_device->part_device->devicename,
-
- );
-
- if ( $ns->responseCode !~ /^2/ ) {
- return $ns->responseCode. ' '.
- join(', ', $self->ns_parse_response( $ns->responseContent ) );
- }
-
- '';
-
-}
-
-sub export_device_delete {
- my( $self, $svc_phone, $phone_device ) = (shift, shift, shift);
-
- my $ns = $self->ns_device_command(
- 'DELETE', $self->ns_device($svc_phone, $phone_device),
- );
-
- if ( $ns->responseCode !~ /^2/ ) {
- return $ns->responseCode. ' '.
- join(', ', $self->ns_parse_response( $ns->responseContent ) );
- }
-
- '';
-
-}
-
-
-sub export_device_replace {
- my( $self, $svc_phone, $new_phone_device, $old_phone_device ) =
- (shift, shift, shift, shift);
-
- #?
- $self->export_device_insert( $svc_phone, $new_phone_device );
-
-}
-
-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>!;
- '';
-}
-
-1;
diff --git a/FS/FS/part_export/null.pm b/FS/FS/part_export/null.pm
deleted file mode 100644
index 0145af3..0000000
--- a/FS/FS/part_export/null.pm
+++ /dev/null
@@ -1,13 +0,0 @@
-package FS::part_export::null;
-
-use vars qw(@ISA);
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-sub rebless { shift; }
-
-sub _export_insert {}
-sub _export_replace {}
-sub _export_delete {}
-
diff --git a/FS/FS/part_export/passwdfile.pm b/FS/FS/part_export/passwdfile.pm
deleted file mode 100644
index 2978d25..0000000
--- a/FS/FS/part_export/passwdfile.pm
+++ /dev/null
@@ -1,18 +0,0 @@
-package FS::part_export::passwdfile;
-
-use strict;
-use vars qw(@ISA %options);
-use Tie::IxHash;
-use FS::part_export::null;
-
-@ISA = qw(FS::part_export::null);
-
-tie %options, 'Tie::IxHash',
- 'crypt' => { label=>'Password encryption',
- type=>'select', options=>[qw(crypt md5)],
- default=>'crypt',
- },
-;
-
-1;
-
diff --git a/FS/FS/part_export/phone_shellcommands.pm b/FS/FS/part_export/phone_shellcommands.pm
deleted file mode 100644
index 040af27..0000000
--- a/FS/FS/part_export/phone_shellcommands.pm
+++ /dev/null
@@ -1,140 +0,0 @@
-package FS::part_export::phone_shellcommands;
-
-use strict;
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use String::ShellQuote;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-#TODO
-#- modify command (get something from freepbx for changing PINs)
-#- suspension/unsuspension
-
-tie my %options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root', },
- 'useradd' => { label=>'Insert command', },
- 'userdel' => { label=>'Delete command', },
- 'usermod' => { label=>'Modify command', },
- 'suspend' => { label=>'Suspension command', },
- 'unsuspend' => { label=>'Unsuspension command', },
-;
-
-%info = (
- 'svc' => 'svc_phone',
- 'desc' => 'Run remote commands via SSH, for phone numbers',
- 'options' => \%options,
- 'notes' => <<'END'
-Run remote commands via SSH, for phone numbers. You will need to
-<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>
- <INPUT TYPE="button" VALUE="FreePBX (build_exten CLI module needed)" onClick='
- this.form.user.value = "root";
- this.form.useradd.value = "build_exten.php --create --exten $phonenum --directdid 1$phonenum --sip-secret $sip_password --name $cust_name --vm-password $pin && /usr/share/asterisk/bin/module_admin reload";
- this.form.userdel.value = "build_exten.php --delete --exten $phonenum && /usr/share/asterisk/bin/module_admin reload";
- this.form.usermod.value = "build_exten.php --modify --exten $new_phonenum --directdid 1$new_phonenum --sip-secret $new_sip_password --name $new_cust_name --vm-password $new_pin && /usr/share/asterisk/bin/module_admin reload";
- this.form.suspend.value = "";
- this.form.unsuspend.value = "";
- '> (Important note: Reduce freeside-queued "max_kids" to 1 when using FreePBX integration)
- </UL>
-
-The following variables are available for interpolation (prefixed with new_ or
-old_ for replace operations):
-<UL>
- <LI><code>$countrycode</code> - Country code
- <LI><code>$phonenum</code> - Phone number
- <LI><code>$sip_password</code> - SIP secret (quoted for the shell)
- <LI><code>$pin</code> - Personal identification number
- <LI><code>$cust_name</code> - Customer name (quoted for the shell)
-</UL>
-END
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self) = shift;
- $self->_export_command('useradd', @_);
-}
-
-sub _export_delete {
- my($self) = shift;
- $self->_export_command('userdel', @_);
-}
-
-sub _export_suspend {
- my($self) = shift;
- $self->_export_command('suspend', @_);
-}
-
-sub _export_unsuspend {
- my($self) = shift;
- $self->_export_command('unsuspend', @_);
-}
-
-sub _export_command {
- my ( $self, $action, $svc_phone) = (shift, shift, shift);
- my $command = $self->option($action);
- return '' if $command =~ /^\s*$/;
-
- #set variable for the command
- no strict 'vars';
- {
- no strict 'refs';
- ${$_} = $svc_phone->getfield($_) foreach $svc_phone->fields;
- }
- my $cust_pkg = $svc_phone->cust_svc->cust_pkg;
- my $cust_name = $cust_pkg ? $cust_pkg->cust_main->name : '';
- $cust_name = shell_quote $cust_name;
- my $sip_password = shell_quote $svc_phone->sip_password;
- #done setting variables for the command
-
- $self->shellcommands_queue( $svc_phone->svcnum,
- user => $self->option('user')||'root',
- host => $self->machine,
- command => eval(qq("$command")),
- );
-}
-
-sub _export_replace {
- my($self, $new, $old ) = (shift, shift, shift);
- my $command = $self->option('usermod');
-
- #set variable for the command
- no strict 'vars';
- {
- no strict 'refs';
- ${"old_$_"} = $old->getfield($_) foreach $old->fields;
- ${"new_$_"} = $new->getfield($_) foreach $new->fields;
- }
-
- my $cust_pkg = $new->cust_svc->cust_pkg;
- my $new_cust_name = $cust_pkg ? $cust_pkg->cust_main->name : '';
- $new_cust_name = shell_quote $new_cust_name;
- #done setting variables for the command
-
- $self->shellcommands_queue( $new->svcnum,
- user => $self->option('user')||'root',
- host => $self->machine,
- command => eval(qq("$command")),
- );
-}
-
-#a good idea to queue anything that could fail or take any time
-sub shellcommands_queue {
- my( $self, $svcnum ) = (shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::phone_shellcommands::ssh_cmd",
- };
- $queue->insert( @_ );
-}
-
-sub ssh_cmd { #subroutine, not method
- use Net::SSH '0.08';
- &Net::SSH::ssh_cmd( { @_ } );
-}
-
diff --git a/FS/FS/part_export/phone_sqlradius.pm b/FS/FS/part_export/phone_sqlradius.pm
deleted file mode 100644
index 24f7845..0000000
--- a/FS/FS/part_export/phone_sqlradius.pm
+++ /dev/null
@@ -1,158 +0,0 @@
-package FS::part_export::phone_sqlradius;
-
-use vars qw(@ISA $DEBUG %info );
-use Tie::IxHash;
-use FS::Record qw( dbh str2time_sql ); #qsearch qsearchs );
-#use FS::part_export;
-use FS::part_export::sqlradius qw(sqlradius_connect);
-#use FS::svc_phone;
-#use FS::export_svc;
-#use Carp qw( cluck );
-
-@ISA = qw(FS::part_export::sqlradius);
-
-$DEBUG = 0;
-
-tie %options, 'Tie::IxHash',
- 'datasrc' => { label=>'DBI data source ' },
- 'username' => { label=>'Database username' },
- 'password' => { label=>'Database password' },
- 'ignore_accounting' => {
- type => 'checkbox',
- label => 'Ignore accounting records from this database'
- },
- 'hide_ip' => {
- type => 'checkbox',
- label => 'Hide IP address information on session reports',
- },
- 'hide_data' => {
- type => 'checkbox',
- label => 'Hide download/upload information on session reports',
- },
-
- #should be default for this one, right?
- #'show_called_station' => {
- # type => 'checkbox',
- # label => 'Show the Called-Station-ID on session reports',
- #},
-
- #N/A
- #'overlimit_groups' => { label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit', } ,
- #'groups_susp_reason' => { label =>
- # 'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)',
- # type => 'textarea',
- # },
-
-;
-
-%info = (
- 'svc' => 'svc_phone',
- 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) for phone provisioning and rating',
- 'options' => \%options,
- 'notes' => <<END,
-Real-time export of <b>radcheck</b> table
-<!--, <b>radreply</b> and <b>usergroup</b>-- tables>
-to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a>
-or <a href="http://radius.innercite.com/">ICRADIUS</a>.
-<br><br>
-
-This export is for phone/VoIP provisioning and rating. For a regular RADIUS
-export, see sqlradius.
-<br><br>
-
-<!--An existing RADIUS database will be updated in realtime, but you can use
-<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-phone_sqlradius-reset">freeside-phone_sqlradius-reset</a>
-to delete the entire RADIUS database and repopulate the tables from the
-Freeside database.
-<br><br>
--->
-
-See the
-<a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
-and the
-<a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
-for the exact syntax of a DBI data source.
-
-END
-);
-
-sub rebless { shift; }
-
-sub export_username {
- my($self, $svc_phone) = (shift, shift);
- $svc_phone->countrycode. $svc_phone->phonenum;
-}
-
-sub _export_suspend {}
-sub _export_unsuspend {}
-
-#probably harmless that we ->can('usage_sessions').... ?
-
-#we want to feed these into CDRs, not update svc_acct records
-sub update_svc {
- my $self = shift;
-
- my $fdbh = dbh;
- my $dbh = sqlradius_connect( map $self->option($_),
- qw( datasrc username password ) );
-
- my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
-
- my @fields = qw( radacctid username realm acctsessiontime );
-
- my @param = ();
- my $where = '';
-
- my $sth = $dbh->prepare("
- SELECT RadAcctId, UserName, AcctSessionTime,
- $str2time AcctStartTime), $str2time AcctStopTime),
- CallingStationID, CalledStationID
- FROM radacct
- WHERE FreesideStatus IS NULL
- AND AcctStopTime != 0
- ") or die $dbh->errstr;
- $sth->execute() or die $sth->errstr;
-
- while ( my $row = $sth->fetchrow_arrayref ) {
- my( $RadAcctId, $UserName, $AcctSessionTime,
- $AcctStartTime, $AcctStopTime,
- $CallingStationID, $CalledStationID,
- )= @$row;
- warn "processing record: ".
- "$RadAcctId ($UserName for ${AcctSessionTime}s"
- if $DEBUG;
-
- my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
- local $FS::UID::AutoCommit = 0; # least we can avoid over counting
-
- my $cdr = new FS::cdr {
- 'src' => $CallingStationID,
- 'charged_party' => $UserName,
- 'dst' => $CalledStationID,
- 'startdate' => $AcctStartTime,
- 'enddate' => $AcctStopTime,
- 'duration' => $AcctStopTime - $AcctStartTime,
- 'billsec' => $AcctSessionTime,
- };
-
- my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
- "(UserName $UserName)";
-
- my $error = $cdr->insert;
- my $status = $error ? 'skipped' : 'done';
-
- warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
- my $psth = $dbh->prepare("UPDATE radacct
- SET FreesideStatus = ?
- WHERE RadAcctId = ?"
- ) or die $dbh->errstr;
- $psth->execute($status, $RadAcctId) or die $psth->errstr;
-
- $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
-
- }
-
-}
-
-1;
-
diff --git a/FS/FS/part_export/postfix.pm b/FS/FS/part_export/postfix.pm
deleted file mode 100644
index 4fd19ee..0000000
--- a/FS/FS/part_export/postfix.pm
+++ /dev/null
@@ -1,32 +0,0 @@
-package FS::part_export::postfix;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export::null;
-
-@ISA = qw(FS::part_export::null);
-
-tie my %options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'aliases' => { label=>'aliases file location', default=>'/etc/aliases' },
- 'virtual' => { label=>'virtual file location', default=>'/etc/postfix/virtual' },
- 'mydomain' => { label=>'local domain', default=>'' },
- 'newaliases' => { label=>'newaliases command', default=>'newaliases' },
- 'postmap' => { label=>'postmap command',
- default=>'postmap hash:/etc/postfix/virtual', },
- 'reload' => { label=>'reload command',
- default=>'postfix reload' },
-;
-
-%info = (
- 'svc' => 'svc_forward',
- 'desc' => 'Postfix text files',
- 'options' => \%options,
- 'notes' => <<'END'
-Batch export of Postfix aliases and virtual files.
-<a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a>
-must be installed. Run bin/postfix.export to export the files.
-END
-);
-
-1;
diff --git a/FS/FS/part_export/prizm.pm b/FS/FS/part_export/prizm.pm
deleted file mode 100644
index 02e89c6..0000000
--- a/FS/FS/part_export/prizm.pm
+++ /dev/null
@@ -1,591 +0,0 @@
-package FS::part_export::prizm;
-
-use vars qw(@ISA %info %options $DEBUG $me);
-use Tie::IxHash;
-use FS::Record qw(fields dbh);
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-$DEBUG = 0;
-$me = '[' . __PACKAGE__ . ']';
-
-tie %options, 'Tie::IxHash',
- 'url' => { label => 'Northbound url', default=>'https://localhost:8443/prizm/nbi' },
- 'user' => { label => 'Northbound username', default=>'nbi' },
- 'password' => { label => 'Password', default => '' },
- 'ems' => { label => 'Full EMS', type => 'checkbox' },
- 'always_bam' => { label => 'Always activate/suspend authentication', type => 'checkbox' },
- 'element_name_length' => { label => 'Size of siteName (best left blank)' },
-;
-
-my $notes = <<'EOT';
-Real-time export of <b>svc_broadband</b>, <b>cust_pkg</b>, and <b>cust_main</b>
-record data to Motorola
-<a href="http://motorola.canopywireless.com/products/prizm/">Canopy Prizm
-software</a> via the Northbound interface.<br><br>
-
-Freeside will attempt to create an element in an existing network with the
-values provided in svc_broadband. Of particular interest are
-<ul>
- <li> mac address - used to identify the element
- <li> vlan profile - an exact match for a vlan profiles defined in prizm
- <li> ip address - defines the management ip address of the prizm element
- <li> latitude - GPS latitude
- <li> longitude - GPS longitude
- <li> altitude - GPS altitude
-</ul>
-
-In addition freeside attempts to set the service plan name in prizm to the
-name of the package in which the service resides.
-
-The service is associated with a customer in prizm as well, and freeside
-will create the customer should none already exist with import id matching
-the freeside customer number. The following fields are set.
-
-<ul>
- <li> importId - the freeside customer number
- <li> customerType - freeside
- <li> customerName - the name associated with the freeside shipping address
- <li> address1 - the shipping address
- <li> address2
- <li> city
- <li> state
- <li> zipCode
- <li> country
- <li> workPhone - the daytime phone number
- <li> homePhone - the night phone number
- <li> freesideId - the freeside customer number
-</ul>
-
- Additionally set on the element are
-<ul>
- <li> Site Name - The shipping name followed by the service broadband description field
- <li> Site Location - the shipping address
- <li> Site Contact - the daytime and night phone numbers
-</ul>
-
-Freeside provisions, suspends, and unsuspends elements BAM only unless the
-'Full EMS' checkbox is checked.<br><br>
-
-When freeside provisions an element the siteName is copied internally by
-prizm in such a manner that it is possible for the value to exceed the size
-of the column used in the prizm database. Therefore freeside truncates
-by default this value to 50 characters. It is thought that this
-column is the account_name column of the element_user_account table. It
-may be possible to lift this limit by modifying the prizm database and
-setting a new appropriate value on this export. This is untested and
-possibly harmful.
-
-EOT
-
-%info = (
- 'svc' => 'svc_broadband',
- 'desc' => 'Real-time export to Northbound Interface',
- 'options' => \%options,
- 'nodomain' => 'Y',
- 'notes' => $notes,
-);
-
-sub prizm_command {
- my ($self,$namespace,$method) = (shift,shift,shift);
-
- eval "use Net::Prizm 0.04 qw(CustomerInfo PrizmElement);";
- die $@ if $@;
-
- my $prizm = new Net::Prizm (
- namespace => $namespace,
- url => $self->option('url'),
- user => $self->option('user'),
- password => $self->option('password'),
- );
-
- $prizm->$method(@_);
-}
-
-sub queued_prizm_command { # subroutine
- my( $url, $user, $password, $namespace, $method, @args ) = @_;
-
- eval "use Net::Prizm 0.04 qw(CustomerInfo PrizmElement);";
- die $@ if $@;
-
- my $prizm = new Net::Prizm (
- namespace => $namespace,
- url => $url,
- user => $user,
- password => $password,
- );
-
- $err_or_som = $prizm->$method( @args);
-
- die $err_or_som
- unless ref($err_or_som);
-
- '';
-
-}
-
-sub _export_insert {
- my( $self, $svc ) = ( shift, shift );
- warn "$me: _export_insert called for export ". $self->exportnum.
- " on service ". $svc->svcnum. "\n"
- if $DEBUG;
-
- my $cust_main = $svc->cust_svc->cust_pkg->cust_main;
-
- my $err_or_som = $self->prizm_command('CustomerIfService', 'getCustomers',
- ['import_id'],
- [$cust_main->custnum],
- ['='],
- );
- return $err_or_som
- unless ref($err_or_som);
-
- my $pre = '';
- if ( defined $cust_main->dbdef_table->column('ship_last') ) {
- $pre = $cust_main->ship_last ? 'ship_' : '';
- }
- my $name = $pre ? $cust_main->ship_name : $cust_main->name;
- my $location = join(" ", map { my $method = "$pre$_"; $cust_main->$method }
- qw (address1 address2 city state zip)
- );
- my $contact = join(" ", map { my $method = "$pre$_"; $cust_main->$method }
- qw (daytime night)
- );
-
- my $pcustomer;
- if ($err_or_som->result->[0]) {
- $pcustomer = $err_or_som->result->[0]->customerId;
- warn "$me: found customer $pcustomer in prizm\n" if $DEBUG;
- }else{
- my $chashref = $cust_main->hashref;
- my $customerinfo = {
- importId => $cust_main->custnum,
- customerName => $name,
- customerType => 'freeside',
- address1 => $chashref->{"${pre}address1"},
- address2 => $chashref->{"${pre}address2"},
- city => $chashref->{"${pre}city"},
- state => $chashref->{"${pre}state"},
- zipCode => $chashref->{"${pre}zip"},
- workPhone => $chashref->{"${pre}daytime"},
- homePhone => $chashref->{"${pre}night"},
- email => @{[$cust_main->invoicing_list_emailonly]}[0],
- extraFieldNames => [ 'country', 'freesideId',
- ],
- extraFieldValues => [ $chashref->{"${pre}country"}, $cust_main->custnum,
- ],
- };
-
- $err_or_som = $self->prizm_command('CustomerIfService', 'addCustomer',
- $customerinfo);
- return $err_or_som
- unless ref($err_or_som);
-
- $pcustomer = $err_or_som->result;
- warn "$me: added customer $pcustomer to prizm\n" if $DEBUG;
- }
- warn "multiple prizm customers found for $cust_main->custnum"
- if scalar(@$pcustomer) > 1;
-
-# #kinda big question/expensive
-# $err_or_som = $self->prizm_command('NetworkIfService', 'getPrizmElements',
-# ['Network Default Gateway Address'],
-# [$svc->addr_block->ip_gateway],
-# ['='],
-# );
-# return $err_or_som
-# unless ref($err_or_som);
-#
-# return "No elements in network" unless exists $err_or_som->result->[0];
-
- my $networkid = 0;
-# for (my $i = 0; $i < $err_or_som->result->[0]->attributeNames; $i++) {
-# if ($err_or_som->result->[0]->attributeNames->[$i] eq "Network.ID"){
-# $networkid = $err_or_som->result->[0]->attributeValues->[$i];
-# last;
-# }
-# }
-
-# here we cope with a problem of prizm failing to insert for reason
-# of duplicate mac addr, but doing so inconsistently... a race in prizm?
-
- $self->prizm_command( 'CustomerIfService', 'removeElementFromCustomer',
- 0,
- $cust_main->custnum,
- 0,
- $svc->mac_addr,
- );
-
- $err_or_som = $self->prizm_command( 'NetworkIfService', 'getPrizmElements',
- [ 'MAC Address' ],
- [ $svc->mac_addr ],
- [ '=' ],
- );
- if ( ref($err_or_som) && $err_or_som->result->[0] ) { # ignore errors
- $self->prizm_command( 'NetworkIfService', 'deleteElement',
- $err_or_som->result->[0],
- 1,
- );
- }
-# end of coping
-
- my $performance_profile = $svc->performance_profile;
- $performance_profile ||= $svc->cust_svc->cust_pkg->part_pkg->pkg;
-
- my $element_name_length = 50;
- $element_name_length = $1
- if $self->option('element_name_length') =~ /^\s*(\d+)\s*$/;
- $err_or_som = $self->prizm_command('NetworkIfService', 'addProvisionedElement',
- $networkid,
- $svc->mac_addr,
- substr($name . " " . $svc->description,
- 0, $element_name_length),
- $location,
- $contact,
- sprintf("%032X", $svc->authkey || 0),
- $performance_profile,
- $svc->vlan_profile,
- ($self->option('ems') ? 1 : 0 ),
- );
- return $err_or_som
- unless ref($err_or_som);
- warn "$me: added provisioned element to prizm\n" if $DEBUG;
-
- my (@names) = ('Management IP',
- 'GPS Latitude',
- 'GPS Longitude',
- 'GPS Altitude',
- 'Site Name',
- 'Site Location',
- 'Site Contact',
- );
- my (@values) = ($svc->ip_addr,
- $svc->latitude,
- $svc->longitude,
- $svc->altitude,
- $name . " " . $svc->description,
- $location,
- $contact,
- );
- $element = $err_or_som->result->elementId;
- $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfig',
- [ $element ],
- \@names,
- \@values,
- 0,
- 1,
- );
- return $err_or_som
- unless ref($err_or_som);
- warn "$me: set element configuration\n" if $DEBUG;
-
- $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet',
- [ $element ],
- $svc->vlan_profile,
- 0,
- 1,
- );
- return $err_or_som
- unless ref($err_or_som);
- warn "$me: set element vlan profile\n" if $DEBUG;
-
- $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet',
- [ $element ],
- $performance_profile,
- 0,
- 1,
- );
- return $err_or_som
- unless ref($err_or_som);
- warn "$me: set element configset (performance profile)\n" if $DEBUG;
-
- $err_or_som = $self->prizm_command('NetworkIfService',
- 'activateNetworkElements',
- [ $element ],
- 1,
- ( $self->option('ems') ? 1 : 0 ),
- );
-
- return $err_or_som
- unless ref($err_or_som);
- warn "$me: activated element\n" if $DEBUG;
-
- $err_or_som = $self->prizm_command('CustomerIfService',
- 'addElementToCustomer',
- 0,
- $cust_main->custnum,
- 0,
- $svc->mac_addr,
- );
-
- return $err_or_som
- unless ref($err_or_som);
- warn "$me: added element to customer\n" if $DEBUG;
-
- '';
-}
-
-sub _export_delete {
- my( $self, $svc ) = ( shift, shift );
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $cust_pkg = $svc->cust_svc->cust_pkg;
-
- my $depend = [];
-
- if ($cust_pkg) {
- my $queue = new FS::queue {
- 'svcnum' => $svc->svcnum,
- 'job' => 'FS::part_export::prizm::queued_prizm_command',
- };
- my $error = $queue->insert(
- ( map { $self->option($_) }
- qw( url user password ) ),
- 'CustomerIfService',
- 'removeElementFromCustomer',
- 0,
- $cust_pkg->custnum,
- 0,
- $svc->mac_addr,
- );
-
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- push @$depend, $queue->jobnum;
- }
-
- my $err_or_queue =
- $self->queue_statuschange('deleteElement', $depend, $svc, 1);
-
- unless (ref($err_or_queue)) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = ( shift, shift, shift );
-
- my $err_or_som = $self->prizm_command('NetworkIfService', 'getPrizmElements',
- [ 'MAC Address' ],
- [ $old->mac_addr ],
- [ '=' ],
- );
- return $err_or_som
- unless ref($err_or_som);
-
- return "Can't find prizm element for " . $old->mac_addr
- unless $err_or_som->result->[0];
-
- my %freeside2prizm = ( mac_addr => 'MAC Address',
- ip_addr => 'Management IP',
- latitude => 'GPS Latitude',
- longitude => 'GPS Longitude',
- altitude => 'GPS Altitude',
- authkey => 'Authentication Key',
- );
-
- my (@values);
- my (@names) = map { push @values, $new->$_; $freeside2prizm{$_} }
- grep { $old->$_ ne $new->$_ }
- grep { exists($freeside2prizm{$_}) }
- fields( 'svc_broadband' );
-
- if ($old->description ne $new->description) {
- my $cust_main = $old->cust_svc->cust_pkg->cust_main;
- my $name = defined($cust_main->dbdef_table->column('ship_last'))
- ? $cust_main->ship_name
- : $cust_main->name;
- push @values, $name . " " . $new->description;
- push @names, "Site Name";
- }
-
- my $element = $err_or_som->result->[0]->elementId;
-
- $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfig',
- [ $element ],
- \@names,
- \@values,
- 0,
- 1,
- );
- return $err_or_som
- unless ref($err_or_som);
-
- $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet',
- [ $element ],
- $new->vlan_profile,
- 0,
- 1,
- )
- if $old->vlan_profile ne $new->vlan_profile;
-
- return $err_or_som
- unless ref($err_or_som);
-
- my $performance_profile = $new->performance_profile;
- $performance_profile ||= $new->cust_svc->cust_pkg->part_pkg->pkg;
-
- $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet',
- [ $element ],
- $performance_profile,
- 0,
- 1,
- );
- return $err_or_som
- unless ref($err_or_som);
-
- '';
-
-}
-
-sub _export_suspend {
- my( $self, $svc ) = ( shift, shift );
- my $depend = [];
- my $ems = $self->option('ems') ? 1 : 0;
- my $err_or_queue = '';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- $err_or_queue =
- $self->queue_statuschange('suspendNetworkElements', [], $svc, 1, $ems);
- unless (ref($err_or_queue)) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
- push @$depend, $err_or_queue->jobnum;
-
- if ($ems && $self->option('always_bam')) {
- $err_or_queue =
- $self->queue_statuschange('suspendNetworkElements', $depend, $svc, 1, 0);
- unless (ref($err_or_queue)) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-sub _export_unsuspend {
- my( $self, $svc ) = ( shift, shift );
- my $depend = [];
- my $ems = $self->option('ems') ? 1 : 0;
- my $err_or_queue = '';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- if ($ems && $self->option('always_bam')) {
- $err_or_queue =
- $self->queue_statuschange('activateNetworkElements', [], $svc, 1, 0);
- unless (ref($err_or_queue)) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
- push @$depend, $err_or_queue->jobnum;
- }
-
- $err_or_queue =
- $self->queue_statuschange('activateNetworkElements', $depend, $svc, 1, $ems);
- unless (ref($err_or_queue)) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-sub export_links {
- my( $self, $svc, $arrayref ) = ( shift, shift, shift );
-
- push @$arrayref,
- '<A HREF="http://'. $svc->ip_addr. '" target="_blank">SM</A>';
-
- '';
-}
-
-sub queue_statuschange {
- my( $self, $method, $jobs, $svc, @args ) = @_;
-
- # already in a transaction and can't die here
-
- my $queue = new FS::queue {
- 'svcnum' => $svc->svcnum,
- 'job' => 'FS::part_export::prizm::statuschange',
- };
- my $error = $queue->insert(
- ( map { $self->option($_) }
- qw( url user password ) ),
- $method,
- $svc->mac_addr,
- @args,
- );
-
- unless ($error) { # successful insertion
- foreach my $job ( @$jobs ) {
- $error ||= $queue->depend_insert($job);
- }
- }
-
- $error or $queue;
-}
-
-sub statuschange { # subroutine
- my( $url, $user, $password, $method, $mac_addr, @args) = @_;
-
- eval "use Net::Prizm 0.04 qw(CustomerInfo PrizmElement);";
- die $@ if $@;
-
- my $prizm = new Net::Prizm (
- namespace => 'NetworkIfService',
- url => $url,
- user => $user,
- password => $password,
- );
-
- my $err_or_som = $prizm->getPrizmElements( [ 'MAC Address' ],
- [ $mac_addr ],
- [ '=' ],
- );
- die $err_or_som
- unless ref($err_or_som);
-
- die "Can't find prizm element for " . $mac_addr
- unless $err_or_som->result->[0];
-
- my $arg1;
- # yuck!
- if ($method =~ /suspendNetworkElements/ || $method =~ /activateNetworkElements/) {
- $arg1 = [ $err_or_som->result->[0]->elementId ];
- }else{
- $arg1 = $err_or_som->result->[0]->elementId;
- }
- $err_or_som = $prizm->$method( $arg1, @args );
-
- die $err_or_som
- unless ref($err_or_som);
-
- '';
-
-}
-
-
-1;
diff --git a/FS/FS/part_export/radiator.pm b/FS/FS/part_export/radiator.pm
deleted file mode 100644
index 2ac3edb..0000000
--- a/FS/FS/part_export/radiator.pm
+++ /dev/null
@@ -1,167 +0,0 @@
-package FS::part_export::radiator;
-
-use vars qw(@ISA %info $radusers);
-use Tie::IxHash;
-use FS::part_export::sqlradius;
-
-tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to RADIATOR',
- 'options' => \%options,
- 'nodomain' => '',
- 'notes' => <<'END',
-Real-time export of the <b>radusers</b> table to any SQL database in
-<a href="http://www.open.com.au/radiator/">Radiator</a>-native format.
-To setup accounting, see the RADIATOR documentation for hooks to update
-a standard <b>radacct</b> table.
-END
-);
-
-@ISA = qw(FS::part_export::sqlradius); #for regular sqlradius accounting
-
-$radusers = 'RADUSERS'; #MySQL is case sensitive about table names! huh
-
-#sub export_username {
-# my($self, $svc_acct) = (shift, shift);
-# $svc_acct->email;
-#}
-
-sub _export_insert {
- my( $self, $svc_acct ) = (shift, shift);
-
- $self->radiator_queue(
- $svc_acct->svcnum,
- 'insert',
- $self->_radiator_hash($svc_acct),
- );
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
-
-# return "can't (yet) change domain with radiator export"
-# if $old->domain ne $new->domain;
-# return "can't (yet) change username with radiator export"
-# if $old->username ne $new->username;
-
- $self->radiator_queue(
- $new->svcnum,
- 'replace',
- $self->export_username($old),
- $self->_radiator_hash($new),
- );
-}
-
-sub _export_delete {
- my( $self, $svc_acct ) = (shift, shift);
-
- $self->radiator_queue(
- $svc_acct->svcnum,
- 'delete',
- $self->export_username($svc_acct),
- );
-}
-
-sub _radiator_hash {
- my( $self, $svc_acct ) = @_;
- my %hash = (
- 'username' => $self->export_username($svc_acct),
- 'pass_word' => $svc_acct->crypt_password,
- 'fullname' => $svc_acct->finger,
- map { my $method = "radius_$_"; $_ => $svc_acct->$method(); }
- qw( framed_filter_id framed_mtu framed_netmask framed_protocol
- framed_routing login_host login_service login_tcp_port )
- );
- $hash{'timeleft'} = $svc_acct->seconds
- if $svc_acct->seconds =~ /^\d+$/;
- $hash{'staticaddress'} = $svc_acct->slipip
- if $svc_acct->slipip =~ /^[\d\.]+$/; # and $self->slipip ne '0.0.0.0';
-
- $hash{'servicename'} = ( $svc_acct->radius_groups )[0];
-
- my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
- $hash{'validto'} = $cust_pkg->bill
- if $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill;
-
- #some other random stuff, should probably be attributes or virtual fields
- #$hash{'state'} = 0; #only inserts
- #$hash{'badlogins'} = 0; #only inserts
- $hash{'maxlogins'} = 1;
- $hash{'addeddate'} = $cust_pkg->setup
- if $cust_pkg && $cust_pkg->setup;
- $hash{'validfrom'} = $cust_pkg->last_bill || $cust_pkg->setup
- if $cust_pkg && ( $cust_pkg->last_bill || $cust_pkg->setup );
- $hash{'state'} = $cust_pkg->susp ? 1 : 0
- if $cust_pkg;
-
- %hash;
-}
-
-sub radiator_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::radiator::radiator_$method",
- };
- $queue->insert(
- $self->option('datasrc'),
- $self->option('username'),
- $self->option('password'),
- @_,
- ); # or $queue;
-}
-
-sub radiator_insert { #subroutine, not method
- my $dbh = radiator_connect(shift, shift, shift);
- my %hash = @_;
- $hash{'state'} = 0; #see "random stuff" above
- $hash{'badlogins'} = 0; #see "random stuff" above
-
- my $sth = $dbh->prepare(
- "INSERT INTO $radusers ( ". join(', ', keys %hash ). ' ) '.
- 'VALUES ( '. join(', ', map '?', keys %hash ). ' ) '
- ) or die $dbh->errstr;
- $sth->execute( values %hash )
- or die $sth->errstr;
-
- $dbh->disconnect;
-
-}
-
-sub radiator_replace { #subroutine, not method
- my $dbh = radiator_connect(shift, shift, shift);
- my ( $old_username, %hash ) = @_;
-
- my $sth = $dbh->prepare(
- "UPDATE $radusers SET ". join(', ', map " $_ = ?", keys %hash ).
- ' WHERE username = ?'
- ) or die $dbh->errstr;
- $sth->execute( values(%hash), $old_username )
- or die $sth->errstr;
-
- $dbh->disconnect;
-}
-
-sub radiator_delete { #subroutine, not method
- my $dbh = radiator_connect(shift, shift, shift);
- my ( $username ) = @_;
-
- my $sth = $dbh->prepare(
- "DELETE FROM $radusers WHERE username = ?"
- ) or die $dbh->errstr;
- $sth->execute( $username )
- or die $sth->errstr;
-
- $dbh->disconnect;
-}
-
-
-sub radiator_connect {
- #my($datasrc, $username, $password) = @_;
- #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
- DBI->connect(@_) or die $DBI::errstr;
-}
-
-1;
diff --git a/FS/FS/part_export/router.pm b/FS/FS/part_export/router.pm
deleted file mode 100644
index 42aa51c..0000000
--- a/FS/FS/part_export/router.pm
+++ /dev/null
@@ -1,375 +0,0 @@
-package FS::part_export::router;
-
-=head1 FS::part_export::router
-
-This export connects to a router and transmits commands via telnet or SSH.
-It requires the following custom router fields:
-
-=head1 Required custom fields
-
-=over 4
-
-=item admin_address - IP address (or hostname) to connect.
-
-=item admin_user - Username for the router.
-
-=item admin_password - Password for the router.
-
-=item admin_protocol - Protocol to use for the router. 'telnet' or 'ssh'. The ssh protocol only support password-less (ie. RSA key) authentication. As such, the admin_password field isn't used if ssh is specified.
-
-=item admin_timeout - Time in seconds to wait for a connection.
-
-=item admin_prompt - A regular expression matching the router's prompt. See Net::Telnet for details. Only applies to the 'telnet' protocol.
-
-=item admin_cmd_insert - Insert export command.
-
-=item admin_cmd_insert_error - Insert export command error pattern.
-
-=item admin_cmd_delete - Delete export command.
-
-=item admin_cmd_delete_error - Delete export command error pattern.
-
-=item admin_cmd_replace - Replace export command.
-
-=item admin_cmd_replace_error - Replace export command error pattern.
-
-=item admin_cmd_suspend - Suspend export command.
-
-=item admin_cmd_suspend_error - Support export command error pattern.
-
-=item admin_cmd_unsuspend - Unsuspend export command.
-
-=item admin_cmd_unsuspend_error - Unsuspend export command error pattern.
-
-The admin_cmd_* virtual fields, if set, will be processed in one of two ways. After being expanded, they will be run on the router specified by admin_address using the protocol specified by admin_protocol.
-
-=over 4
-
-=item Text::Template
-
-If the export command contains the string [@--, then it will be processed with Text::Template using [@-- and --@] as delimeters.
-
-=item eval
-
-If the export command does not contain [@--, it will be double quoted and eval'd.
-
-=back
-
-The admin_cmd_*_error virtual fields, if set, define a regular expression that will be matched against the output of the command being run. If the pattern matches, an error will be raised using the output as the error.
-
-If any of the required router virtual fields are not defined, then the export silently declines.
-
-=back
-
-The export itself takes no options.
-
-=cut
-
-use strict;
-use vars qw(@ISA %info $me $DEBUG);
-use Tie::IxHash;
-use Text::Template;
-
-use FS::Record qw(qsearchs);
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'protocol' => {
- label=>'Protocol',
- type =>'select',
- options => [qw(telnet ssh)],
- default => 'telnet'},
-;
-
-%info = (
- 'svc' => 'svc_broadband',
- 'desc' => 'Send a command to a router.',
- 'options' => \%options,
- 'notes' => 'Installation of Net::Telnet from CPAN is required for telnet connections. This export will execute if the following virtual fields are set on the router: admin_user, admin_password, admin_address, admin_timeout, admin_prompt. Option virtual fields are: admin_cmd_insert, admin_cmd_replace, admin_cmd_delete, admin_cmd_suspend, admin_cmd_unsuspend. See the module documentation for a full list of required/supported router virtual fields.',
-);
-
-$me = '[' . __PACKAGE__ . ']';
-$DEBUG = 1;
-
-
-sub rebless { shift; }
-
-sub _field_prefix { 'admin'; }
-
-sub _req_router_fields {
- map {
- $_[0]->_field_prefix . '_' . $_
- } (qw(address prompt user));
-}
-
-sub _export_insert {
- my($self) = shift;
- warn "Running insert for " . ref($self);
- $self->_export_command('insert', @_);
-}
-
-sub _export_delete {
- my($self) = shift;
- $self->_export_command('delete', @_);
-}
-
-sub _export_suspend {
- my($self) = shift;
- $self->_export_command('suspend', @_);
-}
-
-sub _export_unsuspend {
- my($self) = shift;
- $self->_export_command('unsuspend', @_);
-}
-
-sub _export_replace {
- my($self) = shift;
- $self->_export_command('replace', @_);
-}
-
-sub _export_command {
- my ($self, $action, $svc_broadband) = (shift, shift, shift);
- my ($error, $old);
-
- if ($action eq 'replace') {
- $old = shift;
- }
-
- warn "[debug]$me Processing action '$action'" if $DEBUG;
-
- # fetch router info
- my $router = $self->_get_router($svc_broadband, @_);
- unless ($router) {
- return "Unable to lookup router for $action export";
- }
-
- unless ($self->_check_router_fields($router)) {
- # Virtual fields aren't defined. Exit silently.
- warn "[debug]$me Required router virtual fields not defined. Returning..."
- if $DEBUG;
- return '';
- }
-
- my $args;
- ($error, $args) = $self->_prepare_args(
- $action,
- $router,
- $svc_broadband,
- ($old ? $old : ()),
- @_
- );
-
- if ($error) {
- # Error occured while preparing args.
- return $error;
- } elsif (not defined $args) {
- # Silently decline.
- warn "[debug]$me Declining '$action' export" if $DEBUG;
- return '';
- } # else ... queue the export.
-
- warn "[debug]$me Queueing with args: " . join(', ', @$args) if $DEBUG;
-
- return(
- $self->_queue(
- $svc_broadband->svcnum,
- $self->_get_cmd_sub($svc_broadband, $router),
- @$args
- )
- );
-
-}
-
-sub _prepare_args {
-
- my ($self, $action, $router, $svc_broadband) = (shift, shift, shift, shift);
- my $old = shift if ($action eq 'replace');
- my $error = '';
-
- my $field_prefix = $self->_field_prefix;
- my $command = $router->getfield("${field_prefix}_cmd_${action}");
- unless ($command) {
- warn "[debug]$me router custom field '${field_prefix}_cmd_$action' "
- . "is not defined." if $DEBUG;
- return '';
- }
-
- if ($command =~ /\[\@--/) { # Use Text::Template
-
- my $template_data = {};
-
- if ($action eq 'replace') {
- $template_data->{"old_$_"} = $old->getfield($_) foreach $old->fields;
- $template_data->{"new_$_"} = $svc_broadband->getfield($_)
- foreach $svc_broadband->fields;
- } else {
- $template_data->{$_} = $svc_broadband->getfield($_)
- foreach $svc_broadband->fields;
- }
-
- my $template = new Text::Template (
- TYPE => 'STRING',
- SOURCE => $command,
- DELIMITERS => [ '[@--', '--@]' ],
- ) or return "Unable to construct template for router command: "
- . $Text::Template::ERROR;
-
- $command = $template->fill_in(
- HASH => $template_data,
- BROKEN_ARG => \$error,
- BROKEN => sub {
- my %bargs = @_;
- my $err = $bargs{'arg'};
- $$err = $bargs{'error'};
- return undef;
- },
- );
-
- if (not defined $command or $error) {
- $error ||= $Text::Template::ERROR;
- return "Unable to fill-in template for router command: $error";
- }
-
- } else { # Use eval
- no strict 'vars';
- no strict 'refs';
-
- if ($action eq 'replace') {
- ${"old_$_"} = $old->getfield($_) foreach $old->fields;
- ${"new_$_"} = $svc_broadband->getfield($_) foreach $svc_broadband->fields;
- $command = eval(qq("$command"));
- } else {
- ${$_} = $svc_broadband->getfield($_) foreach $svc_broadband->fields;
- $command = eval(qq("$command"));
- }
- return $@ if $@;
- }
-
- my $args = [
- 'user' => $router->getfield($field_prefix . '_user'),
- 'password' => $router->getfield($field_prefix . '_password'),
- 'host' => $router->getfield($field_prefix . '_address'),
- 'Timeout' => $router->getfield($field_prefix . '_timeout'),
- 'Prompt' => $router->getfield($field_prefix . '_prompt'),
- 'command' => $command,
- ];
-
- my $error_check = $router->getfield("${field_prefix}_cmd_${action}_error");
- push(@$args, ('error_check' => $error_check)) if ($error_check);
-
- return('', $args);
-
-}
-
-sub _get_cmd_sub {
-
- my ($self, $svc_broadband, $router) = (shift, shift, shift);
-
- my $protocol = (
- $router->getfield($self->_field_prefix . '_protocol') =~ /^(telnet|ssh)$/
- ) ? $1 : 'telnet';
-
- return(ref($self)."::".$protocol."_cmd");
-
-}
-
-sub _check_router_fields {
-
- my ($self, $router, $action) = (shift, shift, shift);
- my @check_fields = $self->_req_router_fields;
-
- foreach (@check_fields) {
- if ($router->getfield($_) eq '') {
- warn "[debug]$me Required field '$_' is unset" if $DEBUG;
- return 0;
- } else {
- return 1;
- }
- }
-
-}
-
-sub _queue {
- my( $self, $svcnum, $cmd_sub ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- };
- $queue->job($cmd_sub);
- $queue->insert(@_);
-}
-
-sub _get_router {
- my ($self, $svc_broadband, %args) = (shift, shift, shift, @_);
-
- my $router;
- if ($args{'routernum'}) {
- $router = qsearchs('router', { routernum => $args{'routernum'}});
- } else {
- $router = $svc_broadband->addr_block->router;
- }
-
- return($router);
-
-}
-
-
-# Subroutines
-sub ssh_cmd {
- my %arg = @_;
-
- eval 'use Net::SSH \'0.08\'';
- die $@ if $@;
-
- my @out = &Net::SSH::ssh_cmd( { @_ } );
- my $error = &_cmd_error_check(\%arg, \@out);
-
- die ("Error while processing ssh command: $error") if $error;
-
- return '';
-
-}
-
-sub telnet_cmd {
- my %arg = @_;
-
- eval 'use Net::Telnet';
- die $@ if $@;
-
- my $t = new Net::Telnet (Timeout => $arg{'Timeout'},
- Prompt => $arg{'Prompt'});
- $t->open($arg{'host'});
- $t->login($arg{'user'}, $arg{'password'});
- my @out = $t->cmd($arg{'command'});
- my $error = &_cmd_error_check(\%arg, \@out);
-
- die ("Error while processing telnet command: $error") if $error;
-
- return '';
-
-}
-
-sub _cmd_error_check {
- my ($arg, $out) = (shift, shift);
-
- die "_cmd_error_check called without proper arguments"
- unless (ref($arg) eq 'HASH' and ref($out) eq 'ARRAY');
-
- unless (exists($arg->{'error_check'}) and $arg->{'error_check'} ne '') {
- #Preserve default behaviour and return output if a check isn't defined.
- warn "Output from router command: " . join('', @$out) if $DEBUG;
- return '';
- }
-
- my $error_check = $arg->{'error_check'};
- foreach (@$out) {
- return $_ if /$error_check/;
- }
-
- return '';
-
-}
-
-1;
diff --git a/FS/FS/part_export/rt_ticket.pm b/FS/FS/part_export/rt_ticket.pm
deleted file mode 100644
index b53b7da..0000000
--- a/FS/FS/part_export/rt_ticket.pm
+++ /dev/null
@@ -1,219 +0,0 @@
-package FS::part_export::rt_ticket;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export;
-use FS::Record qw(qsearch qsearchs);
-use FS::Conf;
-use FS::TicketSystem;
-
-@ISA = qw(FS::part_export);
-
-my %templates;
-my %queues;
-my %template_select = (
- type => 'select',
- freeform => 1,
- option_label => sub {
- $templates{$_[0]};
- },
- option_values => sub {
- %templates = (0 => '',
- map { $_->msgnum, $_->msgname }
- qsearch({ table => 'msg_template',
- hashref => {},
- order_by => 'ORDER BY msgnum ASC'
- })
- );
- sort keys (%templates);
- },
-);
-
-my %queue_select = (
- type => 'select',
- freeform => 1,
- option_label => sub {
- $queues{$_[0]};
- },
- option_values => sub {
- %queues = (0 => '', FS::TicketSystem->queues());
- sort {$queues{$a} cmp $queues{$b}} keys %queues;
- },
-);
-
-tie my %options, 'Tie::IxHash', (
- 'insert_queue' => {
- before => '
-<TR><TD COLSPAN=2>
-<TABLE>
- <TR><TH></TH><TH>Queue</TH><TH>Template</TH></TR>
- <TR><TD>New service</TD><TD>',
- %queue_select,
- after => '</TD>'
- },
- 'insert_template' => {
- before => '<TD>',
- %template_select,
- after => '</TD></TR>
-',
- },
- 'delete_queue' => {
- before => '
- <TR><TD>Delete</TD><TD>',
- %queue_select,
- after => '</TD>',
- },
- 'delete_template' => {
- before => '<TD>',
- %template_select,
- after => '</TD></TR>
-',
- },
- 'replace_queue' => {
- before => '
- <TR><TD>Modify</TD><TD>',
- %queue_select,
- after => '</TD>',
- },
- 'replace_template' => {
- before => '<TD>',
- %template_select,
- after => '</TD></TR>
-',
- },
- 'suspend_queue' => {
- before => '
- <TR><TD>Suspend</TD><TD>',
- %queue_select,
- after => '</TD>',
- },
- 'suspend_template' => {
- before => '<TD>',
- %template_select,
- after => '</TD></TR>
-',
- },
- 'unsuspend_queue' => {
- before => '
- <TR><TD>Unsuspend</TD><TD>',
- %queue_select,
- after => '</TD>',
- },
- 'unsuspend_template' => {
- before => '<TD>',
- %template_select,
- after => '</TD></TR>
- </TABLE>
-</TD></TR>',
- },
- 'requestor' => {
- freeform => 0,
- label => 'Requestor',
- 'type' => 'select',
- option_label => sub {
- my @labels = (
- 'Template From: address',
- 'Customer\'s invoice address',
- );
- $labels[shift];
- },
- option_values => sub { (0, 1) },
- },
-);
-
-%info = (
- 'svc' => [qw( svc_acct svc_broadband svc_phone svc_domain )],
- 'desc' =>
- 'Create an RT ticket',
- 'options' => \%options,
- 'nodomain' => '',
- 'notes' => '
- Create a ticket in RT. The subject and body of the ticket
- will be generated from a message template.'
-);
-
-sub _export_ticket {
- my( $self, $action, $svc ) = (shift, shift, shift);
- my $conf = new FS::Conf;
- die "rt_ticket export - no ticket system configured"
- unless $conf->config('ticket_system');
-
- FS::TicketSystem->init();
-
- my $msgnum = $self->option($action.'_template');
- return if !$msgnum;
-
- my $queue = $self->option($action.'_queue');
- return if !$queue;
-
- my $msg_template = FS::msg_template->by_key($msgnum);
- return "Template $msgnum not found\n" if !$msg_template;
-
- my $cust_pkg = $svc->cust_svc->cust_pkg;
- my $cust_main = $svc->cust_svc->cust_pkg->cust_main if $cust_pkg;
- my $custnum = $cust_main->custnum if $cust_main;
- my $svcnum = $svc->svcnum if $action ne 'delete';
-
- my %msg;
- if ( $action eq 'replace' ) {
- my $old = shift;
- %msg = $msg_template->prepare(
- 'cust_main' => $cust_main,
- 'object' => [ $svc, $old ],
- );
-
- }
- else {
- %msg = $msg_template->prepare(
- 'cust_main' => $cust_main,
- 'object' => $svc,
- );
- }
- my $requestor = $msg{'from'};
- $requestor = [ $cust_main->invoicing_list_emailonly ]
- if $cust_main and $self->option('requestor') == 1;
-
- my $err_or_ticket = FS::TicketSystem->create_ticket(
- '', #session should already exist
- 'queue' => $queue,
- 'subject' => $msg{'subject'},
- 'requestor' => $requestor,
- 'message' => $msg{'html_body'},
- 'mime_type' => 'text/html',
- 'custnum' => $custnum,
- 'svcnum' => $svcnum,
- );
- if( ref($err_or_ticket) ) {
- return '';
- }
- else {
- return $err_or_ticket;
- }
-}
-
-sub _export_insert {
- my($self, $svc) = (shift, shift);
- $self->_export_ticket('insert', $svc);
-}
-
-sub _export_replace {
- my($self, $new, $old) = (shift, shift, shift);
- $self->_export_ticket('replace', $new, $old);
-}
-
-sub _export_delete {
- my($self, $svc) = (shift, shift);
- $self->_export_ticket('delete', $svc);
-}
-
-sub _export_suspend {
- my($self, $svc) = (shift, shift);
- $self->_export_ticket('suspend', $svc);
-}
-
-sub _export_unsuspend {
- my($self, $svc) = (shift, shift);
- $self->_export_ticket('unsuspend', $svc);
-}
-
-1;
diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm
deleted file mode 100644
index 50af45d..0000000
--- a/FS/FS/part_export/shellcommands.pm
+++ /dev/null
@@ -1,480 +0,0 @@
-package FS::part_export::shellcommands;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use String::ShellQuote;
-use FS::part_export;
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'useradd' => { label=>'Insert command',
- default=>'useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username'
- #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir'
- },
- 'useradd_no_queue' => { label=>'Run immediately',
- type => 'checkbox',
- },
- 'useradd_stdin' => { label=>'Insert command STDIN',
- type =>'textarea',
- default=>'',
- },
- 'userdel' => { label=>'Delete command',
- default=>'userdel -r $username',
- #default=>'rm -rf $dir',
- },
- 'userdel_no_queue' => { label=>'Run immediately',
- type =>'checkbox',
- },
- 'userdel_stdin' => { label=>'Delete command STDIN',
- type =>'textarea',
- default=>'',
- },
- 'usermod' => { label=>'Modify command',
- default=>'usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -p $new_crypt_password $old_username',
- #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '.
- # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '.
- # 'find . -depth -print | cpio -pdm $new_dir; '.
- # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '.
- # 'rm -rf $old_dir'.
- #')'
- },
- 'usermod_no_queue' => { label=>'Run immediately',
- type =>'checkbox',
- },
- 'usermod_stdin' => { label=>'Modify command STDIN',
- type =>'textarea',
- default=>'',
- },
- 'usermod_pwonly' => { label=>'Disallow username, domain, uid, gid, and dir changes', #and RADIUS group changes',
- type =>'checkbox',
- },
- 'usermod_nousername' => { label=>'Disallow just username changes',
- type =>'checkbox',
- },
- 'suspend' => { label=>'Suspension command',
- default=>'usermod -L $username',
- },
- 'suspend_no_queue' => { label=>'Run immediately',
- type =>'checkbox',
- },
- 'suspend_stdin' => { label=>'Suspension command STDIN',
- default=>'',
- },
- 'unsuspend' => { label=>'Unsuspension command',
- default=>'usermod -U $username',
- },
- 'unsuspend_no_queue' => { label=>'Run immediately',
- type =>'checkbox',
- },
- 'unsuspend_stdin' => { label=>'Unsuspension command STDIN',
- default=>'',
- },
- 'crypt' => { label => 'Default password encryption',
- type=>'select', options=>[qw(crypt md5)],
- default => 'crypt',
- },
- 'groups_susp_reason' => { label =>
- 'Radius group mapping to reason (via template user)',
- type => 'textarea',
- },
-# 'no_queue' => { label => 'Run command immediately',
-# type => 'checkbox',
-# },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' =>
- 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)',
- 'options' => \%options,
- 'nodomain' => 'Y',
- 'notes' => <<'END'
-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="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>
- <INPUT TYPE="button" VALUE="Linux" onClick='
- this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username";
- this.form.useradd_stdin.value = "";
- this.form.userdel.value = "userdel -r $username";
- this.form.userdel_stdin.value="";
- this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -p $new_crypt_password $old_username";
- this.form.usermod_stdin.value = "";
- this.form.suspend.value = "usermod -L $username";
- this.form.suspend_stdin.value="";
- this.form.unsuspend.value = "usermod -U $username";
- this.form.unsuspend_stdin.value="";
- '>
- <LI>
- <INPUT TYPE="button" VALUE="FreeBSD before 4.10 / 5.3" onClick='
- this.form.useradd.value = "lockf /etc/passwd.lock pw useradd $username -d $dir -m -s $shell -u $uid -c $finger -h 0";
- this.form.useradd_stdin.value = "$_password\n";
- this.form.userdel.value = "lockf /etc/passwd.lock pw userdel $username -r"; this.form.userdel_stdin.value="";
- this.form.usermod.value = "lockf /etc/passwd.lock pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -c $new_finger -h 0";
- this.form.usermod_stdin.value = "$new__password\n"; this.form.suspend.value = "lockf /etc/passwd.lock pw lock $username";
- this.form.suspend_stdin.value="";
- this.form.unsuspend.value = "lockf /etc/passwd.lock pw unlock $username"; this.form.unsuspend_stdin.value="";
- '>
- Note: On FreeBSD versions before 5.3 and 4.10 (4.10 is after 4.9, not
- 4.1!), due to deficient locking in pw(1), you must disable the chpass(1),
- chsh(1), chfn(1), passwd(1), and vipw(1) commands, or replace them with
- wrappers that prepend "lockf /etc/passwd.lock". Alternatively, apply the
- patch in
- <A HREF="http://www.freebsd.org/cgi/query-pr.cgi?pr=23501">FreeBSD PR#23501</A>
- and use the "FreeBSD 4.10 / 5.3 or later" button below.
- <LI>
- <INPUT TYPE="button" VALUE="FreeBSD 4.10 / 5.3 or later" onClick='
- this.form.useradd.value = "pw useradd $username -d $dir -m -s $shell -u $uid -g $gid -c $finger -h 0";
- this.form.useradd_stdin.value = "$_password\n";
- this.form.userdel.value = "pw userdel $username -r";
- this.form.userdel_stdin.value="";
- this.form.usermod.value = "pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -c $new_finger -h 0";
- this.form.usermod_stdin.value = "$new__password\n";
- this.form.suspend.value = "pw lock $username";
- this.form.suspend_stdin.value="";
- this.form.unsuspend.value = "pw unlock $username";
- this.form.unsuspend_stdin.value="";
- '>
- <LI>
- <INPUT TYPE="button" VALUE="NetBSD/OpenBSD" onClick='
- this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username";
- this.form.useradd_stdin.value = "";
- this.form.userdel.value = "userdel -r $username";
- this.form.userdel_stdin.value="";
- this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -p $new_crypt_password $old_username";
- this.form.usermod_stdin.value = "";
- this.form.suspend.value = "";
- this.form.suspend_stdin.value="";
- this.form.unsuspend.value = "";
- this.form.unsuspend_stdin.value="";
- '>
- <LI>
- <INPUT TYPE="button" VALUE="Just maintain directories (use with sysvshell or bsdshell)" onClick='
- this.form.useradd.value = "cp -pr /etc/skel $dir; chown -R $uid.$gid $dir"; this.form.useradd_stdin.value = "";
- this.form.usermod.value = "[ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $new_uid.$new_gid $new_dir; rm -rf $old_dir )";
- this.form.usermod_stdin.value = "";
- this.form.userdel.value = "rm -rf $dir";
- this.form.userdel_stdin.value="";
- this.form.suspend.value = "";
- this.form.suspend_stdin.value="";
- this.form.unsuspend.value = "";
- this.form.unsuspend_stdin.value="";
- '>
-</UL>
-
-The following variables are available for interpolation (prefixed with new_ or
-old_ for replace operations):
-<UL>
- <LI><code>$username</code>
- <LI><code>$_password</code>
- <LI><code>$quoted_password</code> - unencrypted password, already quoted for the shell (do not add additional quotes).
- <LI><code>$crypt_password</code> - encrypted password. When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes).
- <LI><code>$ldap_password</code> - Password in LDAP/RFC2307 format (for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or "{MD5}5426824942db4253f87a1009fd5d2d4"). When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes).
- <LI><code>$uid</code>
- <LI><code>$gid</code>
- <LI><code>$finger</code> - GECOS. When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes).
- <LI><code>$first</code> - First name of GECOS. When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes).
- <LI><code>$last</code> - Last name of GECOS. When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes).
- <LI><code>$dir</code> - home directory
- <LI><code>$shell</code>
- <LI><code>$quota</code>
- <LI><code>@radius_groups</code>
- <LI><code>$reasonnum (when suspending)</code>
- <LI><code>$reasontext (when suspending)</code>
- <LI><code>$reasontypenum (when suspending)</code>
- <LI><code>$reasontypetext (when suspending)</code>
- <LI><code>$pkgnum</code>
- <LI><code>$custnum</code>
- <LI>All other fields in <b>svc_acct</b> are also available.
- <LI>The following fields from <b>cust_main</b> are also available (except during replace): company, address1, address2, city, state, zip, county, daytime, night, fax, otaker, agent_custid. When used on the command line (rather than STDIN), they will be quoted for the shell already (do not add additional quotes).
-</UL>
-END
-);
-
-sub _groups_susp_reason_map { shift->_map('groups_susp_reason'); }
-
-sub _map {
- my $self = shift;
- map { reverse(/^\s*(\S+)\s*(.*)\s*$/) } split("\n", $self->option(shift) );
-}
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self) = shift;
- $self->_export_command('useradd', @_);
-}
-
-sub _export_delete {
- my($self) = shift;
- $self->_export_command('userdel', @_);
-}
-
-sub _export_suspend {
- my($self) = shift;
- $self->_export_command_or_super('suspend', @_);
-}
-
-sub _export_unsuspend {
- my($self) = shift;
- $self->_export_command_or_super('unsuspend', @_);
-}
-
-sub _export_command_or_super {
- my($self, $action) = (shift, shift);
- if ( $self->option($action) =~ /^\s*$/ ) {
- my $method = "SUPER::_export_$action";
- $self->$method(@_);
- } else {
- $self->_export_command($action, @_);
- }
-};
-
-sub _export_command {
- my ( $self, $action, $svc_acct) = (shift, shift, shift);
- my $command = $self->option($action);
- return '' if $command =~ /^\s*$/;
- my $stdin = $self->option($action."_stdin");
-
- no strict 'vars';
- {
- no strict 'refs';
- ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields;
-
- # snarfs are unused at this point?
- my $count = 1;
- foreach my $acct_snarf ( $svc_acct->acct_snarf ) {
- ${"snarf_$_$count"} = shell_quote( $acct_snarf->get($_) )
- foreach qw( machine username _password );
- $count++;
- }
- }
-
- my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
- if ( $cust_pkg ) {
- no strict 'vars';
- {
- no strict 'refs';
- foreach my $custf (qw( company address1 address2 city state zip country
- daytime night fax otaker agent_custid
- ))
- {
- ${$custf} = $cust_pkg->cust_main->$custf();
- }
- }
- $email = ( grep { $_ !~ /^(POST|FAX)$/ } $cust_pkg->cust_main->invoicing_list )[0];
- } else {
- $email = '';
- }
-
- $finger =~ /^(.*)\s+(\S+)$/ or $finger =~ /^((.*))$/;
- ($first, $last ) = ( $1, $2 );
- $domain = $svc_acct->domain;
-
- $quoted_password = shell_quote $_password;
-
- $crypt_password = $svc_acct->crypt_password( $self->option('crypt') );
- $ldap_password = $svc_acct->ldap_password( $self->option('crypt') );
-
- @radius_groups = $svc_acct->radius_groups;
-
- my ($reasonnum, $reasontext, $reasontypenum, $reasontypetext);
- if ( $cust_pkg && $action eq 'suspend' &&
- (my $r = $cust_pkg->last_reason('susp')) )
- {
- $reasonnum = $r->reasonnum;
- $reasontext = $r->reason;
- $reasontypenum = $r->reason_type;
- $reasontypetext = $r->reasontype->type;
-
- my %reasonmap = $self->_groups_susp_reason_map;
- my $userspec = '';
- $userspec = $reasonmap{$reasonnum}
- if exists($reasonmap{$reasonnum});
- $userspec = $reasonmap{$reasontext}
- if (!$userspec && exists($reasonmap{$reasontext}));
-
- my $suspend_user;
- if ( $userspec =~ /^\d+$/ ) {
- $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
- } elsif ( $userspec =~ /^\S+\@\S+$/ ) {
- my ($username,$domain) = split(/\@/, $userspec);
- for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
- $suspend_user = $user if $userspec eq $user->email;
- }
- } elsif ($userspec) {
- $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
- }
-
- @radius_groups = $suspend_user->radius_groups
- if $suspend_user;
-
- } else {
- $reasonnum = $reasontext = $reasontypenum = $reasontypetext = '';
- }
-
- $pkgnum = $cust_pkg ? $cust_pkg->pkgnum : '';
- $custnum = $cust_pkg ? $cust_pkg->custnum : '';
-
- my $stdin_string = eval(qq("$stdin"));
-
- $first = shell_quote $first;
- $last = shell_quote $last;
- $finger = shell_quote $finger;
- $crypt_password = shell_quote $crypt_password;
- $ldap_password = shell_quote $ldap_password;
-
- $company = shell_quote $company;
- $address1 = shell_quote $address1;
- $address2 = shell_quote $address2;
- $city = shell_quote $city;
- $state = shell_quote $state;
- $zip = shell_quote $zip;
- $country = shell_quote $country;
- $daytime = shell_quote $daytime;
- $night = shell_quote $night;
- $fax = shell_quote $fax;
- $otaker = shell_quote $otaker;
- $agent_custid = shell_quote $agent_custid;
-
- my $command_string = eval(qq("$command"));
- my @ssh_cmd_args = (
- user => $self->option('user') || 'root',
- host => $self->machine,
- command => $command_string,
- stdin_string => $stdin_string,
- );
-
- if($self->option($action . '_no_queue')) {
- # discard return value just like freeside-queued.
- eval { ssh_cmd(@ssh_cmd_args) };
- $error = $@;
- return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')'
- if $error;
- }
- else {
- $self->shellcommands_queue( $svc_acct->svcnum, @ssh_cmd_args );
- }
-}
-
-sub _export_replace {
- my($self, $new, $old ) = (shift, shift, shift);
- my $command = $self->option('usermod');
- my $stdin = $self->option('usermod_stdin');
- no strict 'vars';
- {
- no strict 'refs';
- ${"old_$_"} = $old->getfield($_) foreach $old->fields;
- ${"new_$_"} = $new->getfield($_) foreach $new->fields;
- }
- my $old_cust_pkg = $old->cust_svc->cust_pkg;
- my $new_cust_pkg = $new->cust_svc->cust_pkg;
- my $new_cust_main = $new_cust_pkg ? $new_cust_pkg->cust_main : '';
-
- $new_finger =~ /^(.*)\s+(\S+)$/ or $new_finger =~ /^((.*))$/;
- ($new_first, $new_last ) = ( $1, $2 );
- $quoted_new__password = shell_quote $new__password; #old, wrong?
- $new_quoted_password = shell_quote $new__password; #new, better?
- $old_domain = $old->domain;
- $new_domain = $new->domain;
-
- $new_crypt_password = $new->crypt_password( $self->option('crypt') );
- $new_ldap_password = $new->ldap_password( $self->option('crypt') );
-
- @old_radius_groups = $old->radius_groups;
- @new_radius_groups = $new->radius_groups;
-
- my $error = '';
- if ( $self->option('usermod_pwonly') || $self->option('usermod_nousername') ){
- if ( $old_username ne $new_username ) {
- $error ||= "can't change username";
- }
- }
- if ( $self->option('usermod_pwonly') ) {
- if ( $old_domain ne $new_domain ) {
- $error ||= "can't change domain";
- }
- if ( $old_uid != $new_uid ) {
- $error ||= "can't change uid";
- }
- if ( $old_gid != $new_gid ) {
- $error ||= "can't change gid";
- }
- if ( $old_dir ne $new_dir ) {
- $error ||= "can't change dir";
- }
- #if ( join("\n", sort @old_radius_groups) ne
- # join("\n", sort @new_radius_groups) ) {
- # $error ||= "can't change RADIUS groups";
- #}
- }
- return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')'
- if $error;
-
- $new_agent_custid = $new_cust_main ? $new_cust_main->agent_custid : '';
- $old_pkgnum = $old_cust_pkg ? $old_cust_pkg->pkgnum : '';
- $old_custnum = $old_cust_pkg ? $old_cust_pkg->custnum : '';
- $new_pkgnum = $new_cust_pkg ? $new_cust_pkg->pkgnum : '';
- $new_custnum = $new_cust_pkg ? $new_cust_pkg->custnum : '';
-
- my $stdin_string = eval(qq("$stdin"));
-
- $new_first = shell_quote $new_first;
- $new_last = shell_quote $new_last;
- $new_finger = shell_quote $new_finger;
- $new_crypt_password = shell_quote $new_crypt_password;
- $new_ldap_password = shell_quote $new_ldap_password;
- $new_agent_custid = shell_quote $new_agent_custid;
-
- my $command_string = eval(qq("$command"));
-
- my @ssh_cmd_args = (
- user => $self->option('user') || 'root',
- host => $self->machine,
- command => $command_string,
- stdin_string => $stdin_string,
- );
-
- if($self->option('usermod_no_queue')) {
- # discard return value just like freeside-queued.
- eval { ssh_cmd(@ssh_cmd_args) };
- $error = $@;
- return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')'
- if $error;
- }
- else {
- $self->shellcommands_queue( $new->svcnum, @ssh_cmd_args );
- }
-}
-
-#a good idea to queue anything that could fail or take any time
-sub shellcommands_queue {
- my( $self, $svcnum ) = (shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::shellcommands::ssh_cmd",
- };
- $queue->insert( @_ );
-}
-
-sub ssh_cmd { #subroutine, not method
- use Net::SSH '0.08';
- &Net::SSH::ssh_cmd( { @_ } );
-}
-
-#sub shellcommands_insert { #subroutine, not method
-#}
-#sub shellcommands_replace { #subroutine, not method
-#}
-#sub shellcommands_delete { #subroutine, not method
-#}
-
-1;
-
diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm
deleted file mode 100644
index d5a6187..0000000
--- a/FS/FS/part_export/shellcommands_withdomain.pm
+++ /dev/null
@@ -1,138 +0,0 @@
-package FS::part_export::shellcommands_withdomain;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export::shellcommands;
-
-@ISA = qw(FS::part_export::shellcommands);
-
-tie my %options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'useradd' => { label=>'Insert command',
- #default=>''
- },
- 'useradd_stdin' => { label=>'Insert command STDIN',
- type =>'textarea',
- #default=>"$_password\n$_password\n",
- },
- 'useradd_no_queue' => { label => 'Run immediately',
- type => 'checkbox',
- },
- 'userdel' => { label=>'Delete command',
- #default=>'',
- },
- 'userdel_stdin' => { label=>'Delete command STDIN',
- type =>'textarea',
- #default=>'',
- },
- 'userdel_no_queue' => { label => 'Run immediately',
- type => 'checkbox',
- },
- 'usermod' => { label=>'Modify command',
- default=>'',
- },
- 'usermod_stdin' => { label=>'Modify command STDIN',
- type =>'textarea',
- #default=>"$_password\n$_password\n",
- },
- 'usermod_no_queue' => { label => 'Run immediately',
- type => 'checkbox',
- },
- 'usermod_pwonly' => { label=>'Disallow username, domain, uid, dir and RADIUS group changes',
- type =>'checkbox',
- },
- 'usermod_nousername' => { label=>'Disallow just username changes',
- type =>'checkbox',
- },
- 'suspend' => { label=>'Suspension command',
- default=>'',
- },
- 'suspend_stdin' => { label=>'Suspension command STDIN',
- default=>'',
- },
- 'suspend_no_queue' => { label => 'Run immediately',
- type => 'checkbox',
- },
- 'unsuspend' => { label=>'Unsuspension command',
- default=>'',
- },
- 'unsuspend_stdin' => { label=>'Unsuspension command STDIN',
- default=>'',
- },
- 'unsuspend_no_queue' => { label => 'Run immediately',
- type => 'checkbox',
- },
- 'crypt' => { label => 'Default password encryption',
- type=>'select', options=>[qw(crypt md5)],
- default => 'crypt',
- },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export via remote SSH (vpopmail, ISPMan)',
- 'options' => \%options,
- 'notes' => <<'END'
-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="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><INPUT TYPE="button" VALUE="vpopmail" onClick='
- this.form.useradd.value = "/home/vpopmail/bin/vadduser $username\\\@$domain $quoted_password";
- this.form.useradd_stdin.value = "";
- this.form.userdel.value = "/home/vpopmail/bin/vdeluser $username\\\@$domain";
- this.form.userdel_stdin.value="";
- this.form.usermod.value = "/home/vpopmail/bin/vpasswd $new_username\\\@$new_domain $new_quoted_password";
- this.form.usermod_stdin.value = "";
- this.form.usermod_pwonly.checked = true;
- '>
- <LI><INPUT TYPE="button" VALUE="ISPMan CLI" onClick='
- this.form.useradd.value = "/usr/local/ispman/bin/ispman.addUser -d $domain -f $first -l $last -q $quota -p $quoted_password $username";
- this.form.useradd_stdin.value = "";
- this.form.userdel.value = "/usr/local/ispman/bin/ispman.delUser -d $domain $username";
- this.form.userdel_stdin.value="";
- this.form.usermod.value = "/usr/local/ispman/bin/ispman.passwd.user $new_username\\\@$new_domain $new_quoted_password";
- this.form.usermod_stdin.value = "";
- this.form.usermod_pwonly.checked = true;
- '>
- <LI><INPUT TYPE="button" VALUE="MagicMail" onClick='
- this.form.useradd.value = "/usr/bin/mm_create_email_service -e $svcnum -d $domain -u $username -p $quoted_password -f $first -l $last -m $svcnum -g EMAIL";
- this.form.useradd_stdin.value = "";
- this.form.useradd_no_queue.checked = 1;
- this.form.userdel.value = "/usr/bin/mm_delete_user -e ${username}\\\@${domain}";
- this.form.userdel_stdin.value = "";
- this.form.suspend.value = "/usr/bin/mm_suspend_user -e ${username}\\\@${domain}";
- this.form.suspend_stdin.value = "";
- this.form.unsuspend.value = "/usr/bin/mm_activate_user -e ${username}\\\@${domain}";
- this.form.unsuspend_stdin.value = "";
- '>
-</UL>
-
-The following variables are available for interpolation (prefixed with
-<code>new_</code> or <code>old_</code> for replace operations):
-<UL>
- <LI><code>$username</code>
- <LI><code>$domain</code>
- <LI><code>$_password</code>
- <LI><code>$quoted_password</code> - unencrypted password, already quoted for the shell (do not add additional quotes)
- <LI><code>$crypt_password</code> - encrypted password, already quoted for the shell (do not add additional quotes)
- <LI><code>$uid</code>
- <LI><code>$gid</code>
- <LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes)
- <LI><code>$first</code> - First name of GECOS, already quoted for the shell (do not add additional quotes)
- <LI><code>$last</code> - Last name of GECOS, already quoted for the shell (do not add additional quotes)
- <LI><code>$dir</code> - home directory
- <LI><code>$shell</code>
- <LI><code>$quota</code>
- <LI><code>@radius_groups</code>
- <LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available.
-</UL>
-END
-);
-
-1;
-
diff --git a/FS/FS/part_export/snmp.pm b/FS/FS/part_export/snmp.pm
deleted file mode 100644
index 81b3c7e..0000000
--- a/FS/FS/part_export/snmp.pm
+++ /dev/null
@@ -1,256 +0,0 @@
-package FS::part_export::snmp;
-
-=head1 FS::part_export::snmp
-
-This export sends SNMP SETs to a router using the Net::SNMP package. It requires the following custom fields to be defined on a router. If any of the required custom fields are not present, then the export will exit quietly.
-
-=head1 Required custom fields
-
-=over 4
-
-=item snmp_address - IP address (or hostname) of the router/agent
-
-=item snmp_comm - R/W SNMP community of the router/agent
-
-=item snmp_version - SNMP version of the router/agent
-
-=back
-
-=head1 Optional custom fields
-
-=over 4
-
-=item snmp_cmd_insert - SNMP SETs to perform on insert. See L</Formatting>
-
-=item snmp_cmd_replace - SNMP SETs to perform on replace. See L</Formatting>
-
-=item snmp_cmd_delete - SNMP SETs to perform on delete. See L</Formatting>
-
-=item snmp_cmd_suspend - SNMP SETs to perform on suspend. See L</Formatting>
-
-=item snmp_cmd_unsuspend - SNMP SETs to perform on unsuspend. See L</Formatting>
-
-=back
-
-=head1 Formatting
-
-The values for the snmp_cmd_* fields should be formatted as follows:
-
-<OID>|<Data Type>|<expr>[||<OID>|<Data Type>|<expr>[...]]
-
-=over 4
-
-=item OID - SNMP object ID (ex. 1.3.6.1.4.1.1.20). If the OID string starts with a '.', then the Private Enterprise OID (1.3.6.1.4.1) is prepended.
-
-=item Data Type - SNMP data types understood by L<Net::SNMP>, as well as HEX_STRING for convenience. ex. INTEGER, OCTET_STRING, IPADDRESS, ...
-
-=item expr - Expression to be eval'd by freeside. By default, the expression is double quoted and eval'd with all FS::svc_broadband fields available as scalars (ex. $svcnum, $ip_addr, $speed_up). However, if the expression contains a non-escaped double quote, the expression is eval'd without being double quoted. In this case, the expression must be a block of valid perl code that returns the desired value.
-
-You must escape non-delimiter pipes ("|") with a backslash.
-
-=back
-
-=head1 Examples
-
-This is an example for exporting to a Trango Access5830 AP. Newlines inserted for clarity.
-
-=over 4
-
-=item snmp_cmd_delete -
-
-1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50||
-1.3.6.1.4.1.5454.1.20.3.5.8|INTEGER|1|
-
-=item snmp_cmd_insert -
-
-1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50||
-1.3.6.1.4.1.5454.1.20.3.5.2|HEX_STRING|join("",$radio_addr =~ /[0-9a-fA-F]{2}/g)||
-1.3.6.1.4.1.5454.1.20.3.5.7|INTEGER|1|
-
-=item snmp_cmd_replace -
-
-1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50||
-1.3.6.1.4.1.5454.1.20.3.5.8|INTEGER|1||1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50||
-1.3.6.1.4.1.5454.1.20.3.5.2|HEX_STRING|join("",$new_radio_addr =~ /[0-9a-fA-F]{2}/g)||
-1.3.6.1.4.1.5454.1.20.3.5.7|INTEGER|1|
-
-=back
-
-=cut
-
-
-use strict;
-use vars qw(@ISA %info $me $DEBUG);
-use Tie::IxHash;
-use FS::Record qw(qsearch qsearchs);
-use FS::part_export;
-use FS::part_export::router;
-
-@ISA = qw(FS::part_export::router);
-
-tie my %options, 'Tie::IxHash', ();
-
-%info = (
- 'svc' => 'svc_broadband',
- 'desc' => 'Sends SNMP SETs to an SNMP agent.',
- 'options' => \%options,
- 'notes' => 'Requires Net::SNMP. See the documentation for FS::part_export::snmp for required virtual fields and usage information.',
-);
-
-$me= '[' . __PACKAGE__ . ']';
-$DEBUG = 1;
-
-
-sub _field_prefix { 'snmp'; }
-
-sub _req_router_fields {
- map {
- $_[0]->_field_prefix . '_' . $_
- } (qw(address comm version));
-}
-
-sub _get_cmd_sub {
-
- my ($self, $svc_broadband, $router) = (shift, shift, shift);
-
- return(ref($self) . '::snmp_cmd');
-
-}
-
-sub _prepare_args {
-
- my ($self, $action, $router) = (shift, shift, shift);
- my ($svc_broadband) = shift;
- my $old;
- my $field_prefix = $self->_field_prefix;
-
- if ($action eq 'replace') { $old = shift; }
-
- my $raw_cmd = $router->getfield("${field_prefix}_cmd_${action}");
- unless ($raw_cmd) {
- warn "[debug]$me router custom field '${field_prefix}_cmd_$action' "
- . "is not defined." if $DEBUG;
- return '';
- }
-
- my $args = [
- '-hostname' => $router->getfield($field_prefix.'_address'),
- '-version' => $router->getfield($field_prefix.'_version'),
- '-community' => $router->getfield($field_prefix.'_comm'),
- ];
-
- my @varbindlist = ();
-
- foreach my $snmp_cmd ($raw_cmd =~ m/(.*?[^\\])(?:\|\||$)/g) {
-
- warn "[debug]$me snmp_cmd is '$snmp_cmd'" if $DEBUG;
-
- my ($oid, $type, $expr) = $snmp_cmd =~ m/(.*?[^\\])(?:\||$)/g;
-
- if ($oid =~ /^([\d\.]+)$/) {
- $oid = $1;
- $oid = ($oid =~ /^\./) ? '1.3.6.1.4.1' . $oid : $oid;
- } else {
- return "Invalid SNMP OID '$oid'";
- }
-
- if ($type =~ /^([A-Z_\d]+)$/) {
- $type = $1;
- } else {
- return "Invalid SNMP ASN.1 type '$type'";
- }
-
- if ($expr =~ /^(.*)$/) {
- $expr = $1;
- } else {
- return "Invalid expression '$expr'";
- }
-
- {
- no strict 'vars';
- no strict 'refs';
-
- if ($action eq 'replace') {
- ${"old_$_"} = $old->getfield($_) foreach $old->fields;
- ${"new_$_"} = $svc_broadband->getfield($_) foreach $svc_broadband->fields;
- $expr = ($expr =~/[^\\]"/) ? eval($expr) : eval(qq("$expr"));
- } else {
- ${$_} = $svc_broadband->getfield($_) foreach $svc_broadband->fields;
- $expr = ($expr =~/[^\\]"/) ? eval($expr) : eval(qq("$expr"));
- }
- return $@ if $@;
- }
-
- push @varbindlist, ($oid, $type, $expr);
-
- }
-
- push @$args, ('-varbindlist', @varbindlist);
-
- return('', $args);
-
-}
-
-sub snmp_cmd {
- eval "use Net::SNMP;";
- die $@ if $@;
-
- my %args = ();
- my @varbindlist = ();
- while (scalar(@_)) {
- my $key = shift;
- if ($key eq '-varbindlist') {
- push @varbindlist, @_;
- last;
- } else {
- $args{$key} = shift;
- }
- }
-
- my $i = 0;
- while ($i*3 < scalar(@varbindlist)) {
- my $type_index = ($i*3)+1;
- my $type_name = $varbindlist[$type_index];
-
- # Implementing HEX_STRING outselves since Net::SNMP doesn't. Ewwww!
- if ($type_name eq 'HEX_STRING') {
- my $value_index = $type_index + 1;
- $type_name = 'OCTET_STRING';
- $varbindlist[$value_index] = pack('H*', $varbindlist[$value_index]);
- }
-
- my $type = eval "Net::SNMP::$type_name";
- if ($@ or not defined $type) {
- warn $@ if $DEBUG;
- die "snmp_cmd error: Unable to lookup type '$type_name'";
- }
-
- $varbindlist[$type_index] = $type;
- } continue {
- $i++;
- }
-
- my ($snmp, $error) = Net::SNMP->session(%args);
- die "snmp_cmd error: $error" unless($snmp);
-
- my $res = $snmp->set_request('-varbindlist' => \@varbindlist);
- unless($res) {
- $error = $snmp->error;
- $snmp->close;
- die "snmp_cmd error: " . $error;
- }
-
- $snmp->close;
-
- return '';
-
-}
-
-
-=head1 BUGS
-
-Plenty, I'm sure.
-
-=cut
-
-1;
diff --git a/FS/FS/part_export/soma.pm b/FS/FS/part_export/soma.pm
deleted file mode 100644
index c73d9f9..0000000
--- a/FS/FS/part_export/soma.pm
+++ /dev/null
@@ -1,412 +0,0 @@
-package FS::part_export::soma;
-
-use vars qw(@ISA %info %options $DEBUG);
-use Tie::IxHash;
-use FS::Record qw(fields dbh);
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-$DEBUG = 1;
-
-tie %options, 'Tie::IxHash',
- 'url' => { label => 'Soma OSS-API url', default=>'https://localhost:8088/ossapi/services' },
- 'data_app_id' => { label => 'SOMA Data Application Id', default => '' },
-;
-
-my $notes = <<'EOT';
-Real-time export of <b>svc_external</b> and <b>svc_broadband</b> record data
-to SOMA Networks <a href="http://www.somanetworks.com">platform</a> via the
-OSS-API.<br><br>
-
-Freeside will attempt to create/delete a cpe for the ESN provided in
-svc_external. If a data application id is provided then freeside will
-use the values provided in svc_broadband to manage the attributes and
-features of that cpe.
-
-EOT
-
-%info = (
- 'svc' => [ qw ( svc_broadband svc_external ) ],
- 'desc' => 'Real-time export to SOMA platform',
- 'options' => \%options,
- 'nodomain' => 'Y',
- 'notes' => $notes,
-);
-
-sub _export_insert {
- my( $self, $svc ) = ( shift, shift );
-
- warn "_export_insert called for service ". $svc->svcnum
- if $DEBUG;
-
- my %args = ( url => $self->option('url'), method => '_queueable_insert' );
-
- $args{esn} = $self->esn($svc) or return 'No ESN found!';
-
- my $svcdb = $svc->cust_svc->part_svc->svcdb;
- $args{svcdb} = $svcdb;
- if ( $svcdb eq 'svc_external' ) {
- #do nothing
- } elsif ( $svcdb eq 'svc_broadband' ){
- $args{data_app_id} = $self->option('data_app_id')
- } else {
- return "Don't know how to provision $svcdb";
- }
-
- warn "dispatching statuschange" if $DEBUG;
-
- eval { statuschange(%args) };
- return $@ if $@;
-
- '';
-}
-
-sub _export_delete {
- my( $self, $svc ) = ( shift, shift );
-
- my %args = ( url => $self->option('url'), method => '_queueable_delete' );
-
- $args{esn} = $self->esn($svc) or return 'No ESN found!';
-
- my $svcdb = $svc->cust_svc->part_svc->svcdb;
- $args{svcdb} = $svcdb;
- if ( $svcdb eq 'svc_external' ) {
- #do nothing
- } elsif ( $svcdb eq 'svc_broadband' ){
- $args{data_app_id} = $self->option('data_app_id')
- } else {
- return "Don't know how to provision $svcdb";
- }
-
- eval { statuschange(%args) };
- return $@ if $@;
-
- '';
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = ( shift, shift, shift );
-
- my %args = ( url => $self->option('url'), method => '_queueable_replace' );
-
- $args{esn} = $self->esn($old) or return 'No old ESN found!';
- $args{new_esn} = $self->esn($new) or return 'No new ESN found!';
-
- my $svcdb = $old->cust_svc->part_svc->svcdb;
- $args{svcdb} = $svcdb;
- if ( $svcdb eq 'svc_external' ) {
- #do nothing
- } elsif ( $svcdb eq 'svc_broadband' ){
- $args{data_app_id} = $self->option('data_app_id')
- } else {
- return "Don't know how to provision $svcdb";
- }
-
- eval { statuschange(%args) };
- return $@ if $@;
-
- '';
-}
-
-sub _export_suspend {
- my( $self, $svc ) = ( shift, shift );
-
- $self->queue_statuschange('_queueable_suspend', $svc);
-}
-
-sub _export_unsuspend {
- my( $self, $svc ) = ( shift, shift );
-
- $self->queue_statuschange('_queueable_unsuspend', $svc);
-}
-
-sub queue_statuschange {
- my( $self, $method, $svc ) = @_;
-
- my %args = ( url => $self->option('url'), method => $method );
-
- my $svcdb = $svc->cust_svc->part_svc->svcdb;
- $args{svcdb} = $svcdb;
- if ( $svcdb eq 'svc_external' ) {
- #do absolutely nothing
- return '';
- } elsif ( $svcdb eq 'svc_broadband' ){
- $args{data_app_id} = $self->option('data_app_id')
- } else {
- return "Don't know how to provision $svcdb";
- }
-
- $args{esn} = $self->esn($svc);
-
- my $queue = new FS::queue {
- 'svcnum' => $svc->svcnum,
- 'job' => 'FS::part_export::soma::statuschange',
- };
- my $error = $queue->insert( %args );
-
- return $error if $error;
-
- '';
-
-}
-
-sub statuschange { # subroutine
- my( %options ) = @_;
-
- warn "statuschange called with options ".
- join (', ', map { "$_ => $options{$_}" } keys(%options))
- if $DEBUG;
-
- my $method = $options{method};
-
- eval "use Net::Soma 0.01 qw(ApplicationDef ApplicationInstance
- AttributeDef AttributeInstance);";
- die $@ if $@;
-
- my %soma_objects = ();
- foreach my $service ( qw ( CPECollection CPEAccess AppCatalog Applications ) )
- {
- $soma_objects{$service} = new Net::Soma ( namespace => $service."Service",
- url => $options{'url'},
- die_on_fault => 1,
- );
- }
-
- my $cpeid = eval {$soma_objects{CPECollection}->getCPEByESN( $options{esn} )};
- warn "failed to find CPE with ESN $options{esn}"
- if ($DEBUG && !$cpeid);
-
- if ( $method eq '_queueable_insert' && $options{svcdb} eq 'svc_external' ) {
- if ( !$cpeid ) {
- # only type 1 is used at this time
- $cpeid = $soma_objects{CPECollection}->createCPE( $options{esn}, 1 );
- } else {
- $soma_objects{CPECollection}->releaseCPE( $cpeid );
- die "Soma element for $options{esn} already exists";
- }
- }
-
- die "Can't find soma element for $options{esn}"
- unless $cpeid;
-
- warn "dispatching $method from statuschange" if $DEBUG;
- &{$method}( \%soma_objects, $cpeid, %options );
-
-}
-
-sub _queueable_insert {
- my( $soma_objects, $cpeid, %options ) = @_;
-
- warn "_queueable_insert called for $cpeid with options ".
- join (', ', map { "$_ => $options{$_}" } keys(%options))
- if $DEBUG;
-
- my $appid = $options{data_app_id};
- if ($appid) {
- my $application =
- $soma_objects->{AppCatalog}
- ->getDefaultApplicationInstance($appid, $cpeid);
-
- my $attribute =
- $soma_objects->{AppCatalog}
- ->getDefaultApplicationAttributeInstance(2, 1, $cpeid);
- $attribute->value('G');
-
- my $i = 0;
- foreach my $instance (@{$application->attributes}) {
- unless ($instance->definitionId == $attribute->definitionId) {
- $i++; next;
- }
- $application->attributes->[$i] = $attribute;
- last;
- }
-
- $soma_objects->{Applications}->subscribeApp( $cpeid, $application );
- }
-
- $soma_objects->{CPECollection}->releaseCPE( $cpeid );
-
- '';
-}
-
-sub _queueable_delete {
- my( $soma_objects, $cpeid, %options ) = @_;
-
- my $appid = $options{data_app_id};
- my $norelease;
-
- if ($appid) {
- my $applications =
- $soma_objects->{Applications}->getSubscribedApplications( $cpeid );
-
- my $instance_id;
- foreach $application (@$applications) {
- next unless $application->definitionId == $appid;
- $instance_id = $application->instanceId;
- }
-
- $soma_objects->{Applications}->unsubscribeApp( $cpeid, $instance_id );
-
- } else {
-
- $soma_objects->{CPECollection}->deleteCPE($cpeid);
- $norelease = 1;
-
- }
-
- $soma_objects->{CPECollection}->releaseCPE( $cpeid ) unless $norelease;
-
- '';
-}
-
-sub _queueable_replace {
- my( $soma_objects, $cpeid, %options ) = @_;
-
- my $appid = $options{data_app_id} || '';
-
- if (exists($options{data_app_id})) {
- my $applications =
- $soma_objects->{Applications}->getSubscribedApplications( $cpeid );
-
- my $instance_id;
- foreach $application (@$applications) {
- next unless $application->internalName eq 'dataApplication';
- if ($application->definitionId != $options{data_app_id}) {
- $instance_id = $application->instanceId;
- $soma_objects->{Applications}->unsubscribeApp( $cpeid, $instance_id );
- }
- }
-
- if ($appid && !$instance_id ) {
- my $application =
- $soma_objects->{AppCatalog}
- ->getDefaultApplicationInstance($appid, $cpeid);
-
- $soma_objects->{Applications}->subscribeApp( $cpeid, $application );
- }
-
- } else {
-
- $soma_objects->{CPEAccess}->switchCPE($cpeid, $options{new_esn})
- unless( $options{new_esn} eq $options{esn});
-
- }
-
- $soma_objects->{CPECollection}->releaseCPE( $cpeid );
-
- '';
-}
-
-sub _queueable_suspend {
- my( $soma_objects, $cpeid, %options ) = @_;
-
- my $appid = $options{data_app_id};
-
- if ($appid) {
- my $applications =
- $soma_objects->{Applications}->getSubscribedApplications( $cpeid );
-
- my $instance_id;
- foreach $application (@$applications) {
- next unless $application->definitionId == $appid;
-
- $instance_id = $application->instanceId;
- my $app_def =
- $soma_objects->{AppCatalog}->getApplicationDef($appid, $cpeid);
- my @attr_def = grep { $_->internalName eq 'status' }
- @{$app_def->attributes};
-
- foreach my $attribute ( @{$application->attributes} ) {
- next unless $attribute->definitionId == $attr_def[0]->definitionId;
- $attribute->{value} = 'S';
-
- $soma_objects->{Applications}->setAppAttribute( $cpeid,
- $instance_id,
- $attribute
- );
- }
-
- }
-
- } else {
-
- #do nothing
-
- }
-
- $soma_objects->{CPECollection}->releaseCPE( $cpeid );
-
- '';
-}
-
-sub _queueable_unsuspend {
- my( $soma_objects, $cpeid, %options ) = @_;
-
- my $appid = $options{data_app_id};
-
- if ($appid) {
- my $applications =
- $soma_objects->{Applications}->getSubscribedApplications( $cpeid );
-
- my $instance_id;
- foreach $application (@$applications) {
- next unless $application->definitionId == $appid;
-
- $instance_id = $application->instanceId;
- my $app_def =
- $soma_objects->{AppCatalog}->getApplicationDef($appid, $cpeid);
- my @attr_def = grep { $_->internalName eq 'status' }
- @{$app_def->attributes};
-
- foreach my $attribute ( @{$application->attributes} ) {
- next unless $attribute->definitionId == $attr_def[0]->definitionId;
- $attribute->{value} = 'E';
-
- $soma_objects->{Applications}->setAppAttribute( $cpeid,
- $instance_id,
- $attribute
- );
- }
-
- }
-
- } else {
-
- #do nothing
-
- }
-
- $soma_objects->{CPECollection}->releaseCPE( $cpeid );
-
- '';
-}
-
-sub esn {
- my ( $self, $svc ) = @_;
- my $svcdb = $svc->cust_svc->part_svc->svcdb;
-
- if ($svcdb eq 'svc_external') {
- my $esn = $svc->title;
- $esn =~ /^\s*([\da-fA-F]{1,16})\s*$/ && ($esn = $1);
- return sprintf( '%016s', $esn );
- }
-
- my $cust_pkg = $svc->cust_svc->cust_pkg;
- return '' unless $cust_pkg;
-
- my @cust_svc = grep { $_->part_svc->svcdb eq 'svc_external' &&
- scalar( $_->part_svc->part_export('soma') )
- }
- $cust_pkg->cust_svc;
- return '' unless scalar(@cust_svc);
- warn "part_export::soma found multiple ESNs for cust_svc ". $svc->svcnum
- if scalar( @cust_svc ) > 1;
-
- my $esn = $cust_svc[0]->svc_x->title;
- $esn =~ /^\s*([\da-fA-F]{1,16})\s*$/ && ($esn = $1);
-
- sprintf( '%016s', $esn );
-}
-
-
-1;
diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm
deleted file mode 100644
index cbdaf7f..0000000
--- a/FS/FS/part_export/sqlmail.pm
+++ /dev/null
@@ -1,220 +0,0 @@
-package FS::part_export::sqlmail;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use Digest::MD5 qw(md5_hex);
-use FS::Record qw(qsearchs);
-use FS::part_export;
-use FS::svc_domain;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'datasrc' => { label => 'DBI data source' },
- 'username' => { label => 'Database username' },
- 'password' => { label => 'Database password' },
- 'server_type' => {
- label => 'Server type',
- type => 'select',
- options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain
- courier_crypt)],
- default => ['dovecot_plain'], },
- 'svc_acct_table' => { label => 'User Table', default => 'user_acct' },
- 'svc_forward_table' => { label => 'Forward Table', default => 'forward' },
- 'svc_domain_table' => { label => 'Domain Table', default => 'domain' },
- 'svc_acct_fields' => { label => 'svc_acct Export Fields',
- default => 'username _password domsvc svcnum' },
- 'svc_forward_fields' => { label => 'svc_forward Export Fields',
- default => 'srcsvc dstsvc dst' },
- 'svc_domain_fields' => { label => 'svc_domain Export Fields',
- default => 'domain svcnum catchall' },
- 'resolve_dstsvc' => { label => q{Resolve svc_forward.dstsvc to an email address and store it in dst. (Doesn't require that you also export dstsvc.)},
- type => 'checkbox' },
-;
-
-%info = (
- 'svc' => [qw( svc_acct svc_domain svc_forward )],
- 'desc' => 'Real-time export to SQL-backed mail server',
- 'options' => \%options,
- 'nodomain' => '',
- 'notes' => <<'END'
-Database schema can be made to work with Courier IMAP, Exim and Dovecot.
-Others could work but are untested. (more detailed description from
-Kristian / fire2wire? )
-END
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self, $svc) = (shift, shift);
- # this is a svc_something.
-
- my $svcdb = $svc->cust_svc->part_svc->svcdb;
- my $export_table = $self->option($svcdb . '_table')
- or die('Export table not defined for svcdb: ' . $svcdb);
- my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
- my $svchash = update_values($self, $svc, $svcdb);
-
- foreach my $key (keys(%$svchash)) {
- unless (grep { $key eq $_ } @export_fields) {
- delete $svchash->{$key};
- }
- }
-
- my $error = $self->sqlmail_queue( $svc->svcnum, 'insert',
- $self->option('server_type'), $export_table,
- (map { ($_, $svchash->{$_}); } keys(%$svchash)));
- return $error if $error;
- '';
-
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
-
- my $svcdb = $new->cust_svc->part_svc->svcdb;
- my $export_table = $self->option($svcdb . '_table')
- or die('Export table not defined for svcdb: ' . $svcdb);
- my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
- my $svchash = update_values($self, $new, $svcdb);
-
- foreach my $key (keys(%$svchash)) {
- unless (grep { $key eq $_ } @export_fields) {
- delete $svchash->{$key};
- }
- }
-
- my $error = $self->sqlmail_queue( $new->svcnum, 'replace',
- $old->svcnum, $self->option('server_type'), $export_table,
- (map { ($_, $svchash->{$_}); } keys(%$svchash)));
- return $error if $error;
- '';
-
-}
-
-sub _export_delete {
- my( $self, $svc ) = (shift, shift);
-
- my $svcdb = $svc->cust_svc->part_svc->svcdb;
- my $table = $self->option($svcdb . '_table')
- or die('Export table not defined for svcdb: ' . $svcdb);
-
- $self->sqlmail_queue( $svc->svcnum, 'delete', $table,
- $svc->svcnum );
-}
-
-sub sqlmail_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::sqlmail::sqlmail_$method",
- };
- $queue->insert(
- $self->option('datasrc'),
- $self->option('username'),
- $self->option('password'),
- @_,
- );
-}
-
-sub sqlmail_insert { #subroutine, not method
- my $dbh = sqlmail_connect(shift, shift, shift);
- my( $server_type, $table ) = (shift, shift);
-
- my %attrs = @_;
-
- map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
- my $query = sprintf("INSERT INTO %s (%s) values (%s)",
- $table, join(",", keys(%attrs)),
- join(',', values(%attrs)));
-
- $dbh->do($query) or die $dbh->errstr;
- $dbh->disconnect;
-
- '';
-}
-
-sub sqlmail_delete { #subroutine, not method
- my $dbh = sqlmail_connect(shift, shift, shift);
- my( $table, $svcnum ) = @_;
-
- $dbh->do("DELETE FROM $table WHERE svcnum = $svcnum") or die $dbh->errstr;
- $dbh->disconnect;
-
- '';
-}
-
-sub sqlmail_replace {
- my $dbh = sqlmail_connect(shift, shift, shift);
- my($oldsvcnum, $server_type, $table) = (shift, shift, shift);
-
- my %attrs = @_;
- map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
-
- my $query = "SELECT COUNT(*) FROM $table WHERE svcnum = $oldsvcnum";
- my $result = $dbh->selectrow_arrayref($query) or die $dbh->errstr;
-
- if (@$result[0] == 0) {
- $query = sprintf("INSERT INTO %s (%s) values (%s)",
- $table, join(",", keys(%attrs)),
- join(',', values(%attrs)));
- $dbh->do($query) or die $dbh->errstr;
- } else {
- $query = sprintf('UPDATE %s SET %s WHERE svcnum = %s',
- $table, join(', ', map {"$_ = $attrs{$_}"} keys(%attrs)),
- $oldsvcnum);
- $dbh->do($query) or die $dbh->errstr;
- }
-
- $dbh->disconnect;
-
- '';
-}
-
-sub sqlmail_connect {
- DBI->connect(@_) or die $DBI::errstr;
-}
-
-sub update_values {
-
- # Update records to conform to a particular server_type.
-
- my ($self, $svc, $svcdb) = (shift,shift,shift);
- my $svchash = { %{$svc->hashref} } or return ''; # We need a copy.
-
- if ($svcdb eq 'svc_acct') {
- if ($self->option('server_type') eq 'courier_crypt') {
- my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
- $svchash->{_password} = crypt($svchash->{_password}, $salt);
-
- } elsif ($self->option('server_type') eq 'dovecot_plain') {
- $svchash->{_password} = '{PLAIN}' . $svchash->{_password};
-
- } elsif ($self->option('server_type') eq 'dovecot_crypt') {
- my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
- $svchash->{_password} = '{CRYPT}' . crypt($svchash->{_password}, $salt);
-
- } elsif ($self->option('server_type') eq 'dovecot_digest_md5') {
- my $svc_domain = qsearchs('svc_domain', { svcnum => $svc->domsvc });
- die('Unable to lookup svc_domain with domsvc: ' . $svc->domsvc)
- unless ($svc_domain);
-
- my $domain = $svc_domain->domain;
- my $md5hash = '{DIGEST-MD5}' . md5_hex(join(':', $svchash->{username},
- $domain, $svchash->{_password}));
- $svchash->{_password} = $md5hash;
- }
- } elsif ($svcdb eq 'svc_forward') {
- if ($self->option('resolve_dstsvc') && $svc->dstsvc_acct) {
- $svchash->{dst} = $svc->dstsvc_acct->username . '@' .
- $svc->dstsvc_acct->svc_domain->domain;
- }
- }
-
- return($svchash);
-
-}
-
-1;
-
diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm
deleted file mode 100644
index 15aa986..0000000
--- a/FS/FS/part_export/sqlradius.pm
+++ /dev/null
@@ -1,861 +0,0 @@
-package FS::part_export::sqlradius;
-
-use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2);
-use Exporter;
-use Tie::IxHash;
-use FS::Record qw( dbh qsearch qsearchs str2time_sql );
-use FS::part_export;
-use FS::svc_acct;
-use FS::export_svc;
-use Carp qw( cluck );
-
-@ISA = qw(FS::part_export);
-@EXPORT_OK = qw( sqlradius_connect );
-
-$DEBUG = 0;
-
-tie %options, 'Tie::IxHash',
- 'datasrc' => { label=>'DBI data source ' },
- 'username' => { label=>'Database username' },
- 'password' => { label=>'Database password' },
- 'usergroup' => { label => 'Group table',
- type => 'select',
- options => [qw( usergroup radusergroup ) ],
- },
- 'ignore_accounting' => {
- type => 'checkbox',
- label => 'Ignore accounting records from this database'
- },
- 'process_single_realm' => {
- type => 'checkbox',
- label => 'Only process one realm of accounting records',
- },
- 'realm' => { label => 'The realm of of accounting records to be processed' },
- 'ignore_long_sessions' => {
- type => 'checkbox',
- label => 'Ignore sessions which span billing periods',
- },
- 'hide_ip' => {
- type => 'checkbox',
- label => 'Hide IP address information on session reports',
- },
- 'hide_data' => {
- type => 'checkbox',
- label => 'Hide download/upload information on session reports',
- },
- 'show_called_station' => {
- type => 'checkbox',
- label => 'Show the Called-Station-ID on session reports',
- },
- 'overlimit_groups' => { label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit (if not overridden by overlimit_groups global or per-agent config)', } ,
- 'groups_susp_reason' => { label =>
- 'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)',
- type => 'textarea',
- },
-
-;
-
-$notes1 = <<'END';
-Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>/<b>radusergroup</b>
-tables to any SQL database for
-<a href="http://www.freeradius.org/">FreeRADIUS</a>
-or <a href="http://radius.innercite.com/">ICRADIUS</a>.
-END
-
-$notes2 = <<'END';
-An existing RADIUS database will be updated in realtime, but you can use
-<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
-to delete the entire RADIUS database and repopulate the tables from the
-Freeside database. See the
-<a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
-and the
-<a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
-for the exact syntax of a DBI data source.
-<ul>
- <li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected.
- <li>Using ICRADIUS, add a dummy "op" column to your database:
- <blockquote><code>
- ALTER&nbsp;TABLE&nbsp;radcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
- ALTER&nbsp;TABLE&nbsp;radreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
- ALTER&nbsp;TABLE&nbsp;radgroupcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
- ALTER&nbsp;TABLE&nbsp;radgroupreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='
- </code></blockquote>
- <li>Using Radiator, see the
- <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
- for configuration information.
-</ul>
-END
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
- 'options' => \%options,
- 'nodomain' => 'Y',
- 'notes' => $notes1.
- 'This export does not export RADIUS realms (see also '.
- 'sqlradius_withdomain). '.
- $notes2
-);
-
-sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
- split( "\n", shift->option('groups_susp_reason'));
-}
-
-sub rebless { shift; }
-
-sub export_username {
- my($self, $svc_acct) = (shift, shift);
- warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
- $svc_acct->username;
-}
-
-sub _export_insert {
- my($self, $svc_x) = (shift, shift);
-
- foreach my $table (qw(reply check)) {
- my $method = "radius_$table";
- my %attrib = $svc_x->$method();
- next unless keys %attrib;
- my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert',
- $table, $self->export_username($svc_x), %attrib );
- return $err_or_queue unless ref($err_or_queue);
- }
- my @groups = $svc_x->radius_groups;
- if ( @groups ) {
- cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
- " (". $self->export_username($svc_x). " with ". join(", ", @groups)
- if $DEBUG;
- my $usergroup = $self->option('usergroup') || 'usergroup';
- my $err_or_queue = $self->sqlradius_queue(
- $svc_x->svcnum, 'usergroup_insert',
- $self->export_username($svc_x), $usergroup, @groups );
- return $err_or_queue unless ref($err_or_queue);
- }
- '';
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, 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 $jobnum = '';
- if ( $self->export_username($old) ne $self->export_username($new) ) {
- my $usergroup = $self->option('usergroup') || 'usergroup';
- my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
- $self->export_username($new), $self->export_username($old), $usergroup );
- unless ( ref($err_or_queue) ) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
- $jobnum = $err_or_queue->jobnum;
- }
-
- foreach my $table (qw(reply check)) {
- my $method = "radius_$table";
- my %new = $new->$method();
- my %old = $old->$method();
- if ( grep { !exists $old{$_} #new attributes
- || $new{$_} ne $old{$_} #changed
- } keys %new
- ) {
- my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
- $table, $self->export_username($new), %new );
- unless ( ref($err_or_queue) ) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
- if ( $jobnum ) {
- my $error = $err_or_queue->depend_insert( $jobnum );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- my @del = grep { !exists $new{$_} } keys %old;
- if ( @del ) {
- my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
- $table, $self->export_username($new), @del );
- unless ( ref($err_or_queue) ) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
- if ( $jobnum ) {
- my $error = $err_or_queue->depend_insert( $jobnum );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
- }
-
- my $error;
- my (@oldgroups) = $old->radius_groups;
- my (@newgroups) = $new->radius_groups;
- $error = $self->sqlreplace_usergroups( $new->svcnum,
- $self->export_username($new),
- $jobnum ? $jobnum : '',
- \@oldgroups,
- \@newgroups,
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-sub _export_suspend {
- my( $self, $svc_acct ) = (shift, shift);
-
- my $new = $svc_acct->clone_suspended;
-
- 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 $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
- 'check', $self->export_username($new), $new->radius_check );
- unless ( ref($err_or_queue) ) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
-
- my $error;
- my (@newgroups) = $self->suspended_usergroups($svc_acct);
- $error =
- $self->sqlreplace_usergroups( $new->svcnum,
- $self->export_username($new),
- '',
- $svc_acct->usergroup,
- \@newgroups,
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-sub _export_unsuspend {
- my( $self, $svc_acct ) = (shift, 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 $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
- 'check', $self->export_username($svc_acct), $svc_acct->radius_check );
- unless ( ref($err_or_queue) ) {
- $dbh->rollback if $oldAutoCommit;
- return $err_or_queue;
- }
-
- my $error;
- my (@oldgroups) = $self->suspended_usergroups($svc_acct);
- $error = $self->sqlreplace_usergroups( $svc_acct->svcnum,
- $self->export_username($svc_acct),
- '',
- \@oldgroups,
- $svc_acct->usergroup,
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-sub _export_delete {
- my( $self, $svc_x ) = (shift, shift);
- my $usergroup = $self->option('usergroup') || 'usergroup';
- my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete',
- $self->export_username($svc_x), $usergroup );
- ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-sub sqlradius_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::sqlradius::sqlradius_$method",
- };
- $queue->insert(
- $self->option('datasrc'),
- $self->option('username'),
- $self->option('password'),
- @_,
- ) or $queue;
-}
-
-sub suspended_usergroups {
- my ($self, $svc_acct) = (shift, shift);
-
- return () unless $svc_acct;
-
- #false laziness with FS::part_export::shellcommands
- #subclass part_export?
-
- my $r = $svc_acct->cust_svc->cust_pkg->last_reason('susp');
- my %reasonmap = $self->_groups_susp_reason_map;
- my $userspec = '';
- if ($r) {
- $userspec = $reasonmap{$r->reasonnum}
- if exists($reasonmap{$r->reasonnum});
- $userspec = $reasonmap{$r->reason}
- if (!$userspec && exists($reasonmap{$r->reason}));
- }
- my $suspend_user;
- if ($userspec =~ /^d+$/ ){
- $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
- }elsif ($userspec =~ /^\S+\@\S+$/){
- my ($username,$domain) = split(/\@/, $userspec);
- for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
- $suspend_user = $user if $userspec eq $user->email;
- }
- }elsif ($userspec){
- $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
- }
- #esalf
- return $suspend_user->radius_groups if $suspend_user;
- ();
-}
-
-sub sqlradius_insert { #subroutine, not method
- my $dbh = sqlradius_connect(shift, shift, shift);
- my( $table, $username, %attributes ) = @_;
-
- foreach my $attribute ( keys %attributes ) {
-
- my $s_sth = $dbh->prepare(
- "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
- ) or die $dbh->errstr;
- $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
-
- if ( $s_sth->fetchrow_arrayref->[0] ) {
-
- my $u_sth = $dbh->prepare(
- "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
- ) or die $dbh->errstr;
- $u_sth->execute($attributes{$attribute}, $username, $attribute)
- or die $u_sth->errstr;
-
- } else {
-
- my $i_sth = $dbh->prepare(
- "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
- "VALUES ( ?, ?, ?, ? )"
- ) or die $dbh->errstr;
- $i_sth->execute(
- $username,
- $attribute,
- ( $attribute eq 'Password' ? '==' : ':=' ),
- $attributes{$attribute},
- ) or die $i_sth->errstr;
-
- }
-
- }
- $dbh->disconnect;
-}
-
-sub sqlradius_usergroup_insert { #subroutine, not method
- my $dbh = sqlradius_connect(shift, shift, shift);
- my $username = shift;
- my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
- my @groups = @_;
-
- my $s_sth = $dbh->prepare(
- "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?"
- ) or die $dbh->errstr;
-
- my $sth = $dbh->prepare(
- "INSERT INTO $usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
- ) or die $dbh->errstr;
-
- foreach my $group ( @groups ) {
- $s_sth->execute( $username, $group ) or die $s_sth->errstr;
- if ($s_sth->fetchrow_arrayref->[0]) {
- warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
- "$group for $username\n"
- if $DEBUG;
- next;
- }
- $sth->execute( $username, $group )
- or die "can't insert into groupname table: ". $sth->errstr;
- }
- if ( $s_sth->{Active} ) {
- warn "sqlradius s_sth still active; calling ->finish()";
- $s_sth->finish;
- }
- if ( $sth->{Active} ) {
- warn "sqlradius sth still active; calling ->finish()";
- $sth->finish;
- }
- $dbh->disconnect;
-}
-
-sub sqlradius_usergroup_delete { #subroutine, not method
- my $dbh = sqlradius_connect(shift, shift, shift);
- my $username = shift;
- my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
- my @groups = @_;
-
- my $sth = $dbh->prepare(
- "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
- ) or die $dbh->errstr;
- foreach my $group ( @groups ) {
- $sth->execute( $username, $group )
- or die "can't delete from groupname table: ". $sth->errstr;
- }
- $dbh->disconnect;
-}
-
-sub sqlradius_rename { #subroutine, not method
- my $dbh = sqlradius_connect(shift, shift, shift);
- my($new_username, $old_username) = (shift, shift);
- my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
- foreach my $table (qw(radreply radcheck), $usergroup ) {
- my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
- or die $dbh->errstr;
- $sth->execute($new_username, $old_username)
- or die "can't update $table: ". $sth->errstr;
- }
- $dbh->disconnect;
-}
-
-sub sqlradius_attrib_delete { #subroutine, not method
- my $dbh = sqlradius_connect(shift, shift, shift);
- my( $table, $username, @attrib ) = @_;
-
- foreach my $attribute ( @attrib ) {
- my $sth = $dbh->prepare(
- "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
- or die $dbh->errstr;
- $sth->execute($username,$attribute)
- or die "can't delete from rad$table table: ". $sth->errstr;
- }
- $dbh->disconnect;
-}
-
-sub sqlradius_delete { #subroutine, not method
- my $dbh = sqlradius_connect(shift, shift, shift);
- my $username = shift;
- my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup';
-
- foreach my $table (qw( radcheck radreply), $usergroup ) {
- my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
- $sth->execute($username)
- or die "can't delete from $table table: ". $sth->errstr;
- }
- $dbh->disconnect;
-}
-
-sub sqlradius_connect {
- #my($datasrc, $username, $password) = @_;
- #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
- DBI->connect(@_) or die $DBI::errstr;
-}
-
-sub sqlreplace_usergroups {
- my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
-
- # (sorta) false laziness with FS::svc_acct::replace
- my @oldgroups = @$old;
- my @newgroups = @$new;
- my @delgroups = ();
- foreach my $oldgroup ( @oldgroups ) {
- if ( grep { $oldgroup eq $_ } @newgroups ) {
- @newgroups = grep { $oldgroup ne $_ } @newgroups;
- next;
- }
- push @delgroups, $oldgroup;
- }
-
- my $usergroup = $self->option('usergroup') || 'usergroup';
-
- if ( @delgroups ) {
- my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
- $username, $usergroup, @delgroups );
- return $err_or_queue
- unless ref($err_or_queue);
- if ( $jobnum ) {
- my $error = $err_or_queue->depend_insert( $jobnum );
- return $error if $error;
- }
- }
-
- if ( @newgroups ) {
- cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
- "with ". join(", ", @newgroups)
- if $DEBUG;
- my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
- $username, $usergroup, @newgroups );
- return $err_or_queue
- unless ref($err_or_queue);
- if ( $jobnum ) {
- my $error = $err_or_queue->depend_insert( $jobnum );
- return $error if $error;
- }
- }
- '';
-}
-
-
-#--
-
-=item usage_sessions HASHREF
-
-=item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
-
-New-style: pass a hashref with the following keys:
-
-=over 4
-
-=item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp
-
-=item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp
-
-=item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead)
-
-=item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp
-
-=item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp
-
-=item svc_acct
-
-=item ip
-
-=item prefix
-
-=back
-
-Old-style:
-
-TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
-L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-SVC_ACCT, if specified, limits the results to the specified account.
-
-IP, if specified, limits the results to the specified IP address.
-
-PREFIX, if specified, limits the results to records with a matching
-Called-Station-ID.
-
-#SQL_SELECT defaults to * if unspecified. It can be useful to set it to
-#SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
-
-Returns an arrayref of hashrefs with the following fields:
-
-=over 4
-
-=item username
-
-=item framedipaddress
-
-=item acctstarttime
-
-=item acctstoptime
-
-=item acctsessiontime
-
-=item acctinputoctets
-
-=item acctoutputoctets
-
-=item calledstationid
-
-=back
-
-=cut
-
-#some false laziness w/cust_svc::seconds_since_sqlradacct
-
-sub usage_sessions {
- my( $self ) = shift;
-
- my $opt = {};
- my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
- if ( ref($_[0]) ) {
- $opt = shift;
- $start = $opt->{stoptime_start};
- $end = $opt->{stoptime_end};
- $svc_acct = $opt->{svc_acct};
- $ip = $opt->{ip};
- $prefix = $opt->{prefix};
- } else {
- ( $start, $end ) = splice(@_, 0, 2);
- $svc_acct = @_ ? shift : '';
- $ip = @_ ? shift : '';
- $prefix = @_ ? shift : '';
- #my $select = @_ ? shift : '*';
- }
-
- $end ||= 2147483647;
-
- return [] if $self->option('ignore_accounting');
-
- my $dbh = sqlradius_connect( map $self->option($_),
- qw( datasrc username password ) );
-
- #select a unix time conversion function based on database type
- my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
-
- my @fields = (
- qw( username realm framedipaddress
- acctsessiontime acctinputoctets acctoutputoctets
- calledstationid
- ),
- "$str2time acctstarttime ) as acctstarttime",
- "$str2time acctstoptime ) as acctstoptime",
- );
-
- my @param = ();
- my @where = ();
-
- if ( $svc_acct ) {
- my $username = $self->export_username($svc_acct);
- if ( $username =~ /^([^@]+)\@([^@]+)$/ ) {
- push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )';
- push @param, $username, $1, $2;
- } else {
- push @where, 'UserName = ?';
- push @param, $username;
- }
- }
-
- if ($self->option('process_single_realm')) {
- push @where, 'Realm = ?';
- push @param, $self->option('realm');
- }
-
- if ( length($ip) ) {
- push @where, ' FramedIPAddress = ?';
- push @param, $ip;
- }
-
- if ( length($prefix) ) {
- #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
- push @where, " CalledStationID LIKE 'sip:$prefix\%'";
- }
-
- if ( $start ) {
- push @where, "$str2time AcctStopTime ) >= ?";
- push @param, $start;
- }
- if ( $end ) {
- push @where, "$str2time AcctStopTime ) <= ?";
- push @param, $end;
- }
- if ( $opt->{open_sessions} ) {
- push @where, 'AcctStopTime IS NULL';
- }
- if ( $opt->{starttime_start} ) {
- push @where, "$str2time AcctStartTime ) >= ?";
- push @param, $opt->{starttime_start};
- }
- if ( $opt->{starttime_end} ) {
- push @where, "$str2time AcctStartTime ) <= ?";
- push @param, $opt->{starttime_end};
- }
-
- my $where = join(' AND ', @where);
- $where = "WHERE $where" if $where;
-
- my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
- " FROM radacct
- $where
- ORDER BY AcctStartTime DESC
- ") or die $dbh->errstr;
- $sth->execute(@param) or die $sth->errstr;
-
- [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
-
-}
-
-=item update_svc_acct
-
-=cut
-
-sub update_svc {
- my $self = shift;
-
- my $conf = new FS::Conf;
-
- my $fdbh = dbh;
- my $dbh = sqlradius_connect( map $self->option($_),
- qw( datasrc username password ) );
-
- my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
- my @fields = qw( radacctid username realm acctsessiontime );
-
- my @param = ();
- my $where = '';
-
- my $sth = $dbh->prepare("
- SELECT RadAcctId, UserName, Realm, AcctSessionTime,
- $str2time AcctStartTime), $str2time AcctStopTime),
- AcctInputOctets, AcctOutputOctets
- FROM radacct
- WHERE FreesideStatus IS NULL
- AND AcctStopTime != 0
- ") or die $dbh->errstr;
- $sth->execute() or die $sth->errstr;
-
- while ( my $row = $sth->fetchrow_arrayref ) {
- my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
- $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
- warn "processing record: ".
- "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
- if $DEBUG;
-
- $UserName = lc($UserName) unless $conf->exists('username-uppercase');
-
- #my %search = ( 'username' => $UserName );
-
- my $extra_sql = '';
- if ( ref($self) =~ /withdomain/ ) { #well...
- $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
- WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
- }
-
- my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
- local $FS::UID::AutoCommit = 0; # least we can avoid over counting
-
- my $status = 'skipped';
- my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
- "(UserName $UserName, Realm $Realm)";
-
- if ( $self->option('process_single_realm')
- && $self->option('realm') ne $Realm )
- {
- warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG;
- } else {
- my @svc_acct =
- grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
- 'svcpart' => $_->cust_svc->svcpart, } )
- }
- qsearch( 'svc_acct',
- { 'username' => $UserName },
- '',
- $extra_sql
- );
-
- if ( !@svc_acct ) {
- warn "WARNING: no svc_acct record found $errinfo - skipping\n";
- } elsif ( scalar(@svc_acct) > 1 ) {
- warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
- } else {
-
- my $svc_acct = $svc_acct[0];
- warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
-
- $svc_acct->last_login($AcctStartTime);
- $svc_acct->last_logout($AcctStopTime);
-
- my $session_time = $AcctStopTime;
- $session_time = $AcctStartTime if $self->option('ignore_long_sessions');
-
- my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
- if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill
- || $cust_pkg->setup ) ) {
- $status = 'skipped (too old)';
- } else {
- my @st;
- push @st, _try_decrement($svc_acct, 'seconds', $AcctSessionTime);
- push @st, _try_decrement($svc_acct, 'upbytes', $AcctInputOctets);
- push @st, _try_decrement($svc_acct, 'downbytes', $AcctOutputOctets);
- push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets
- + $AcctOutputOctets);
- $status=join(' ', @st);
- }
- }
- }
-
- warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG;
- my $psth = $dbh->prepare("UPDATE radacct
- SET FreesideStatus = ?
- WHERE RadAcctId = ?"
- ) or die $dbh->errstr;
- $psth->execute($status, $RadAcctId) or die $psth->errstr;
-
- $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
-
- }
-
-}
-
-sub _try_decrement {
- my ($svc_acct, $column, $amount) = @_;
- if ( $svc_acct->$column !~ /^$/ ) {
- warn " svc_acct.$column found (". $svc_acct->$column.
- ") - decrementing\n"
- if $DEBUG;
- my $method = 'decrement_' . $column;
- my $error = $svc_acct->$method($amount);
- die $error if $error;
- return 'done';
- } else {
- warn " no existing $column value for svc_acct - skipping\n" if $DEBUG;
- }
- return 'skipped';
-}
-
-###
-#class methods
-###
-
-sub all_sqlradius {
- #my $class = shift;
-
- #don't just look for ->can('usage_sessions'), we're sqlradius-specific
- # (radiator is supposed to be setup with a radacct table)
- #i suppose it would be more slick to look for things that inherit from us..
-
- my @part_export = ();
- push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
- foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius );
- @part_export;
-}
-
-sub all_sqlradius_withaccounting {
- my $class = shift;
- grep { ! $_->option('ignore_accounting') } $class->all_sqlradius;
-}
-
-1;
-
diff --git a/FS/FS/part_export/sqlradius_withdomain.pm b/FS/FS/part_export/sqlradius_withdomain.pm
deleted file mode 100644
index e5a7151..0000000
--- a/FS/FS/part_export/sqlradius_withdomain.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-package FS::part_export::sqlradius_withdomain;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export::sqlradius;
-
-tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) with realms',
- 'options' => \%options,
- 'nodomain' => '',
- 'notes' => $FS::part_export::sqlradius::notes1.
- 'This export exports domains to RADIUS realms (see also '.
- 'sqlradius). '.
- $FS::part_export::sqlradius::notes2
-);
-
-@ISA = qw(FS::part_export::sqlradius);
-
-sub export_username {
- my($self, $svc_acct) = (shift, shift);
- $svc_acct->email;
-}
-
-1;
-
diff --git a/FS/FS/part_export/sysvshell.pm b/FS/FS/part_export/sysvshell.pm
deleted file mode 100644
index 244c3bf..0000000
--- a/FS/FS/part_export/sysvshell.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-package FS::part_export::sysvshell;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export::passwdfile;
-
-@ISA = qw(FS::part_export::passwdfile);
-
-tie my %options, 'Tie::IxHash', %FS::part_export::passwdfile::options;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' =>
- 'Batch export of /etc/passwd and /etc/shadow files (Linux, Solaris)',
- 'options' => \%options,
- 'nodomain' => 'Y',
- 'notes' => <<'END'
-MD5 crypt requires installation of
-<a href="http://search.cpan.org/dist/Crypt-PasswdMD5">Crypt::PasswdMD5</a>
-from CPAN. Run bin/sysvshell.export to export the files.
-END
-);
-
-1;
-
diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm
deleted file mode 100644
index 869c7c7..0000000
--- a/FS/FS/part_export/textradius.pm
+++ /dev/null
@@ -1,191 +0,0 @@
-package FS::part_export::textradius;
-
-use vars qw(@ISA %info $prefix);
-use Fcntl qw(:flock);
-use Tie::IxHash;
-use FS::UID qw(datasrc);
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'users' => { label=>'users file location', default=>'/etc/raddb/users' },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' =>
- 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)',
- 'options' => \%options,
- 'notes' => <<'END'
-This will edit a text RADIUS users file in place on a remote server.
-Requires installation of
-<a href="http://search.cpan.org/dist/RADIUS-UserFile">RADIUS::UserFile</a>
-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="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">SSH is setup for unattended
-operation</a>.
-END
-);
-
-$prefix = "%%%FREESIDE_CONF%%%/export.";
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self, $svc_acct) = (shift, shift);
- $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, 'insert',
- $svc_acct->username, $svc_acct->radius_check, '-', $svc_acct->radius_reply);
- ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
- return "can't (yet?) change username with textradius"
- if $old->username ne $new->username;
- #return '' unless $old->_password ne $new->_password;
- $err_or_queue = $self->textradius_queue( $new->svcnum, 'insert',
- $new->username, $new->radius_check, '-', $new->radius_reply);
- ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-sub _export_delete {
- my( $self, $svc_acct ) = (shift, shift);
- $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, 'delete',
- $svc_acct->username );
- ref($err_or_queue) ? '' : $err_or_queue;
-}
-
-#a good idea to queue anything that could fail or take any time
-sub textradius_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::textradius::textradius_$method",
- };
- $queue->insert(
- $self->option('user')||'root',
- $self->machine,
- $self->option('users'),
- @_,
- ) or $queue;
-}
-
-sub textradius_insert { #subroutine, not method
- my( $user, $host, $users, $username, @attributes ) = @_;
-
- #silly arg processing
- my($att, @check);
- push @check, $att while @attributes && ($att=shift @attributes) ne '-';
- my %check = @check;
- my %reply = @attributes;
-
- my $file = textradius_download($user, $host, $users);
-
- eval "use RADIUS::UserFile;";
- die $@ if $@;
-
- my $userfile = new RADIUS::UserFile(
- File => $file,
- Who => [ $username ],
- Check_Items => [ keys %check ],
- ) or die "error parsing $file";
-
- $userfile->remove($username);
- $userfile->add(
- Who => $username,
- Attributes => { %check, %reply },
- Comment => 'user added by Freeside',
- ) or die "error adding to $file";
-
- $userfile->update( Who => [ $username ] )
- or die "error updating $file";
-
- textradius_upload($user, $host, $users);
-
-}
-
-sub textradius_delete { #subroutine, not method
- my( $user, $host, $users, $username ) = @_;
-
- my $file = textradius_download($user, $host, $users);
-
- eval "use RADIUS::UserFile;";
- die $@ if $@;
-
- my $userfile = new RADIUS::UserFile(
- File => $file,
- Who => [ $username ],
- ) or die "error parsing $file";
-
- $userfile->remove($username);
-
- $userfile->update( Who => [ $username ] )
- or die "error updating $file";
-
- textradius_upload($user, $host, $users);
-}
-
-sub textradius_download {
- my( $user, $host, $users ) = @_;
-
- my $dir = $prefix. datasrc;
- mkdir $dir, 0700 or die $! unless -d $dir;
- $dir .= "/$host";
- mkdir $dir, 0700 or die $! unless -d $dir;
-
- my $dest = "$dir/users";
-
- eval "use File::Rsync;";
- die $@ if $@;
- my $rsync = File::Rsync->new({ rsh => 'ssh' });
-
- open(LOCK, "+>>$dest.lock")
- and flock(LOCK,LOCK_EX)
- or die "can't open $dest.lock: $!";
-
- $rsync->exec( {
- src => "$user\@$host:$users",
- dest => $dest,
- } ); # true/false return value from exec is not working, alas
- if ( $rsync->err ) {
- die "error downloading $user\@$host:$users : ".
- 'exit status: '. $rsync->status. ', '.
- 'STDERR: '. join(" / ", $rsync->err). ', '.
- 'STDOUT: '. join(" / ", $rsync->out);
- }
-
- $dest;
-}
-
-sub textradius_upload {
- my( $user, $host, $users ) = @_;
-
- my $dir = $prefix. datasrc. "/$host";
-
- eval "use File::Rsync;";
- die $@ if $@;
- my $rsync = File::Rsync->new({
- rsh => 'ssh',
- #dry_run => 1,
- });
- $rsync->exec( {
- src => "$dir/users",
- dest => "$user\@$host:$users",
- } ); # true/false return value from exec is not working, alas
- if ( $rsync->err ) {
- die "error uploading to $user\@$host:$users : ".
- 'exit status: '. $rsync->status. ', '.
- 'STDERR: '. join(" / ", $rsync->err). ', '.
- 'STDOUT: '. join(" / ", $rsync->out);
- }
-
- flock(LOCK,LOCK_UN);
- close LOCK;
-
-}
-
-1;
-
diff --git a/FS/FS/part_export/thirdlane.pm b/FS/FS/part_export/thirdlane.pm
deleted file mode 100644
index 60c0997..0000000
--- a/FS/FS/part_export/thirdlane.pm
+++ /dev/null
@@ -1,348 +0,0 @@
-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/trango.pm b/FS/FS/part_export/trango.pm
deleted file mode 100644
index e7f1126..0000000
--- a/FS/FS/part_export/trango.pm
+++ /dev/null
@@ -1,434 +0,0 @@
-package FS::part_export::trango;
-
-=head1 FS::part_export::trango
-
-This export sends SNMP SETs to a router using the Net::SNMP package. It requires the following custom fields to be defined on a router. If any of the required custom fields are not present, then the export will exit quietly.
-
-=head1 Required custom fields
-
-=over 4
-
-=item trango_address - IP address (or hostname) of the Trango AP.
-
-=item trango_comm - R/W SNMP community of the Trango AP.
-
-=item trango_ap_type - Trango AP Model. Currently 'access5830' is the only supported option.
-
-=back
-
-=head1 Optional custom fields
-
-=over 4
-
-=item trango_baseid - Base ID of the Trango AP. See L</"Generating SU IDs">.
-
-=item trango_apid - AP ID of the Trango AP. See L</"Generating SU IDs">.
-
-=back
-
-=head1 Generating SU IDs
-
-This export will/must generate a unique SU ID for each service exported to a Trango AP. It can be done such that SU IDs are globally unique, unique per Base ID, or unique per Base ID/AP ID pair. This is accomplished by setting neither trango_baseid and trango_apid, only trango_baseid, or both trango_baseid and trango_apid, respectively. An SU ID will be generated if the FS::svc_broadband virtual field specified by suid_field export option is unset, otherwise the existing value will be used.
-
-=head1 Device Support
-
-This export has been tested with the Trango Access5830 AP.
-
-
-=cut
-
-
-use strict;
-use vars qw(@ISA %info $me $DEBUG $trango_mib $counter_dir);
-
-use FS::UID qw(dbh datasrc);
-use FS::Record qw(qsearch qsearchs);
-use FS::part_export::snmp;
-
-use Tie::IxHash;
-use File::CounterFile;
-use Data::Dumper qw(Dumper);
-
-@ISA = qw(FS::part_export::snmp);
-
-tie my %options, 'Tie::IxHash', (
- 'suid_field' => {
- 'label' => 'Trango SU ID field',
- 'default' => 'trango_suid',
- 'notes' => 'Name of the FS::svc_broadband virtual field that will contain the SU ID.',
- },
- 'mac_field' => {
- 'label' => 'Trango MAC address field',
- 'default' => '',
- 'notes' => 'Name of the FS::svc_broadband virtual field that will contain the SU\'s MAC address.',
- },
-);
-
-%info = (
- 'svc' => 'svc_broadband',
- 'desc' => 'Sends SNMP SETs to a Trango AP.',
- 'options' => \%options,
- 'notes' => 'Requires Net::SNMP. See the documentation for FS::part_export::trango for required virtual fields and usage information.',
-);
-
-$me= '[' . __PACKAGE__ . ']';
-$DEBUG = 1;
-
-$trango_mib = {
- 'access5830' => {
- 'snmpversion' => 'snmpv1',
- 'varbinds' => {
- 'insert' => [
- { # sudbDeleteOrAddID
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1',
- 'type' => 'INTEGER',
- 'value' => \&_trango_access5830_sudbDeleteOrAddId,
- },
- { # sudbAddMac
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.2',
- 'type' => 'HEX_STRING',
- 'value' => \&_trango_access5830_sudbAddMac,
- },
- { # sudbAddSU
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.7',
- 'type' => 'INTEGER',
- 'value' => 1,
- },
- ],
- 'delete' => [
- { # sudbDeleteOrAddID
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1',
- 'type' => 'INTEGER',
- 'value' => \&_trango_access5830_sudbDeleteOrAddId,
- },
- { # sudbDeleteSU
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.8',
- 'type' => 'INTEGER',
- 'value' => 1,
- },
- ],
- 'replace' => [
- { # sudbDeleteOrAddID
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1',
- 'type' => 'INTEGER',
- 'value' => \&_trango_access5830_sudbDeleteOrAddId,
- },
- { # sudbDeleteSU
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.8',
- 'type' => 'INTEGER',
- 'value' => 1,
- },
- { # sudbDeleteOrAddID
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1',
- 'type' => 'INTEGER',
- 'value' => \&_trango_access5830_sudbDeleteOrAddId,
- },
- { # sudbAddMac
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.2',
- 'type' => 'HEX_STRING',
- 'value' => \&_trango_access5830_sudbAddMac,
- },
- { # sudbAddSU
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.7',
- 'type' => 'INTEGER',
- 'value' => 1,
- },
- ],
- 'suspend' => [
- { # sudbDeleteOrAddID
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1',
- 'type' => 'INTEGER',
- 'value' => \&_trango_access5830_sudbDeleteOrAddId,
- },
- { # sudbDeleteSU
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.8',
- 'type' => 'INTEGER',
- 'value' => 1,
- },
- ],
- 'unsuspend' => [
- { # sudbDeleteOrAddID
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1',
- 'type' => 'INTEGER',
- 'value' => \&_trango_access5830_sudbDeleteOrAddId,
- },
- { # sudbAddMac
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.2',
- 'type' => 'HEX_STRING',
- 'value' => \&_trango_access5830_sudbAddMac,
- },
- { # sudbAddSU
- 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.7',
- 'type' => 'INTEGER',
- 'value' => 1,
- },
- ],
- },
- },
-};
-
-
-sub _field_prefix { 'trango'; }
-
-sub _req_router_fields {
- map {
- $_[0]->_field_prefix . '_' . $_
- } (qw(address comm ap_type suid_field));
-}
-
-sub _get_cmd_sub {
-
- return('FS::part_export::snmp::snmp_cmd');
-
-}
-
-sub _prepare_args {
-
- my ($self, $action, $router) = (shift, shift, shift);
- my ($svc_broadband) = shift;
- my $old = shift if $action eq 'replace';
- my $field_prefix = $self->_field_prefix;
- my $error;
-
- my $ap_type = $router->getfield($field_prefix . '_ap_type');
-
- unless (exists $trango_mib->{$ap_type}) {
- return "Unsupported Trango AP type '$ap_type'";
- }
-
- $error = $self->_check_suid(
- $action, $router, $svc_broadband, ($old) ? $old : ()
- );
- return $error if $error;
-
- $error = $self->_check_mac(
- $action, $router, $svc_broadband, ($old) ? $old : ()
- );
- return $error if $error;
-
- my $ap_mib = $trango_mib->{$ap_type};
-
- my $args = [
- '-hostname' => $router->getfield($field_prefix.'_address'),
- '-version' => $ap_mib->{'snmpversion'},
- '-community' => $router->getfield($field_prefix.'_comm'),
- ];
-
- my @varbindlist = ();
-
- foreach my $oid (@{$ap_mib->{'varbinds'}->{$action}}) {
- warn "[debug]$me Processing OID '" . $oid->{'oid'} . "'" if $DEBUG;
- my $value;
- if (ref($oid->{'value'}) eq 'CODE') {
- eval {
- $value = &{$oid->{'value'}}(
- $self, $action, $router, $svc_broadband,
- (($old) ? $old : ()),
- );
- };
- return "While processing OID '" . $oid->{'oid'} . "':" . $@
- if $@;
- } else {
- $value = $oid->{'value'};
- }
-
- warn "[debug]$me Value for OID '" . $oid->{'oid'} . "': " if $DEBUG;
-
- if (defined $value) { # Skip OIDs with undefined values.
- push @varbindlist, ($oid->{'oid'}, $oid->{'type'}, $value);
- }
- }
-
-
- push @$args, ('-varbindlist', @varbindlist);
-
- return('', $args);
-
-}
-
-sub _check_suid {
-
- my ($self, $action, $router, $svc_broadband) = (shift, shift, shift, shift);
- my $old = shift if $action eq 'replace';
- my $error;
-
- my $suid_field = $self->option('suid_field');
- unless (grep {$_ eq $suid_field} $svc_broadband->fields) {
- return "Missing Trango SU ID field. "
- . "See the trango export options for more info.";
- }
-
- my $suid = $svc_broadband->getfield($suid_field);
- if ($action eq 'replace') {
- my $old_suid = $old->getfield($suid_field);
-
- if ($old_suid ne '' and $old_suid ne $suid) {
- return 'Cannot change Trango SU ID';
- }
- }
-
- if (not $suid =~ /^\d+$/ and $action ne 'delete') {
- my $new_suid = eval { $self->_get_next_suid($router); };
- return "Error while getting next Trango SU ID: $@" if ($@);
-
- warn "[debug]$me Got new SU ID: $new_suid" if $DEBUG;
- $svc_broadband->set($suid_field, $new_suid);
-
- #FIXME: Probably a bad hack.
- # We need to update the SU ID field in the database.
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::svc_Common::noexport_hack = 1;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $svcnum = $svc_broadband->svcnum;
-
- my $old_svc = qsearchs('svc_broadband', { svcnum => $svcnum });
- unless ($old_svc) {
- return "Unable to retrieve svc_broadband with svcnum '$svcnum";
- }
-
- my $svcpart = $svc_broadband->svcpart
- ? $svc_broadband->svcpart
- : $svc_broadband->cust_svc->svcpart;
-
- my $new_svc = new FS::svc_broadband {
- $old_svc->hash,
- $suid_field => $new_suid,
- svcpart => $svcpart,
- };
-
- $error = $new_svc->check;
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return "Error while updating the Trango SU ID: $error" if $error;
- }
-
- warn "[debug]$me Updating svc_broadband with SU ID '$new_suid'...\n" .
- &Dumper($new_svc) if $DEBUG;
-
- $error = eval { $new_svc->replace($old_svc); };
-
- if ($@ or $error) {
- $error ||= $@;
- $dbh->rollback if $oldAutoCommit;
- return "Error while updating the Trango SU ID: $error" if $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- }
-
- return '';
-
-}
-
-sub _check_mac {
-
- my ($self, $action, $router, $svc_broadband) = (shift, shift, shift, shift);
- my $old = shift if $action eq 'replace';
-
- my $mac_field = $self->option('mac_field');
- unless (grep {$_ eq $mac_field} $svc_broadband->fields) {
- return "Missing Trango MAC address field. "
- . "See the trango export options for more info.";
- }
-
- my $mac_addr = $svc_broadband->getfield($mac_field);
- unless (length(join('', $mac_addr =~ /[0-9a-fA-F]/g)) == 12) {
- return "Invalid Trango MAC address: $mac_addr";
- }
-
- return('');
-
-}
-
-sub _get_next_suid {
-
- my ($self, $router) = (shift, shift);
-
- my $counter_dir = '/usr/local/etc/freeside/export.'. datasrc . '/trango';
- my $baseid = $router->getfield('trango_baseid');
- my $apid = $router->getfield('trango_apid');
-
- my $counter_file_suffix = '';
- if ($baseid ne '') {
- $counter_file_suffix .= "_B$baseid";
- if ($apid ne '') {
- $counter_file_suffix .= "_A$apid";
- }
- }
-
- my $counter_file = $counter_dir . '/SUID' . $counter_file_suffix;
-
- warn "[debug]$me Using SUID counter file '$counter_file'";
-
- my $suid = eval {
- mkdir $counter_dir, 0700 unless -d $counter_dir;
-
- my $cf = new File::CounterFile($counter_file, 0);
- $cf->inc;
- };
-
- die "Error generating next Trango SU ID: $@" if (not $suid or $@);
-
- return($suid);
-
-}
-
-
-
-# Trango-specific subroutines for generating varbind values.
-#
-# All subs should die on error, and return undef to decline. OIDs that
-# decline will not be added to varbinds.
-
-sub _trango_access5830_sudbDeleteOrAddId {
-
- my ($self, $action, $router) = (shift, shift, shift);
- my ($svc_broadband) = shift;
- my $old = shift if $action eq 'replace';
-
- my $suid = $svc_broadband->getfield($self->option('suid_field'));
-
- # Sanity check.
- unless ($suid =~ /^\d+$/) {
- if ($action eq 'delete') {
- # Silently ignore. If we don't have a valid SU ID now, we probably
- # never did.
- return undef;
- } else {
- die "Invalid Trango SU ID '$suid'";
- }
- }
-
- return ($suid);
-
-}
-
-sub _trango_access5830_sudbAddMac {
-
- my ($self, $action, $router) = (shift, shift, shift);
- my ($svc_broadband) = shift;
- my $old = shift if $action eq 'replace';
-
- my $mac_addr = $svc_broadband->getfield($self->option('mac_field'));
- $mac_addr = join('', $mac_addr =~ /[0-9a-fA-F]/g);
-
- # Sanity check.
- die "Invalid Trango MAC address '$mac_addr'" unless (length($mac_addr)==12);
-
- return($mac_addr);
-
-}
-
-
-=head1 BUGS
-
-Plenty, I'm sure.
-
-=cut
-
-
-1;
diff --git a/FS/FS/part_export/vitelity.pm b/FS/FS/part_export/vitelity.pm
deleted file mode 100644
index 7803b3f..0000000
--- a/FS/FS/part_export/vitelity.pm
+++ /dev/null
@@ -1,250 +0,0 @@
-package FS::part_export::vitelity;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::Record qw(qsearch dbh);
-use FS::part_export;
-use FS::phone_avail;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'login' => { label=>'Vitelity API login' },
- 'pass' => { label=>'Vitelity API password' },
- 'dry_run' => { label=>"Test mode - don't actually provision" },
- 'routesip' => { label=>'routesip (optional sub-account)' },
- 'type' => { label=>'type (optional DID type to order)' },
-;
-
-%info = (
- 'svc' => 'svc_phone',
- 'desc' => 'Provision phone numbers to Vitelity',
- 'options' => \%options,
- 'notes' => <<'END'
-Requires installation of
-<a href="http://search.cpan.org/dist/Net-Vitelity">Net::Vitelity</a>
-from CPAN.
-<br><br>
-routesip - optional Vitelity sub-account to which newly ordered DIDs will be routed
-<br>type - optional DID type (perminute, unlimited, or your-pri)
-END
-);
-
-sub rebless { shift; }
-
-sub get_dids {
- my $self = shift;
- my %opt = ref($_[0]) ? %{$_[0]} : @_;
-
-# currently one of three cases: areacode+exchange, areacode, state
-# name == ratecenter
-
- my %search = ();
-
- my $method = '';
-
- if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers in format NPA-NXX-XXXX
-
- return [
- map { join('-', $_->npa, $_->nxx, $_->station ) }
- qsearch({
- 'table' => 'phone_avail',
- 'hashref' => { 'exportnum' => $self->exportnum,
- 'countrycode' => '1', # vitelity is US/CA only now
- 'npa' => $opt{'areacode'},
- 'nxx' => $opt{'exchange'},
- },
- 'order_by' => 'ORDER BY station',
- })
- ];
-
- } elsif ( $opt{'areacode'} ) { #return exchanges in format NPA-NXX- literal 'XXXX'
-
- # you can't call $->name .... that returns "(unlinked)"
- # and in any case this is still major abuse of encapsulation, it just happens to work for the other fields
- return [
- map { $_->{'Hash'}->{name}.' ('. $_->npa. '-'. $_->nxx. '-XXXX)' }
- qsearch({
- # i know this doesn't do the same thing as before, but now the sort works
- 'select' => 'DISTINCT npa,nxx,name',
- 'table' => 'phone_avail',
- 'hashref' => { 'exportnum' => $self->exportnum,
- 'countrycode' => '1', # vitelity is US/CA only now
- 'npa' => $opt{'areacode'},
- },
- 'order_by' => 'ORDER BY nxx',
- })
- ];
-
- } elsif ( $opt{'state'} ) { #and not other things, then return areacode
-
- #XXX need to flush the cache at some point :/
-
- my @avail = qsearch({
- 'select' => 'DISTINCT npa',
- 'table' => 'phone_avail',
- 'hashref' => { 'exportnum' => $self->exportnum,
- 'countrycode' => '1', # vitelity is US/CA only now
- 'state' => $opt{'state'},
- },
- 'order_by' => 'ORDER BY npa',
- });
-
- return [ map $_->npa, @avail ] if @avail; #return cached area codes instead
-
- #otherwise, search for em
-
- my @ratecenters = $self->vitelity_command( 'listavailratecenters',
- 'state' => $opt{'state'},
- );
- # XXX: Options: type=unlimited OR type=pri
-
- if ( $ratecenters[0] eq 'unavailable' ) {
- return [];
- } elsif ( $ratecenters[0] eq 'missingdata' ) {
- die "missingdata error running Vitelity API"; #die?
- }
-
- 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 $errmsg = 'WARNING: error populating phone availability cache: ';
-
- my %npa = ();
- foreach my $ratecenter (@ratecenters) {
-
- my @dids = $self->vitelity_command( 'listlocal',
- 'state' => $opt{'state'},
- 'ratecenter' => $ratecenter,
- );
- # XXX: Options: type=unlimited OR type=pri
-
- if ( $dids[0] eq 'unavailable' ) {
- next;
- } elsif ( $dids[0] eq 'missingdata' ) {
- die "missingdata error running Vitelity API"; #die?
- }
-
- foreach my $did ( @dids ) {
- $did =~ /^(\d{3})(\d{3})(\d{4}),/ or die "unparsable did $did\n";
- my($npa, $nxx, $station) = ($1, $2, $3);
- $npa{$npa}++;
-
- my $phone_avail = new FS::phone_avail {
- 'exportnum' => $self->exportnum,
- 'countrycode' => '1', # vitelity is US/CA only now
- 'state' => $opt{'state'},
- 'npa' => $npa,
- 'nxx' => $nxx,
- 'station' => $station,
- 'name' => $ratecenter,
- };
-
- $error = $phone_avail->insert();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die $errmsg.$error;
- }
-
- }
-
- }
-
- $dbh->commit or warn $errmsg.$dbh->errstr if $oldAutoCommit;
-
- my @return = sort { $a <=> $b } keys %npa;
- #@return = sort { (split(' ', $a))[0] <=> (split(' ', $b))[0] } @return;
-
- return \@return;
-
- } else {
- die "get_dids called without state or areacode options";
- }
-
-}
-
-sub vitelity_command {
- my( $self, $command, @args ) = @_;
-
- eval "use Net::Vitelity;";
- die $@ if $@;
-
- my $vitelity = Net::Vitelity->new(
- 'login' => $self->option('login'),
- 'pass' => $self->option('pass'),
- #'debug' => $debug,
- );
-
- $vitelity->$command(@args);
-}
-
-sub _export_insert {
- my( $self, $svc_phone ) = (shift, shift);
-
- return '' if $self->option('dry_run');
-
- #we want to provision and catch errors now, not queue
-
- %vparams = ( 'did' => $svc_phone->phonenum );
- $vparams{'routesip'} = $self->option('routesip')
- if defined $self->option('routesip');
- $vparams{'type'} = $self->option('type')
- if defined $self->option('type');
-
- my $result = $self->vitelity_command('getlocaldid',%vparams);
-
- if ( $result ne 'success' ) {
- return "Error running Vitelity getlocaldid: $result";
- }
-
- '';
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
-
- #hmm, what's to change?
- '';
-}
-
-sub _export_delete {
- my( $self, $svc_phone ) = (shift, shift);
-
- return '' if $self->option('dry_run');
-
- #probably okay to queue the deletion...?
- #but hell, let's do it inline anyway, who wants phone numbers hanging around
-
- my $result = $self->vitelity_command('removedid',
- 'did' => $svc_phone->phonenum,
- );
-
- if ( $result ne 'success' ) {
- return "Error running Vitelity getlocaldid: $result";
- }
-
- '';
-}
-
-sub _export_suspend {
- my( $self, $svc_phone ) = (shift, shift);
- #nop for now
- '';
-}
-
-sub _export_unsuspend {
- my( $self, $svc_phone ) = (shift, shift);
- #nop for now
- '';
-}
-
-1;
-
diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm
deleted file mode 100644
index 799a8e1..0000000
--- a/FS/FS/part_export/vpopmail.pm
+++ /dev/null
@@ -1,254 +0,0 @@
-package FS::part_export::vpopmail;
-
-use vars qw(@ISA %info @saltset $exportdir);
-use Fcntl qw(:flock);
-use Tie::IxHash;
-use File::Path;
-use FS::UID qw( datasrc );
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- #'machine' => { label=>'vpopmail machine', },
- 'dir' => { label=>'directory', }, # ?more info? default?
- 'uid' => { label=>'vpopmail uid' },
- 'gid' => { label=>'vpopmail gid' },
- 'restart' => { label=> 'vpopmail restart command',
- default=> 'cd /home/vpopmail/domains; for domain in *; do /home/vpopmail/bin/vmkpasswd $domain; done; /var/qmail/bin/qmail-newu; killall -HUP qmail-send',
- },
-;
-
-%info = (
- 'svc' => 'svc_acct',
- 'desc' => 'Real-time export to vpopmail text files',
- 'options' => \%options,
- 'notes' => <<'END'
-This export is currently unmaintained. See shellcommands_withdomain for an
-export that uses vpopmail CLI commands instead.<BR>
-<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="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
-);
-
-@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self, $svc_acct) = (shift, shift);
- $self->vpopmail_queue( $svc_acct->svcnum, 'insert',
- $svc_acct->username,
- crypt($svc_acct->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]),
- $svc_acct->domain,
- $svc_acct->quota,
- $svc_acct->finger,
- );
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
-
- my $cpassword = crypt(
- $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))]
- );
-
- return "can't change username with vpopmail"
- if $old->username ne $new->username;
-
- #no.... if mail can't be preserved, better to disallow username changes
- #if ($old->username ne $new->username || $old->domain ne $new->domain ) {
- # vpopmail_queue( $svc_acct->svcnum, 'delete',
- # $old->username, $old->domain
- # );
- # vpopmail_queue( $svc_acct->svcnum, 'insert',
- # $new->username,
- # $cpassword,
- # $new->domain,
- # );
-
- return '' unless $old->_password ne $new->_password;
-
- $self->vpopmail_queue( $new->svcnum, 'replace',
- $new->username, $cpassword, $new->domain, $new->quota, $new->finger );
-}
-
-sub _export_delete {
- my( $self, $svc_acct ) = (shift, shift);
- $self->vpopmail_queue( $svc_acct->svcnum, 'delete',
- $svc_acct->username, $svc_acct->domain );
-}
-
-#a good idea to queue anything that could fail or take any time
-sub vpopmail_queue {
- my( $self, $svcnum, $method ) = (shift, shift, shift);
-
- my $exportdir = "%%%FREESIDE_EXPORT%%%/export." . datasrc;
- mkdir $exportdir, 0700 or die $! unless -d $exportdir;
- $exportdir .= "/vpopmail";
- mkdir $exportdir, 0700 or die $! unless -d $exportdir;
- $exportdir .= '/'. $self->machine;
- mkdir $exportdir, 0700 or die $! unless -d $exportdir;
- mkdir "$exportdir/domains", 0700 or die $! unless -d "$exportdir/domains";
-
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::vpopmail::vpopmail_$method",
- };
- $queue->insert(
- $exportdir,
- $self->machine,
- $self->option('dir'),
- $self->option('uid'),
- $self->option('gid'),
- $self->option('restart'),
- @_
- );
-}
-
-sub vpopmail_insert { #subroutine, not method
- my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6;
- my( $username, $password, $domain, $quota, $finger ) = @_;
-
- mkdir "$exportdir/domains/$domain", 0700 or die $!
- unless -d "$exportdir/domains/$domain";
-
- (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd")
- and flock(VPASSWD,LOCK_EX)
- ) or die "can't open vpasswd file for $username\@$domain: ".
- "$exportdir/domains/$domain/vpasswd: $!";
- print VPASSWD join(":",
- $username,
- $password,
- '1',
- '0',
- $finger,
- "$dir/domains/$domain/$username",
- $quota ? $quota.'S' : 'NOQUOTA',
- ), "\n";
-
- flock(VPASSWD,LOCK_UN);
- close(VPASSWD);
-
- for my $mkdir (
- grep { ! -d $_ } map { "$exportdir/domains/$domain/$username$_" }
- ( '', qw( /Maildir /Maildir/cur /Maildir/new /Maildir/tmp ) )
- ) {
- mkdir $mkdir, 0700 or die "can't mkdir $mkdir: $!";
- }
-
- vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart );
-
-}
-
-sub vpopmail_replace { #subroutine, not method
- my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6;
- my( $username, $password, $domain, $quota, $finger ) = @_;
-
- (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
- and flock(VPASSWD,LOCK_EX)
- ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
-
- open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
- or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
-
- while (<VPASSWD>) {
- my ($mailbox, $pw, $vuid, $vgid, $vfinger, $vdir, $vquota, @rest) =
- split(':', $_);
- if ( $username ne $mailbox ) {
- print VPASSWDTMP $_;
- next
- }
- print VPASSWDTMP join (':',
- $mailbox,
- $password,
- '1',
- '0',
- $finger,
- "$dir/domains/$domain/$username", #$vdir
- $quota ? $quota.'S' : 'NOQUOTA',
- ), "\n";
- }
-
- close(VPASSWDTMP);
-
- rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd"
- or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
-
- flock(VPASSWD,LOCK_UN);
- close(VPASSWD);
-
- vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart );
-
-}
-
-sub vpopmail_delete { #subroutine, not method
- my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6;
- my( $username, $domain ) = @_;
-
- (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
- and flock(VPASSWD,LOCK_EX)
- ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
-
- open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
- or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
-
- while (<VPASSWD>) {
- my ($mailbox, $rest) = split(':', $_);
- print VPASSWDTMP $_ unless $username eq $mailbox;
- }
-
- close(VPASSWDTMP);
-
- rename "$exportdir/domains/$domain/vpasswd.tmp",
- "$exportdir/domains/$domain/vpasswd"
- or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
-
- flock(VPASSWD,LOCK_UN);
- close(VPASSWD);
-
- rmtree "$exportdir/domains/$domain/$username"
- or die "can't rmtree $exportdir/domains/$domain/$username: $!";
-
- vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart );
-}
-
-sub vpopmail_sync {
- my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6;
-
- chdir $exportdir;
-# my @args = ( $rsync, "-rlpt", "-e", $ssh, "domains/",
-# "vpopmail\@$machine:$dir/domains/" );
-# system {$args[0]} @args;
-
- eval "use File::Rsync;";
- die $@ if $@;
-
- my $rsync = File::Rsync->new({ rsh => 'ssh' });
-
- $rsync->exec( {
- recursive => 1,
- perms => 1,
- times => 1,
- src => "$exportdir/domains/",
- dest => "vpopmail\@$machine:$dir/domains/",
- } ); # true/false return value from exec is not working, alas
- if ( $rsync->err ) {
- die "error uploading to vpopmail\@$machine:$dir/domains/ : ".
- 'exit status: '. $rsync->status. ', '.
- 'STDERR: '. join(" / ", $rsync->err). ', '.
- 'STDOUT: '. join(" / ", $rsync->out);
- }
-
- eval "use Net::SSH qw(ssh);";
- die $@ if $@;
-
- ssh("vpopmail\@$machine", $restart) if $restart;
-}
-
-1;
-
diff --git a/FS/FS/part_export/www_plesk.pm b/FS/FS/part_export/www_plesk.pm
deleted file mode 100644
index ccf9b3e..0000000
--- a/FS/FS/part_export/www_plesk.pm
+++ /dev/null
@@ -1,138 +0,0 @@
-package FS::part_export::www_plesk;
-
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'URL' => { label=>'URL' },
- 'login' => { label=>'Login' },
- 'password' => { label=>'Password' },
- 'template' => { label=>'Domain Template' },
- 'web' => { label=>'Host Website',
- type=>'checkbox' },
- 'debug' => { label=>'Enable debugging',
- type=>'checkbox' },
-;
-
-%info = (
- 'svc' => 'svc_www',
- 'desc' => 'Real-time export to Plesk managed hosting service',
- 'options'=> \%options,
- 'notes' => <<'END'
-Real-time export to
-<a href="http://www.swsoft.com/">Plesk</a> managed server.
-Requires installation of
-<a href="http://search.cpan.org/dist/Net-Plesk">Net::Plesk</a>
-from CPAN and proper <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration:www_plesk.pm">configuration</a>.
-END
-);
-
-sub rebless { shift; }
-
-# experiment: want the status of these right away (don't want account to
-# create or whatever and then get error in the queue from dup username or
-# something), so no queueing
-
-sub _export_insert {
- my( $self, $www ) = ( shift, shift );
-
- eval "use Net::Plesk;";
- return $@ if $@;
-
- my $plesk = new Net::Plesk (
- 'POST' => $self->option('URL'),
- ':HTTP_AUTH_LOGIN' => $self->option('login'),
- ':HTTP_AUTH_PASSWD' => $self->option('password'),
- );
-
- my $gcresp = $plesk->client_get( $www->svc_acct->username );
- return $gcresp->errortext
- unless $gcresp->is_success;
-
- unless ($gcresp->id) {
- my $cust_main = $www->cust_svc->cust_pkg->cust_main;
- $gcresp = $plesk->client_add( $cust_main->name,
- $www->svc_acct->username,
- $www->svc_acct->_password,
- $cust_main->daytime,
- $cust_main->fax,
- $cust_main->invoicing_list->[0],
- $cust_main->address1 . $cust_main->address2,
- $cust_main->city,
- $cust_main->state,
- $cust_main->zip,
- $cust_main->country,
- );
- return $gcresp->errortext
- unless $gcresp->is_success;
- }
-
- $plesk->client_ippool_add_ip ( $gcresp->id,
- $www->domain_record->recdata,
- );
-
- if ($self->option('web')) {
- $self->_plesk_command( 'domain_add',
- $www->domain_record->svc_domain->domain,
- $gcresp->id,
- $www->domain_record->recdata,
- $self->option('template')?$self->option('template'):'',
- $www->svc_acct->username,
- $www->svc_acct->_password,
- );
- }else{
- $self->_plesk_command( 'domain_add',
- $www->domain_record->svc_domain->domain,
- $gcresp->id,
- $www->domain_record->recdata,
- $self->option('template')?$self->option('template'):'',
- );
- }
-}
-
-sub _plesk_command {
- my( $self, $method, @args ) = @_;
-
- eval "use Net::Plesk;";
- return $@ if $@;
-
- local($Net::Plesk::DEBUG) = 1
- if $self->option('debug');
-
- my $plesk = new Net::Plesk (
- 'POST' => $self->option('URL'),
- ':HTTP_AUTH_LOGIN' => $self->option('login'),
- ':HTTP_AUTH_PASSWD' => $self->option('password'),
- );
-
- my $response = $plesk->$method(@args);
- return $response->errortext unless $response->is_success;
- '';
-
-}
-
-sub _export_replace {
- my( $self, $new, $old ) = (shift, shift, shift);
-
- return "can't change domain with Plesk"
- if $old->domain_record->svc_domain->domain ne
- $new->domain_record->svc_domain->domain;
-
- return "can't change client with Plesk"
- if $old->svc_acct->username ne
- $new->svc_acct->username;
-
- return '';
-
-}
-
-sub _export_delete {
- my( $self, $www ) = ( shift, shift );
- $self->_plesk_command( 'domain_del', $www->domain_record->svc_domain->domain);
-}
-
-1;
-
diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm
deleted file mode 100644
index 91b294e..0000000
--- a/FS/FS/part_export/www_shellcommands.pm
+++ /dev/null
@@ -1,190 +0,0 @@
-package FS::part_export::www_shellcommands;
-
-use strict;
-use vars qw(@ISA %info);
-use Tie::IxHash;
-use FS::part_export;
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'useradd' => { label=>'Insert command',
- default=>'mkdir $homedir/$zone; chown $username $homedir/$zone; ln -s $homedir/$zone /var/www/$zone',
- },
- 'userdel' => { label=>'Delete command',
- default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm -rf $homedir/$zone',
- },
- 'usermod' => { label=>'Modify command',
- default=>'[ -n "$old_zone" ] && rm /var/www/$old_zone; [ "$old_zone" != "$new_zone" -a -n "$new_zone" ] && ( mv $old_homedir/$old_zone $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone ); [ "$old_username" != "$new_username" ] && chown -R $new_username $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone',
- },
- 'suspend' => { label=>'Suspension command',
- default=>'[ -n "$zone" ] && chmod 0 /var/www/$zone',
- },
- 'unsuspend'=> { label=>'Unsuspension command',
- default=>'[ -n "$zone" ] && chmod 755 /var/www/$zone',
- },
-;
-
-%info = (
- 'svc' => 'svc_www',
- 'desc' => 'Run remote commands via SSH, for virtual web sites (directory maintenance, FrontPage, ISPMan)',
- 'options' => \%options,
- 'notes' => <<'END'
-Run remote commands via SSH, for virtual web sites. You will need to
-<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>
- <INPUT TYPE="button" VALUE="Maintain directories" onClick='
- this.form.user.value = "root";
- this.form.useradd.value = "mkdir $homedir/$zone; chown $username $homedir/$zone; ln -s $homedir/$zone /var/www/$zone";
- this.form.userdel.value = "[ -n \"$zone\" ] && rm -rf /var/www/$zone; rm -rf $homedir/$zone";
- this.form.usermod.value = "[ -n \"$old_zone\" ] && rm /var/www/$old_zone; [ \"$old_zone\" != \"$new_zone\" -a -n \"$new_zone\" ] && ( mv $old_homedir/$old_zone $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone ); [ \"$old_username\" != \"$new_username\" ] && chown -R $new_username $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone";
- this.form.suspend.value = "[ -n \"$zone\" ] && chmod 0 /var/www/$zone";
- this.form.unsuspend.value = "[ -n \"$zone\" ] && chmod 755 /var/www/$zone";
- '>
- <LI>
- <INPUT TYPE="button" VALUE="FrontPage extensions" onClick='
- this.form.user.value = "root";
- this.form.useradd.value = "/usr/local/frontpage/version5.0/bin/owsadm.exe -o install -p 80 -m $zone -xu $username -xg www-data -s /etc/apache/httpd.conf -u $username -pw $_password";
- this.form.userdel.value = "/usr/local/frontpage/version5.0/bin/owsadm.exe -o uninstall -p 80 -m $zone -s /etc/apache/httpd.conf";
- this.form.usermod.value = "";
- this.form.suspend.value = "";
- this.form.unsuspend.value = "";
- '>
- <LI>
- <INPUT TYPE="button" VALUE="ISPMan CLI" onClick='
- this.form.user.value = "root";
- this.form.useradd.value = "/usr/local/ispman/bin/ispman.addvhost -d $domain $bare_zone";
- this.form.userdel.value = "/usr/local/ispman/bin/ispman.deletevhost -d $domain $bare_zone";
- this.form.usermod.value = "";
- this.form.suspend.value = "";
- this.form.unsuspend.value = "";
- '></UL>
-The following variables are available for interpolation (prefixed with
-<code>new_</code> or <code>old_</code> for replace operations):
-<UL>
- <LI><code>$zone</code> - fully-qualified zone of this virtual host
- <LI><code>$bare_zone</code> - just the zone of this virtual host, without the domain portion
- <LI><code>$domain</code> - base domain
- <LI><code>$username</code>
- <LI><code>$_password</code>
- <LI><code>$homedir</code>
- <LI>All other fields in <a href="../docs/schema.html#svc_www">svc_www</a>
- are also available.
-</UL>
-END
-);
-
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self) = shift;
- $self->_export_command('useradd', @_);
-}
-
-sub _export_delete {
- my($self) = shift;
- $self->_export_command('userdel', @_);
-}
-
-sub _export_suspend {
- my($self) = shift;
- $self->_export_command('suspend', @_);
-}
-
-sub _export_unsuspend {
- my($self) = shift;
- $self->_export_command('unsuspend', @_);
-}
-
-sub _export_command {
- my ( $self, $action, $svc_www) = (shift, shift, shift);
- my $command = $self->option($action);
- return '' if $command =~ /^\s*$/;
-
- #set variable for the command
- no strict 'vars';
- {
- no strict 'refs';
- ${$_} = $svc_www->getfield($_) foreach $svc_www->fields;
- }
- my $domain_record = $svc_www->domain_record; # or die ?
- my $zone = $domain_record->zone; # or die ?
- my $domain = $domain_record->svc_domain->domain;
- ( my $bare_zone = $zone ) =~ s/\.$domain$//;
- my $svc_acct = $svc_www->svc_acct; # or die ?
- my $username = $svc_acct->username;
- my $_password = $svc_acct->_password;
- my $homedir = $svc_acct->dir; # or die ?
-
- #done setting variables for the command
-
- $self->shellcommands_queue( $svc_www->svcnum,
- user => $self->option('user')||'root',
- host => $self->machine,
- command => eval(qq("$command")),
- );
-}
-
-sub _export_replace {
- my($self, $new, $old ) = (shift, shift, shift);
- my $command = $self->option('usermod');
-
- #set variable for the command
- no strict 'vars';
- {
- no strict 'refs';
- ${"old_$_"} = $old->getfield($_) foreach $old->fields;
- ${"new_$_"} = $new->getfield($_) foreach $new->fields;
- }
- my $old_domain_record = $old->domain_record; # or die ?
- my $old_zone = $old_domain_record->zone; # or die ?
- my $old_domain = $old_domain_record->svc_domain->domain;
- ( my $old_bare_zone = $old_zone ) =~ s/\.$old_domain$//;
- my $old_svc_acct = $old->svc_acct; # or die ?
- my $old_username = $old_svc_acct->username;
- my $old_homedir = $old_svc_acct->dir; # or die ?
-
- my $new_domain_record = $new->domain_record; # or die ?
- my $new_zone = $new_domain_record->zone; # or die ?
- my $new_domain = $new_domain_record->svc_domain->domain;
- ( my $new_bare_zone = $new_zone ) =~ s/\.$new_domain$//;
- my $new_svc_acct = $new->svc_acct; # or die ?
- my $new_username = $new_svc_acct->username;
- #my $new__password = $new_svc_acct->_password;
- my $new_homedir = $new_svc_acct->dir; # or die ?
-
- #done setting variables for the command
-
- $self->shellcommands_queue( $new->svcnum,
- user => $self->option('user')||'root',
- host => $self->machine,
- command => eval(qq("$command")),
- );
-}
-
-#a good idea to queue anything that could fail or take any time
-sub shellcommands_queue {
- my( $self, $svcnum ) = (shift, shift);
- my $queue = new FS::queue {
- 'svcnum' => $svcnum,
- 'job' => "FS::part_export::www_shellcommands::ssh_cmd",
- };
- $queue->insert( @_ );
-}
-
-sub ssh_cmd { #subroutine, not method
- use Net::SSH '0.08';
- &Net::SSH::ssh_cmd( { @_ } );
-}
-
-#sub shellcommands_insert { #subroutine, not method
-#}
-#sub shellcommands_replace { #subroutine, not method
-#}
-#sub shellcommands_delete { #subroutine, not method
-#}
-
diff --git a/FS/FS/part_export_option.pm b/FS/FS/part_export_option.pm
deleted file mode 100644
index e759404..0000000
--- a/FS/FS/part_export_option.pm
+++ /dev/null
@@ -1,134 +0,0 @@
-package FS::part_export_option;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::part_export;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::part_export_option - Object methods for part_export_option records
-
-=head1 SYNOPSIS
-
- use FS::part_export_option;
-
- $record = new FS::part_export_option \%hash;
- $record = new FS::part_export_option { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_export_option object represents an export option.
-FS::part_export_option inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item optionnum - primary key
-
-=item exportnum - export (see L<FS::part_export>)
-
-=item optionname - option name
-
-=item optionvalue - option value
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new export option. To add the export option 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 { 'part_export_option'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid export option. 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('optionnum')
- || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum')
- || $self->ut_alpha('optionname')
- || $self->ut_anything('optionvalue')
- ;
- return $error if $error;
-
- return "Unknown exportnum: ". $self->exportnum
- unless qsearchs('part_export', { 'exportnum' => $self->exportnum } );
-
- #check options & values?
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-Possibly.
-
-=head1 SEE ALSO
-
-L<FS::part_export>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm
deleted file mode 100644
index f4aacae..0000000
--- a/FS/FS/part_pkg.pm
+++ /dev/null
@@ -1,1643 +0,0 @@
-package FS::part_pkg;
-
-use strict;
-use vars qw( @ISA %plans $DEBUG $setup_hack $skip_pkg_svc_hack );
-use Carp qw(carp cluck confess);
-use Scalar::Util qw( blessed );
-use Time::Local qw( timelocal_nocheck );
-use Tie::IxHash;
-use FS::Conf;
-use FS::Record qw( qsearch qsearchs dbh dbdef );
-use FS::pkg_svc;
-use FS::part_svc;
-use FS::cust_pkg;
-use FS::agent_type;
-use FS::type_pkgs;
-use FS::part_pkg_option;
-use FS::pkg_class;
-use FS::agent;
-use FS::part_pkg_taxrate;
-use FS::part_pkg_taxoverride;
-use FS::part_pkg_taxproduct;
-use FS::part_pkg_link;
-use FS::part_pkg_discount;
-use FS::part_pkg_vendor;
-
-@ISA = qw( FS::m2m_Common FS::option_Common );
-$DEBUG = 0;
-$setup_hack = 0;
-$skip_pkg_svc_hack = 0;
-
-=head1 NAME
-
-FS::part_pkg - Object methods for part_pkg objects
-
-=head1 SYNOPSIS
-
- use FS::part_pkg;
-
- $record = new FS::part_pkg \%hash
- $record = new FS::part_pkg { 'column' => 'value' };
-
- $custom_record = $template_record->clone;
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- @pkg_svc = $record->pkg_svc;
-
- $svcnum = $record->svcpart;
- $svcnum = $record->svcpart( 'svc_acct' );
-
-=head1 DESCRIPTION
-
-An FS::part_pkg object represents a package definition. FS::part_pkg
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item pkgpart - primary key (assigned automatically for new package definitions)
-
-=item pkg - Text name of this package definition (customer-viewable)
-
-=item comment - Text name of this package definition (non-customer-viewable)
-
-=item classnum - Optional package class (see L<FS::pkg_class>)
-
-=item promo_code - Promotional code
-
-=item setup - Setup fee expression (deprecated)
-
-=item freq - Frequency of recurring fee
-
-=item recur - Recurring fee expression (deprecated)
-
-=item setuptax - Setup fee tax exempt flag, empty or `Y'
-
-=item recurtax - Recurring fee tax exempt flag, empty or `Y'
-
-=item taxclass - Tax class
-
-=item plan - Price plan
-
-=item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
-
-=item disabled - Disabled flag, empty or `Y'
-
-=item custom - Custom flag, empty or `Y'
-
-=item setup_cost - for cost tracking
-
-=item recur_cost - for cost tracking
-
-=item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items.
-
-=item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items.
-
-=item agentnum - Optional agentnum (see L<FS::agent>)
-
-=item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new package definition. To add the package definition to
-the database, see L<"insert">.
-
-=cut
-
-sub table { 'part_pkg'; }
-
-=item clone
-
-An alternate constructor. Creates a new package definition by duplicating
-an existing definition. A new pkgpart is assigned and the custom flag is
-set to Y. To add the package definition to the database, see L<"insert">.
-
-=cut
-
-sub clone {
- my $self = shift;
- my $class = ref($self);
- my %hash = $self->hash;
- $hash{'pkgpart'} = '';
- $hash{'custom'} = 'Y';
- #new FS::part_pkg ( \%hash ); # ?
- new $class ( \%hash ); # ?
-}
-
-=item insert [ , OPTION => VALUE ... ]
-
-Adds this package definition to the database. If there is an error,
-returns the error, otherwise returns false.
-
-Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
-I<custnum_ref> and I<options>.
-
-If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
-values, appropriate FS::pkg_svc records will be inserted. I<hidden_svc> can
-be set to a hashref of svcparts and flag values ('Y' or '') to set the
-'hidden' field in these records.
-
-If I<primary_svc> is set to the svcpart of the primary service, the appropriate
-FS::pkg_svc record will be updated.
-
-If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
-record itself), the object will be updated to point to this package definition.
-
-In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
-the scalar will be updated with the custnum value from the cust_pkg record.
-
-If I<tax_overrides> is set to a hashref with usage classes as keys and comma
-separated tax class numbers as values, appropriate FS::part_pkg_taxoverride
-records will be inserted.
-
-If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
-records will be inserted.
-
-=cut
-
-sub insert {
- my $self = shift;
- my %options = @_;
- warn "FS::part_pkg::insert called on $self with options ".
- join(', ', map "$_=>$options{$_}", keys %options)
- if $DEBUG;
-
- 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;
-
- warn " inserting part_pkg record" if $DEBUG;
- my $error = $self->SUPER::insert( $options{options} );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- my $conf = new FS::Conf;
- if ( $conf->exists('agent_defaultpkg') ) {
- warn " agent_defaultpkg set; allowing all agents to purchase package"
- if $DEBUG;
- foreach my $agent_type ( qsearch('agent_type', {} ) ) {
- my $type_pkgs = new FS::type_pkgs({
- 'typenum' => $agent_type->typenum,
- 'pkgpart' => $self->pkgpart,
- });
- my $error = $type_pkgs->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- warn " inserting part_pkg_taxoverride records" if $DEBUG;
- my %overrides = %{ $options{'tax_overrides'} || {} };
- foreach my $usage_class ( keys %overrides ) {
- my $override =
- ( exists($overrides{$usage_class}) && defined($overrides{$usage_class}) )
- ? $overrides{$usage_class}
- : '';
- my @overrides = (grep "$_", split(',', $override) );
- my $error = $self->process_m2m (
- 'link_table' => 'part_pkg_taxoverride',
- 'target_table' => 'tax_class',
- 'hashref' => { 'usage_class' => $usage_class },
- 'params' => \@overrides,
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- unless ( $skip_pkg_svc_hack ) {
-
- warn " inserting pkg_svc records" if $DEBUG;
- my $pkg_svc = $options{'pkg_svc'} || {};
- my $hidden_svc = $options{'hidden_svc'} || {};
- foreach my $part_svc ( qsearch('part_svc', {} ) ) {
- my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
- my $primary_svc =
- ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart )
- ? 'Y'
- : '';
-
- my $pkg_svc = new FS::pkg_svc( {
- 'pkgpart' => $self->pkgpart,
- 'svcpart' => $part_svc->svcpart,
- 'quantity' => $quantity,
- 'primary_svc' => $primary_svc,
- 'hidden' => $hidden_svc->{$part_svc->svcpart},
- } );
- my $error = $pkg_svc->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- }
-
- if ( $options{'cust_pkg'} ) {
- warn " updating cust_pkg record " if $DEBUG;
- my $old_cust_pkg =
- ref($options{'cust_pkg'})
- ? $options{'cust_pkg'}
- : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
- ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
- if $options{'custnum_ref'};
- my %hash = $old_cust_pkg->hash;
- $hash{'pkgpart'} = $self->pkgpart,
- my $new_cust_pkg = new FS::cust_pkg \%hash;
- local($FS::cust_pkg::disable_agentcheck) = 1;
- my $error = $new_cust_pkg->replace($old_cust_pkg);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error modifying cust_pkg record: $error";
- }
- }
-
- if ( $options{'part_pkg_vendor'} ) {
- my($exportnum,$vendor_pkg_id);
- my %options_part_pkg_vendor = $options{'part_pkg_vendor'};
- while(($exportnum,$vendor_pkg_id) = each %options_part_pkg_vendor){
- my $ppv = new FS::part_pkg_vendor( {
- 'pkgpart' => $self->pkgpart,
- 'exportnum' => $exportnum,
- 'vendor_pkg_id' => $vendor_pkg_id,
- } );
- my $error = $ppv->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error inserting part_pkg_vendor record: $error";
- }
- }
- }
-
- warn " commiting transaction" if $DEBUG;
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- return "Can't (yet?) delete package definitions.";
-# check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
-}
-
-=item replace OLD_RECORD [ , OPTION => VALUE ... ]
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc>
-and I<options>
-
-If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
-values, the appropriate FS::pkg_svc records will be replaced. I<hidden_svc>
-can be set to a hashref of svcparts and flag values ('Y' or '') to set the
-'hidden' field in these records.
-
-If I<primary_svc> is set to the svcpart of the primary service, the appropriate
-FS::pkg_svc record will be updated.
-
-If I<options> is set to a hashref, the appropriate FS::part_pkg_option records
-will be replaced.
-
-=cut
-
-sub replace {
- my $new = shift;
-
- my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
- ? shift
- : $new->replace_old;
-
- my $options =
- ( ref($_[0]) eq 'HASH' )
- ? shift
- : { @_ };
-
- $options->{options} = {} unless defined($options->{options});
-
- warn "FS::part_pkg::replace called on $new to replace $old with options".
- join(', ', map "$_ => ". $options->{$_}, keys %$options)
- if $DEBUG;
-
- 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;
-
- #plandata shit stays in replace for upgrades until after 2.0 (or edit
- #_upgrade_data)
- warn " saving legacy plandata" if $DEBUG;
- my $plandata = $new->get('plandata');
- $new->set('plandata', '');
-
- warn " deleting old part_pkg_option records" if $DEBUG;
- foreach my $part_pkg_option ( $old->part_pkg_option ) {
- my $error = $part_pkg_option->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- warn " replacing part_pkg record" if $DEBUG;
- my $error = $new->SUPER::replace($old, $options->{options} );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- warn " inserting part_pkg_option records for plandata: $plandata|" if $DEBUG;
- foreach my $part_pkg_option (
- map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
- return "illegal plandata: $plandata";
- };
- new FS::part_pkg_option {
- 'pkgpart' => $new->pkgpart,
- 'optionname' => $1,
- 'optionvalue' => $2,
- };
- }
- split("\n", $plandata)
- ) {
- my $error = $part_pkg_option->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- warn " replacing pkg_svc records" if $DEBUG;
- my $pkg_svc = $options->{'pkg_svc'} || {};
- my $hidden_svc = $options->{'hidden_svc'} || {};
- foreach my $part_svc ( qsearch('part_svc', {} ) ) {
- my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
- my $hidden = $hidden_svc->{$part_svc->svcpart} || '';
- my $primary_svc =
- ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
- && $options->{'primary_svc'} == $part_svc->svcpart
- )
- ? 'Y'
- : '';
-
- my $old_pkg_svc = qsearchs('pkg_svc', {
- 'pkgpart' => $old->pkgpart,
- 'svcpart' => $part_svc->svcpart,
- }
- );
- my $old_quantity = 0;
- my $old_primary_svc = '';
- my $old_hidden = '';
- if ( $old_pkg_svc ) {
- $old_quantity = $old_pkg_svc->quantity;
- $old_primary_svc = $old_pkg_svc->primary_svc
- if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
- $old_hidden = $old_pkg_svc->hidden;
- }
-
- next unless $old_quantity != $quantity ||
- $old_primary_svc ne $primary_svc ||
- $old_hidden ne $hidden;
-
- my $new_pkg_svc = new FS::pkg_svc( {
- 'pkgsvcnum' => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
- 'pkgpart' => $new->pkgpart,
- 'svcpart' => $part_svc->svcpart,
- 'quantity' => $quantity,
- 'primary_svc' => $primary_svc,
- 'hidden' => $hidden,
- } );
- my $error = $old_pkg_svc
- ? $new_pkg_svc->replace($old_pkg_svc)
- : $new_pkg_svc->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my @part_pkg_vendor = $old->part_pkg_vendor;
- my @current_exportnum = ();
- if ( $options->{'part_pkg_vendor'} ) {
- my($exportnum,$vendor_pkg_id);
- while ( ($exportnum,$vendor_pkg_id)
- = each %{$options->{'part_pkg_vendor'}} ) {
- my $noinsert = 0;
- foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
- if($exportnum == $part_pkg_vendor->exportnum
- && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) {
- $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id);
- my $error = $part_pkg_vendor->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error replacing part_pkg_vendor record: $error";
- }
- $noinsert = 1;
- last;
- }
- elsif($exportnum == $part_pkg_vendor->exportnum
- && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) {
- $noinsert = 1;
- last;
- }
- }
- unless ( $noinsert ) {
- my $ppv = new FS::part_pkg_vendor( {
- 'pkgpart' => $new->pkgpart,
- 'exportnum' => $exportnum,
- 'vendor_pkg_id' => $vendor_pkg_id,
- } );
- my $error = $ppv->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error inserting part_pkg_vendor record: $error";
- }
- }
- push @current_exportnum, $exportnum;
- }
- }
- foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
- unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) {
- my $error = $part_pkg_vendor->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error deleting part_pkg_vendor record: $error";
- }
- }
- }
-
- warn " commiting transaction" if $DEBUG;
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
-=item check
-
-Checks all fields to make sure this is a valid package definition. If
-there is an error, returns the error, otherwise returns false. Called by the
-insert and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
- warn "FS::part_pkg::check called on $self" if $DEBUG;
-
- for (qw(setup recur plandata)) {
- #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
- return "Use of $_ field is deprecated; set a plan and options: ".
- $self->get($_)
- if length($self->get($_));
- $self->set($_, '');
- }
-
- if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
- my $error = $self->ut_number('freq');
- return $error if $error;
- } else {
- $self->freq =~ /^(\d+[hdw]?)$/
- or return "Illegal or empty freq: ". $self->freq;
- $self->freq($1);
- }
-
- my @null_agentnum_right = ( 'Edit global package definitions' );
- push @null_agentnum_right, 'One-time charge'
- if $self->freq =~ /^0/;
- push @null_agentnum_right, 'Customize customer package'
- if $self->disabled eq 'Y'; #good enough
-
- my $error = $self->ut_numbern('pkgpart')
- || $self->ut_text('pkg')
- || $self->ut_text('comment')
- || $self->ut_textn('promo_code')
- || $self->ut_alphan('plan')
- || $self->ut_enum('setuptax', [ '', 'Y' ] )
- || $self->ut_enum('recurtax', [ '', 'Y' ] )
- || $self->ut_textn('taxclass')
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- || $self->ut_enum('custom', [ '', 'Y' ] )
- || $self->ut_enum('no_auto', [ '', 'Y' ])
- #|| $self->ut_moneyn('setup_cost')
- #|| $self->ut_moneyn('recur_cost')
- || $self->ut_floatn('setup_cost')
- || $self->ut_floatn('recur_cost')
- || $self->ut_floatn('pay_weight')
- || $self->ut_floatn('credit_weight')
- || $self->ut_numbern('taxproductnum')
- || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum')
- || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
- || $self->ut_foreign_keyn('taxproductnum',
- 'part_pkg_taxproduct',
- 'taxproductnum'
- )
- || ( $setup_hack
- ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
- : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
- )
- || $self->ut_numbern('fcc_ds0s')
- || $self->SUPER::check
- ;
- return $error if $error;
-
- return 'Unknown plan '. $self->plan
- unless exists($plans{$self->plan});
-
- my $conf = new FS::Conf;
- return 'Taxclass is required'
- if ! $self->taxclass && $conf->exists('require_taxclasses');
-
- '';
-}
-
-=item pkg_comment [ OPTION => VALUE... ]
-
-Returns an (internal) string representing this package. Currently,
-"pkgpart: pkg - comment", is returned. "pkg - comment" may be returned in the
-future, omitting pkgpart. The comment will have '(CUSTOM) ' prepended if
-custom is Y.
-
-If the option nopkgpart is true then the "pkgpart: ' is omitted.
-
-=cut
-
-sub pkg_comment {
- my $self = shift;
- my %opt = @_;
-
- #$self->pkg. ' - '. $self->comment;
- #$self->pkg. ' ('. $self->comment. ')';
- my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
- $pre. $self->pkg. ' - '. $self->custom_comment;
-}
-
-sub custom_comment {
- my $self = shift;
- ( $self->custom ? '(CUSTOM) ' : '' ). $self->comment;
-}
-
-=item pkg_class
-
-Returns the package class, as an FS::pkg_class object, or the empty string
-if there is no package class.
-
-=cut
-
-sub pkg_class {
- my $self = shift;
- if ( $self->classnum ) {
- qsearchs('pkg_class', { 'classnum' => $self->classnum } );
- } else {
- return '';
- }
-}
-
-=item addon_pkg_class
-
-Returns the add-on package class, as an FS::pkg_class object, or the empty
-string if there is no add-on package class.
-
-=cut
-
-sub addon_pkg_class {
- my $self = shift;
- if ( $self->addon_classnum ) {
- qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
- } else {
- return '';
- }
-}
-
-=item categoryname
-
-Returns the package category name, or the empty string if there is no package
-category.
-
-=cut
-
-sub categoryname {
- my $self = shift;
- my $pkg_class = $self->pkg_class;
- $pkg_class
- ? $pkg_class->categoryname
- : '';
-}
-
-=item classname
-
-Returns the package class name, or the empty string if there is no package
-class.
-
-=cut
-
-sub classname {
- my $self = shift;
- my $pkg_class = $self->pkg_class;
- $pkg_class
- ? $pkg_class->classname
- : '';
-}
-
-=item addon_classname
-
-Returns the add-on package class name, or the empty string if there is no
-add-on package class.
-
-=cut
-
-sub addon_classname {
- my $self = shift;
- my $pkg_class = $self->addon_pkg_class;
- $pkg_class
- ? $pkg_class->classname
- : '';
-}
-
-=item agent
-
-Returns the associated agent for this event, if any, as an FS::agent object.
-
-=cut
-
-sub agent {
- my $self = shift;
- qsearchs('agent', { 'agentnum' => $self->agentnum } );
-}
-
-=item pkg_svc [ HASHREF | OPTION => VALUE ]
-
-Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
-definition (with non-zero quantity).
-
-One option is available, I<disable_linked>. If set true it will return the
-services for this package definition alone, omitting services from any add-on
-packages.
-
-=cut
-
-=item type_pkgs
-
-Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
-definition.
-
-=cut
-
-sub type_pkgs {
- my $self = shift;
- qsearch('type_pkgs', { 'pkgpart' => $self->pkgpart } );
-}
-
-sub pkg_svc {
- my $self = shift;
-
-# #sort { $b->primary cmp $a->primary }
-# grep { $_->quantity }
-# qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
-
- my $opt = ref($_[0]) ? $_[0] : { @_ };
- my %pkg_svc = map { $_->svcpart => $_ }
- grep { $_->quantity }
- qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
-
- unless ( $opt->{disable_linked} ) {
- foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
- my @pkg_svc = grep { $_->quantity }
- qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } );
- foreach my $pkg_svc ( @pkg_svc ) {
- if ( $pkg_svc{$pkg_svc->svcpart} ) {
- my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
- $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
- } else {
- $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
- }
- }
- }
- }
-
- values(%pkg_svc);
-
-}
-
-=item svcpart [ SVCDB ]
-
-Returns the svcpart of the primary service definition (see L<FS::part_svc>)
-associated with this package definition (see L<FS::pkg_svc>). Returns
-false if there not a primary service definition or exactly one service
-definition with quantity 1, or if SVCDB is specified and does not match the
-svcdb of the service definition. SVCDB can be specified as a scalar table
-name, such as 'svc_acct', or as an arrayref of possible table names.
-
-=cut
-
-sub svcpart {
- my $pkg_svc = shift->_primary_pkg_svc(@_);
- $pkg_svc ? $pkg_svc->svcpart : '';
-}
-
-=item part_svc [ SVCDB ]
-
-Like the B<svcpart> method, but returns the FS::part_svc object (see
-L<FS::part_svc>).
-
-=cut
-
-sub part_svc {
- my $pkg_svc = shift->_primary_pkg_svc(@_);
- $pkg_svc ? $pkg_svc->part_svc : '';
-}
-
-sub _primary_pkg_svc {
- my $self = shift;
-
- my $svcdb = scalar(@_) ? shift : [];
- $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
- my %svcdb = map { $_=>1 } @$svcdb;
-
- my @svcdb_pkg_svc =
- grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
- $self->pkg_svc;
-
- my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
- @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
- unless @pkg_svc;
- return '' if scalar(@pkg_svc) != 1;
- $pkg_svc[0];
-}
-
-=item svcpart_unique_svcdb SVCDB
-
-Returns the svcpart of a service definition (see L<FS::part_svc>) matching
-SVCDB associated with this package definition (see L<FS::pkg_svc>). Returns
-false if there not a primary service definition for SVCDB or there are multiple
-service definitions for SVCDB.
-
-=cut
-
-sub svcpart_unique_svcdb {
- my( $self, $svcdb ) = @_;
- my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
- return '' if scalar(@svcdb_pkg_svc) != 1;
- $svcdb_pkg_svc[0]->svcpart;
-}
-
-=item payby
-
-Returns a list of the acceptable payment types for this package. Eventually
-this should come out of a database table and be editable, but currently has the
-following logic instead:
-
-If the package is free, the single item B<BILL> is
-returned, otherwise, the single item B<CARD> is returned.
-
-(CHEK? LEC? Probably shouldn't accept those by default, prone to abuse)
-
-=cut
-
-sub payby {
- my $self = shift;
- if ( $self->is_free ) {
- ( 'BILL' );
- } else {
- ( 'CARD' );
- }
-}
-
-=item is_free
-
-Returns true if this package is free.
-
-=cut
-
-sub is_free {
- my $self = shift;
- unless ( $self->plan ) {
- $self->setup =~ /^\s*0+(\.0*)?\s*$/
- && $self->recur =~ /^\s*0+(\.0*)?\s*$/;
- } elsif ( $self->can('is_free_options') ) {
- not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
- map { $self->option($_) }
- $self->is_free_options;
- } else {
- warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
- "provides neither is_free_options nor is_free method; returning false";
- 0;
- }
-}
-
-sub can_discount { 0; }
-
-sub freqs_href {
- # moved to FS::Misc to make this accessible to other packages
- # at initialization
- FS::Misc::pkg_freqs();
-}
-
-=item freq_pretty
-
-Returns an english representation of the I<freq> field, such as "monthly",
-"weekly", "semi-annually", etc.
-
-=cut
-
-sub freq_pretty {
- my $self = shift;
- my $freq = $self->freq;
-
- #my $freqs_href = $self->freqs_href;
- my $freqs_href = freqs_href();
-
- if ( exists($freqs_href->{$freq}) ) {
- $freqs_href->{$freq};
- } else {
- my $interval = 'month';
- if ( $freq =~ /^(\d+)([hdw])$/ ) {
- my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
- $interval = $interval{$2};
- }
- if ( $1 == 1 ) {
- "every $interval";
- } else {
- "every $freq ${interval}s";
- }
- }
-}
-
-=item add_freq TIMESTAMP [ FREQ ]
-
-Adds a billing period of some frequency to the provided timestamp and
-returns the resulting timestamp, or -1 if the frequency could not be
-parsed (shouldn't happen). By default, the frequency of this package
-will be used; to override this, pass a different frequency as a second
-argument.
-
-=cut
-
-sub add_freq {
- my( $self, $date, $freq ) = @_;
- $freq = $self->freq unless $freq;
-
- #change this bit to use Date::Manip? CAREFUL with timezones (see
- # mailing list archive)
- my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
-
- if ( $freq =~ /^\d+$/ ) {
- $mon += $freq;
- until ( $mon < 12 ) { $mon -= 12; $year++; }
- } elsif ( $freq =~ /^(\d+)w$/ ) {
- my $weeks = $1;
- $mday += $weeks * 7;
- } elsif ( $freq =~ /^(\d+)d$/ ) {
- my $days = $1;
- $mday += $days;
- } elsif ( $freq =~ /^(\d+)h$/ ) {
- my $hours = $1;
- $hour += $hours;
- } else {
- return -1;
- }
-
- timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
-}
-
-=item plandata
-
-For backwards compatibility, returns the plandata field as well as all options
-from FS::part_pkg_option.
-
-=cut
-
-sub plandata {
- my $self = shift;
- carp "plandata is deprecated";
- if ( @_ ) {
- $self->SUPER::plandata(@_);
- } else {
- my $plandata = $self->get('plandata');
- my %options = $self->options;
- $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
- $plandata;
- }
-}
-
-=item part_pkg_vendor
-
-Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
-L<FS::part_pkg_vendor>).
-
-=cut
-
-sub part_pkg_vendor {
- my $self = shift;
- qsearch('part_pkg_vendor', { 'pkgpart' => $self->pkgpart } );
-}
-
-=item vendor_pkg_ids
-
-Returns a list of vendor/external package ids by exportnum
-
-=cut
-
-sub vendor_pkg_ids {
- my $self = shift;
- map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
-}
-
-=item part_pkg_option
-
-Returns all options as FS::part_pkg_option objects (see
-L<FS::part_pkg_option>).
-
-=cut
-
-sub part_pkg_option {
- my $self = shift;
- qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
-}
-
-=item options
-
-Returns a list of option names and values suitable for assigning to a hash.
-
-=cut
-
-sub options {
- my $self = shift;
- map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
-}
-
-=item option OPTIONNAME [ QUIET ]
-
-Returns the option value for the given name, or the empty string. If a true
-value is passed as the second argument, warnings about missing the option
-will be suppressed.
-
-=cut
-
-sub option {
- my( $self, $opt, $ornull ) = @_;
- my $part_pkg_option =
- qsearchs('part_pkg_option', {
- pkgpart => $self->pkgpart,
- optionname => $opt,
- } );
- return $part_pkg_option->optionvalue if $part_pkg_option;
- my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
- split("\n", $self->get('plandata') );
- return $plandata{$opt} if exists $plandata{$opt};
- cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
- "not found in options or plandata!\n"
- unless $ornull;
- '';
-}
-
-=item bill_part_pkg_link
-
-Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
-
-=cut
-
-sub bill_part_pkg_link {
- shift->_part_pkg_link('bill', @_);
-}
-
-=item svc_part_pkg_link
-
-Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
-
-=cut
-
-sub svc_part_pkg_link {
- shift->_part_pkg_link('svc', @_);
-}
-
-sub _part_pkg_link {
- my( $self, $type ) = @_;
- qsearch({ table => 'part_pkg_link',
- hashref => { 'src_pkgpart' => $self->pkgpart,
- 'link_type' => $type,
- #protection against infinite recursive links
- 'dst_pkgpart' => { op=>'!=', value=> $self->pkgpart },
- },
- order_by => "ORDER BY hidden",
- });
-}
-
-sub self_and_bill_linked {
- shift->_self_and_linked('bill', @_);
-}
-
-sub _self_and_linked {
- my( $self, $type, $hidden ) = @_;
- $hidden ||= '';
-
- my @result = ();
- foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
- $self->_part_pkg_link($type) ) )
- {
- $_->hidden($hidden) if $hidden;
- push @result, $_;
- }
-
- (@result);
-}
-
-=item part_pkg_taxoverride [ CLASS ]
-
-Returns all associated FS::part_pkg_taxoverride objects (see
-L<FS::part_pkg_taxoverride>). Limits the returned set to those
-of class CLASS if defined. Class may be one of 'setup', 'recur',
-the empty string (default), or a usage class number (see L<FS::usage_class>).
-When a class is specified, the empty string class (default) is returned
-if no more specific values exist.
-
-=cut
-
-sub part_pkg_taxoverride {
- my $self = shift;
- my $class = shift;
-
- my $hashref = { 'pkgpart' => $self->pkgpart };
- $hashref->{'usage_class'} = $class if defined($class);
- my @overrides = qsearch('part_pkg_taxoverride', $hashref );
-
- unless ( scalar(@overrides) || !defined($class) || !$class ){
- $hashref->{'usage_class'} = '';
- @overrides = qsearch('part_pkg_taxoverride', $hashref );
- }
-
- @overrides;
-}
-
-=item has_taxproduct
-
-Returns true if this package has any taxproduct associated with it.
-
-=cut
-
-sub has_taxproduct {
- my $self = shift;
-
- $self->taxproductnum ||
- scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
- keys %{ {$self->options} }
- )
-
-}
-
-
-=item taxproduct [ CLASS ]
-
-Returns the associated tax product for this package definition (see
-L<FS::part_pkg_taxproduct>). CLASS may be one of 'setup', 'recur' or
-the usage classnum (see L<FS::usage_class>). Returns the default
-tax product for this record if the more specific CLASS value does
-not exist.
-
-=cut
-
-sub taxproduct {
- my $self = shift;
- my $class = shift;
-
- my $part_pkg_taxproduct;
-
- my $taxproductnum = $self->taxproductnum;
- if ($class) {
- my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
- $taxproductnum = $class_taxproductnum
- if $class_taxproductnum
- }
-
- $part_pkg_taxproduct =
- qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
-
- unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
- $taxproductnum = $self->taxproductnum;
- $part_pkg_taxproduct =
- qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
- }
-
- $part_pkg_taxproduct;
-}
-
-=item taxproduct_description [ CLASS ]
-
-Returns the description of the associated tax product for this package
-definition (see L<FS::part_pkg_taxproduct>).
-
-=cut
-
-sub taxproduct_description {
- my $self = shift;
- my $part_pkg_taxproduct = $self->taxproduct(@_);
- $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
-}
-
-=item part_pkg_taxrate DATA_PROVIDER, GEOCODE, [ CLASS ]
-
-Returns the package to taxrate m2m records for this package in the location
-specified by GEOCODE (see L<FS::part_pkg_taxrate>) and usage class CLASS.
-CLASS may be one of 'setup', 'recur', or one of the usage classes numbers
-(see L<FS::usage_class>).
-
-=cut
-
-sub _expand_cch_taxproductnum {
- my $self = shift;
- my $class = shift;
- my $part_pkg_taxproduct = $self->taxproduct($class);
-
- my ($a,$b,$c,$d) = ( $part_pkg_taxproduct
- ? ( split ':', $part_pkg_taxproduct->taxproduct )
- : ()
- );
- $a = '' unless $a; $b = '' unless $b; $c = '' unless $c; $d = '' unless $d;
- my $extra_sql = "AND ( taxproduct = '$a:$b:$c:$d'
- OR taxproduct = '$a:$b:$c:'
- OR taxproduct = '$a:$b:".":$d'
- OR taxproduct = '$a:$b:".":' )";
- map { $_->taxproductnum } qsearch( { 'table' => 'part_pkg_taxproduct',
- 'hashref' => { 'data_vendor'=>'cch' },
- 'extra_sql' => $extra_sql,
- } );
-
-}
-
-sub part_pkg_taxrate {
- my $self = shift;
- my ($data_vendor, $geocode, $class) = @_;
-
- my $dbh = dbh;
- my $extra_sql = 'WHERE part_pkg_taxproduct.data_vendor = '.
- dbh->quote($data_vendor);
-
- # CCH oddness in m2m
- $extra_sql .= ' AND ('.
- join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
- qw(10 5 2)
- ).
- ')';
- # much more CCH oddness in m2m -- this is kludgy
- my @tpnums = $self->_expand_cch_taxproductnum($class);
- if (scalar(@tpnums)) {
- $extra_sql .= ' AND ('.
- join(' OR ', map{ "taxproductnum = $_" } @tpnums ).
- ')';
- } else {
- $extra_sql .= ' AND ( 0 = 1 )';
- }
-
- my $addl_from = 'LEFT JOIN part_pkg_taxproduct USING ( taxproductnum )';
- my $order_by = 'ORDER BY taxclassnum, length(geocode) desc, length(taxproduct) desc';
- my $select = 'DISTINCT ON(taxclassnum) *, taxproduct';
-
- # should qsearch preface columns with the table to facilitate joins?
- qsearch( { 'table' => 'part_pkg_taxrate',
- 'select' => $select,
- 'hashref' => { # 'data_vendor' => $data_vendor,
- # 'taxproductnum' => $self->taxproductnum,
- },
- 'addl_from' => $addl_from,
- 'extra_sql' => $extra_sql,
- 'order_by' => $order_by,
- } );
-}
-
-=item part_pkg_discount
-
-Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
-for this package.
-
-=cut
-
-sub part_pkg_discount {
- my $self = shift;
- qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart });
-}
-
-=item _rebless
-
-Reblesses the object into the FS::part_pkg::PLAN class (if available), where
-PLAN is the object's I<plan> field. There should be better docs
-on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
-
-=cut
-
-sub _rebless {
- my $self = shift;
- my $plan = $self->plan;
- unless ( $plan ) {
- cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
- if $DEBUG;
- return $self;
- }
- return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
- my $class = ref($self). "::$plan";
- warn "reblessing $self into $class" if $DEBUG;
- eval "use $class;";
- die $@ if $@;
- bless($self, $class) unless $@;
- $self;
-}
-
-#fallbacks that eval the setup and recur fields, for backwards compat
-
-sub calc_setup {
- my $self = shift;
- warn 'no price plan class for '. $self->plan. ", eval-ing setup\n";
- $self->_calc_eval('setup', @_);
-}
-
-sub calc_recur {
- my $self = shift;
- warn 'no price plan class for '. $self->plan. ", eval-ing recur\n";
- $self->_calc_eval('recur', @_);
-}
-
-use vars qw( $sdate @details );
-sub _calc_eval {
- #my( $self, $field, $cust_pkg ) = @_;
- my( $self, $field, $cust_pkg, $sdateref, $detailsref ) = @_;
- *sdate = $sdateref;
- *details = $detailsref;
- $self->$field() =~ /^(.*)$/
- or die "Illegal $field (pkgpart ". $self->pkgpart. '): '.
- $self->$field(). "\n";
- my $prog = $1;
- return 0 if $prog =~ /^\s*$/;
- my $value = eval $prog;
- die $@ if $@;
- $value;
-}
-
-#fallback that return 0 for old legacy packages with no plan
-
-sub calc_remain { 0; }
-sub calc_cancel { 0; }
-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
-in the plan info. Returns DATA if no such function exists.
-
-=cut
-
-sub format {
- my ($self, $option, $data) = (shift, shift, shift);
- if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
- &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
- }else{
- $data;
- }
-}
-
-=item parse OPTION DATA
-
-Returns data parsed according to the function 'parse' described
-in the plan info. Returns DATA if no such function exists.
-
-=cut
-
-sub parse {
- my ($self, $option, $data) = (shift, shift, shift);
- if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
- &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
- }else{
- $data;
- }
-}
-
-=back
-
-=cut
-
-=head1 CLASS METHODS
-
-=over 4
-
-=cut
-
-# _upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-
-sub _upgrade_data { # class method
- my($class, %opts) = @_;
-
- warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
-
- my @part_pkg = qsearch({
- 'table' => 'part_pkg',
- 'extra_sql' => "WHERE ". join(' OR ',
- ( map "($_ IS NOT NULL AND $_ != '' )",
- qw( plandata setup recur ) ),
- 'plan IS NULL', "plan = '' ",
- ),
- });
-
- foreach my $part_pkg (@part_pkg) {
-
- unless ( $part_pkg->plan ) {
- $part_pkg->plan('flat');
- }
-
- if ( length($part_pkg->option('setup_fee')) == 0
- && $part_pkg->setup =~ /^\s*([\d\.]+)\s*$/ ) {
-
- my $opt = new FS::part_pkg_option {
- 'pkgpart' => $part_pkg->pkgpart,
- 'optionname' => 'setup_fee',
- 'optionvalue' => $1,
- };
- my $error = $opt->insert;
- die $error if $error;
-
-
- #} else {
- # die "Can't parse part_pkg.setup for fee; convert pkgnum ".
- # $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
- }
- $part_pkg->setup('');
-
- if ( length($part_pkg->option('recur_fee')) == 0
- && $part_pkg->recur =~ /^\s*([\d\.]+)\s*$/ ) {
-
- my $opt = new FS::part_pkg_option {
- 'pkgpart' => $part_pkg->pkgpart,
- 'optionname' => 'recur_fee',
- 'optionvalue' => $1,
- };
- my $error = $opt->insert;
- die $error if $error;
-
-
- #} else {
- # die "Can't parse part_pkg.setup for fee; convert pkgnum ".
- # $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
- }
- $part_pkg->recur('');
-
- $part_pkg->replace; #this should take care of plandata, right?
-
- }
-
- # now upgrade to the explicit custom flag
-
- @part_pkg = qsearch({
- 'table' => 'part_pkg',
- 'hashref' => { disabled => 'Y', custom => '' },
- 'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
- });
-
- foreach my $part_pkg (@part_pkg) {
- my $new = new FS::part_pkg { $part_pkg->hash };
- $new->custom('Y');
- my $comment = $part_pkg->comment;
- $comment =~ s/^\(CUSTOM\) //;
- $comment = '(none)' unless $comment =~ /\S/;
- $new->comment($comment);
-
- my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
- my $primary = $part_pkg->svcpart;
- my $options = { $part_pkg->options };
-
- my $error = $new->replace( $part_pkg,
- 'pkg_svc' => $pkg_svc,
- 'primary_svc' => $primary,
- 'options' => $options,
- );
- die $error if $error;
- }
-
- my @part_pkg_option = qsearch('part_pkg_option',
- { 'optionname' => 'unused_credit',
- 'optionvalue' => 1,
- });
- foreach my $old_opt (@part_pkg_option) {
- my $pkgpart = $old_opt->pkgpart;
- my $error = $old_opt->delete;
- die $error if $error;
-
- foreach (qw(unused_credit_cancel unused_credit_change)) {
- my $new_opt = new FS::part_pkg_option {
- 'pkgpart' => $pkgpart,
- 'optionname' => $_,
- 'optionvalue' => 1,
- };
- $error = $new_opt->insert;
- die $error if $error;
- }
- }
-}
-
-=item curuser_pkgs_sql
-
-Returns an SQL fragment for searching for packages the current user can
-use, either via part_pkg.agentnum directly, or via agent type (see
-L<FS::type_pkgs>).
-
-=cut
-
-sub curuser_pkgs_sql {
- my $class = shift;
-
- $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
-
-}
-
-=item agent_pkgs_sql AGENT | AGENTNUM, ...
-
-Returns an SQL fragment for searching for packages the provided agent or agents
-can use, either via part_pkg.agentnum directly, or via agent type (see
-L<FS::type_pkgs>).
-
-=cut
-
-sub agent_pkgs_sql {
- my $class = shift; #i'm a class method, not a sub (the question is... why??)
- my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
-
- $class->_pkgs_sql(@agentnums); #is this why
-
-}
-
-sub _pkgs_sql {
- my( $class, @agentnums ) = @_;
- my $agentnums = join(',', @agentnums);
-
- "
- (
- ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
- OR ( agentnum IS NULL
- AND EXISTS ( SELECT 1
- FROM type_pkgs
- LEFT JOIN agent_type USING ( typenum )
- LEFT JOIN agent AS typeagent USING ( typenum )
- WHERE type_pkgs.pkgpart = part_pkg.pkgpart
- AND typeagent.agentnum IN ($agentnums)
- )
- )
- )
- ";
-
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item plan_info
-
-=cut
-
-#false laziness w/part_export & cdr
-my %info;
-foreach my $INC ( @INC ) {
- warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG;
- foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) {
- warn "attempting to load plan info from $file\n" if $DEBUG;
- $file =~ /\/(\w+)\.pm$/ or do {
- warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
- next;
- };
- my $mod = $1;
- my $info = eval "use FS::part_pkg::$mod; ".
- "\\%FS::part_pkg::$mod\::info;";
- if ( $@ ) {
- die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
- next;
- }
- unless ( keys %$info ) {
- warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
- next;
- }
- warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
- #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
- # warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
- # next;
- #}
- $info{$mod} = $info;
- $info->{'weight'} ||= 0; # quiet warnings
- }
-}
-
-# copy one level deep to allow replacement of fields and fieldorder
-tie %plans, 'Tie::IxHash',
- map { my %infohash = %{ $info{$_} };
- $_ => \%infohash }
- sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
- keys %info;
-
-# inheritance of plan options
-foreach my $name (keys(%info)) {
- if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
- warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
- delete $plans{$name};
- next;
- }
- my $parents = $info{$name}->{'inherit_fields'} || [];
- my (%fields, %field_exists, @fieldorder);
- foreach my $parent ($name, @$parents) {
- %fields = ( # avoid replacing existing fields
- %{ $info{$parent}->{'fields'} || {} },
- %fields
- );
- foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
- # avoid duplicates
- next if $field_exists{$_};
- $field_exists{$_} = 1;
- # allow inheritors to remove inherited fields from the fieldorder
- push @fieldorder, $_ if !exists($fields{$_}->{'disabled'});
- }
- }
- $plans{$name}->{'fields'} = \%fields;
- $plans{$name}->{'fieldorder'} = \@fieldorder;
-}
-
-sub plan_info {
- \%plans;
-}
-
-
-=back
-
-=head1 NEW PLAN CLASSES
-
-A module should be added in FS/FS/part_pkg/ Eventually, an example may be
-found in eg/plan_template.pm. Until then, it is suggested that you use the
-other modules in FS/FS/part_pkg/ as a guide.
-
-=head1 BUGS
-
-The delete method is unimplemented.
-
-setup and recur semantics are not yet defined (and are implemented in
-FS::cust_bill. hmm.). now they're deprecated and need to go.
-
-plandata should go
-
-part_pkg_taxrate is Pg specific
-
-replace should be smarter about managing the related tables (options, pkg_svc)
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
-schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_pkg/agent.pm b/FS/FS/part_pkg/agent.pm
deleted file mode 100644
index 6ab21d6..0000000
--- a/FS/FS/part_pkg/agent.pm
+++ /dev/null
@@ -1,172 +0,0 @@
-package FS::part_pkg::agent;
-
-use strict;
-use vars qw(@ISA $DEBUG $me %info);
-use Date::Format;
-use FS::Record qw( qsearch );
-use FS::agent;
-use FS::cust_main;
-
-#use FS::part_pkg::recur_Common;;
-#@ISA = qw(FS::part_pkg::recur_Common);
-use FS::part_pkg::prorate;
-@ISA = qw(FS::part_pkg::prorate);
-
-$DEBUG = 0;
-
-$me = '[FS::part_pkg::agent]';
-
-%info = (
- 'name' => 'Wholesale bulk billing, for master customers of an agent.',
- 'shortname' => 'Wholesale bulk billing for agent.',
- 'inherit_fields' => [qw( prorate global_Mixin)],
- 'fields' => {
- #'recur_method' => { 'name' => 'Recurring fee method',
- # #'type' => 'radio',
- # #'options' => \%recur_method,
- # 'type' => 'select',
- # 'select_options' => \%recur_Common::recur_method,
- # },
- 'cutoff_day' => { 'name' => 'Billing Day (1 - 28)',
- 'default' => '1',
- },
- 'add_full_period'=> { 'name' => 'When prorating first month, also bill '.
- 'for one full period after that',
- 'type' => 'checkbox',
- },
-
- 'no_pkg_prorate' => { 'name' => 'Disable prorating bulk packages (charge full price for packages active only a portion of the month)',
- 'type' => 'checkbox',
- },
-
- },
-
- 'fieldorder' => [qw( cutoff_day add_full_period no_pkg_prorate ) ],
-
- 'weight' => 51,
-
-);
-
-#some false laziness-ish w/bulk.pm... not a lot
-sub calc_recur {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- my $last_bill = $cust_pkg->last_bill;
-
- return sprintf("%.2f", $self->SUPER::calc_recur(@_) )
- unless $$sdate > $last_bill;
-
- my $conf = new FS::Conf;
- my $money_char = $conf->config('money_char') || '$';
-
- my $total_agent_charge = 0;
-
- warn "$me billing for agent packages from ". time2str('%x', $last_bill).
- " to ". time2str('%x', $$sdate). "\n"
- if $DEBUG;
-
- my $prorate_ratio = ( $$sdate - $last_bill )
- / ( $self->add_freq($last_bill) - $last_bill );
-
- #almost always just one,
- #unless you have multiple agents with same master customer0
- my @agents = qsearch('agent', { 'agent_custnum' => $cust_pkg->custnum } );
-
- foreach my $agent (@agents) {
-
- warn "$me billing for agent ". $agent->agent. "\n"
- if $DEBUG;
-
- #not the most efficient to load them all into memory,
- #but good enough for our current needs
- my @cust_main = qsearch('cust_main', { 'agentnum' => $agent->agentnum } );
-
- foreach my $cust_main (@cust_main) {
-
- warn "$me billing agent charges for ". $cust_main->name_short. "\n"
- if $DEBUG;
-
- #make sure setup dates are filled in
- my $error = $cust_main->bill; #options don't propogate from freeside-daily
- die "Error pre-billing agent customer: $error" if $error;
-
- my @cust_pkg = grep { my $setup = $_->get('setup');
- my $cancel = $_->get('cancel');
-
- $setup < $$sdate # END
- && ( ! $cancel || $cancel > $last_bill ) #START
- }
- $cust_main->all_pkgs;
-
- foreach my $cust_pkg ( @cust_pkg ) {
-
- warn "$me billing agent charges for pkgnum ". $cust_pkg->pkgnum. "\n"
- if $DEBUG;
-
- my $pkg_details = $cust_main->name_short. ': '; #name?
- # + something to identify package... primary service probably
-
- my $pkg_charge = 0;
-
- my $part_pkg = $cust_pkg->part_pkg;
- #option to not fallback? via options above
- my $pkg_setup_fee =
- $part_pkg->setup_cost || $part_pkg->option('setup_fee');
- my $pkg_base_recur =
- $part_pkg->recur_cost || $part_pkg->base_recur_permonth($cust_pkg);
-
- my $pkg_start = $cust_pkg->get('setup');
- if ( $pkg_start < $last_bill ) {
- $pkg_start = $last_bill;
- } elsif ( $pkg_setup_fee ) {
- $pkg_charge += $pkg_setup_fee;
- $pkg_details .= $money_char. sprintf('%.2f setup, ', $pkg_setup_fee );
- }
-
- my $pkg_end = $cust_pkg->get('cancel');
- $pkg_end = ( !$pkg_end || $pkg_end > $$sdate ) ? $$sdate : $pkg_end;
-
-
- my $pkg_recur_charge = $prorate_ratio * $pkg_base_recur;
- $pkg_recur_charge *= ( $pkg_end - $pkg_start )
- / ( $$sdate - $last_bill )
- unless $self->option('no_pkg_prorate');
-
- my $recur_charge += $pkg_recur_charge;
-
- $pkg_details .= $money_char. sprintf('%.2f', $recur_charge ).
- ' ('. time2str('%x', $pkg_start).
- ' - '. time2str('%x', $pkg_end ). ')'
- if $recur_charge;
-
- $pkg_charge += $recur_charge;
-
- push @$details, $pkg_details
- if $pkg_charge;
- $total_agent_charge += $pkg_charge;
-
- } #foreach $cust_pkg
-
- } #foreach $cust_main
-
- } #foreach $agent;
-
- my $charges = $total_agent_charge + $self->SUPER::calc_recur(@_); #prorate
-
- sprintf('%.2f', $charges );
-
-}
-
-sub can_discount { 0; }
-
-sub hide_svc_detail {
- 1;
-}
-
-sub is_free {
- 0;
-}
-
-1;
-
diff --git a/FS/FS/part_pkg/base_delayed.pm b/FS/FS/part_pkg/base_delayed.pm
deleted file mode 100644
index c6864a6..0000000
--- a/FS/FS/part_pkg/base_delayed.pm
+++ /dev/null
@@ -1,42 +0,0 @@
-package FS::part_pkg::base_delayed;
-
-use strict;
-use vars qw(@ISA %info);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg::base_rate;
-
-@ISA = qw(FS::part_pkg::base_rate);
-
-%info = (
- 'name' => 'Free (or setup fee) for X days, then base rate'.
- ' (anniversary billing)',
- 'shortname' => 'Bulk (manual from "units" option), w/intro period',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'free_days' => { 'name' => 'Initial free days',
- 'default' => 0,
- },
- 'recur_notify' => { 'name' => 'Number of days before recurring billing'.
- ' commences to notify customer. (0 means'.
- ' no warning)',
- 'default' => 0,
- },
- },
- 'fieldorder' => [ 'free_days', 'recur_notify',
- ],
- #'setup' => '\'my $d = $cust_pkg->bill || $time; $d += 86400 * \' + what.free_days.value + \'; $cust_pkg->bill($d); $cust_pkg_mod_flag=1; \' + what.setup_fee.value',
- #'recur' => 'what.recur_fee.value',
- 'weight' => 54, #&g!
-);
-
-sub calc_setup {
- my($self, $cust_pkg, $time ) = @_;
-
- my $d = $cust_pkg->bill || $time;
- $d += 86400 * $self->option('free_days');
- $cust_pkg->bill($d);
-
- $self->option('setup_fee');
-}
-
-1;
diff --git a/FS/FS/part_pkg/base_rate.pm b/FS/FS/part_pkg/base_rate.pm
deleted file mode 100644
index 6781977..0000000
--- a/FS/FS/part_pkg/base_rate.pm
+++ /dev/null
@@ -1,83 +0,0 @@
-package FS::part_pkg::base_rate;
-
-use strict;
-use vars qw(@ISA %info);
-#use FS::Record qw(qsearch);
-use FS::part_pkg;
-
-@ISA = qw(FS::part_pkg);
-
-%info = (
- 'name' => 'Base rate (anniversary billing, Times units ordered)',
- # XXX it multiplies recurring fee by cust_pkg option "units", how to
- # express that
- 'shortname' => 'Bulk (manual from "units" option)',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'externalid' => { 'name' => 'Optional External ID',
- 'default' => '',
- },
- },
- 'fieldorder' => [ qw( externalid ) ],
- 'weight' => 52,
-);
-
-sub calc_setup {
- my($self, $cust_pkg, $sdate, $details ) = @_;
-
- my $i = 0;
- my $count = $self->option( 'additional_count', 'quiet' ) || 0;
- while ($i < $count) {
- push @$details, $self->option( 'additional_info' . $i++ );
- }
-
- $self->option('setup_fee');
-}
-
-sub calc_recur {
- my($self, $cust_pkg) = @_;
- $self->base_recur($cust_pkg);
-}
-
-sub base_recur {
- my($self, $cust_pkg) = @_;
- my $units = $cust_pkg->option('units') ? $cust_pkg->option('units') : 1 ;
- # default to 1 if not found
- sprintf("%.2f",
- ($self->option('recur_fee') * $units )
- );
-}
-
-sub calc_remain {
- my ($self, $cust_pkg, %options) = @_;
- my $time = $options{'time'} || time;
- my $next_bill = $cust_pkg->getfield('bill') || 0;
- return 0 if ! $self->base_recur($cust_pkg)
- || ! $next_bill
- || $next_bill < $time;
-
- my %sec = (
- 'h' => 3600, # 60 * 60
- 'd' => 86400, # 60 * 60 * 24
- 'w' => 604800, # 60 * 60 * 24 * 7
- 'm' => 2629744, # 60 * 60 * 24 * 365.2422 / 12
- );
-
- $self->freq =~ /^(\d+)([hdwm]?)$/
- or die 'unparsable frequency: '. $self->freq;
- my $freq_sec = $1 * $sec{$2||'m'};
- return 0 unless $freq_sec;
-
- sprintf("%.2f", $self->base_recur($cust_pkg) * ( $next_bill - $time ) / $freq_sec );
-
-}
-
-sub is_free_options {
- qw( setup_fee recur_fee );
-}
-
-sub is_prepaid {
- 0; #no, we're postpaid
-}
-
-1;
diff --git a/FS/FS/part_pkg/bulk.pm b/FS/FS/part_pkg/bulk.pm
deleted file mode 100644
index 0df929e..0000000
--- a/FS/FS/part_pkg/bulk.pm
+++ /dev/null
@@ -1,130 +0,0 @@
-package FS::part_pkg::bulk;
-
-use strict;
-use vars qw(@ISA $DEBUG $me %info);
-use Date::Format;
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-$DEBUG = 0;
-$me = '[FS::part_pkg::bulk]';
-
-%info = (
- 'name' => 'Bulk billing based on number of active services',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'svc_setup_fee' => { 'name' => 'Setup fee for each new service',
- 'default' => 0,
- },
- 'svc_recur_fee' => { 'name' => 'Recurring fee for each service',
- 'default' => 0,
- },
- 'summarize_svcs'=> { 'name' => 'Show a count of services on the invoice, '.
- 'instead of a detailed list',
- 'type' => 'checkbox',
- },
- 'no_prorate' => { 'name' => 'Don\'t prorate recurring fees on services '.
- 'active for a partial month',
- 'type' => 'checkbox',
- },
- },
- 'fieldorder' => [ 'svc_setup_fee', 'svc_recur_fee',
- 'summarize_svcs', 'no_prorate' ],
- 'weight' => 50,
-);
-
-#some false laziness-ish w/agent.pm... not a lot
-sub calc_recur {
- my($self, $cust_pkg, $sdate, $details ) = @_;
-
- my $conf = new FS::Conf;
- my $money_char = $conf->config('money_char') || '$';
-
- my $svc_setup_fee = $self->option('svc_setup_fee');
-
- my $last_bill = $cust_pkg->last_bill;
-
- return sprintf("%.2f", $self->base_recur($cust_pkg) )
- unless $$sdate > $last_bill;
-
- my $total_svc_charge = 0;
- my %n_setup = ();
- my %n_recur = ();
- my %part_svc_label = ();
-
- my $summarize = $self->option('summarize_svcs',1);
-
- warn "$me billing for bulk services from ". time2str('%x', $last_bill).
- " to ". time2str('%x', $$sdate). "\n"
- if $DEBUG;
-
- # END START
- foreach my $h_cust_svc ( $cust_pkg->h_cust_svc( $$sdate, $last_bill ) ) {
-
- my @label = $h_cust_svc->label_long( $$sdate, $last_bill );
- die "fatal: no historical label found, wtf?" unless scalar(@label); #?
- my $svc_details = $label[0]. ': '. $label[1]. ': ';
- $part_svc_label{$h_cust_svc->svcpart} ||= $label[0];
-
- my $svc_charge = 0;
-
- my $svc_start = $h_cust_svc->date_inserted;
- if ( $svc_start < $last_bill ) {
- $svc_start = $last_bill;
- } elsif ( $svc_setup_fee ) {
- $svc_charge += $svc_setup_fee;
- $svc_details .= $money_char. sprintf('%.2f setup, ', $svc_setup_fee);
- $n_setup{$h_cust_svc->svcpart}++;
- }
-
- my $svc_end = $h_cust_svc->date_deleted;
- $svc_end = ( !$svc_end || $svc_end > $$sdate ) ? $$sdate : $svc_end;
-
- my $recur_charge;
- if ( $self->option('no_prorate',1) ) {
- $recur_charge = $self->option('svc_recur_fee');
- }
- else {
- $recur_charge = $self->option('svc_recur_fee')
- * ( $svc_end - $svc_start )
- / ( $$sdate - $last_bill );
- }
-
- $svc_details .= $money_char. sprintf('%.2f', $recur_charge ).
- ' ('. time2str('%x', $svc_start).
- ' - '. time2str('%x', $svc_end ). ')'
- if $recur_charge;
-
- $svc_charge += $recur_charge;
- $n_recur{$h_cust_svc->svcpart}++;
- push @$details, $svc_details if !$summarize;
- $total_svc_charge += $svc_charge;
-
- }
- if ( $summarize ) {
- foreach my $svcpart (keys %part_svc_label) {
- push @$details, sprintf('Setup fee: %d @ '.$money_char.'%.2f',
- $n_setup{$svcpart}, $svc_setup_fee )
- if $svc_setup_fee and $n_setup{$svcpart};
- push @$details, sprintf('%d services @ '.$money_char.'%.2f',
- $n_recur{$svcpart}, $self->option('svc_recur_fee') )
- if $n_recur{$svcpart};
- }
- }
-
- sprintf('%.2f', $self->base_recur($cust_pkg) + $total_svc_charge );
-}
-
-sub can_discount { 0; }
-
-sub hide_svc_detail {
- 1;
-}
-
-sub is_free_options {
- qw( setup_fee recur_fee svc_setup_fee svc_recur_fee );
-}
-
-1;
-
diff --git a/FS/FS/part_pkg/cdr_termination.pm b/FS/FS/part_pkg/cdr_termination.pm
deleted file mode 100644
index 840da82..0000000
--- a/FS/FS/part_pkg/cdr_termination.pm
+++ /dev/null
@@ -1,204 +0,0 @@
-package FS::part_pkg::cdr_termination;
-
-use strict;
-use base qw( FS::part_pkg::recur_Common );
-use vars qw( $DEBUG %info );
-use Tie::IxHash;
-use FS::Record qw( qsearch ); #qsearchs );
-use FS::cdr;
-use FS::cdr_termination;
-
-tie my %temporalities, 'Tie::IxHash',
- 'upcoming' => "Upcoming (future)",
- 'preceding' => "Preceding (past)",
-;
-
-%info = (
- 'name' => 'VoIP rating of CDR records for termination partners.',
- 'shortname' => 'VoIP/telco CDR termination',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- #'cdr_column' => { 'name' => 'Column from CDR records',
- # 'type' => 'select',
- # 'select_enum' => [qw(
- # dcontext
- # channel
- # dstchannel
- # lastapp
- # lastdata
- # accountcode
- # userfield
- # cdrtypenum
- # calltypenum
- # description
- # carrierid
- # upstream_rateid
- # )],
- # },
-
- #false laziness w/flat.pm
- 'recur_temporality' => { 'name' => 'Charge recurring fee for period',
- 'type' => 'select',
- 'select_options' => \%temporalities,
- },
-
- 'cutoff_day' => { 'name' => 'Billing Day (1 - 28) for prorating or '.
- 'subscription',
- 'default' => '1',
- },
- 'add_full_period'=> { 'name' => 'When prorating first month, also bill '.
- 'for one full period after that',
- 'type' => 'checkbox',
- },
-
- 'recur_method' => { 'name' => 'Recurring fee method',
- #'type' => 'radio',
- #'options' => \%recur_method,
- 'type' => 'select',
- 'select_options' => \%FS::part_pkg::recur_Common::recur_method,
- },
-
- #false laziness w/voip_cdr.pm
- 'output_format' => { 'name' => 'CDR invoice display format',
- 'type' => 'select',
- 'select_options' => { FS::cdr::invoice_formats() },
- 'default' => 'simple2', #XXX test
- },
-
- 'usage_section' => { 'name' => 'Section in which to place separate usage charges',
- },
-
- 'summarize_usage' => { 'name' => 'Include usage summary with recurring charges when usage is in separate section',
- 'type' => 'checkbox',
- },
-
- 'usage_mandate' => { 'name' => 'Always put usage details in separate section',
- 'type' => 'checkbox',
- },
- #eofalse
-
- },
- #cdr_column
- 'fieldorder' => [qw(
- recur_temporality recur_method cutoff_day
- add_full_period
- output_format usage_section summarize_usage usage_mandate
- )
- ],
-
- 'weight' => 48,
-
-);
-
-sub calc_setup {
- my($self, $cust_pkg ) = @_;
- $self->option('setup_fee');
-}
-
-sub calc_recur {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- #my $last_bill = $cust_pkg->last_bill;
- my $last_bill = $cust_pkg->get('last_bill'); #->last_bill falls back to setup
-
- return 0
- if $self->option('recur_temporality', 1) eq 'preceding'
- && ( $last_bill eq '' || $last_bill == 0 );
-
- # termination calculations
-
- my $term_percent = $cust_pkg->cust_main->cdr_termination_percentage;
- die "no customer termination percentage" unless $term_percent;
-
- my $output_format = $self->option('output_format', 'Hush!') || 'simple2';
-
- my $charges = 0;
-
- #find an svc_external record
- my @svc_external = map { $_->svc_x }
- grep { $_->part_svc->svcdb eq 'svc_external' }
- $cust_pkg->cust_svc;
-
- die "cdr_termination package has no svc_external service"
- unless @svc_external;
- die "cdr_termination package has multiple svc_external services"
- if scalar(@svc_external) > 1;
-
- my $svc_external = $svc_external[0];
-
- # find CDRs:
- # - matching our customer via svc_external.id/title? (and via what field?)
-
- #let's try carrierid for now, can always make it configurable or rewrite
- my $cdr_column = 'carrierid';
-
- my %hashref = ( 'freesidestatus' => 'done' );
-
- # try matching on svc_external.id for now... (or title? if ints don't cut it)
- $hashref{$cdr_column} = $svc_external[0]->id;
-
- # - with no cdr_termination.status
-
- my $termpart = 1; #or from an option
-
- #false lazienss w/search/cdr.html (i should be a part_termination method)
- my $where_term =
- "( cdr.acctid = cdr_termination.acctid AND termpart = $termpart ) ";
- #my $join_term = "LEFT JOIN cdr_termination ON ( $where_term )";
- my $extra_sql =
- "AND NOT EXISTS ( SELECT 1 FROM cdr_termination WHERE $where_term )";
-
- #may need to process in batches if there's waaay too many
- my @cdrs = qsearch({
- 'table' => 'cdr',
- #'addl_from' => $join_term,
- 'hashref' => \%hashref,
- 'extra_sql' => "$extra_sql FOR UPDATE",
- });
-
- foreach my $cdr (@cdrs) {
-
- #add a cdr_termination record and the charges
-
- # XXX config?
- #my $term_price = sprintf('%.2f', $cdr->rated_price * $term_percent / 100 );
- my $term_price = sprintf('%.4f', $cdr->rated_price * $term_percent / 100 );
-
- my $cdr_termination = new FS::cdr_termination {
- 'acctid' => $cdr->acctid,
- 'termpart' => $termpart,
- 'rated_price' => $term_price,
- 'status' => 'done',
- };
-
- my $error = $cdr_termination->insert;
- die $error if $error; #next if $error; #or just skip this one??? why?
-
- $charges += $term_price;
-
- # and add a line to the invoice
-
- my $call_details = $cdr->downstream_csv( 'format' => $output_format,
- 'charge' => $term_price,
- );
-
- my $classnum = ''; #usage class?
-
- #option to turn off? or just use squelch_cdr for the customer probably
- push @$details, [ 'C', $call_details, $term_price, $classnum ];
-
- }
-
- # eotermiation calculation
-
- $charges += $self->calc_recur_Common(@_);
-
- $charges;
-}
-
-sub is_free {
- 0;
-}
-
-1;
diff --git a/FS/FS/part_pkg/discount_Mixin.pm b/FS/FS/part_pkg/discount_Mixin.pm
deleted file mode 100644
index df65e97..0000000
--- a/FS/FS/part_pkg/discount_Mixin.pm
+++ /dev/null
@@ -1,128 +0,0 @@
-package FS::part_pkg::discount_Mixin;
-
-use strict;
-use vars qw(@ISA %info);
-use FS::part_pkg;
-use FS::cust_pkg;
-use FS::cust_bill_pkg_discount;
-use Time::Local qw(timelocal);
-use List::Util 'min';
-
-@ISA = qw(FS::part_pkg);
-%info = ( 'disabled' => 1 );
-
-=head1 NAME
-
-FS::part_pkg::discount_Mixin - Mixin class for part_pkg:: classes that
-can be discounted.
-
-=head1 SYNOPSIS
-
-package FS::part_pkg::...;
-use base qw( FS::part_pkg::discount_Mixin );
-
-sub calc_recur {
- ...
- my $discount = $self->calc_discount($cust_pkg, $$sdate, $details, $param);
- $charge -= $discount;
- ...
-}
-
-=head METHODS
-
-=item calc_discount
-
-Takes all the arguments of calc_recur. Calculates and returns the amount
-by which to reduce the recurring fee; also increments months used on the
-discount and generates an invoice detail describing it.
-
-=cut
-
-sub calc_discount {
- my($self, $cust_pkg, $sdate, $details, $param ) = @_;
-
- my $br = $self->base_recur($cust_pkg);
-
- my $tot_discount = 0;
- #UI enforces just 1 for now, will need ordering when they can be stacked
-
- if ( $param->{freq_override} ) {
- # When a customer pays for more than one month at a time to receive a
- # term discount, freq_override is set to the number of months.
- my $real_part_pkg = new FS::part_pkg { $self->hash };
- $real_part_pkg->pkgpart($param->{real_pkgpart} || $self->pkgpart);
- # Find a discount with that duration...
- my @discount = grep { $_->months == $param->{freq_override} }
- map { $_->discount } $real_part_pkg->part_pkg_discount;
- my $discount = shift @discount;
- # and default to bill that many months at once.
- $param->{months} = $param->{freq_override} unless $param->{months};
- my $error;
- if ($discount) {
- # Then set the cust_pkg discount.
- if ($discount->months == $param->{months}) {
- $cust_pkg->discountnum($discount->discountnum);
- $error = $cust_pkg->insert_discount;
- } else {
- $cust_pkg->discountnum(-1);
- foreach ( qw( amount percent months ) ) {
- my $method = "discountnum_$_";
- $cust_pkg->$method($discount->$_);
- }
- $error = $cust_pkg->insert_discount;
- }
- die "error discounting using part_pkg_discount: $error" if $error;
- }
- }
-
- my @cust_pkg_discount = $cust_pkg->cust_pkg_discount_active;
- foreach my $cust_pkg_discount ( @cust_pkg_discount ) {
- my $discount = $cust_pkg_discount->discount;
- #UI enforces one or the other (for now? probably for good)
- my $amount = 0;
- $amount += $discount->amount
- if $cust_pkg->pkgpart == $param->{real_pkgpart};
- $amount += sprintf('%.2f', $discount->percent * $br / 100 );
- my $chg_months = $param->{'months'} || $cust_pkg->part_pkg->freq;
-
- my $months = $discount->months
- ? min( $chg_months,
- $discount->months - $cust_pkg_discount->months_used )
- : $chg_months;
-
- my $error = $cust_pkg_discount->increment_months_used($months)
- if $cust_pkg->pkgpart == $param->{real_pkgpart};
- die "error discounting: $error" if $error;
-
- $amount *= $months;
- $amount = sprintf('%.2f', $amount);
-
- next unless $amount > 0;
-
- #record details in cust_bill_pkg_discount
- my $cust_bill_pkg_discount = new FS::cust_bill_pkg_discount {
- 'pkgdiscountnum' => $cust_pkg_discount->pkgdiscountnum,
- 'amount' => $amount,
- 'months' => $months,
- };
- push @{ $param->{'discounts'} }, $cust_bill_pkg_discount;
-
- #add details on discount to invoice
- my $conf = new FS::Conf;
- my $money_char = $conf->config('money_char') || '$';
- $months = sprintf('%.2f', $months) if $months =~ /\./;
-
- my $d = 'Includes ';
- $d .= $discount->name. ' ' if $discount->name;
- $d .= 'discount of '. $discount->description_short;
- $d .= " for $months month". ( $months!=1 ? 's' : '' );
- $d .= ": $money_char$amount" if $months != 1 || $discount->percent;
- push @$details, $d;
-
- $tot_discount += $amount;
- }
-
- sprintf('%.2f', $tot_discount);
-}
-
-1;
diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm
deleted file mode 100644
index b5e0fa0..0000000
--- a/FS/FS/part_pkg/flat.pm
+++ /dev/null
@@ -1,204 +0,0 @@
-package FS::part_pkg::flat;
-
-use strict;
-use vars qw( @ISA %info
- %usage_recharge_fields @usage_recharge_fieldorder
- );
-use Tie::IxHash;
-use List::Util qw(min); # max);
-#use FS::Record qw(qsearch);
-use FS::UI::bytecount;
-use FS::Conf;
-use FS::part_pkg;
-
-@ISA = qw(FS::part_pkg
- FS::part_pkg::prorate_Mixin
- FS::part_pkg::discount_Mixin);
-
-tie my %temporalities, 'Tie::IxHash',
- 'upcoming' => "Upcoming (future)",
- 'preceding' => "Preceding (past)",
-;
-
-tie my %contract_years, 'Tie::IxHash', (
- '' => '(none)',
- map { $_*12 => $_ } (1..5),
-);
-
-%info = (
- 'name' => 'Flat rate (anniversary billing)',
- 'shortname' => 'Anniversary',
- 'inherit_fields' => [ 'usage_Mixin', 'global_Mixin' ],
- 'fields' => {
- #false laziness w/voip_cdr.pm
- 'recur_temporality' => { 'name' => 'Charge recurring fee for period',
- 'type' => 'select',
- 'select_options' => \%temporalities,
- },
-
- #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',
- },
- 'adjourn_months'=> { 'name' => 'Auto-add a suspension date this number of months out',
- },
- 'contract_end_months'=> {
- 'name' => 'Auto-add a contract end date this number of years out',
- 'type' => 'select',
- 'select_options' => \%contract_years,
- },
- #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',
- },
- 'sync_bill_date' => { 'name' => 'Prorate first month to synchronize '.
- 'with the customer\'s other packages',
- 'type' => 'checkbox',
- },
- 'suspend_bill' => { 'name' => 'Continue recurring billing while suspended',
- 'type' => 'checkbox',
- },
- 'unsuspend_adjust_bill' =>
- { 'name' => 'Adjust next bill date forward when '.
- 'unsuspending',
- 'type' => 'checkbox',
- },
-
- 'externalid' => { 'name' => 'Optional External ID',
- 'default' => '',
- },
- },
- 'fieldorder' => [ qw( recur_temporality
- expire_months adjourn_months
- contract_end_months
- start_1st sync_bill_date
- suspend_bill unsuspend_adjust_bill
- externalid ),
- ],
- 'weight' => 10,
-);
-
-sub calc_setup {
- my($self, $cust_pkg, $sdate, $details ) = @_;
-
- my $i = 0;
- my $count = $self->option( 'additional_count', 'quiet' ) || 0;
- while ($i < $count) {
- push @$details, $self->option( 'additional_info' . $i++ );
- }
-
- my $quantity = $cust_pkg->quantity || 1;
-
- sprintf("%.2f", $quantity * $self->unit_setup($cust_pkg, $sdate, $details) );
-}
-
-sub unit_setup {
- my($self, $cust_pkg, $sdate, $details ) = @_;
-
- $self->option('setup_fee') || 0;
-}
-
-sub calc_recur {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- #my $last_bill = $cust_pkg->last_bill;
- my $last_bill = $cust_pkg->get('last_bill'); #->last_bill falls back to setup
-
- return 0
- if $self->option('recur_temporality', 1) eq 'preceding' && $last_bill == 0;
-
- my $charge = $self->base_recur($cust_pkg);
- if ( $self->option('sync_bill_date',1) ) {
- my $next_bill = $cust_pkg->cust_main->next_bill_date;
- if ( defined($next_bill) ) {
- my $cutoff_day = (localtime($next_bill))[3];
- $charge = $self->calc_prorate(@_, $cutoff_day);
- }
- }
- elsif ( $param->{freq_override} ) {
- # XXX not sure if this should be mutually exclusive with sync_bill_date.
- # Given the very specific problem that freq_override is meant to 'solve',
- # it probably should.
- $charge *= $param->{freq_override} if $param->{freq_override};
- }
-
- my $discount = $self->calc_discount($cust_pkg, $sdate, $details, $param);
- return sprintf('%.2f', $charge - $discount);
-}
-
-sub base_recur {
- my($self, $cust_pkg) = @_;
- $self->option('recur_fee', 1) || 0;
-}
-
-sub base_recur_permonth {
- my($self, $cust_pkg) = @_;
-
- return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
-
- sprintf('%.2f', $self->base_recur($cust_pkg) / $self->freq );
-}
-
-sub calc_remain {
- my ($self, $cust_pkg, %options) = @_;
-
- my $time;
- if ($options{'time'}) {
- $time = $options{'time'};
- } else {
- $time = time;
- }
-
- my $next_bill = $cust_pkg->getfield('bill') || 0;
-
- return 0 if ! $self->base_recur($cust_pkg)
- || ! $next_bill
- || $next_bill < $time;
-
- my %sec = (
- 'h' => 3600, # 60 * 60
- 'd' => 86400, # 60 * 60 * 24
- 'w' => 604800, # 60 * 60 * 24 * 7
- 'm' => 2629744, # 60 * 60 * 24 * 365.2422 / 12
- );
-
- $self->freq =~ /^(\d+)([hdwm]?)$/
- or die 'unparsable frequency: '. $self->freq;
- my $freq_sec = $1 * $sec{$2||'m'};
- return 0 unless $freq_sec;
-
- sprintf("%.2f", $self->base_recur($cust_pkg) * ( $next_bill - $time ) / $freq_sec );
-
-}
-
-sub is_free_options {
- qw( setup_fee recur_fee );
-}
-
-sub is_prepaid { 0; } #no, we're postpaid
-
-#XXX discounts only on recurring fees for now (no setup/one-time or usage)
-sub can_discount {
- my $self = shift;
- $self->freq =~ /^\d+$/ && $self->freq > 0;
-}
-
-sub usage_valuehash {
- my $self = shift;
- map { $_, $self->option($_) }
- grep { $self->option($_, 'hush') }
- qw(seconds upbytes downbytes totalbytes);
-}
-
-sub reset_usage {
- my($self, $cust_pkg, %opt) = @_;
- warn " resetting usage counters" if defined($opt{debug}) && $opt{debug} > 1;
- my %values = $self->usage_valuehash;
- if ($self->option('usage_rollover', 1)) {
- $cust_pkg->recharge(\%values);
- }else{
- $cust_pkg->set_usage(\%values, %opt);
- }
-}
-
-1;
diff --git a/FS/FS/part_pkg/flat_comission.pm b/FS/FS/part_pkg/flat_comission.pm
deleted file mode 100644
index ec8c8eb..0000000
--- a/FS/FS/part_pkg/flat_comission.pm
+++ /dev/null
@@ -1,60 +0,0 @@
-package FS::part_pkg::flat_comission;
-
-use strict;
-use vars qw(@ISA %info);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-%info = (
- 'name' => 'Flat rate with recurring commission per (any) active package',
- 'shortname' => 'Commission per (any) active package',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'comission_amount' => { 'name' => 'Commission amount per month (per active package)',
- 'default' => 0,
- },
- 'comission_depth' => { 'name' => 'Number of layers',
- 'default' => 1,
- },
- 'reason_type' => { 'name' => 'Reason type for commission credits',
- 'type' => 'select',
- 'select_table' => 'reason_type',
- 'select_hash' => { 'class' => 'R' },
- 'select_key' => 'typenum',
- 'select_label' => 'type',
- },
- },
- 'fieldorder' => [ 'comission_depth', 'comission_amount', 'reason_type' ],
- #'setup' => 'what.setup_fee.value',
- #'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'',
- 'weight' => 62,
-);
-
-sub calc_recur {
- my($self, $cust_pkg ) = @_;
-
- my $amount = $self->option('comission_amount');
- my $num_active = scalar(
- $cust_pkg->cust_main->referral_cust_pkg( $self->option('comission_depth') )
- );
-
- my $commission = sprintf('%.2f', $amount*$num_active);
-
- if ( $commission > 0 ) {
-
- my $error =
- $cust_pkg->cust_main->credit( $commission, "commission",
- 'reason_type'=>$self->option('reason_type'),
- );
- die $error if $error;
-
- }
-
- $self->option('recur_fee');
-}
-
-sub can_discount { 0; }
-
-1;
diff --git a/FS/FS/part_pkg/flat_comission_cust.pm b/FS/FS/part_pkg/flat_comission_cust.pm
deleted file mode 100644
index 5acf73d..0000000
--- a/FS/FS/part_pkg/flat_comission_cust.pm
+++ /dev/null
@@ -1,44 +0,0 @@
-package FS::part_pkg::flat_comission_cust;
-
-use strict;
-use vars qw(@ISA %info);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-%info = (
- 'name' => 'Flat rate with recurring commission per active customer',
- 'shortname' => 'Commission per active customer',
- 'inherit_fields' => [ 'flat_comission', 'global_Mixin' ],
- 'fields' => { },
- 'fieldorder' => [ ],
- #'setup' => 'what.setup_fee.value',
- #'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_main_ncancelled(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'',
- 'weight' => '60',
-);
-
-sub calc_recur {
- my($self, $cust_pkg ) = @_;
-
- my $amount = $self->option('comission_amount');
- my $num_active = scalar(
- $cust_pkg->cust_main->referral_cust_main_ncancelled(
- $self->option('comission_depth')
- )
- );
-
- if ( $amount && $num_active ) {
- my $error =
- $cust_pkg->cust_main->credit( $amount*$num_active, "commission",
- 'reason_type'=>$self->option('reason_type'),
- );
- die $error if $error;
- }
-
- $self->option('recur_fee');
-}
-
-sub can_discount { 0; }
-
-1;
diff --git a/FS/FS/part_pkg/flat_comission_pkg.pm b/FS/FS/part_pkg/flat_comission_pkg.pm
deleted file mode 100644
index 26dd4d2..0000000
--- a/FS/FS/part_pkg/flat_comission_pkg.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-package FS::part_pkg::flat_comission_pkg;
-
-use strict;
-use vars qw(@ISA %info);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-%info = (
- 'name' => 'Flat rate with recurring commission per (selected) active package',
- 'shortname' => 'Commission per (selected) active package',
- 'inherit_fields' => [ 'flat_comission', 'global_Mixin' ],
- 'fields' => {
- 'comission_pkgpart' => { 'name' => 'Applicable packages<BR><FONT SIZE="-1">(hold <b>ctrl</b> to select multiple packages)</FONT>',
- 'type' => 'select_multiple',
- 'select_table' => 'part_pkg',
- 'select_hash' => { 'disabled' => '' } ,
- 'select_key' => 'pkgpart',
- 'select_label' => 'pkg',
- },
- },
- 'fieldorder' => [ 'comission_depth', 'comission_amount', 'comission_pkgpart', 'reason_type' ],
- #'setup' => 'what.setup_fee.value',
- #'recur' => '""; var pkgparts = ""; for ( var c=0; c < document.flat_comission_pkg.comission_pkgpart.options.length; c++ ) { if (document.flat_comission_pkg.comission_pkgpart.options[c].selected) { pkgparts = pkgparts + document.flat_comission_pkg.comission_pkgpart.options[c].value + \', \'; } } what.recur.value = \'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar( grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } ( \' + pkgparts + \' ) } $cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'',
- #'disabled' => 1,
- 'weight' => '64',
-);
-
-# XXX this needs to be fixed!!!
-sub calc_recur {
- my($self, $cust_pkg ) = @_;
- $self->option('recur_fee');
-}
-
-sub can_discount { 0; }
-
-1;
diff --git a/FS/FS/part_pkg/flat_delayed.pm b/FS/FS/part_pkg/flat_delayed.pm
deleted file mode 100644
index b4be72b..0000000
--- a/FS/FS/part_pkg/flat_delayed.pm
+++ /dev/null
@@ -1,54 +0,0 @@
-package FS::part_pkg::flat_delayed;
-
-use strict;
-use vars qw(@ISA %info);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-%info = (
- 'name' => 'Free (or setup fee) for X days, then flat rate'.
- ' (anniversary billing)',
- 'shortname' => 'Anniversary, with intro period',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'free_days' => { 'name' => 'Initial free days',
- 'default' => 0,
- },
- 'recur_notify' => { 'name' => 'Number of days before recurring billing'.
- ' commences to notify customer. (0 means'.
- ' no warning)',
- 'default' => 0,
- },
- },
- 'fieldorder' => [ 'free_days', 'recur_notify',
- ],
- #'setup' => '\'my $d = $cust_pkg->bill || $time; $d += 86400 * \' + what.free_days.value + \'; $cust_pkg->bill($d); $cust_pkg_mod_flag=1; \' + what.setup_fee.value',
- #'recur' => 'what.recur_fee.value',
- 'weight' => 12,
-);
-
-sub calc_setup {
- my($self, $cust_pkg, $time ) = @_;
-
- my $d = $cust_pkg->bill || $time;
- $d += 86400 * $self->option('free_days');
- $cust_pkg->bill($d);
-
- $self->option('setup_fee');
-}
-
-sub calc_remain {
- my ($self, $cust_pkg, %options) = @_;
- my $next_bill = $cust_pkg->getfield('bill') || 0;
- my $last_bill = $cust_pkg->last_bill || 0;
- my $free_days = $self->option('free_days');
-
- return 0 if $last_bill + (86400 * $free_days) == $next_bill
- && $last_bill == $cust_pkg->setup;
-
- return $self->SUPER::calc_remain($cust_pkg, %options);
-}
-
-1;
diff --git a/FS/FS/part_pkg/flat_introrate.pm b/FS/FS/part_pkg/flat_introrate.pm
deleted file mode 100644
index 1447730..0000000
--- a/FS/FS/part_pkg/flat_introrate.pm
+++ /dev/null
@@ -1,60 +0,0 @@
-package FS::part_pkg::flat_introrate;
-
-use strict;
-use vars qw(@ISA %info $DEBUG $me);
-use FS::part_pkg::flat;
-
-use Date::Manip qw(DateCalc UnixDate ParseDate);
-
-@ISA = qw(FS::part_pkg::flat);
-$me = '[' . __PACKAGE__ . ']';
-$DEBUG = 0;
-
-%info = (
- 'name' => 'Introductory price for X months, then flat rate,'.
- 'relative to setup date (anniversary billing)',
- 'shortname' => 'Anniversary, with intro price',
- 'inherit_fields' => [ 'flat', 'usage_Mixin', 'global_Mixin' ],
- 'fields' => {
- 'intro_fee' => { 'name' => 'Introductory recurring fee for this package',
- 'default' => 0,
- },
- 'intro_duration' =>
- { 'name' => 'Duration of the introductory period, in number of months',
- 'default' => 0,
- },
- },
- 'fieldorder' => [ qw(intro_duration intro_fee) ],
- 'weight' => 14,
-);
-
-sub base_recur {
- my($self, $cust_pkg, $time ) = @_;
-
- my $now = $time ? $$time : time;
-
- my ($duration) = ($self->option('intro_duration') =~ /^(\d+)$/);
- unless ($duration) {
- die "Invalid intro_duration: " . $self->option('intro_duration');
- }
-
- my $setup = &ParseDate('epoch ' . $cust_pkg->getfield('setup'));
- my $intro_end = &DateCalc($setup, "+${duration} month");
- my $recur;
-
- warn "$me: \$duration = ${duration}" if $DEBUG;
- warn "$me: \$intro_end = ${intro_end}" if $DEBUG;
- warn "$me: $now < " . &UnixDate($intro_end, '%s') if $DEBUG;
-
- if ($now < &UnixDate($intro_end, '%s')) {
- $recur = $self->option('intro_fee');
- } else {
- $recur = $self->option('recur_fee');
- }
-
- $recur;
-
-}
-
-
-1;
diff --git a/FS/FS/part_pkg/global_Mixin.pm b/FS/FS/part_pkg/global_Mixin.pm
deleted file mode 100644
index 56f1602..0000000
--- a/FS/FS/part_pkg/global_Mixin.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-package FS::part_pkg::global_Mixin;
-
-use strict;
-use vars qw(@ISA %info);
-use FS::part_pkg;
-@ISA = qw(FS::part_pkg);
-
-%info = (
- 'disabled' => 1,
- 'fields' => {
- 'setup_fee' => {
- 'name' => 'Setup fee for this package',
- 'default' => 0,
- },
- 'recur_fee' => {
- 'name' => 'Recurring fee for this package',
- 'default' => 0,
- },
- 'unused_credit_cancel' => {
- 'name' => 'Credit the customer for the unused portion of service at '.
- 'cancellation',
- 'type' => 'checkbox',
- },
- 'unused_credit_change' => {
- 'name' => 'Credit the customer for the unused portion of service when '.
- 'changing packages',
- 'type' => 'checkbox',
- },
- },
- 'fieldorder' => [ qw(
- setup_fee
- recur_fee
- unused_credit_cancel
- unused_credit_change
- )],
-);
-
-1;
diff --git a/FS/FS/part_pkg/incomplete/billoneday.pm b/FS/FS/part_pkg/incomplete/billoneday.pm
deleted file mode 100644
index 8740547..0000000
--- a/FS/FS/part_pkg/incomplete/billoneday.pm
+++ /dev/null
@@ -1,48 +0,0 @@
-package FS::part_pkg::billoneday;
-
-use strict;
-use vars qw(@ISA %info);
-use Time::Local qw(timelocal);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-%info = (
- 'name' => 'charge a full month every (selectable) billing day',
- 'fields' => {
- 'setup_fee' => { 'name' => 'Setup fee for this package',
- 'default' => 0,
- },
- 'recur_fee' => { 'name' => 'Recurring fee for this package',
- 'default' => 0,
- },
- 'cutoff_day' => { 'name' => 'billing day',
- 'default' => 1,
- },
-
- },
- 'fieldorder' => [ 'setup_fee', 'recur_fee','cutoff_day'],
- #'setup' => 'what.setup_fee.value',
- #'recur' => '\'my $mnow = $sdate; my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($sdate) )[0,1,2,3,4,5]; $sdate = timelocal(0,0,0,$self->option('cutoff_day'),$mon,$year); \' + what.recur_fee.value',
- 'freq' => 'm',
- 'weight' => 30,
-);
-
-sub calc_recur {
- my($self, $cust_pkg, $sdate ) = @_;
-
- my $mnow = $$sdate;
- my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($mnow) )[0,1,2,3,4,5];
- my $mstart = timelocal(0,0,0,$self->option('cutoff_day'),$mon,$year);
- my $mend = timelocal(0,0,0,$self->option('cutoff_day'), $mon == 11 ? 0 : $mon+1, $year+($mon==11));
-
- if($mday > $self->option('cutoff_date') and $mstart != $mnow ) {
- $$sdate = timelocal(0,0,0,$self->option('cutoff_day'), $mon == 11 ? 0 : $mon+1, $year+($mon==11));
- }
- else{
- $$sdate = timelocal(0,0,0,$self->option('cutoff_day'), $mon, $year);
- }
- $self->option('recur_fee');
-}
-1;
diff --git a/FS/FS/part_pkg/prepaid.pm b/FS/FS/part_pkg/prepaid.pm
deleted file mode 100644
index 407343b..0000000
--- a/FS/FS/part_pkg/prepaid.pm
+++ /dev/null
@@ -1,51 +0,0 @@
-package FS::part_pkg::prepaid;
-
-use strict;
-use vars qw(@ISA %info %recur_action);
-use Tie::IxHash;
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-tie %recur_action, 'Tie::IxHash',
- 'suspend' => 'suspend',
- 'cancel' => 'cancel',
-;
-
-tie my %overlimit_action, 'Tie::IxHash',
- 'overlimit' => 'Default overlimit processing',
- 'cancel' => 'Cancel',
-;
-
-%info = (
- 'name' => 'Prepaid, flat rate',
- #'name' => 'Prepaid (no automatic recurring)', #maybe use it here too
- 'shortname' => 'Prepaid, no automatic cycle',
- 'inherit_fields' => [ 'usage_Mixin', 'global_Mixin' ],
- 'fields' => {
- 'recur_action' => { 'name' => 'Action to take upon reaching end of prepaid preiod',
- 'type' => 'select',
- 'select_options' => \%recur_action,
- },
- 'overlimit_action' => { 'name' => 'Action to take upon reaching a usage limit.',
- 'type' => 'select',
- 'select_options' => \%overlimit_action,
- },
- #XXX if you set overlimit_action to 'cancel', should also have the ability
- # to select a reason
-
- # do we need to disable these?
- map { $_ => { 'disabled' => 1 } } (
- qw(recharge_amount recharge_seconds recharge_upbytes recharge_downbytes
- recharge_totalbytes usage_rollover recharge_reset) ),
- },
- 'fieldorder' => [ qw( recur_action overlimit_action ) ],
- 'weight' => 25,
-);
-
-sub is_prepaid {
- 1;
-}
-
-1;
-
diff --git a/FS/FS/part_pkg/prorate.pm b/FS/FS/part_pkg/prorate.pm
deleted file mode 100644
index 367f152..0000000
--- a/FS/FS/part_pkg/prorate.pm
+++ /dev/null
@@ -1,43 +0,0 @@
-package FS::part_pkg::prorate;
-
-use strict;
-use vars qw(@ISA %info);
-use Time::Local qw(timelocal);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-%info = (
- 'name' => 'First partial month pro-rated, then flat-rate (selectable billing day)',
- 'shortname' => 'Prorate (Nth of month billing)',
- 'inherit_fields' => [ 'flat', 'usage_Mixin', 'global_Mixin' ],
- 'fields' => {
- 'recur_temporality' => {'disabled' => 1},
- 'sync_bill_date' => {'disabled' => 1},
- 'cutoff_day' => { 'name' => 'Billing Day (1 - 28)',
- 'default' => 1,
- },
-
- 'add_full_period'=> { 'name' => 'When prorating first month, also bill '.
- 'for one full period after that',
- 'type' => 'checkbox',
- },
- 'prorate_round_day'=> {
- 'name' => 'When prorating first month, round to '.
- 'the nearest full day',
- 'type' => 'checkbox',
- },
- },
- 'fieldorder' => [ 'cutoff_day', 'add_full_period', 'prorate_round_day' ],
- 'freq' => 'm',
- 'weight' => 20,
-);
-
-sub calc_recur {
- my $self = shift;
- my $cutoff_day = $self->option('cutoff_day') || 1;
- return $self->calc_prorate(@_, $cutoff_day) - $self->calc_discount(@_);
-}
-
-1;
diff --git a/FS/FS/part_pkg/prorate_Mixin.pm b/FS/FS/part_pkg/prorate_Mixin.pm
deleted file mode 100644
index 3f3d86f..0000000
--- a/FS/FS/part_pkg/prorate_Mixin.pm
+++ /dev/null
@@ -1,105 +0,0 @@
-package FS::part_pkg::prorate_Mixin;
-
-use strict;
-use vars qw(@ISA %info);
-use Time::Local qw(timelocal);
-
-@ISA = qw(FS::part_pkg);
-%info = (
- 'disabled' => 1,
-);
-
-=head1 NAME
-
-FS::part_pkg::prorate_Mixin - Mixin class for part_pkg:: classes that
-need to prorate partial months
-
-=head1 SYNOPSIS
-
-package FS::part_pkg::...;
-use base qw( FS::part_pkg::prorate_Mixin );
-
-sub calc_recur {
- ...
- if( conditions that trigger prorate ) {
- # sets $$sdate and $param->{'months'}, returns the prorated charge
- $charges = $self->calc_prorate($cust_pkg, $sdate, $param, $cutoff_day);
- }
- ...
-}
-
-=head METHODS
-
-=item calc_prorate CUST_PKG
-
-Takes all the arguments of calc_recur, followed by a day of the month
-to prorate to (which must be <= 28). Calculates a prorated charge from
-the $sdate to that day, and sets the $sdate and $param->{months} accordingly.
-
-Options:
-- recur_fee: The charge to use for a complete billing period.
-- add_full_period: Bill for the time up to the prorate day plus one full
-billing period after that.
-- prorate_round_day: Round the current time to the nearest full day,
-instead of using the exact time.
-
-=cut
-
-sub calc_prorate {
- my $self = shift;
- my ($cust_pkg, $sdate, $details, $param, $cutoff_day) = @_;
-
- my $charge = $self->option('recur_fee',1) || 0;
- if($cutoff_day) {
- # only works for freq >= 1 month; probably can't be fixed
- my $mnow = $$sdate;
- my ($sec, $min, $hour, $mday, $mon, $year) = (localtime($mnow))[0..5];
- if( $self->option('prorate_round_day',1) ) {
- $mday++ if $hour >= 12;
- $mnow = timelocal(0,0,0,$mday,$mon,$year);
- }
- my $mend;
- my $mstart;
- # if cutoff day > 28, force it to the 1st of next month
- if ( $cutoff_day > 28 ) {
- $cutoff_day = 1;
- # and if we are currently after the 28th, roll the current day
- # forward to that day
- if ( $mday > 28 ) {
- $mday = 1;
- #set $mnow = $mend so the amount billed will be zero
- $mnow = timelocal(0,0,0,1,$mon == 11 ? 0 : $mon + 1,$year+($mon==11));
- }
- }
- if ( $mday >= $cutoff_day ) {
- $mend =
- timelocal(0,0,0,$cutoff_day,$mon == 11 ? 0 : $mon + 1,$year+($mon==11));
- $mstart =
- timelocal(0,0,0,$cutoff_day,$mon,$year);
- }
- else {
- $mend =
- timelocal(0,0,0,$cutoff_day,$mon,$year);
- $mstart =
- timelocal(0,0,0,$cutoff_day,$mon == 0 ? 11 : $mon - 1,$year-($mon==0));
- }
-
- # next bill date will be figured as $$sdate + one period
- $$sdate = $mstart;
-
- my $permonth = $charge / $self->freq;
- my $months = ( ( $self->freq - 1 ) + ($mend-$mnow) / ($mend-$mstart) );
-
- if ( $self->option('add_full_period',1) ) {
- # charge a full period in addition to the partial month
- $months += $self->freq;
- $$sdate = $self->add_freq($mstart);
- }
-
- $param->{'months'} = $months;
- $charge = sprintf('%.2f', $permonth * $months);
- }
- return $charge;
-}
-
-1;
diff --git a/FS/FS/part_pkg/prorate_delayed.pm b/FS/FS/part_pkg/prorate_delayed.pm
deleted file mode 100644
index dd1b816..0000000
--- a/FS/FS/part_pkg/prorate_delayed.pm
+++ /dev/null
@@ -1,53 +0,0 @@
-package FS::part_pkg::prorate_delayed;
-
-use strict;
-use vars qw(@ISA %info);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg;
-
-@ISA = qw(FS::part_pkg::prorate);
-
-%info = (
- 'name' => 'Free (or setup fee) for X days, then prorate, then flat-rate ' .
- '(1st of month billing)',
- 'shortname' => 'Prorate (Nth of month billing), with intro period', #??
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'free_days' => { 'name' => 'Initial free days',
- 'default' => 0,
- },
- 'recur_notify' => { 'name' => 'Number of days before recurring billing'.
- ' commences to notify customer. (0 means'.
- ' no warning)',
- 'default' => 0,
- },
- },
- 'fieldorder' => [ 'free_days', 'recur_notify' ],
- #'setup' => '\'my $d = $cust_pkg->bill || $time; $d += 86400 * \' + what.free_days.value + \'; $cust_pkg->bill($d); $cust_pkg_mod_flag=1; \' + what.setup_fee.value',
- #'recur' => 'what.recur_fee.value',
- 'weight' => 22,
-);
-
-sub calc_setup {
- my($self, $cust_pkg, $time ) = @_;
-
- my $d = $cust_pkg->bill || $time;
- $d += 86400 * $self->option('free_days');
- $cust_pkg->bill($d);
-
- $self->option('setup_fee');
-}
-
-sub calc_remain {
- my ($self, $cust_pkg, %options) = @_;
- my $last_bill = $cust_pkg->last_bill || 0;
- my $next_bill = $cust_pkg->getfield('bill') || 0;
- my $free_days = $self->option('free_days');
-
- return 0 if $last_bill + (86400 * $free_days) == $next_bill
- && $last_bill == $cust_pkg->setup;
-
- return $self->SUPER::calc_remain($cust_pkg, %options);
-}
-
-1;
diff --git a/FS/FS/part_pkg/recur_Common.pm b/FS/FS/part_pkg/recur_Common.pm
deleted file mode 100644
index 7614d7a..0000000
--- a/FS/FS/part_pkg/recur_Common.pm
+++ /dev/null
@@ -1,70 +0,0 @@
-package FS::part_pkg::recur_Common;
-
-use strict;
-use vars qw( @ISA %info %recur_method );
-use Tie::IxHash;
-use Time::Local;
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-%info = ( 'disabled' => 1 ); #recur_Common not a usable price plan directly
-
-tie %recur_method, 'Tie::IxHash',
- 'anniversary' => 'Charge the recurring fee at the frequency specified above',
- 'prorate' => 'Charge a prorated fee the first time (selectable billing date)',
- 'subscription' => 'Charge the full fee for the first partial period (selectable billing date)',
-;
-
-sub base_recur {
- my $self = shift;
- $self->option('recur_fee', 1) || 0;
-}
-
-sub calc_recur_Common {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_; #only need $sdate & $param
-
- my $charges = 0;
-
- if ( $param->{'increment_next_bill'} ) {
-
- my $recur_method = $self->option('recur_method', 1) || 'anniversary';
-
- $charges = $self->base_recur;
-
- if ( $recur_method eq 'prorate' ) {
- my $cutoff_day = $self->option('cutoff_day') || 1;
- $charges = $self->calc_prorate(@_, $cutoff_day);
- }
- elsif ( $recur_method eq 'anniversary' and
- $self->option('sync_bill_date',1) ) {
- my $next_bill = $cust_pkg->cust_main->next_bill_date;
- if ( defined($next_bill) ) {
- my $cutoff_day = (localtime($next_bill))[3];
- $charges = $self->calc_prorate(@_, $cutoff_day);
- }
- }
- elsif ( $recur_method eq 'subscription' ) {
-
- my $cutoff_day = $self->option('cutoff_day', 1) || 1;
- my ($day, $mon, $year) = ( localtime($$sdate) )[ 3..5 ];
-
- if ( $day < $cutoff_day ) {
- if ( $mon == 0 ) { $mon=11; $year--; }
- else { $mon--; }
- }
-
- $$sdate = timelocal(0, 0, 0, $cutoff_day, $mon, $year);
-
- }#$recur_method eq 'subscription'
-
- $charges -= $self->calc_discount( $cust_pkg, $sdate, $details, $param );
-
- }#increment_next_bill
-
- return $charges;
-
-}
-
-1;
diff --git a/FS/FS/part_pkg/rt_time.pm b/FS/FS/part_pkg/rt_time.pm
deleted file mode 100644
index 03ed1cd..0000000
--- a/FS/FS/part_pkg/rt_time.pm
+++ /dev/null
@@ -1,73 +0,0 @@
-package FS::part_pkg::rt_time;
-
-use strict;
-use FS::Conf;
-use FS::Record qw(qsearchs qsearch);
-use FS::part_pkg::recur_Common;
-use Carp qw(cluck);
-
-our @ISA = qw(FS::part_pkg::recur_Common);
-
-our $DEBUG = 0;
-
-our %info = (
- 'name' => 'Bill from Time Worked on tickets in RT',
- 'shortname' => 'Project Billing (RT)',
- 'weight' => 55,
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'base_rate' => { 'name' => 'Rate (per minute)',
- 'default' => 0,
- },
- 'recur_fee' => {'disabled' => 1},
- },
- 'fieldorder' => [ 'base_rate' ],
-);
-
-sub calc_setup {
- my($self, $cust_pkg ) = @_;
- $self->option('setup_fee');
-}
-
-sub calc_recur {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- my $charges = 0;
-
- $charges += $self->calc_usage(@_);
- $charges += $self->calc_recur_Common(@_);
-
- $charges;
-
-}
-
-sub can_discount { 0; }
-
-sub calc_cancel {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- $self->calc_usage(@_);
-}
-
-sub calc_usage {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- my $last_bill = $cust_pkg->get('last_bill') || $cust_pkg->get('setup');
- my @tickets = @{ FS::TicketSystem->comments_on_tickets( $cust_pkg->custnum, 100, $last_bill ) };
-
- my $charges = 0;
-
- my $rate = $self->option('base_rate');
-
- foreach my $ding ( @tickets) {
- $charges += sprintf('%.2f', $ding->{'timetaken'} * $rate);
- push @$details, join( ", ", ("($ding->{timetaken}) Minutes", substr($ding->{'content'},0,255)));
- }
- cluck $rate, $charges, @$details if $DEBUG > 0;
- return $charges;
-}
-
-1;
diff --git a/FS/FS/part_pkg/sesmon_hour.pm b/FS/FS/part_pkg/sesmon_hour.pm
deleted file mode 100644
index 97274d0..0000000
--- a/FS/FS/part_pkg/sesmon_hour.pm
+++ /dev/null
@@ -1,50 +0,0 @@
-package FS::part_pkg::sesmon_hour;
-
-use strict;
-use vars qw(@ISA %info);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-%info = (
- 'name' => 'Base charge plus charge per-hour from the session monitor',
- 'shortname' => 'Session monitor (per-hour)',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'recur_included_hours' => { 'name' => 'Hours included',
- 'default' => 0,
- },
- 'recur_hourly_charge' => { 'name' => 'Additional charge per hour',
- 'default' => 0,
- },
- },
- 'fieldorder' => [ 'recur_included_hours', 'recur_hourly_charge' ],
- #'setup' => 'what.setup_fee.value',
- #'recur' => '\'my $hours = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 3600 - \' + what.recur_included_hours.value + \'; $hours = 0 if $hours < 0; \' + what.recur_fee.value + \' + \' + what.recur_hourly_charge.value + \' * $hours;\'',
- 'weight' => 80,
-);
-
-sub calc_recur {
- my($self, $cust_pkg ) = @_;
-
- my $hours = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 3600;
- $hours -= $self->option('recur_included_hours');
- $hours = 0 if $hours < 0;
-
- $self->option('recur_fee') + $hours * $self->option('recur_hourly_charge');
-
-}
-
-sub can_discount { 0; }
-
-sub is_free_options {
- qw( setup_fee recur_fee recur_hourly_charge );
-}
-
-sub base_recur {
- my($self, $cust_pkg) = @_;
- $self->option('recur_fee');
-}
-
-1;
diff --git a/FS/FS/part_pkg/sesmon_minute.pm b/FS/FS/part_pkg/sesmon_minute.pm
deleted file mode 100644
index 9c8dfd1..0000000
--- a/FS/FS/part_pkg/sesmon_minute.pm
+++ /dev/null
@@ -1,49 +0,0 @@
-package FS::part_pkg::sesmon_minute;
-
-use strict;
-use vars qw(@ISA %info);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-%info = (
- 'name' => 'Base charge plus charge per-minute from the session monitor',
- 'shortname' => 'Session monitor (per-minute)',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'recur_included_min' => { 'name' => 'Minutes included',
- 'default' => 0,
- },
- 'recur_minly_charge' => { 'name' => 'Additional charge per minute',
- 'default' => 0,
- },
- },
- 'fieldorder' => [ 'recur_included_min', 'recur_minly_charge' ],
- #'setup' => 'what.setup_fee.value',
- #'recur' => '\'my $min = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 60 - \' + what.recur_included_min.value + \'; $min = 0 if $min < 0; \' + what.recur_fee.value + \' + \' + what.recur_minly_charge.value + \' * $min;\'',
- 'weight' => 80,
-);
-
-
-sub calc_recur {
- my( $self, $cust_pkg ) = @);
- my $min = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 60;
- $min -= $self->option('recur_included_min');
- $min = 0 if $min < 0;
-
- $self->option('recur_fee') + $min * $self->option('recur_minly_charge');
-}
-
-sub can_discount { 0; }
-
-sub is_free_options {
- qw( setup_fee recur_fee recur_minly_charge );
-}
-
-sub base_recur {
- my($self, $cust_pkg) = @_;
- $self->option('recur_fee');
-}
-
-1;
diff --git a/FS/FS/part_pkg/sql_external.pm b/FS/FS/part_pkg/sql_external.pm
deleted file mode 100644
index 8d43086..0000000
--- a/FS/FS/part_pkg/sql_external.pm
+++ /dev/null
@@ -1,77 +0,0 @@
-package FS::part_pkg::sql_external;
-
-use strict;
-use base qw( FS::part_pkg::recur_Common );
-use vars qw( %info );
-use DBI;
-#use FS::Record qw(qsearch qsearchs);
-
-%info = (
- 'name' => 'Base charge plus additional fees for external services from a configurable SQL query',
- 'shortname' => 'External SQL query',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'cutoff_day' => { 'name' => 'Billing Day (1 - 28) for prorating or '.
- 'subscription',
- 'default' => '1',
- },
- 'add_full_period'=> { 'name' => 'When prorating first month, also bill '.
- 'for one full period after that',
- 'type' => 'checkbox',
- },
-
- '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' => '',
- },
- 'db_username' => { 'name' => 'Database username',
- 'default' => '',
- },
- 'db_password' => { 'name' => 'Database password',
- 'default' => '',
- },
- 'query' => { 'name' => 'SQL query',
- 'default' => '',
- },
- },
- 'fieldorder' => [qw( recur_method cutoff_day
- add_full_period datasrc db_username db_password query
- )],
- 'weight' => '58',
-);
-
-sub calc_recur {
- 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 )
- )
- or die $DBI::errstr;
-
- my $sth = $dbh->prepare( $self->option('query') )
- or die $dbh->errstr;
-
- 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;
-}
-
-sub can_discount { 0; }
-
-sub is_free { 0; }
-
-1;
diff --git a/FS/FS/part_pkg/sql_generic.pm b/FS/FS/part_pkg/sql_generic.pm
deleted file mode 100644
index cf38257..0000000
--- a/FS/FS/part_pkg/sql_generic.pm
+++ /dev/null
@@ -1,81 +0,0 @@
-package FS::part_pkg::sql_generic;
-
-use strict;
-use vars qw(@ISA %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 a per-domain metered rate from a configurable SQL query',
- 'shortname' => 'Bulk (per-domain from SQL query)',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'recur_included' => { 'name' => 'Units included',
- 'default' => 0,
- },
- 'recur_unit_charge' => { 'name' => 'Additional charge per unit',
- 'default' => 0,
- },
- 'datasrc' => { 'name' => 'DBI data source',
- 'default' => '',
- },
- 'db_username' => { 'name' => 'Database username',
- 'default' => '',
- },
- 'db_password' => { 'name' => 'Database username',
- 'default' => '',
- },
- 'query' => { 'name' => 'SQL query',
- 'default' => '',
- },
- },
- 'fieldorder' => [qw( recur_included recur_unit_charge datasrc db_username db_password query )],
- # 'setup' => 'what.setup_fee.value',
- # 'recur' => '\'my $dbh = DBI->connect(\"\' + what.datasrc.value + \'\", \"\' + what.db_username.value + \'\") or die $DBI::errstr; \'',
- #'recur' => '\'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 $units = 0; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq \"svc_domain\" } $cust_pkg->cust_svc ) { my $domain = $cust_svc->svc_x->domain; $sth->execute($domain) or die $sth->errstr; $units += $sth->fetchrow_arrayref->[0]; } $units -= \' + what.recur_included.value + \'; $units = 0 if $units < 0; \' + what.recur_fee.value + \' + $units * \' + what.recur_unit_charge.value + \';\'',
- #'recur' => '\'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 $units = 0; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq "svc_domain" } $cust_pkg->cust_svc ) { my $domain = $cust_svc->svc_x->domain; $sth->execute($domain) or die $sth->errstr; $units += $sth->fetchrow_arrayref->[0]; } $units -= \' + what.recur_included.value + \'; $units = 0 if $units < 0; \' + what.recur_fee.value + \' + $units * \' + what.recur_unit_charge + \';\'',
- 'weight' => '56',
-);
-
-sub calc_recur {
- my($self, $cust_pkg ) = @_;
-
- my $dbh = DBI->connect( map { $self->option($_) }
- qw( datasrc db_username db_password )
- )
- or die $DBI::errstr;
-
- my $sth = $dbh->prepare( $self->option('query') )
- or die $dbh->errstr;
-
- my $units = 0;
- foreach my $cust_svc (
- grep { $_->part_svc->svcdb eq "svc_domain" } $cust_pkg->cust_svc
- ) {
- my $domain = $cust_svc->svc_x->domain;
- $sth->execute($domain) or die $sth->errstr;
-
- $units += $sth->fetchrow_arrayref->[0];
- }
-
- $units -= $self->option('recur_included');
- $units = 0 if $units < 0;
-
- $self->option('recur_fee') + $units * $self->option('recur_unit_charge');
-}
-
-sub can_discount { 0; }
-
-sub is_free_options {
- qw( setup_fee recur_fee recur_unit_charge );
-}
-
-sub base_recur {
- my($self, $cust_pkg) = @_;
- $self->option('recur_fee');
-}
-
-1;
diff --git a/FS/FS/part_pkg/sqlradacct_hour.pm b/FS/FS/part_pkg/sqlradacct_hour.pm
deleted file mode 100644
index 3cc46ac..0000000
--- a/FS/FS/part_pkg/sqlradacct_hour.pm
+++ /dev/null
@@ -1,163 +0,0 @@
-package FS::part_pkg::sqlradacct_hour;
-
-use strict;
-use vars qw(@ISA %info);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-%info = (
- 'name' => 'Base charge plus per-hour (and for data) from an SQL RADIUS radacct table',
- 'shortname' => 'Usage charges from RADIUS',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'recur_included_hours' => { 'name' => 'Hours included',
- 'default' => 0,
- },
- 'recur_hourly_charge' => { 'name' => 'Additional charge per hour',
- 'default' => 0,
- },
- 'recur_hourly_cap' => { 'name' => 'Maximum overage charge for hours'.
- ' (0 means no cap)',
-
- 'default' => 0,
- },
-
- 'recur_included_input' => { 'name' => 'Upload megabytes included',
- 'default' => 0,
- },
- 'recur_input_charge' => { 'name' =>
- 'Additional charge per megabyte upload',
- 'default' => 0,
- },
- 'recur_input_cap' => { 'name' => 'Maximum overage charge for upload'.
- ' (0 means no cap)',
- 'default' => 0,
- },
-
- 'recur_included_output' => { 'name' => 'Download megabytes included',
- 'default' => 0,
- },
- 'recur_output_charge' => { 'name' =>
- 'Additional charge per megabyte download',
- 'default' => 0,
- },
- 'recur_output_cap' => { 'name' => 'Maximum overage charge for download'.
- ' (0 means no cap)',
- 'default' => 0,
- },
-
- 'recur_included_total' => { 'name' =>
- 'Total megabytes included',
- 'default' => 0,
- },
- 'recur_total_charge' => { 'name' =>
- 'Additional charge per megabyte total',
- 'default' => 0,
- },
- 'recur_total_cap' => { 'name' => 'Maximum overage charge for total'.
- ' megabytes (0 means no cap)',
- 'default' => 0,
- },
-
- 'global_cap' => { 'name' => 'Global cap on all overage charges'.
- ' (0 means no cap)',
- 'default' => 0,
- },
-
- },
- 'fieldorder' => [qw( recur_included_hours recur_hourly_charge recur_hourly_cap recur_included_input recur_input_charge recur_input_cap recur_included_output recur_output_charge recur_output_cap recur_included_total recur_total_charge recur_total_cap global_cap )],
- #'setup' => 'what.setup_fee.value',
- #'recur' => '\'my $last_bill = $cust_pkg->last_bill; my $hours = $cust_pkg->seconds_since_sqlradacct($last_bill, $sdate ) / 3600 - \' + what.recur_included_hours.value + \'; $hours = 0 if $hours < 0; my $input = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctInputOctets\" ) / 1048576; my $output = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctOutputOctets\" ) / 1048576; my $total = $input + $output - \' + what.recur_included_total.value + \'; $total = 0 if $total < 0; my $input = $input - \' + what.recur_included_input.value + \'; $input = 0 if $input < 0; my $output = $output - \' + what.recur_included_output.value + \'; $output = 0 if $output < 0; my $totalcharge = sprintf(\"%.2f\", \' + what.recur_total_charge.value + \' * $total); my $inputcharge = sprintf(\"%.2f\", \' + what.recur_input_charge.value + \' * $input); my $outputcharge = sprintf(\"%.2f\", \' + what.recur_output_charge.value + \' * $output); my $hourscharge = sprintf(\"%.2f\", \' + what.recur_hourly_charge.value + \' * $hours); if ( \' + what.recur_total_charge.value + \' > 0 ) { push @details, \"Last month\\\'s data \". sprintf(\"%.1f\", $total). \" megs: \\\$$totalcharge\" } if ( \' + what.recur_input_charge.value + \' > 0 ) { push @details, \"Last month\\\'s download \". sprintf(\"%.1f\", $input). \" megs: \\\$$inputcharge\" } if ( \' + what.recur_output_charge.value + \' > 0 ) { push @details, \"Last month\\\'s upload \". sprintf(\"%.1f\", $output). \" megs: \\\$$outputcharge\" } if ( \' + what.recur_hourly_charge.value + \' > 0 ) { push @details, \"Last month\\\'s time \". sprintf(\"%.1f\", $hours). \" hours: \\\$$hourscharge\"; } \' + what.recur_fee.value + \' + $hourscharge + $inputcharge + $outputcharge + $totalcharge ;\'',
- 'weight' => 40,
-);
-
-sub calc_recur {
- my($self, $cust_pkg, $sdate, $details ) = @_;
-
- my $last_bill = $cust_pkg->last_bill;
- my $hours = $cust_pkg->seconds_since_sqlradacct($last_bill, $$sdate ) / 3600;
- $hours -= $self->option('recur_included_hours');
- $hours = 0 if $hours < 0;
-
- my $input = $cust_pkg->attribute_since_sqlradacct( $last_bill,
- $$sdate,
- 'AcctInputOctets' )
- / 1048576;
-
- my $output = $cust_pkg->attribute_since_sqlradacct( $last_bill,
- $$sdate,
- 'AcctOutputOctets' )
- / 1048576;
-
- my $total = $input + $output - $self->option('recur_included_total');
- $total = 0 if $total < 0;
- $input = $input - $self->option('recur_included_input');
- $input = 0 if $input < 0;
- $output = $output - $self->option('recur_included_output');
- $output = 0 if $output < 0;
-
- my $totalcharge =
- $total * sprintf('%.2f', $self->option('recur_total_charge'));
- $totalcharge = $self->option('recur_total_cap')
- if $self->option('recur_total_cap')
- && $totalcharge > $self->option('recur_total_cap');
-
- my $inputcharge =
- $input * sprintf('%.2f', $self->option('recur_input_charge'));
- $inputcharge = $self->option('recur_input_cap')
- if $self->option('recur_input_cap')
- && $inputcharge > $self->option('recur_input_cap');
-
- my $outputcharge =
- $output * sprintf('%.2f', $self->option('recur_output_charge'));
- $outputcharge = $self->option('recur_output_cap')
- if $self->option('recur_output_cap')
- && $outputcharge > $self->option('recur_output_cap');
-
- my $hourscharge =
- $hours * sprintf('%.2f', $self->option('recur_hourly_charge'));
- $hourscharge = $self->option('recur_hourly_cap')
- if $self->option('recur_hourly_cap')
- && $hourscharge > $self->option('recur_hourly_cap');
-
- if ( $self->option('recur_total_charge') > 0 ) {
- push @$details, "Last month's data ".
- sprintf('%.1f', $total). " megs: $totalcharge";
- }
- if ( $self->option('recur_input_charge') > 0 ) {
- push @$details, "Last month's download ".
- sprintf('%.1f', $input). " megs: $inputcharge";
- }
- if ( $self->option('recur_output_charge') > 0 ) {
- push @$details, "Last month's upload ".
- sprintf('%.1f', $output). " megs: $outputcharge";
- }
- if ( $self->option('recur_hourly_charge') > 0 ) {
- push @$details, "Last month\'s time ".
- sprintf('%.1f', $hours). " hours: $hourscharge";
- }
-
- my $charges = $hourscharge + $inputcharge + $outputcharge + $totalcharge;
- if ( $self->option('global_cap') && $charges > $self->option('global_cap') ) {
- $charges = $self->option('global_cap');
- push @$details, "Usage charges capped at: $charges";
- }
-
- $self->option('recur_fee') + $charges;
-}
-
-sub can_discount { 0; }
-
-sub is_free_options {
- qw( setup_fee recur_fee recur_hourly_charge
- recur_input_charge recur_output_charge recur_total_charge );
-}
-
-sub base_recur {
- my($self, $cust_pkg) = @_;
- $self->option('recur_fee');
-}
-
-1;
diff --git a/FS/FS/part_pkg/subscription.pm b/FS/FS/part_pkg/subscription.pm
deleted file mode 100644
index 3c5f96b..0000000
--- a/FS/FS/part_pkg/subscription.pm
+++ /dev/null
@@ -1,108 +0,0 @@
-package FS::part_pkg::subscription;
-
-use strict;
-use vars qw(@ISA %info);
-use Time::Local qw(timelocal);
-#use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg::flat;
-
-@ISA = qw(FS::part_pkg::flat);
-
-%info = (
- 'name' => 'First partial month full charge, then flat-rate (selectable billing day)',
- 'shortname' => 'Subscription (Nth of month, full charge for first)',
- 'inherit_fields' => [ 'usage_Mixin', 'global_Mixin' ],
- 'fields' => {
- 'cutoff_day' => { 'name' => 'Billing day',
- 'default' => 1,
- },
- 'seconds' => { 'name' => 'Time limit for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- },
- 'upbytes' => { 'name' => 'Upload limit for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'downbytes' => { 'name' => 'Download limit for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'totalbytes' => { 'name' => 'Transfer limit for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'recharge_amount' => { 'name' => 'Cost of recharge for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*(\.\d{2})?$/ },
- },
- 'recharge_seconds' => { 'name' => 'Recharge time for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- },
- 'recharge_upbytes' => { 'name' => 'Recharge upload for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'recharge_downbytes' => { 'name' => 'Recharge download for this package', 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'recharge_totalbytes' => { 'name' => 'Recharge transfer for this package', 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'usage_rollover' => { 'name' => 'Allow usage from previous period to roll '.
- 'over into current period',
- 'type' => 'checkbox',
- },
- 'recharge_reset' => { 'name' => 'Reset usage to these values on manual '.
- 'package recharge',
- 'type' => 'checkbox',
- },
-
- #it would be better if this had to be turned on, its confusing
- 'externalid' => { 'name' => 'Optional External ID',
- 'default' => '',
- },
- },
- 'fieldorder' => [ 'cutoff_day', 'seconds',
- 'upbytes', 'downbytes', 'totalbytes',
- 'recharge_amount', 'recharge_seconds', 'recharge_upbytes',
- 'recharge_downbytes', 'recharge_totalbytes',
- 'usage_rollover', 'recharge_reset', 'externalid' ],
- 'freq' => 'm',
- 'weight' => 30,
-);
-
-sub calc_recur {
- my($self, $cust_pkg, $sdate, $details, $param ) = @_;
- my $cutoff_day = $self->option('cutoff_day', 1) || 1;
- my $mnow = $$sdate;
- my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($mnow) )[0,1,2,3,4,5];
-
- if ( $mday < $cutoff_day ) {
- if ($mon==0) {$mon=11;$year--;}
- else {$mon--;}
- }
-
- $$sdate = timelocal(0,0,0,$cutoff_day,$mon,$year);
-
- my $br = $self->base_recur($cust_pkg);
-
- my $discount = $self->calc_discount($cust_pkg, $sdate, $details, $param);
-
- sprintf('%.2f', $br - $discount);
-}
-
-1;
diff --git a/FS/FS/part_pkg/usage_Mixin.pm b/FS/FS/part_pkg/usage_Mixin.pm
deleted file mode 100644
index 028fce7..0000000
--- a/FS/FS/part_pkg/usage_Mixin.pm
+++ /dev/null
@@ -1,77 +0,0 @@
-package FS::part_pkg::usage_Mixin;
-
-use strict;
-use vars qw( @ISA %info );
-use FS::part_pkg;
-use FS::UI::bytecount;
-@ISA = qw(FS::part_pkg);
-
-# Field definitions for time and data usage, other than CDRs.
-
-%info = (
- 'disabled' => 1,
- 'fields' => {
- 'seconds' => { 'name' => 'Time limit for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- },
- 'upbytes' => { 'name' => 'Upload limit for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'downbytes' => { 'name' => 'Download limit for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'totalbytes' => { 'name' => 'Transfer limit for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'recharge_amount' => { 'name' => 'Cost of recharge for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*(\.\d{2})?$/ },
- },
- 'recharge_seconds' => { 'name' => 'Recharge time for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- },
- 'recharge_upbytes' => { 'name' => 'Recharge upload for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'recharge_downbytes' => { 'name' => 'Recharge download for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'recharge_totalbytes' => { 'name' => 'Recharge transfer for this package',
- 'default' => '',
- 'check' => sub { shift =~ /^\d*$/ },
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- },
- 'usage_rollover' => { 'name' => 'Allow usage from previous period to roll '.
- ' over into current period',
- 'type' => 'checkbox',
- },
- 'recharge_reset' => { 'name' => 'Reset usage to these values on manual '.
- 'package recharge',
- 'type' => 'checkbox',
- },
- },
- 'fieldorder' => [ qw( seconds upbytes downbytes totalbytes
- recharge_amount recharge_seconds recharge_upbytes
- recharge_downbytes recharge_totalbytes
- usage_rollover recharge_reset ) ],
-);
-
-1;
diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm
deleted file mode 100644
index 5dbd115..0000000
--- a/FS/FS/part_pkg/voip_cdr.pm
+++ /dev/null
@@ -1,925 +0,0 @@
-package FS::part_pkg::voip_cdr;
-
-use strict;
-use vars qw(@ISA $DEBUG %info);
-use Date::Format;
-use Tie::IxHash;
-use FS::Conf;
-use FS::Record qw(qsearchs qsearch);
-use FS::part_pkg::recur_Common;
-use FS::cdr;
-use FS::rate;
-use FS::rate_prefix;
-use FS::rate_detail;
-use FS::part_pkg::recur_Common;
-
-use List::Util qw(first min);
-
-@ISA = qw(FS::part_pkg::recur_Common);
-
-$DEBUG = 0;
-
-tie my %cdr_svc_method, 'Tie::IxHash',
- 'svc_phone.phonenum' => 'Phone numbers (svc_phone.phonenum)',
- 'svc_pbx.title' => 'PBX name (svc_pbx.title)',
- 'svc_pbx.svcnum' => 'Freeside service # (svc_pbx.svcnum)',
-;
-
-tie my %rating_method, 'Tie::IxHash',
- 'prefix' => 'Rate calls by using destination prefix to look up a region and rate according to the internal prefix and rate tables',
-# 'upstream' => 'Rate calls based on upstream data: If the call type is "1", map the upstream rate ID directly to an internal rate (rate_detail), otherwise, pass the upstream price through directly.',
- 'upstream_simple' => 'Simply pass through and charge the "upstream_price" amount.',
- 'single_price' => 'A single price per minute for all calls.',
-;
-
-#tie my %cdr_location, 'Tie::IxHash',
-# 'internal' => 'Internal: CDR records imported into the internal CDR table',
-# 'external' => 'External: CDR records queried directly from an external '.
-# 'Asterisk (or other?) CDR table',
-#;
-
-tie my %temporalities, 'Tie::IxHash',
- 'upcoming' => "Upcoming (future)",
- 'preceding' => "Preceding (past)",
-;
-
-tie my %granularity, 'Tie::IxHash', FS::rate_detail::granularities();
-
-%info = (
- 'name' => 'VoIP rating by plan of CDR records in an internal (or external) SQL table',
- 'shortname' => 'VoIP/telco CDR rating (standard)',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- #false laziness w/flat.pm
- 'recur_temporality' => { 'name' => 'Charge recurring fee for period',
- 'type' => 'select',
- 'select_options' => \%temporalities,
- },
-
- 'cutoff_day' => { 'name' => 'Billing Day (1 - 28) for prorating or '.
- 'subscription',
- 'default' => '1',
- },
- 'add_full_period'=> { 'name' => 'When prorating first month, also bill '.
- 'for one full period after that',
- 'type' => 'checkbox',
- },
- 'recur_method' => { 'name' => 'Recurring fee method',
- #'type' => 'radio',
- #'options' => \%recur_method,
- 'type' => 'select',
- 'select_options' => \%FS::part_pkg::recur_Common::recur_method,
- },
-
- 'cdr_svc_method' => { 'name' => 'CDR service matching method',
- 'type' => 'radio',
- 'options' => \%cdr_svc_method,
- },
-
- 'rating_method' => { 'name' => 'Rating method',
- 'type' => 'radio',
- 'options' => \%rating_method,
- },
-
- 'ratenum' => { 'name' => 'Rate plan',
- 'type' => 'select',
- 'select_table' => 'rate',
- 'select_key' => 'ratenum',
- 'select_label' => 'ratename',
- },
-
- 'min_included' => { 'name' => 'Minutes included when using "single price per minute" rating method',
- },
-
-
- 'min_charge' => { 'name' => 'Charge per minute when using "single price per minute" rating method',
- },
-
- 'sec_granularity' => { 'name' => 'Granularity when using "single price per minute" rating method',
- 'type' => 'select',
- 'select_options' => \%granularity,
- },
-
- 'ignore_unrateable' => { 'name' => 'Ignore calls without a rate in the rate tables. By default, the system will throw a fatal error upon encountering unrateable calls.',
- 'type' => 'checkbox',
- },
-
- 'default_prefix' => { 'name' => 'Default prefix optionally prepended to customer DID numbers when searching for CDR records',
- 'default' => '+1',
- },
-
- 'disable_src' => { 'name' => 'Disable rating of CDR records based on the "src" field in addition to "charged_party"',
- 'type' => 'checkbox'
- },
-
- 'domestic_prefix' => { 'name' => 'Destination prefix for domestic CDR records',
- 'default' => '1',
- },
-
-# 'domestic_prefix_required' => { 'name' => 'Require explicit destination prefix for domestic CDR records',
-# 'type' => 'checkbox',
-# },
-
- 'international_prefix' => { 'name' => 'Destination prefix for international CDR records',
- 'default' => '011',
- },
-
- 'disable_tollfree' => { 'name' => 'Disable automatic toll-free processing',
- 'type' => 'checkbox',
- },
-
- 'use_amaflags' => { 'name' => 'Do not charge for CDRs where the amaflags field is not set to "2" ("BILL"/"BILLING").',
- 'type' => 'checkbox',
- },
-
- 'use_disposition' => { 'name' => 'Do not charge for CDRs where the disposition flag is not set to "ANSWERED".',
- 'type' => 'checkbox',
- },
-
- 'use_disposition_taqua' => { 'name' => 'Do not charge for CDRs where the disposition is not set to "100" (Taqua).',
- 'type' => 'checkbox',
- },
-
- 'use_carrierid' => { 'name' => 'Do not charge for CDRs where the Carrier ID is not set to: ',
- },
-
- 'use_cdrtypenum' => { 'name' => 'Do not charge for CDRs where the CDR Type is not set to: ',
- },
-
- 'skip_dst_prefix' => { 'name' => 'Do not charge for CDRs where the destination number starts with any of these values: ',
- },
-
- 'skip_dcontext' => { 'name' => 'Do not charge for CDRs where the dcontext is set to any of these (comma-separated) values: ',
- },
-
- 'skip_dstchannel_prefix' => { 'name' => 'Do not charge for CDRs where the dstchannel starts with:',
- },
-
- 'skip_src_length_more' => { 'name' => 'Do not charge for CDRs where the source is more than this many digits:',
- },
-
- 'noskip_src_length_accountcode_tollfree' => { 'name' => 'Do charge for CDRs where source is equal or greater than the specified digits, when accountcode is toll free',
- 'type' => 'checkbox',
- },
-
- 'accountcode_tollfree_ratenum' => {
- 'name' => 'Optional alternate rate plan when accountcode is toll free: ',
- 'type' => 'select',
- 'select_table' => 'rate',
- 'select_key' => 'ratenum',
- 'select_label' => 'ratename',
- 'disable_empty' => 0,
- 'empty_label' => '',
- },
-
- 'skip_dst_length_less' => { 'name' => 'Do not charge for CDRs where the destination is less than this many digits:',
- },
-
- 'noskip_dst_length_accountcode_tollfree' => { 'name' => 'Do charge for CDRs where dst is less than the specified digits, when accountcode is toll free',
- 'type' => 'checkbox',
- },
-
- 'skip_lastapp' => { 'name' => 'Do not charge for CDRs where the lastapp matches this value: ',
- },
-
- 'skip_max_callers' => { 'name' => 'Do not charge for CDRs where max_callers is less than or equal to this value: ',
- },
-
- 'use_duration' => { 'name' => 'Calculate usage based on the duration field instead of the billsec field',
- 'type' => 'checkbox',
- },
-
- '411_rewrite' => { 'name' => 'Rewrite these (comma-separated) destination numbers to 411 for rating purposes (also ignore any carrierid check): ',
- },
-
- #false laziness w/cdr_termination.pm
- 'output_format' => { 'name' => 'CDR invoice display format',
- 'type' => 'select',
- 'select_options' => { FS::cdr::invoice_formats() },
- 'default' => 'default', #XXX test
- },
-
- 'usage_section' => { 'name' => 'Section in which to place usage charges (whether separated or not): ',
- },
-
- 'summarize_usage' => { 'name' => 'Include usage summary with recurring charges when usage is in separate section',
- 'type' => 'checkbox',
- },
-
- 'usage_mandate' => { 'name' => 'Always put usage details in separate section',
- 'type' => 'checkbox',
- },
- #eofalse
-
- 'bill_every_call' => { 'name' => 'Generate an invoice immediately for every call (as well any setup fee, upon first payment). Useful for prepaid.',
- 'type' => 'checkbox',
- },
-
- 'bill_inactive_svcs' => { 'name' => 'Bill for all phone numbers that were active during the billing period',
- 'type' => 'checkbox',
- },
-
- 'count_available_phones' => { 'name' => 'Consider for tax purposes the number of lines to be svc_phones that may be provisioned rather than those that actually are.',
- 'type' => 'checkbox',
- },
-
- #XXX also have option for an external db
-# 'cdr_location' => { 'name' => 'CDR database location'
-# 'type' => 'select',
-# 'select_options' => \%cdr_location,
-# 'select_callback' => {
-# 'external' => {
-# 'enable' => [ 'datasrc', 'username', 'password' ],
-# },
-# 'internal' => {
-# 'disable' => [ 'datasrc', 'username', 'password' ],
-# }
-# },
-# },
-# 'datasrc' => { 'name' => 'DBI data source for external CDR table',
-# 'disabled' => 'Y',
-# },
-# 'username' => { 'name' => 'External database username',
-# 'disabled' => 'Y',
-# },
-# 'password' => { 'name' => 'External database password',
-# 'disabled' => 'Y',
-# },
-
- },
- 'fieldorder' => [qw(
- recur_temporality
- recur_method cutoff_day
- add_full_period
- cdr_svc_method
- rating_method ratenum min_charge sec_granularity
- ignore_unrateable
- default_prefix
- disable_src
- domestic_prefix international_prefix
- disable_tollfree
- use_amaflags use_disposition
- use_disposition_taqua use_carrierid use_cdrtypenum
- skip_dcontext skip_dst_prefix
- skip_dstchannel_prefix skip_src_length_more
- noskip_src_length_accountcode_tollfree
- accountcode_tollfree_ratenum
- skip_dst_length_less
- noskip_dst_length_accountcode_tollfree
- skip_lastapp
- skip_max_callers
- use_duration
- 411_rewrite
- output_format usage_mandate summarize_usage usage_section
- bill_every_call bill_inactive_svcs
- count_available_phones
- )
- ],
- 'weight' => 40,
-);
-
-sub calc_setup {
- my($self, $cust_pkg ) = @_;
- $self->option('setup_fee');
-}
-
-sub calc_recur {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- my $charges = 0;
-
- $charges += $self->calc_usage(@_);
- $charges += $self->calc_recur_Common(@_);
-
- $charges;
-
-}
-
-sub calc_cancel {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- $self->calc_usage(@_);
-}
-
-#false laziness w/voip_sqlradacct calc_recur resolve it if that one ever gets used again
-
-sub calc_usage {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- #my $last_bill = $cust_pkg->last_bill;
- my $last_bill = $cust_pkg->get('last_bill'); #->last_bill falls back to setup
-
- return 0
- if $self->option('recur_temporality', 1) eq 'preceding'
- && ( $last_bill eq '' || $last_bill == 0 );
-
- my $ratenum = $cust_pkg->part_pkg->option('ratenum');
-
- my $spool_cdr = $cust_pkg->cust_main->spool_cdr;
-
- my %included_min = ();
-
- my $charges = 0;
-
-# my $downstream_cdr = '';
-
- my $cdr_svc_method = $self->option('cdr_svc_method',1)||'svc_phone.phonenum';
- my $rating_method = $self->option('rating_method') || 'prefix';
- my $intl = $self->option('international_prefix') || '011';
- my $domestic_prefix = $self->option('domestic_prefix');
- my $disable_tollfree = $self->option('disable_tollfree');
- my $ignore_unrateable = $self->option('ignore_unrateable', 'Hush!');
- my $use_duration = $self->option('use_duration');
-
- my $output_format = $self->option('output_format', 'Hush!')
- || ( $rating_method eq 'upstream_simple'
- ? 'simple'
- : 'default'
- );
-
- my @dirass = ();
- if ( $self->option('411_rewrite') ) {
- my $dirass = $self->option('411_rewrite');
- $dirass =~ s/\s//g;
- @dirass = split(',', $dirass);
- }
-
- my %interval_cache = (); # for timed rates
-
- #for check_chargable, so we don't keep looking up options inside the loop
- my %opt_cache = ();
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
- my $csv = new Text::CSV_XS;
-
- my($svc_table, $svc_field) = split('\.', $cdr_svc_method);
-
- my @cust_svc;
- if( $self->option('bill_inactive_svcs',1) ) {
- #XXX in this mode do we need to restrict the set of CDRs by date also?
- @cust_svc = $cust_pkg->h_cust_svc($$sdate, $last_bill);
- }
- else {
- @cust_svc = $cust_pkg->cust_svc;
- }
- @cust_svc = grep { $_->part_svc->svcdb eq $svc_table } @cust_svc;
-
- foreach my $cust_svc (@cust_svc) {
-
- my $svc_x;
- if( $self->option('bill_inactive_svcs',1) ) {
- $svc_x = $cust_svc->h_svc_x($$sdate, $last_bill);
- }
- else {
- $svc_x = $cust_svc->svc_x;
- }
- my %options = (
- 'disable_src' => $self->option('disable_src'),
- 'default_prefix' => $self->option('default_prefix'),
- 'status' => '',
- 'for_update' => 1,
- ); # $last_bill, $$sdate )
- $options{'by_svcnum'} = 1 if $svc_field eq 'svcnum';
-
- foreach my $cdr (
- $svc_x->get_cdrs( %options )
- ) {
- if ( $DEBUG > 1 ) {
- warn "rating CDR $cdr\n".
- join('', map { " $_ => ". $cdr->{$_}. "\n" } keys %$cdr );
- }
-
- my $rate_detail;
- my( $rate_region, $regionnum );
- my $rate;
- my $pretty_destnum;
- my $charge = '';
- my $seconds = '';
- my $weektime = '';
- my $regionname = '';
- my $classnum = '';
- my $countrycode;
- my $number;
-
- my @call_details = ();
- if ( $rating_method eq 'prefix' ) {
-
- my $da_rewrote = 0;
- if ( length($cdr->dst) && grep { $cdr->dst eq $_ } @dirass ){
- $cdr->dst('411');
- $da_rewrote = 1;
- }
-
- my $reason = $self->check_chargable( $cdr,
- 'da_rewrote' => $da_rewrote,
- 'option_cache' => \%opt_cache,
- );
-
- if ( $reason ) {
-
- warn "not charging for CDR ($reason)\n" if $DEBUG;
- $charge = 0;
-
- } else {
-
- ###
- # look up rate details based on called station id
- # (or calling station id for toll free calls)
- ###
-
- my( $to_or_from );
- if ( $cdr->is_tollfree && ! $disable_tollfree )
- { #tollfree call
- $to_or_from = 'from';
- $number = $cdr->src;
- } else { #regular call
- $to_or_from = 'to';
- $number = $cdr->dst;
- }
-
- warn "parsing call $to_or_from $number\n" if $DEBUG;
-
- #remove non-phone# stuff and whitespace
- $number =~ s/\s//g;
-# my $proto = '';
-# $dest =~ s/^(\w+):// and $proto = $1; #sip:
-# my $siphost = '';
-# $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
-
- #determine the country code
- $countrycode = '';
- if ( $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
- || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
- )
- {
-
- my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 );
- #first look for 1 digit country code
- if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
- $countrycode = $one;
- $number = $u1.$u2.$rest;
- } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
- $countrycode = $two;
- $number = $u2.$rest;
- } else { #3 digit country code
- $countrycode = $three;
- $number = $rest;
- }
-
- } else {
- $countrycode = $domestic_prefix || '1';
- $number =~ s/^$countrycode//;# if length($number) > 10;
- }
-
- warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
- $pretty_destnum = "+$countrycode $number";
- #asterisks here causes inserting the detail to barf, so:
- $pretty_destnum =~ s/\*//g;
-
- my $eff_ratenum = $cdr->is_tollfree('accountcode')
- ? $cust_pkg->part_pkg->option('accountcode_tollfree_ratenum')
- : '';
- $eff_ratenum ||= $ratenum;
- $rate = qsearchs('rate', { 'ratenum' => $eff_ratenum })
- or die "ratenum $eff_ratenum not found!";
-
- my @ltime = localtime($cdr->startdate);
- $weektime = $ltime[0] +
- $ltime[1]*60 + #minutes
- $ltime[2]*3600 + #hours
- $ltime[6]*86400; #days since sunday
- # if there's no timed rate_detail for this time/region combination,
- # dest_detail returns the default. There may still be a timed rate
- # that applies after the starttime of the call, so be careful...
- $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
- 'phonenum' => $number,
- 'weektime' => $weektime,
- });
-
- if ( $rate_detail ) {
-
- $rate_region = $rate_detail->dest_region;
- $regionnum = $rate_region->regionnum;
- $regionname = $rate_region->regionname;
- warn " found rate for regionnum $regionnum ".
- "and rate detail $rate_detail\n"
- if $DEBUG;
-
- if ( !exists($interval_cache{$regionnum}) ) {
- my @intervals = (
- sort { $a->stime <=> $b->stime }
- map { my $r = $_->rate_time; $r ? $r->intervals : () }
- $rate->rate_detail
- );
- $interval_cache{$regionnum} = \@intervals;
- warn " cached ".scalar(@intervals)." interval(s)\n"
- if $DEBUG;
- }
-
- } elsif ( $ignore_unrateable ) {
-
- $rate_region = '';
- $regionnum = '';
- #code below will throw a warning & skip
-
- } else {
-
- die "FATAL: no rate_detail found in ".
- $rate->ratenum. ":". $rate->ratename. " rate plan ".
- "for +$countrycode $number (CDR acctid ". $cdr->acctid. "); ".
- "add a rate or set ignore_unrateable flag on the package def\n";
- }
-
- }
-
- } elsif ( $rating_method eq 'upstream_simple' ) {
-
- #XXX $charge = sprintf('%.2f', $cdr->upstream_price);
- $charge = sprintf('%.3f', $cdr->upstream_price);
- $charges += $charge;
- warn "Incrementing \$charges by $charge. Now $charges\n" if $DEBUG;
-
- @call_details = ($cdr->downstream_csv( 'format' => $output_format,
- 'charge' => $charge,
- )
- );
- $classnum = $cdr->calltypenum;
-
- } elsif ( $rating_method eq 'single_price' ) {
-
- # a little false laziness w/below
- # $rate_detail = new FS::rate_detail({sec_granularity => ... }) ?
-
- my $granularity = length($self->option('sec_granularity'))
- ? $self->option('sec_granularity')
- : 60;
-
- $seconds = $use_duration ? $cdr->duration : $cdr->billsec;
-
- $seconds += $granularity - ( $seconds % $granularity )
- if $seconds # don't granular-ize 0 billsec calls (bills them)
- && $granularity # 0 is per call
- && $seconds % $granularity;
- my $minutes = $seconds / 60;
- # XXX config?
- #$charge = sprintf('%.2f', ( $self->option('min_charge') * $minutes )
- #+ 0.00000001 ); #so 1.005 rounds to 1.01
- $charge = sprintf('%.4f', ( $self->option('min_charge') * $minutes )
- + 0.0000000001 ); #so 1.00005 rounds to 1.0001
-
- warn "Incrementing \$charges by $charge. Now $charges\n" if $DEBUG;
- $charges += $charge;
-
- @call_details = ($cdr->downstream_csv( 'format' => $output_format,
- 'charge' => $charge,
- 'seconds' => ($use_duration ?
- $cdr->duration :
- $cdr->billsec),
- 'granularity' => $granularity,
- )
- );
-
- } else {
- die "don't know how to rate CDRs using method: $rating_method\n";
- }
-
- ###
- # find the price and add detail to the invoice
- ###
-
- # if $rate_detail is not found, skip this CDR... i.e.
- # don't add it to invoice, don't set its status to done,
- # don't call downstream_csv or something on it...
- # but DO emit a warning...
- #if ( ! $rate_detail && ! scalar(@call_details) ) {}
- if ( ! $rate_detail && $charge eq '' ) {
-
- warn "no rate_detail found for CDR.acctid: ". $cdr->acctid.
- "; skipping\n"
-
- } else { # there *is* a rate_detail (or call_details), proceed...
- # About this section:
- # We don't round _anything_ (except granularizing)
- # until the final $charge = sprintf("%.2f"...).
-
- unless ( @call_details || ( $charge ne '' && $charge == 0 ) ) {
-
- my $seconds_left = $use_duration ? $cdr->duration : $cdr->billsec;
- # charge for the first (conn_sec) seconds
- $seconds = min($seconds_left, $rate_detail->conn_sec);
- $seconds_left -= $seconds;
- $weektime += $seconds;
- $charge = $rate_detail->conn_charge;
-
- my $etime;
- while($seconds_left) {
- my $ratetimenum = $rate_detail->ratetimenum; # may be empty
-
- # find the end of the current rate interval
- if(@{ $interval_cache{$regionnum} } == 0) {
- # There are no timed rates in this group, so just stay
- # in the default rate_detail for the entire duration.
- # Set an "end" of 1 past the end of the current call.
- $etime = $weektime + $seconds_left + 1;
- }
- elsif($ratetimenum) {
- # This is a timed rate, so go to the etime of this interval.
- # If it's followed by another timed rate, the stime of that
- # interval should match the etime of this one.
- my $interval = $rate_detail->rate_time->contains($weektime);
- $etime = $interval->etime;
- }
- else {
- # This is a default rate, so use the stime of the next
- # interval in the sequence.
- my $next_int = first { $_->stime > $weektime }
- @{ $interval_cache{$regionnum} };
- if ($next_int) {
- $etime = $next_int->stime;
- }
- else {
- # weektime is near the end of the week, so decrement
- # it by a full week and use the stime of the first
- # interval.
- $weektime -= (3600*24*7);
- $etime = $interval_cache{$regionnum}->[0]->stime;
- }
- }
-
- my $charge_sec = min($seconds_left, $etime - $weektime);
-
- $seconds_left -= $charge_sec;
-
- $included_min{$regionnum}{$ratetimenum} = $rate_detail->min_included
- unless exists $included_min{$regionnum}{$ratetimenum};
-
- my $granularity = $rate_detail->sec_granularity;
-
- my $minutes;
- if ( $granularity ) { # charge per minute
- # Round up to the nearest $granularity
- if ( $charge_sec and $charge_sec % $granularity ) {
- $charge_sec += $granularity - ($charge_sec % $granularity);
- }
- $minutes = $charge_sec / 60; #don't round this
- }
- else { # per call
- $minutes = 1;
- $seconds_left = 0;
- }
-
- $seconds += $charge_sec;
-
- $included_min{$regionnum}{$ratetimenum} -= $minutes;
- if ( $included_min{$regionnum}{$ratetimenum} <= 0 ) {
- my $charge_min = 0 - $included_min{$regionnum}{$ratetimenum}; #XXX should preserve
- #(display?) this
- $included_min{$regionnum}{$ratetimenum} = 0;
- $charge += ($rate_detail->min_charge * $charge_min); #still not rounded
- }
-
- # choose next rate_detail
- $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
- 'phonenum' => $number,
- 'weektime' => $etime })
- if($seconds_left);
- # we have now moved forward to $etime
- $weektime = $etime;
-
- } #while $seconds_left
- # this is why we need regionnum/rate_region....
- warn " (rate region $rate_region)\n" if $DEBUG;
-
- $classnum = $rate_detail->classnum;
- $charge = sprintf('%.2f', $charge + 0.000001); # NOW round it.
- warn "Incrementing \$charges by $charge. Now $charges\n" if $DEBUG;
- $charges += $charge;
-
- @call_details = (
- $cdr->downstream_csv( 'format' => $output_format,
- 'granularity' => $rate_detail->sec_granularity,
- 'seconds' => ($use_duration ?
- $cdr->duration :
- $cdr->billsec),
- 'charge' => $charge,
- 'pretty_dst' => $pretty_destnum,
- 'dst_regionname' => $regionname,
- )
- );
- } #if(there is a rate_detail)
-
-
- if ( $charge > 0 ) {
- #just use FS::cust_bill_pkg_detail objects?
- my $call_details;
- my $phonenum = $svc_x->phonenum;
-
- if ( scalar(@call_details) == 1 ) {
- $call_details =
- [ 'C',
- $call_details[0],
- $charge,
- $classnum,
- $phonenum,
- $seconds,
- $regionname,
- ];
- } else { #only used for $rating_method eq 'upstream' now
- $csv->combine(@call_details);
- $call_details =
- [ 'C',
- $csv->string,
- $charge,
- $classnum,
- $phonenum,
- $seconds,
- $regionname,
- ];
- }
- warn " adding details on charge to invoice: [ ".
- join(', ', @{$call_details} ). " ]"
- if ( $DEBUG && ref($call_details) );
- push @$details, $call_details; #\@call_details,
- }
-
- # if the customer flag is on, call "downstream_csv" or something
- # like it to export the call downstream!
- # XXX price plan option to pick format, or something...
- #$downstream_cdr .= $cdr->downstream_csv( 'format' => 'XXX format' )
- # if $spool_cdr;
-
- my $error = $cdr->set_status_and_rated_price( 'done',
- $charge,
- $cust_svc->svcnum,
- );
- die $error if $error;
-
- }
-
- } # $cdr
-
- } # $cust_svc
-
- unshift @$details, [ 'C',
- FS::cdr::invoice_header($output_format),
- '',
- '',
- '',
- '',
- '',
- ]
- if @$details && $rating_method ne 'upstream';
-
-# if ( $spool_cdr && length($downstream_cdr) ) {
-#
-# use FS::UID qw(datasrc);
-# my $dir = '/usr/local/etc/freeside/export.'. datasrc. '/cdr';
-# mkdir $dir, 0700 unless -d $dir;
-# $dir .= '/'. $cust_pkg->custnum.
-# mkdir $dir, 0700 unless -d $dir;
-# my $filename = time2str("$dir/CDR%Y%m%d-spool.CSV", time); #XXX invoice date instead? would require changing the order things are generated in cust_main::bill insert cust_bill first - with transactions it could be done though
-#
-# push @{ $param->{'precommit_hooks'} },
-# sub {
-# #lock the downstream spool file and append the records
-# use Fcntl qw(:flock);
-# use IO::File;
-# my $spool = new IO::File ">>$filename"
-# or die "can't open $filename: $!\n";
-# flock( $spool, LOCK_EX)
-# or die "can't lock $filename: $!\n";
-# seek($spool, 0, 2)
-# or die "can't seek to end of $filename: $!\n";
-# print $spool $downstream_cdr;
-# flock( $spool, LOCK_UN );
-# close $spool;
-# };
-#
-# } #if ( $spool_cdr && length($downstream_cdr) )
-
- $charges;
-}
-
-#returns a reason why not to rate this CDR, or false if the CDR is chargeable
-sub check_chargable {
- my( $self, $cdr, %flags ) = @_;
-
- #should have some better way of checking these options from a hash
- #or something
-
- my @opt = qw(
- use_amaflags
- use_disposition
- use_disposition_taqua
- use_carrierid
- use_cdrtypenum
- skip_dst_prefix
- skip_dcontext
- skip_dstchannel_prefix
- skip_src_length_more noskip_src_length_accountcode_tollfree
- skip_dst_length_less noskip_dst_length_accountcode_tollfree
- skip_lastapp
- skip_max_callers
- );
- foreach my $opt (grep !exists($flags{option_cache}->{$_}), @opt ) {
- $flags{option_cache}->{$opt} = $self->option($opt, 1);
- }
- my %opt = %{ $flags{option_cache} };
-
- return 'amaflags != 2'
- if $opt{'use_amaflags'} && $cdr->amaflags != 2;
-
- return 'disposition != ANSWERED'
- if $opt{'use_disposition'} && $cdr->disposition ne 'ANSWERED';
-
- return "disposition != 100"
- if $opt{'use_disposition_taqua'} && $cdr->disposition != 100;
-
- return "carrierid != $opt{'use_carrierid'}"
- if length($opt{'use_carrierid'})
- && $cdr->carrierid ne $opt{'use_carrierid'} #ne otherwise 0 matches ''
- && ! $flags{'da_rewrote'};
-
- return "cdrtypenum != $opt{'use_cdrtypenum'}"
- if length($opt{'use_cdrtypenum'})
- && $cdr->cdrtypenum ne $opt{'use_cdrtypenum'}; #ne otherwise 0 matches ''
-
- foreach(split(',',$opt{'skip_dst_prefix'})) {
- return "dst starts with '$_'"
- if length($_) && substr($cdr->dst,0,length($_)) eq $_;
- }
-
- return "dcontext IN ( $opt{'skip_dcontext'} )"
- if $opt{'skip_dcontext'} =~ /\S/
- && grep { $cdr->dcontext eq $_ } split(/\s*,\s*/, $opt{'skip_dcontext'});
-
- my $len_prefix = length($opt{'skip_dstchannel_prefix'});
- return "dstchannel starts with $opt{'skip_dstchannel_prefix'}"
- if $len_prefix
- && substr($cdr->dstchannel,0,$len_prefix) eq $opt{'skip_dstchannel_prefix'};
-
- my $dst_length = $opt{'skip_dst_length_less'};
- return "destination less than $dst_length digits"
- if $dst_length && length($cdr->dst) < $dst_length
- && ! ( $opt{'noskip_dst_length_accountcode_tollfree'}
- && $cdr->is_tollfree('accountcode')
- );
-
- return "lastapp is $opt{'skip_lastapp'}"
- if length($opt{'skip_lastapp'}) && $cdr->lastapp eq $opt{'skip_lastapp'};
-
- my $src_length = $opt{'skip_src_length_more'};
- if ( $src_length ) {
-
- if ( $opt{'noskip_src_length_accountcode_tollfree'} ) {
-
- if ( $cdr->is_tollfree('accountcode') ) {
- return "source less than or equal to $src_length digits"
- if length($cdr->src) <= $src_length;
- } else {
- return "source more than $src_length digits"
- if length($cdr->src) > $src_length;
- }
-
- } else {
- return "source more than $src_length digits"
- if length($cdr->src) > $src_length;
- }
-
- }
-
- return "max_callers <= $opt{skip_max_callers}"
- if length($opt{'skip_max_callers'})
- and length($cdr->max_callers)
- and $cdr->max_callers <= $opt{'skip_max_callers'};
-
- #all right then, rate it
- '';
-}
-
-sub is_free {
- 0;
-}
-
-# This equates svc_phone records; perhaps svc_phone should have a field
-# to indicate it represents a line
-sub calc_units {
- my($self, $cust_pkg ) = @_;
- my $count = 0;
- if ( $self->option('count_available_phones', 1)) {
- map { $count += ( $_->quantity || 0 ) }
- grep { $_->part_svc->svcdb eq 'svc_phone' }
- $cust_pkg->part_pkg->pkg_svc;
- } else {
- $count =
- scalar(grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc);
- }
- $count;
-}
-
-1;
-
diff --git a/FS/FS/part_pkg/voip_inbound.pm b/FS/FS/part_pkg/voip_inbound.pm
deleted file mode 100644
index 1b91575..0000000
--- a/FS/FS/part_pkg/voip_inbound.pm
+++ /dev/null
@@ -1,366 +0,0 @@
-package FS::part_pkg::voip_inbound;
-
-use strict;
-use vars qw(@ISA $DEBUG %info);
-use Date::Format;
-use Tie::IxHash;
-use FS::Conf;
-use FS::Record qw(qsearchs qsearch);
-use FS::part_pkg::recur_Common;
-use FS::cdr;
-use FS::part_pkg::recur_Common;
-
-@ISA = qw(FS::part_pkg::recur_Common);
-
-$DEBUG = 0;
-
-tie my %temporalities, 'Tie::IxHash',
- 'upcoming' => "Upcoming (future)",
- 'preceding' => "Preceding (past)",
-;
-
-tie my %granularity, 'Tie::IxHash', FS::rate_detail::granularities();
-
-%info = (
- 'name' => 'VoIP flat rate pricing of CDRs for inbound calls',
- 'shortname' => 'VoIP/telco CDR rating (inbound)',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- #false laziness w/flat.pm
- 'recur_temporality' => { 'name' => 'Charge recurring fee for period',
- 'type' => 'select',
- 'select_options' => \%temporalities,
- },
- 'cutoff_day' => { 'name' => 'Billing Day (1 - 28) for prorating or '.
- 'subscription',
- 'default' => '1',
- },
- 'add_full_period'=> { 'name' => 'When prorating first month, also bill '.
- 'for one full period after that',
- 'type' => 'checkbox',
- },
-
- 'recur_method' => { 'name' => 'Recurring fee method',
- 'type' => 'select',
- 'select_options' => \%FS::part_pkg::recur_Common::recur_method,
- },
-
- 'min_charge' => { 'name' => 'Charge per minute',
- },
-
- 'sec_granularity' => { 'name' => 'Granularity',
- 'type' => 'select',
- 'select_options' => \%granularity,
- },
-
- 'default_prefix' => { 'name' => 'Default prefix optionally prepended to customer DID numbers when searching for CDR records',
- 'default' => '+1',
- },
-
- 'disable_tollfree' => { 'name' => 'Disable automatic toll-free processing',
- 'type' => 'checkbox',
- },
-
- 'use_amaflags' => { 'name' => 'Do not charge for CDRs where the amaflags field is not set to "2" ("BILL"/"BILLING").',
- 'type' => 'checkbox',
- },
-
- 'use_disposition' => { 'name' => 'Do not charge for CDRs where the disposition flag is not set to "ANSWERED".',
- 'type' => 'checkbox',
- },
-
- 'use_disposition_taqua' => { 'name' => 'Do not charge for CDRs where the disposition is not set to "100" (Taqua).',
- 'type' => 'checkbox',
- },
-
- 'use_carrierid' => { 'name' => 'Do not charge for CDRs where the Carrier ID is not set to: ',
- },
-
- 'use_cdrtypenum' => { 'name' => 'Do not charge for CDRs where the CDR Type is not set to: ',
- },
-
- 'skip_dcontext' => { 'name' => 'Do not charge for CDRs where the dcontext is set to any of these (comma-separated) values:',
- },
-
- 'skip_dstchannel_prefix' => { 'name' => 'Do not charge for CDRs where the dstchannel starts with:',
- },
-
- 'skip_dst_length_less' => { 'name' => 'Do not charge for CDRs where the destination is less than this many digits:',
- },
-
- 'skip_lastapp' => { 'name' => 'Do not charge for CDRs where the lastapp matches this value',
- },
-
- 'use_duration' => { 'name' => 'Calculate usage based on the duration field instead of the billsec field',
- 'type' => 'checkbox',
- },
-
- #false laziness w/cdr_termination.pm
- 'output_format' => { 'name' => 'CDR invoice display format',
- 'type' => 'select',
- 'select_options' => { FS::cdr::invoice_formats() },
- 'default' => 'default', #XXX test
- },
-
- 'usage_section' => { 'name' => 'Section in which to place usage charges (whether separated or not)',
- },
-
- 'summarize_usage' => { 'name' => 'Include usage summary with recurring charges when usage is in separate section',
- 'type' => 'checkbox',
- },
-
- 'usage_mandate' => { 'name' => 'Always put usage details in separate section',
- 'type' => 'checkbox',
- },
- #eofalse
-
- 'bill_every_call' => { 'name' => 'Generate an invoice immediately for every call. Useful for prepaid.',
- 'type' => 'checkbox',
- },
-
- #XXX also have option for an external db
-# 'cdr_location' => { 'name' => 'CDR database location'
-# 'type' => 'select',
-# 'select_options' => \%cdr_location,
-# 'select_callback' => {
-# 'external' => {
-# 'enable' => [ 'datasrc', 'username', 'password' ],
-# },
-# 'internal' => {
-# 'disable' => [ 'datasrc', 'username', 'password' ],
-# }
-# },
-# },
-# 'datasrc' => { 'name' => 'DBI data source for external CDR table',
-# 'disabled' => 'Y',
-# },
-# 'username' => { 'name' => 'External database username',
-# 'disabled' => 'Y',
-# },
-# 'password' => { 'name' => 'External database password',
-# 'disabled' => 'Y',
-# },
-
- },
- 'fieldorder' => [qw(
- recur_temporality
- recur_method cutoff_day add_full_period
- min_charge sec_granularity
- default_prefix
- disable_tollfree
- use_amaflags use_disposition
- use_disposition_taqua use_carrierid use_cdrtypenum
- skip_dcontext skip_dstchannel_prefix
- skip_dst_length_less skip_lastapp
- use_duration
- output_format usage_mandate summarize_usage usage_section
- bill_every_call
- )
- ],
- 'weight' => 40,
-);
-
-sub calc_setup {
- my($self, $cust_pkg ) = @_;
- $self->option('setup_fee');
-}
-
-sub calc_recur {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- my $charges = 0;
-
- $charges += $self->calc_usage(@_);
- $charges += $self->calc_recur_Common(@_);
-
- $charges;
-
-}
-
-sub calc_cancel {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- $self->calc_usage(@_);
-}
-
-#false laziness w/voip_sqlradacct calc_recur resolve it if that one ever gets used again
-
-sub calc_usage {
- my $self = shift;
- my($cust_pkg, $sdate, $details, $param ) = @_;
-
- #my $last_bill = $cust_pkg->last_bill;
- my $last_bill = $cust_pkg->get('last_bill'); #->last_bill falls back to setup
-
- return 0
- if $self->option('recur_temporality', 1) eq 'preceding'
- && ( $last_bill eq '' || $last_bill == 0 );
-
- my $spool_cdr = $cust_pkg->cust_main->spool_cdr;
-
- my %included_min = ();
-
- my $charges = 0;
-
-# my $downstream_cdr = '';
-
- my $disable_tollfree = $self->option('disable_tollfree');
- my $ignore_unrateable = $self->option('ignore_unrateable', 'Hush!');
- my $use_duration = $self->option('use_duration');
-
- my $output_format = $self->option('output_format', 'Hush!') || 'default';
-
- #for check_chargable, so we don't keep looking up options inside the loop
- my %opt_cache = ();
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
- my $csv = new Text::CSV_XS;
-
- foreach my $cust_svc (
- grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc
- ) {
- my $svc_phone = $cust_svc->svc_x;
-
- foreach my $cdr ( $svc_phone->get_cdrs(
- 'for_update' => 1,
- 'status' => '', # unprocessed only
- 'default_prefix' => $self->option('default_prefix'),
- 'inbound' => 1,
- )
- ) {
- if ( $DEBUG > 1 ) {
- warn "rating inbound CDR $cdr\n".
- join('', map { " $_ => ". $cdr->{$_}. "\n" } keys %$cdr );
- }
- my $granularity = length($self->option('sec_granularity'))
- ? $self->option('sec_granularity')
- : 60;
-
- my $seconds = $use_duration ? $cdr->duration : $cdr->billsec;
-
- $seconds += $granularity - ( $seconds % $granularity )
- if $seconds # don't granular-ize 0 billsec calls (bills them)
- && $granularity; # 0 is per call
- my $minutes = sprintf("%.1f",$seconds / 60);
- $minutes =~ s/\.0$// if $granularity == 60; # count whole minutes, convert to integer
- $minutes = 1 unless $granularity; # per call
- my $charge = sprintf('%.2f', ( $self->option('min_charge') * $minutes )
- + 0.00000001 ); #so 1.00005 rounds to 1.0001
- next if !$charge;
- $charges += $charge;
- my @call_details = ($cdr->downstream_csv( 'format' => $output_format,
- 'charge' => $charge,
- 'minutes' => $minutes,
- 'granularity' => $granularity,
- )
- );
- push @$details,
- [ 'C',
- $call_details[0],
- $charge,
- $cdr->calltypenum, #classnum
- $self->phonenum,
- $seconds,
- '', #regionname, not set for inbound calls
- ];
-
- my $error = $cdr->set_status_and_rated_price( 'done',
- $charge,
- $cust_svc->svcnum,
- 'inbound' => 1 );
- die $error if $error;
-
- } #$cdr
- } # $cust_svc
- unshift @$details, [ 'C',
- FS::cdr::invoice_header($output_format),
- '',
- '',
- '',
- '',
- '',
- ]
- if @$details;
-
- $charges;
-}
-
-#returns a reason why not to rate this CDR, or false if the CDR is chargeable
-sub check_chargable {
- my( $self, $cdr, %flags ) = @_;
-
- #should have some better way of checking these options from a hash
- #or something
-
- my @opt = qw(
- use_amaflags
- use_disposition
- use_disposition_taqua
- use_carrierid
- use_cdrtypenum
- skip_dcontext
- skip_dstchannel_prefix
- skip_dst_length_less
- skip_lastapp
- );
- foreach my $opt (grep !exists($flags{option_cache}->{$_}), @opt ) {
- $flags{option_cache}->{$opt} = $self->option($opt, 1);
- }
- my %opt = %{ $flags{option_cache} };
-
- return 'amaflags != 2'
- if $opt{'use_amaflags'} && $cdr->amaflags != 2;
-
- return 'disposition != ANSWERED'
- if $opt{'use_disposition'} && $cdr->disposition ne 'ANSWERED';
-
- return "disposition != 100"
- if $opt{'use_disposition_taqua'} && $cdr->disposition != 100;
-
- return "carrierid != $opt{'use_carrierid'}"
- if length($opt{'use_carrierid'})
- && $cdr->carrierid ne $opt{'use_carrierid'} #ne otherwise 0 matches ''
- && ! $flags{'da_rewrote'};
-
- return "cdrtypenum != $opt{'use_cdrtypenum'}"
- if length($opt{'use_cdrtypenum'})
- && $cdr->cdrtypenum ne $opt{'use_cdrtypenum'}; #ne otherwise 0 matches ''
-
- return "dcontext IN ( $opt{'skip_dcontext'} )"
- if $opt{'skip_dcontext'} =~ /\S/
- && grep { $cdr->dcontext eq $_ } split(/\s*,\s*/, $opt{'skip_dcontext'});
-
- my $len_prefix = length($opt{'skip_dstchannel_prefix'});
- return "dstchannel starts with $opt{'skip_dstchannel_prefix'}"
- if $len_prefix
- && substr($cdr->dstchannel,0,$len_prefix) eq $opt{'skip_dstchannel_prefix'};
-
- my $dst_length = $opt{'skip_dst_length_less'};
- return "destination less than $dst_length digits"
- if $dst_length && length($cdr->dst) < $dst_length;
-
- return "lastapp is $opt{'skip_lastapp'}"
- if length($opt{'skip_lastapp'}) && $cdr->lastapp eq $opt{'skip_lastapp'};
-
- #all right then, rate it
- '';
-}
-
-sub is_free {
- 0;
-}
-
-# This equates svc_phone records; perhaps svc_phone should have a field
-# to indicate it represents a line
-sub calc_units {
- my($self, $cust_pkg ) = @_;
- my $count =
- scalar(grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc);
- $count;
-}
-
-1;
-
diff --git a/FS/FS/part_pkg/voip_sqlradacct.pm b/FS/FS/part_pkg/voip_sqlradacct.pm
deleted file mode 100644
index 5388767..0000000
--- a/FS/FS/part_pkg/voip_sqlradacct.pm
+++ /dev/null
@@ -1,185 +0,0 @@
-package FS::part_pkg::voip_sqlradacct;
-
-use strict;
-use vars qw(@ISA $DEBUG %info);
-use Date::Format;
-use FS::Record qw(qsearchs qsearch);
-use FS::part_pkg::flat;
-#use FS::rate;
-use FS::rate_prefix;
-
-@ISA = qw(FS::part_pkg::flat);
-
-$DEBUG = 1;
-
-%info = (
- 'disabled' => 1, #they're sucked into our CDR table now instead
- 'name' => 'VoIP rating by plan of CDR records in an SQL RADIUS radacct table',
- 'shortname' => 'VoIP/telco CDR rating (external RADIUS)',
- 'inherit_fields' => [ 'global_Mixin' ],
- 'fields' => {
- 'ratenum' => { 'name' => 'Rate plan',
- 'type' => 'select',
- 'select_table' => 'rate',
- 'select_key' => 'ratenum',
- 'select_label' => 'ratename',
- },
- },
- 'fieldorder' => [qw( ratenum ignore_unrateable )],
- 'weight' => 40,
-);
-
-sub calc_setup {
- my($self, $cust_pkg ) = @_;
- $self->option('setup_fee');
-}
-
-#false laziness w/voip_cdr... resolve it if this one ever gets used again
-sub calc_recur {
- my($self, $cust_pkg, $sdate, $details ) = @_;
-
- my $last_bill = $cust_pkg->last_bill;
-
- my $ratenum = $cust_pkg->part_pkg->option('ratenum');
-
- my %included_min = ();
-
- my $charges = 0;
-
- foreach my $cust_svc (
- grep { $_->part_svc->svcdb eq 'svc_acct' } $cust_pkg->cust_svc
- ) {
-
- foreach my $session (
- $cust_svc->get_session_history( $last_bill, $$sdate )
- ) {
- if ( $DEBUG > 1 ) {
- warn "rating session $session\n".
- join('', map { " $_ => ". $session->{$_}. "\n" } keys %$session );
- }
-
- ###
- # look up rate details based on called station id
- ###
-
- my $dest = $session->{'calledstationid'};
-
- #remove non-phone# stuff and whitespace
- $dest =~ s/\s//g;
- my $proto = '';
- $dest =~ s/^(\w+):// and $proto = $1; #sip:
- my $siphost = '';
- $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
-
- #determine the country code
- my $countrycode;
- if ( $dest =~ /^011(((\d)(\d))(\d))(\d+)$/ ) {
-
- my( $three, $two, $one, $u1, $u2, $rest ) = ( $1, $2, $3, $4, $5, $6 );
- #first look for 1 digit country code
- if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
- $countrycode = $one;
- $dest = $u1.$u2.$rest;
- } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
- $countrycode = $two;
- $dest = $u2.$rest;
- } else { #3 digit country code
- $countrycode = $three;
- $dest = $rest;
- }
-
- } else {
- $countrycode = '1';
- $dest =~ s/^1//;# if length($dest) > 10;
- }
-
- warn "rating call to +$countrycode $dest\n" if $DEBUG;
-
- #find a rate prefix, first look at most specific (4 digits) then 3, etc.,
- # finally trying the country code only
- my $rate_prefix = '';
- for my $len ( reverse(1..6) ) {
- $rate_prefix = qsearchs('rate_prefix', {
- 'countrycode' => $countrycode,
- #'npa' => { op=> 'LIKE', value=> substr($dest, 0, $len) }
- 'npa' => substr($dest, 0, $len),
- } ) and last;
- }
- $rate_prefix ||= qsearchs('rate_prefix', {
- 'countrycode' => $countrycode,
- 'npa' => '',
- });
-
- die "Can't find rate for call to +$countrycode $dest\n"
- unless $rate_prefix;
-
- my $regionnum = $rate_prefix->regionnum;
- my $rate_detail = qsearchs('rate_detail', {
- 'ratenum' => $ratenum,
- 'dest_regionnum' => $regionnum,
- } );
-
- warn " found rate for regionnum $regionnum ".
- "and rate detail $rate_detail\n"
- if $DEBUG;
-
- ###
- # find the price and add detail to the invoice
- ###
-
- $included_min{$regionnum} = $rate_detail->min_included
- unless exists $included_min{$regionnum};
-
- my $granularity = $rate_detail->sec_granularity;
- my $seconds = $session->{'acctsessiontime'};
- $seconds += $granularity - ( $seconds % $granularity );
- my $minutes = sprintf("%.1f", $seconds / 60);
- $minutes =~ s/\.0$// if $granularity == 60;
-
- $included_min{$regionnum} -= $minutes;
-
- my $charge = 0;
- if ( $included_min{$regionnum} < 0 ) {
- my $charge_min = 0 - $included_min{$regionnum};
- $included_min{$regionnum} = 0;
- $charge = sprintf('%.2f', $rate_detail->min_charge * $charge_min );
- $charges += $charge;
- }
-
- my $rate_region = $rate_prefix->rate_region;
- warn " (rate region $rate_region)\n" if $DEBUG;
-
- my @call_details = (
- #time2str("%Y %b %d - %r", $session->{'acctstarttime'}),
- time2str("%c", $session->{'acctstarttime'}),
- $minutes.'m',
- '$'.$charge,
- "+$countrycode $dest",
- $rate_region->regionname,
- );
-
- warn " adding details on charge to invoice: ".
- join(' - ', @call_details )
- if $DEBUG;
-
- push @$details, join(' - ', @call_details); #\@call_details,
-
- } # $session
-
- } # $cust_svc
-
- $self->option('recur_fee') + $charges;
-
-}
-
-sub can_discount { 0; }
-
-sub is_free { 0; }
-
-sub base_recur {
- my($self, $cust_pkg) = @_;
- $self->option('recur_fee');
-}
-
-1;
-
diff --git a/FS/FS/part_pkg_discount.pm b/FS/FS/part_pkg_discount.pm
deleted file mode 100644
index 2187e10..0000000
--- a/FS/FS/part_pkg_discount.pm
+++ /dev/null
@@ -1,129 +0,0 @@
-package FS::part_pkg_discount;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::discount;
-use FS::part_pkg;
-
-=head1 NAME
-
-FS::part_pkg_discount - Object methods for part_pkg_discount records
-
-=head1 SYNOPSIS
-
- use FS::part_pkg_discount;
-
- $record = new FS::part_pkg_discount \%hash;
- $record = new FS::part_pkg_discount { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pkg_discount object represents a link from a package definition
-to a discount. This permits discounts for lengthened terms. FS::part_pkg_discount inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item pkgdiscountnum
-
-primary key
-
-=item pkgpart
-
-pkgpart
-
-=item discountnum
-
-discountnum
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new part_pkg_discount. To add the example 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 { 'part_pkg_discount'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('pkgdiscountnum')
- || $self->ut_number('pkgpart')
- || $self->ut_number('discountnum')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item discount
-
-Returns the discount associated with this part_pkg_discount.
-
-=cut
-
-sub discount {
- my $self = shift;
- qsearch('discount', { 'discountnum' => $self->discountnum });
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_pkg_link.pm b/FS/FS/part_pkg_link.pm
deleted file mode 100644
index fb7a8d3..0000000
--- a/FS/FS/part_pkg_link.pm
+++ /dev/null
@@ -1,163 +0,0 @@
-package FS::part_pkg_link;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs );
-use FS::part_pkg;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::part_pkg_link - Object methods for part_pkg_link records
-
-=head1 SYNOPSIS
-
- use FS::part_pkg_link;
-
- $record = new FS::part_pkg_link \%hash;
- $record = new FS::part_pkg_link { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pkg_link object represents an link from one package definition to
-another. FS::part_pkg_link inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item pkglinknum
-
-primary key
-
-=item src_pkgpart
-
-Source package (see L<FS::part_pkg>)
-
-=item dst_pkgpart
-
-Destination package (see L<FS::part_pkg>)
-
-=item link_type
-
-Link type - currently, "bill" (source package bills a line item from target
-package), or "svc" (source package includes services from target package).
-
-=item hidden
-
-Flag indicating that this subpackage should be felt, but not seen as an invoice
-line item when set to 'Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new link. To add the link 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 { 'part_pkg_link'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid link. 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('pkglinknum')
- || $self->ut_foreign_key('src_pkgpart', 'part_pkg', 'pkgpart')
- || $self->ut_foreign_key('dst_pkgpart', 'part_pkg', 'pkgpart')
- || $self->ut_enum('link_type', [ 'bill', 'svc' ] )
- || $self->ut_enum('hidden', [ '', 'Y' ] )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item src_pkg
-
-Returns the source part_pkg object (see L<FS::part_pkg>).
-
-=cut
-
-sub src_pkg {
- my $self = shift;
- qsearchs('part_pkg', { 'pkgpart' => $self->src_pkgpart } );
-}
-
-=item dst_pkg
-
-Returns the source part_pkg object (see L<FS::part_pkg>).
-
-=cut
-
-sub dst_pkg {
- my $self = shift;
- qsearchs('part_pkg', { 'pkgpart' => $self->dst_pkgpart } );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_pkg_option.pm b/FS/FS/part_pkg_option.pm
deleted file mode 100644
index 142622b..0000000
--- a/FS/FS/part_pkg_option.pm
+++ /dev/null
@@ -1,159 +0,0 @@
-package FS::part_pkg_option;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::part_pkg;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::part_pkg_option - Object methods for part_pkg_option records
-
-=head1 SYNOPSIS
-
- use FS::part_pkg_option;
-
- $record = new FS::part_pkg_option \%hash;
- $record = new FS::part_pkg_option { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pkg_option object represents an package definition option.
-FS::part_pkg_option inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item optionnum - primary key
-
-=item pkgpart - package definition (see L<FS::part_pkg>)
-
-=item optionname - option name
-
-=item optionvalue - option value
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new package definition option. To add the package definition option
-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 { 'part_pkg_option'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid package definition option. 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('optionnum')
- || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart')
- || $self->ut_alpha('optionname')
- || $self->ut_anything('optionvalue')
- ;
- return $error if $error;
-
- #check options & values?
-
- $self->SUPER::check;
-}
-
-=back
-
-=cut
-
-#
-# Used by FS::Upgrade to migrate to a new database.
-#
-#
-
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
-
- my $sql = "UPDATE part_pkg_option SET optionname = 'recur_fee'".
- " WHERE optionname = 'recur_flat'";
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
-
- $sql = "UPDATE part_pkg_option SET optionname = 'recur_method',".
- "optionvalue = 'prorate' WHERE optionname = 'enable_prorate'";
- $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
-
- $sql = "UPDATE part_pkg_option SET optionvalue = NULL WHERE ".
- "optionname = 'contract_end_months' AND optionvalue = '(none)'";
- $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
- '';
-
-}
-
-=head1 BUGS
-
-Possibly.
-
-=head1 SEE ALSO
-
-L<FS::part_pkg>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_pkg_report_option.pm b/FS/FS/part_pkg_report_option.pm
deleted file mode 100644
index 16a4c98..0000000
--- a/FS/FS/part_pkg_report_option.pm
+++ /dev/null
@@ -1,125 +0,0 @@
-package FS::part_pkg_report_option;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::part_pkg_report_option - Object methods for part_pkg_report_option records
-
-=head1 SYNOPSIS
-
- use FS::part_pkg_report_option;
-
- $record = new FS::part_pkg_report_option \%hash;
- $record = new FS::part_pkg_report_option { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pkg_report_option object represents a package definition optional
-reporting classification. FS::part_pkg_report_option inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item num
-
-primary key
-
-=item name
-
-name - The name associated with the reporting option
-
-=item disabled
-
-disabled - set to 'Y' to prevent addition to new packages
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new report option. To add the option 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 { 'part_pkg_report_option'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-sub delete {
- return "Can't delete part_pkg_report_option records!";
-}
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('num')
- || $self->ut_text('name')
- || $self->ut_enum('disabled', [ '', 'Y' ])
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-Overlaps somewhat with pkg_class and pkg_category
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_pkg_taxclass.pm b/FS/FS/part_pkg_taxclass.pm
deleted file mode 100644
index 824fd17..0000000
--- a/FS/FS/part_pkg_taxclass.pm
+++ /dev/null
@@ -1,226 +0,0 @@
-package FS::part_pkg_taxclass;
-
-use strict;
-use vars qw( @ISA );
-use Scalar::Util qw( blessed );
-use FS::UID qw( dbh );
-use FS::Record; # qw( qsearch qsearchs );
-use FS::cust_main_county;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::part_pkg_taxclass - Object methods for part_pkg_taxclass records
-
-=head1 SYNOPSIS
-
- use FS::part_pkg_taxclass;
-
- $record = new FS::part_pkg_taxclass \%hash;
- $record = new FS::part_pkg_taxclass { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pkg_taxclass object represents a tax class. FS::part_pkg_taxclass
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item taxclassnum
-
-Primary key
-
-=item taxclass
-
-Tax class
-
-=item disabled
-
-Disabled flag, empty or 'Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new tax class. To add the tax class 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 { 'part_pkg_taxclass'; }
-
-=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;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- my $sth = dbh->prepare("
- SELECT country, state, county FROM cust_main_county
- WHERE taxclass IS NOT NULL AND taxclass != ''
- GROUP BY country, state, county
- ") or die dbh->errstr;
- $sth->execute or die $sth->errstr;
-
- while ( my $row = $sth->fetchrow_hashref ) {
- #warn "inserting for $row";
- my $cust_main_county = new FS::cust_main_county {
- 'country' => $row->{country},
- 'state' => $row->{state},
- 'county' => $row->{county},
- 'tax' => 0,
- 'taxclass' => $self->taxclass,
- #exempt_amount
- #taxname
- #setuptax
- #recurtax
- };
- $error = $cust_main_county->insert;
- #last if $error;
- 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
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my $new = shift;
-
- my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
- ? shift
- : $new->replace_old;
-
- return "Can't change tax class name (disable and create anew)"
- if $old->taxclass ne $new->taxclass;
-
- $new->SUPER::replace(@_);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid tax class. 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('taxclassnum')
- || $self->ut_text('taxclass')
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=cut
-
-# _upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-
-sub _upgrade_data { # class method
- my ($class, %opts) = @_;
-
- my $sth = dbh->prepare('
- SELECT DISTINCT taxclass
- FROM cust_main_county
- LEFT JOIN part_pkg_taxclass USING ( taxclass )
- WHERE taxclassnum IS NULL
- AND taxclass IS NOT NULL
- ') or die dbh->errstr;
- $sth->execute or die $sth->errstr;
- my %taxclass = map { $_->[0] => 1 } @{$sth->fetchall_arrayref};
- my @taxclass = grep $_, keys %taxclass;
-
- foreach my $taxclass ( @taxclass ) {
-
- my $part_pkg_taxclass = new FS::part_pkg_taxclass ( {
- 'taxclass' => $taxclass,
- } );
- my $error = $part_pkg_taxclass->insert;
- die $error if $error;
-
- }
-
-}
-
-=head1 BUGS
-
-Other tables (cust_main_county, part_pkg, agent_payment_gateway) have a text
-taxclass instead of a key to this table.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_pkg_taxoverride.pm b/FS/FS/part_pkg_taxoverride.pm
deleted file mode 100644
index 0fdfa50..0000000
--- a/FS/FS/part_pkg_taxoverride.pm
+++ /dev/null
@@ -1,119 +0,0 @@
-package FS::part_pkg_taxoverride;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::part_pkg_taxoverride - Object methods for part_pkg_taxoverride records
-
-=head1 SYNOPSIS
-
- use FS::part_pkg_taxoverride;
-
- $record = new FS::part_pkg_taxoverride \%hash;
- $record = new FS::part_pkg_taxoverride { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pkg_taxoverride object represents a manual mapping of a
-package to tax rates. FS::part_pkg_taxoverride inherits from FS::Record.
-The following fields are currently supported:
-
-=over 4
-
-=item taxoverridenum
-
-Primary key
-
-=item pkgpart
-
-The package definition id
-
-=item taxclassnum
-
-The tax class id
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new tax override. To add the tax product 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 { 'part_pkg_taxoverride'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid tax product. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('taxoverridenum')
- || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart')
- || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=cut
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_pkg_taxproduct.pm b/FS/FS/part_pkg_taxproduct.pm
deleted file mode 100644
index 56e63b6..0000000
--- a/FS/FS/part_pkg_taxproduct.pm
+++ /dev/null
@@ -1,139 +0,0 @@
-package FS::part_pkg_taxproduct;
-
-use strict;
-use vars qw( @ISA $delete_kludge );
-use FS::Record qw( qsearch );
-
-@ISA = qw(FS::Record);
-$delete_kludge = 0;
-
-=head1 NAME
-
-FS::part_pkg_taxproduct - Object methods for part_pkg_taxproduct records
-
-=head1 SYNOPSIS
-
- use FS::part_pkg_taxproduct;
-
- $record = new FS::part_pkg_taxproduct \%hash;
- $record = new FS::part_pkg_taxproduct { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pkg_taxproduct object represents a tax product.
-FS::part_pkg_taxproduct inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item taxproductnum
-
-Primary key
-
-=item data_vendor
-
-Tax data vendor
-
-=item taxproduct
-
-Tax product id from the vendor
-
-=item description
-
-A human readable description of the id in taxproduct
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new tax product. To add the tax product 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 { 'part_pkg_taxproduct'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-sub delete {
- my $self = shift;
-
- return "Can't delete a tax product which has attached package tax rates!"
- if qsearch( 'part_pkg_taxrate', { 'taxproductnum' => $self->taxproductnum } );
-
- unless ( $delete_kludge ) {
- return "Can't delete a tax product which has attached packages!"
- if qsearch( 'part_pkg', { 'taxproductnum' => $self->taxproductnum } );
- }
-
- $self->SUPER::delete(@_);
-}
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid tax product. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('taxproductnum')
- || $self->ut_textn('data_vendor')
- || $self->ut_text('taxproduct')
- || $self->ut_textn('description')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=cut
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_pkg_taxrate.pm b/FS/FS/part_pkg_taxrate.pm
deleted file mode 100644
index fb1afce..0000000
--- a/FS/FS/part_pkg_taxrate.pm
+++ /dev/null
@@ -1,420 +0,0 @@
-package FS::part_pkg_taxrate;
-
-use strict;
-use vars qw( @ISA );
-use Date::Parse;
-use DateTime;
-use DateTime::Format::Strptime;
-use FS::UID qw(dbh);
-use FS::Record qw( qsearch qsearchs );
-use FS::part_pkg_taxproduct;
-use FS::Misc qw(csv_from_fixed);
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::part_pkg_taxrate - Object methods for part_pkg_taxrate records
-
-=head1 SYNOPSIS
-
- use FS::part_pkg_taxrate;
-
- $record = new FS::part_pkg_taxrate \%hash;
- $record = new FS::part_pkg_taxrate { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pkg_taxrate object maps packages onto tax rates.
-FS::part_pkg_taxrate inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item pkgtaxratenum
-
-Primary key
-
-=item data_vendor
-
-Tax data vendor
-
-=item geocode
-
-Tax vendor location code
-
-=item taxproductnum
-
-Class of package for tax purposes, Index into FS::part_pkg_taxproduct
-
-=item city
-
-city
-
-=item county
-
-county
-
-=item state
-
-state
-
-=item local
-
-local
-
-=item country
-
-country
-
-=item taxclassnum
-
-Class of tax index into FS::tax_taxclass and FS::tax_rate
-
-=item taxclassnumtaxed
-
-Class of tax taxed by this entry.
-
-=item taxable
-
-taxable
-
-=item effdate
-
-effdate
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new customer (location), package, tax rate mapping. To add the
-mapping 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 { 'part_pkg_taxrate'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid tax rate mapping. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('pkgtaxratenum')
- || $self->ut_textn('data_vendor')
- || $self->ut_textn('geocode')
- || $self->
- ut_foreign_key('taxproductnum', 'part_pkg_taxproduct', 'taxproductnum')
- || $self->ut_textn('city')
- || $self->ut_textn('county')
- || $self->ut_textn('state')
- || $self->ut_textn('local')
- || $self->ut_text('country')
- || $self->ut_foreign_keyn('taxclassnumtaxed', 'tax_class', 'taxclassnum')
- || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
- || $self->ut_snumbern('effdate')
- || $self->ut_enum('taxable', [ 'Y', '' ])
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item batch_import
-
-Loads part_pkg_taxrate records from an external CSV file. If there is
-an error, returns the error, otherwise returns false.
-
-=cut
-
-sub batch_import {
- my ($param, $job) = @_;
-
- my $fh = $param->{filehandle};
- my $format = $param->{'format'};
-
- my $imported = 0;
- my @fields;
- my $hook;
-
- my @column_lengths = ();
- my @column_callbacks = ();
- if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
- $format =~ s/-fixed//;
- my $date_format = sub { my $r='';
- /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
- $r;
- };
- $column_callbacks[16] = $date_format;
- push @column_lengths, qw( 28 25 2 1 10 4 30 3 100 2 2 2 2 1 2 2 8 1 );
- push @column_lengths, 1 if $format eq 'cch-update';
- }
-
- my $line;
- my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar
- if ( $job || scalar(@column_callbacks) ) {
- my $error =
- csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
- return $error if $error;
- }
-
- if ( $format eq 'cch' || $format eq 'cch-update' ) {
- @fields = qw( city county state local geocode group groupdesc item
- itemdesc provider customer taxtypetaxed taxcattaxed
- taxable taxtype taxcat effdate rectype );
- push @fields, 'actionflag' if $format eq 'cch-update';
-
- $imported++ if $format eq 'cch-update'; #empty file ok
-
- $hook = sub {
- my $hash = shift;
-
- unless ( $hash->{'rectype'} eq 'R' or $hash->{'rectype'} eq 'T' ) {
- delete($hash->{$_}) for (keys %$hash);
- return;
- }
-
- $hash->{'data_vendor'} = 'cch';
-
- my %providers = ( '00' => 'Regulated LEC',
- '01' => 'Regulated IXC',
- '02' => 'Unregulated LEC',
- '03' => 'Unregulated IXC',
- '04' => 'ISP',
- '05' => 'Wireless',
- );
-
- my %customers = ( '00' => 'Residential',
- '01' => 'Commercial',
- '02' => 'Industrial',
- '09' => 'Lifeline',
- '10' => 'Senior Citizen',
- );
-
- my $taxproduct =
- join(':', map{ $hash->{$_} } qw(group item provider customer ) );
-
- my %part_pkg_taxproduct = ( 'data_vendor' => 'cch',
- 'taxproduct' => $taxproduct,
- );
-
- my $part_pkg_taxproduct = qsearchs( 'part_pkg_taxproduct',
- { %part_pkg_taxproduct }
- );
-
- unless ($part_pkg_taxproduct) {
- return "Can't find part_pkg_taxproduct for txmatrix deletion: ".
- join(" ", map { "$_ => ". $hash->{$_} } @fields)
- if ($hash->{'actionfield'} && $hash->{'actionflag'} eq 'D');
-
- $part_pkg_taxproduct{'description'} =
- join(' : ', (map{ $hash->{$_} } qw(groupdesc itemdesc)),
- $providers{$hash->{'provider'}} || '',
- $customers{$hash->{'customer'}} || '',
- );
- $part_pkg_taxproduct = new FS::part_pkg_taxproduct \%part_pkg_taxproduct;
- my $error = $part_pkg_taxproduct->insert;
- return "Error inserting tax product (part_pkg_taxproduct): $error"
- if $error;
-
- }
- $hash->{'taxproductnum'} = $part_pkg_taxproduct->taxproductnum;
-
- delete($hash->{$_})
- for qw(group groupdesc item itemdesc provider customer rectype );
-
- my %map = ( 'taxclassnum' => [ 'taxtype', 'taxcat' ],
- 'taxclassnumtaxed' => [ 'taxtypetaxed', 'taxcattaxed' ],
- );
-
- for my $item (keys %map) {
- my $class = join(':', map($hash->{$_}, @{$map{$item}}));
- my $tax_class =
- qsearchs( 'tax_class',
- { data_vendor => 'cch',
- 'taxclass' => $class,
- }
- );
- $hash->{$item} = $tax_class->taxclassnum
- if $tax_class;
-
- return "Can't find tax class for txmatrix deletion: ".
- join(" ", map { "$_ => ". $hash->{$_} } @fields)
- if ( $hash->{'actionflag'} && $hash->{'actionflag'} eq 'D' &&
- !$tax_class && $class ne ':'
- );
-
- delete($hash->{$_}) foreach @{$map{$item}};
- }
-
- my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
- time_zone => 'floating',
- );
- my $dt = $parser->parse_datetime( $hash->{'effdate'} );
- $hash->{'effdate'} = $dt ? $dt->epoch : '';
-
- $hash->{'country'} = 'US'; # CA is available
-
- $hash->{'taxable'} = '' if ($hash->{'taxable'} eq 'N');
-
- if (exists($hash->{actionflag}) && $hash->{actionflag} eq 'D') {
- delete($hash->{actionflag});
-
- my $part_pkg_taxrate = qsearchs('part_pkg_taxrate', $hash);
- unless ( $part_pkg_taxrate ) {
- if ( $hash->{taxproductnum} ) {
- my $taxproduct =
- qsearchs( 'part_pkg_taxproduct',
- { 'taxproductnum' => $hash->{taxproductnum} }
- );
- $hash->{taxproductnum} .= ' ( '. $taxproduct->taxproduct. ' )'
- if $taxproduct;
- }
- return "Can't find part_pkg_taxrate to delete: ".
- join(" ", map { "$_ => *". $hash->{$_}. '*' } keys(%$hash) );
- }
-
- my $error = $part_pkg_taxrate->delete;
- return $error if $error;
-
- delete($hash->{$_}) foreach (keys %$hash);
- }
-
- delete($hash->{actionflag});
-
- '';
- };
-
- } elsif ( $format eq 'extended' ) {
- die "unimplemented\n";
- @fields = qw( );
- $hook = sub {};
- } else {
- die "unknown format $format";
- }
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
-
- my $csv = new Text::CSV_XS;
-
- 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;
-
- while ( defined($line=<$fh>) ) {
- $csv->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $csv->error_input();
- };
-
-
- if ( $job ) { # progress bar
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $imported / $count ). ",Importing tax matrix"
- );
- die $error if $error;
- $last = time;
- }
- }
-
- my @columns = $csv->fields();
-
- my %part_pkg_taxrate = ( 'data_vendor' => $format );
- foreach my $field ( @fields ) {
- $part_pkg_taxrate{$field} = shift @columns;
- }
- if ( scalar( @columns ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Unexpected trailing columns in line (wrong format?): $line";
- }
-
- my $error = &{$hook}(\%part_pkg_taxrate);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- next unless scalar(keys %part_pkg_taxrate);
-
-
- my $part_pkg_taxrate = new FS::part_pkg_taxrate( \%part_pkg_taxrate );
- $error = $part_pkg_taxrate->insert;
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert part_pkg_taxrate for $line: $error";
- }
-
- $imported++;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return "Empty file!" unless ( $imported || $format eq 'cch-update' );
-
- ''; #no error
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
-
diff --git a/FS/FS/part_pkg_vendor.pm b/FS/FS/part_pkg_vendor.pm
deleted file mode 100644
index 6b91f75..0000000
--- a/FS/FS/part_pkg_vendor.pm
+++ /dev/null
@@ -1,140 +0,0 @@
-package FS::part_pkg_vendor;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::part_pkg_vendor - Object methods for part_pkg_vendor records
-
-=head1 SYNOPSIS
-
- use FS::part_pkg_vendor;
-
- $record = new FS::part_pkg_vendor \%hash;
- $record = new FS::part_pkg_vendor { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pkg_vendor object represents a mapping of pkgpart numbers to
-external package numbers. FS::part_pkg_vendor inherits from FS::Record.
-The following fields are currently supported:
-
-=over 4
-
-=item num
-
-primary key
-
-=item pkgpart
-
-pkgpart
-
-=item exportnum
-
-exportnum
-
-=item vendor_pkg_id
-
-vendor_pkg_id
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new example. To add the example 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 { 'part_pkg_vendor'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('num')
- || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart')
- || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum')
- || $self->ut_textn('vendor_pkg_id')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item part_export
-
-Returns the L<FS::part_export> associated with this vendor/external package id.
-
-=cut
-sub part_export {
- my $self = shift;
- qsearchs( 'part_export', { 'exportnum' => $self->exportnum } );
-}
-
-=back
-
-=head1 SEE ALSO
-
-L<FS::part_pkg>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_pop_local.pm b/FS/FS/part_pop_local.pm
deleted file mode 100644
index 01c59df..0000000
--- a/FS/FS/part_pop_local.pm
+++ /dev/null
@@ -1,113 +0,0 @@
-package FS::part_pop_local;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record; # qw( qsearchs );
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::part_pop_local - Object methods for part_pop_local records
-
-=head1 SYNOPSIS
-
- use FS::part_pop_local;
-
- $record = new FS::part_pop_local \%hash;
- $record = new FS::part_pop_local { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pop_local object represents a local call area. Each
-FS::part_pop_local record maps a NPA/NXX (area code and exchange) to the POP
-(see L<FS::svc_acct_pop>) which is a local call. FS::part_pop_local inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item localnum - primary key (assigned automatically for new accounts)
-
-=item popnum - see L<FS::svc_acct_pop>
-
-=item city
-
-=item state
-
-=item npa - area code
-
-=item nxx - exchange
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new point of presence (if only it were that easy!). To add the
-point of presence to the database, see L<"insert">.
-
-=cut
-
-sub table { 'part_pop_local'; }
-
-=item insert
-
-Adds this point of presence to the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item delete
-
-Removes this point of presence from the database.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid point of presence. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->ut_numbern('localnum')
- or $self->ut_numbern('popnum')
- or $self->ut_text('city')
- or $self->ut_text('state')
- or $self->ut_number('npa')
- or $self->ut_number('nxx')
- or $self->SUPER::check
- ;
-
-}
-
-=back
-
-=head1 BUGS
-
-US/CA-centric.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::svc_acct_pop>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_referral.pm b/FS/FS/part_referral.pm
deleted file mode 100644
index c94c57e..0000000
--- a/FS/FS/part_referral.pm
+++ /dev/null
@@ -1,208 +0,0 @@
-package FS::part_referral;
-
-use strict;
-use vars qw( @ISA $setup_hack );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::agent;
-
-@ISA = qw( FS::Record );
-$setup_hack = 0;
-
-=head1 NAME
-
-FS::part_referral - Object methods for part_referral objects
-
-=head1 SYNOPSIS
-
- use FS::part_referral;
-
- $record = new FS::part_referral \%hash
- $record = new FS::part_referral { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_referral represents a advertising source - where a customer heard
-of your services. This can be used to track the effectiveness of a particular
-piece of advertising, for example. FS::part_referral inherits from FS::Record.
-The following fields are currently supported:
-
-=over 4
-
-=item refnum - primary key (assigned automatically for new referrals)
-
-=item referral - Text name of this advertising source
-
-=item disabled - Disabled flag, empty or 'Y'
-
-=item agentnum - Optional agentnum (see L<FS::agent>)
-
-=back
-
-=head1 NOTE
-
-These were called B<referrals> before version 1.4.0 - the name was changed
-so as not to be confused with the new customer-to-customer referrals.
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new advertising source. To add the referral to the database, see
-L<"insert">.
-
-=cut
-
-sub table { 'part_referral'; }
-
-=item insert
-
-Adds this advertising source to the database. If there is an error, returns
-the error, otherwise returns false.
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- my $self = shift;
- return "Can't (yet?) delete part_referral records";
- #need to make sure no customers have this referral!
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid advertising source. If there is
-an error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error = $self->ut_numbern('refnum')
- || $self->ut_text('referral')
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- #|| $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
- || ( $setup_hack
- ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
- : $self->ut_agentnum_acl('agentnum', 'Edit global advertising sources')
- )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item agent
-
-Returns the associated agent for this referral, if any, as an FS::agent object.
-
-=cut
-
-sub agent {
- my $self = shift;
- qsearchs('agent', { 'agentnum' => $self->agentnum } );
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item acl_agentnum_sql [ INCLUDE_GLOBAL_BOOL ]
-
-Returns an SQL fragment for searching for part_referral records allowed by the
-current users's agent ACLs (and "Edit global advertising sources" right).
-
-Pass a true value to include global advertising sources (for example, when
-simply using rather than editing advertising sources).
-
-=cut
-
-sub acl_agentnum_sql {
- my $self = shift;
-
- my $curuser = $FS::CurrentUser::CurrentUser;
- my $sql = $curuser->agentnums_sql;
- $sql = " ( $sql OR agentnum IS NULL ) "
- if $curuser->access_right('Edit global advertising sources')
- or defined($_[0]) && $_[0];
-
- $sql;
-
-}
-
-=item all_part_referral [ INCLUDE_GLOBAL_BOOL ]
-
-Returns all part_referral records allowed by the current users's agent ACLs
-(and "Edit global advertising sources" right).
-
-Pass a true value to include global advertising sources (for example, when
-simply using rather than editing advertising sources).
-
-=cut
-
-sub all_part_referral {
- my $self = shift;
-
- qsearch({
- 'table' => 'part_referral',
- 'extra_sql' => ' WHERE '. $self->acl_agentnum_sql(@_). ' ORDER BY refnum ',
- });
-
-}
-
-=item num_part_referral [ INCLUDE_GLOBAL_BOOL ]
-
-Returns the number of part_referral records allowed by the current users's
-agent ACLs (and "Edit global advertising sources" right).
-
-=cut
-
-sub num_part_referral {
- my $self = shift;
-
- my $sth = dbh->prepare(
- 'SELECT COUNT(*) FROM part_referral WHERE '. $self->acl_agentnum_sql(@_)
- ) or die dbh->errstr;
- $sth->execute() or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
-}
-
-=back
-
-=head1 BUGS
-
-The delete method is unimplemented.
-
-`Advertising source'. Yes, it's a sucky name. The only other ones I could
-come up with were "Marketing channel" and "Heard Abouts" and those are
-definately both worse.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm
deleted file mode 100644
index 164bad0..0000000
--- a/FS/FS/part_svc.pm
+++ /dev/null
@@ -1,881 +0,0 @@
-package FS::part_svc;
-
-use strict;
-use vars qw( @ISA $DEBUG );
-use Tie::IxHash;
-use FS::Record qw( qsearch qsearchs fields dbh );
-use FS::Schema qw( dbdef );
-use FS::part_svc_column;
-use FS::part_export;
-use FS::export_svc;
-use FS::cust_svc;
-
-@ISA = qw(FS::Record);
-
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::part_svc - Object methods for part_svc objects
-
-=head1 SYNOPSIS
-
- use FS::part_svc;
-
- $record = new FS::part_svc \%hash
- $record = new FS::part_svc { 'column' => 'value' };
-
- $error = $record->insert;
- $error = $record->insert( [ 'pseudofield' ] );
- $error = $record->insert( [ 'pseudofield' ], \%exportnums );
-
- $error = $new_record->replace($old_record);
- $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ] );
- $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ], \%exportnums );
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_svc represents a service definition. FS::part_svc inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcpart - primary key (assigned automatically for new service definitions)
-
-=item svc - text name of this service definition
-
-=item svcdb - table used for this service. See L<FS::svc_acct>,
-L<FS::svc_domain>, and L<FS::svc_forward>, among others.
-
-=item disabled - Disabled flag, empty or `Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new service definition. To add the service definition to the
-database, see L<"insert">.
-
-=cut
-
-sub table { 'part_svc'; }
-
-=item insert [ EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF [ , JOB ] ] ]
-
-Adds this service definition to the database. If there is an error, returns
-the error, otherwise returns false.
-
-The following pseudo-fields may be defined, and will be maintained in
-the part_svc_column table appropriately (see L<FS::part_svc_column>).
-
-=over 4
-
-=item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
-
-=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null or empty (no default), `D' for default, `F' for fixed (unchangeable), `M' for manual selection from inventory, or `A' for automatic selection from inventory. For virtual fields, can also be 'X' for excluded.
-
-=back
-
-If you want to add part_svc_column records for fields that do not exist as
-(real or virtual) fields in the I<svcdb> table, make sure to list then in
-EXTRA_FIELDS_ARRAYREF also.
-
-If EXPORTNUMS_HASHREF is specified (keys are exportnums and values are
-boolean), the appopriate export_svc records will be inserted.
-
-TODOC: JOB
-
-=cut
-
-sub insert {
- my $self = shift;
- my @fields = ();
- my @exportnums = ();
- @fields = @{shift(@_)} if @_;
- if ( @_ ) {
- my $exportnums = shift;
- @exportnums = grep $exportnums->{$_}, keys %$exportnums;
- }
- my $job = '';
- $job = shift if @_;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- # add part_svc_column records
-
- my $svcdb = $self->svcdb;
-# my @rows = map { /^${svcdb}__(.*)$/; $1 }
-# grep ! /_flag$/,
-# grep /^${svcdb}__/,
-# fields('part_svc');
- foreach my $field (
- grep { $_ ne 'svcnum'
- && ( defined( $self->getfield($svcdb.'__'.$_.'_flag') )
- || $self->getfield($svcdb.'__'.$_.'_label') !~ /^\s*$/ )
- } (fields($svcdb), @fields)
- ) {
- my $part_svc_column = $self->part_svc_column($field);
- my $previous = qsearchs('part_svc_column', {
- 'svcpart' => $self->svcpart,
- 'columnname' => $field,
- } );
-
- my $flag = $self->getfield($svcdb.'__'.$field.'_flag');
- my $label = $self->getfield($svcdb.'__'.$field.'_label');
- if ( uc($flag) =~ /^([A-Z])$/ || $label !~ /^\s*$/ ) {
-
- if ( uc($flag) =~ /^([A-Z])$/ ) {
- my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse}
- || sub { shift };
- $part_svc_column->setfield('columnflag', $1);
- $part_svc_column->setfield('columnvalue',
- &$parser($self->getfield($svcdb.'__'.$field))
- );
- }
-
- $part_svc_column->setfield('columnlabel', $label)
- if $label !~ /^\s*$/;
-
- if ( $previous ) {
- $error = $part_svc_column->replace($previous);
- } else {
- $error = $part_svc_column->insert;
- }
-
- } else {
- $error = $previous ? $previous->delete : '';
- }
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- }
-
- # add export_svc records
- my $slice = 100/scalar(@exportnums) if @exportnums;
- my $done = 0;
- foreach my $exportnum ( @exportnums ) {
- my $export_svc = new FS::export_svc ( {
- 'exportnum' => $exportnum,
- 'svcpart' => $self->svcpart,
- } );
- $error = $export_svc->insert($job, $slice*$done++, $slice);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-=item delete
-
-Currently unimplemented. Set the "disabled" field instead.
-
-=cut
-
-sub delete {
- return "Can't (yet?) delete service definitions.";
-# check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)?
-}
-
-=item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF [ , JOB ] ] ] ]
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-TODOC: 1.3-COMPAT
-
-TODOC: EXTRA_FIELDS_ARRAYREF (same as insert method)
-
-TODOC: JOB
-
-=cut
-
-sub replace {
- my ( $new, $old ) = ( shift, shift );
- my $compat = '';
- my @fields = ();
- my $exportnums;
- my $job = '';
- if ( @_ && $_[0] eq '1.3-COMPAT' ) {
- shift;
- $compat = '1.3';
- @fields = @{shift(@_)} if @_;
- $exportnums = @_ ? shift : '';
- $job = shift if @_;
- } else {
- return 'non-1.3-COMPAT interface not yet written';
- #not yet implemented
- }
-
- return "Can't change svcdb for an existing service definition!"
- unless $old->svcdb eq $new->svcdb;
-
- 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 );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $compat eq '1.3' ) {
-
- # maintain part_svc_column records
-
- my $svcdb = $new->svcdb;
- foreach my $field (
- grep { $_ ne 'svcnum'
- && ( defined( $new->getfield($svcdb.'__'.$_.'_flag') )
- || $new->getfield($svcdb.'__'.$_.'_label') !~ /^\s*$/ )
- } (fields($svcdb),@fields)
- ) {
-
- my $part_svc_column = $new->part_svc_column($field);
- my $previous = qsearchs('part_svc_column', {
- 'svcpart' => $new->svcpart,
- 'columnname' => $field,
- } );
-
- my $flag = $new->getfield($svcdb.'__'.$field.'_flag');
- my $label = $new->getfield($svcdb.'__'.$field.'_label');
-
- if ( uc($flag) =~ /^([A-Z])$/ || $label !~ /^\s*$/ ) {
-
- if ( uc($flag) =~ /^([A-Z])$/ ) {
- $part_svc_column->setfield('columnflag', $1);
- my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse}
- || sub { shift };
- $part_svc_column->setfield('columnvalue',
- &$parser($new->getfield($svcdb.'__'.$field))
- );
- } else {
- $part_svc_column->setfield('columnflag', '');
- $part_svc_column->setfield('columnvalue', '');
- }
-
- $part_svc_column->setfield('columnlabel', $label)
- if $label !~ /^\s*$/;
-
- if ( $previous ) {
- $error = $part_svc_column->replace($previous);
- } else {
- $error = $part_svc_column->insert;
- }
- } else {
- $error = $previous ? $previous->delete : '';
- }
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- # maintain export_svc records
-
- if ( $exportnums ) {
-
- #false laziness w/ edit/process/agent_type.cgi
- my @new_export_svc = ();
- foreach my $part_export ( qsearch('part_export', {}) ) {
- my $exportnum = $part_export->exportnum;
- my $hashref = {
- 'exportnum' => $exportnum,
- 'svcpart' => $new->svcpart,
- };
- my $export_svc = qsearchs('export_svc', $hashref);
-
- if ( $export_svc && ! $exportnums->{$exportnum} ) {
- $error = $export_svc->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- } elsif ( ! $export_svc && $exportnums->{$exportnum} ) {
- push @new_export_svc, new FS::export_svc ( $hashref );
- }
-
- }
-
- my $slice = 100/scalar(@new_export_svc) if @new_export_svc;
- my $done = 0;
- foreach my $export_svc (@new_export_svc) {
- $error = $export_svc->insert($job, $slice*$done++, $slice);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- if ( $job ) {
- $error = $job->update_statustext( int( $slice * $done ) );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- }
-
- } else {
- $dbh->rollback if $oldAutoCommit;
- return 'non-1.3-COMPAT interface not yet written';
- #not yet implemented
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-=item check
-
-Checks all fields to make sure this is a valid service definition. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error;
- $error=
- $self->ut_numbern('svcpart')
- || $self->ut_text('svc')
- || $self->ut_alpha('svcdb')
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- ;
- return $error if $error;
-
- my @fields = eval { fields( $self->svcdb ) }; #might die
- return "Unknown svcdb: ". $self->svcdb. " (Error: $@)"
- unless @fields;
-
- $self->SUPER::check;
-}
-
-=item part_svc_column COLUMNNAME
-
-Returns the part_svc_column object (see L<FS::part_svc_column>) for the given
-COLUMNNAME, or a new part_svc_column object if none exists.
-
-=cut
-
-sub part_svc_column {
- my( $self, $columnname) = @_;
- $self->svcpart &&
- qsearchs('part_svc_column', {
- 'svcpart' => $self->svcpart,
- 'columnname' => $columnname,
- }
- ) or new FS::part_svc_column {
- 'svcpart' => $self->svcpart,
- 'columnname' => $columnname,
- };
-}
-
-=item all_part_svc_column
-
-=cut
-
-sub all_part_svc_column {
- my $self = shift;
- qsearch('part_svc_column', { 'svcpart' => $self->svcpart } );
-}
-
-=item part_export [ EXPORTTYPE ]
-
-Returns a list of all exports (see L<FS::part_export>) for this service, or,
-if an export type is specified, only returns exports of the given type.
-
-=cut
-
-sub part_export {
- my $self = shift;
- my %search;
- $search{'exporttype'} = shift if @_;
- map { qsearchs('part_export', { 'exportnum' => $_->exportnum, %search } ) }
- qsearch('export_svc', { 'svcpart' => $self->svcpart } );
-}
-
-=item part_export_usage
-
-Returns a list of any exports (see L<FS::part_export>) for this service that
-are capable of reporting usage information.
-
-=cut
-
-sub part_export_usage {
- my $self = shift;
- grep $_->can('usage_sessions'), $self->part_export;
-}
-
-=item part_export_did
-
-Returns a list of any exports (see L<FS::part_export>) for this service that
-are capable of returing available DID (phone number) information.
-
-=cut
-
-sub part_export_did {
- my $self = shift;
- grep $_->can('get_dids'), $self->part_export;
-}
-
-=item part_export_dsl_pull
-
-Returns a list of any exports (see L<FS::part_export>) for this service that
-are capable of pulling/pushing DSL orders.
-
-=cut
-
-sub part_export_dsl_pull {
- my $self = shift;
- grep $_->can('dsl_pull'), $self->part_export;
-}
-
-=item cust_svc [ PKGPART ]
-
-Returns a list of associated customer services (FS::cust_svc records).
-
-If a PKGPART is specified, returns the customer services which are contained
-within packages of that type (see L<FS::part_pkg>). If PKGPARTis specified as
-B<0>, returns unlinked customer services.
-
-=cut
-
-sub cust_svc {
- my $self = shift;
-
- my $hashref = { 'svcpart' => $self->svcpart };
-
- my( $addl_from, $extra_sql ) = ( '', '' );
- if ( @_ ) {
- my $pkgpart = shift;
- if ( $pkgpart =~ /^(\d+)$/ ) {
- $addl_from = 'LEFT JOIN cust_pkg USING ( pkgnum )';
- $extra_sql = "AND pkgpart = $1";
- } elsif ( $pkgpart eq '0' ) {
- $hashref->{'pkgnum'} = '';
- }
- }
-
- qsearch({
- 'table' => 'cust_svc',
- 'addl_from' => $addl_from,
- 'hashref' => $hashref,
- 'extra_sql' => $extra_sql,
- });
-}
-
-=item num_cust_svc [ PKGPART ]
-
-Returns the number of associated customer services (FS::cust_svc records).
-
-If a PKGPART is specified, returns the number of customer services which are
-contained within packages of that type (see L<FS::part_pkg>). If PKGPART
-is specified as B<0>, returns the number of unlinked customer services.
-
-=cut
-
-sub num_cust_svc {
- my $self = shift;
-
- my @param = ( $self->svcpart );
-
- my( $join, $and ) = ( '', '' );
- if ( @_ ) {
- my $pkgpart = shift;
- if ( $pkgpart ) {
- $join = 'LEFT JOIN cust_pkg USING ( pkgnum )';
- $and = 'AND pkgpart = ?';
- push @param, $pkgpart;
- } elsif ( $pkgpart eq '0' ) {
- $and = 'AND pkgnum IS NULL';
- }
- }
-
- my $sth = dbh->prepare(
- "SELECT COUNT(*) FROM cust_svc $join WHERE svcpart = ? $and"
- ) or die dbh->errstr;
- $sth->execute(@param)
- or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
-}
-
-=item svc_x
-
-Returns a list of associated FS::svc_* records.
-
-=cut
-
-sub svc_x {
- my $self = shift;
- map { $_->svc_x } $self->cust_svc;
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=cut
-
-my $svc_defs;
-sub _svc_defs {
-
- return $svc_defs if $svc_defs; #cache
-
- my $conf = new FS::Conf;
-
- #false laziness w/part_pkg.pm::plan_info
-
- my %info;
- foreach my $INC ( @INC ) {
- warn "globbing $INC/FS/svc_*.pm\n" if $DEBUG;
- foreach my $file ( glob("$INC/FS/svc_*.pm") ) {
-
- warn "attempting to load service table info from $file\n" if $DEBUG;
- $file =~ /\/(\w+)\.pm$/ or do {
- warn "unrecognized file in $INC/FS/: $file\n";
- next;
- };
- my $mod = $1;
-
- if ( $mod =~ /^svc_[A-Z]/ or $mod =~ /^svc_acct_pop$/ ) {
- warn "skipping FS::$mod" if $DEBUG;
- next;
- }
-
- eval "use FS::$mod;";
- if ( $@ ) {
- die "error using FS::$mod (skipping): $@\n" if $@;
- next;
- }
- unless ( UNIVERSAL::can("FS::$mod", 'table_info') ) {
- warn "FS::$mod has no table_info method; skipping";
- next;
- }
-
- my $info = "FS::$mod"->table_info;
- unless ( keys %$info ) {
- warn "FS::$mod->table_info doesn't return info, skipping\n";
- next;
- }
- warn "got info from FS::$mod: $info\n" if $DEBUG;
- if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
- warn "skipping disabled service FS::$mod" if $DEBUG;
- next;
- }
- $info{$mod} = $info;
- }
- }
-
- tie my %svc_defs, 'Tie::IxHash',
- map { $_ => $info{$_}->{'fields'} }
- sort { $info{$a}->{'display_weight'} <=> $info{$b}->{'display_weight'} }
- keys %info,
- ;
-
- # yuck. maybe this won't be so bad when virtual fields become real fields
- my %vfields;
- foreach my $svcdb (grep dbdef->table($_), keys %svc_defs ) {
- eval "use FS::$svcdb;";
- my $self = "FS::$svcdb"->new;
- $vfields{$svcdb} = {};
- foreach my $field ($self->virtual_fields) { # svc_Common::virtual_fields with a null svcpart returns all of them
- my $pvf = $self->pvf($field);
- my @list = $pvf->list;
- if (scalar @list) {
- $svc_defs{$svcdb}->{$field} = { desc => $pvf->label,
- type => 'select',
- select_list => \@list };
- } else {
- $svc_defs{$svcdb}->{$field} = $pvf->label;
- } #endif
- $vfields{$svcdb}->{$field} = $pvf;
- warn "\$vfields{$svcdb}->{$field} = $pvf"
- if $DEBUG;
- } #next $field
- } #next $svcdb
-
- $svc_defs = \%svc_defs; #cache
-
-}
-
-=item svc_tables
-
-Returns a list of all svc_ tables.
-
-=cut
-
-sub svc_tables {
- my $class = shift;
- my $svc_defs = $class->_svc_defs;
- grep { defined( dbdef->table($_) ) } keys %$svc_defs;
-}
-
-=item svc_table_fields TABLE
-
-Given a table name, returns a hashref of field names. The field names
-returned are those with additional (service-definition related) information,
-not necessarily all database fields of the table. Pseudo-fields may also
-be returned (i.e. svc_acct.usergroup).
-
-Each value of the hashref is another hashref, which can have one or more of
-the following keys:
-
-=over 4
-
-=item label - Description of the field
-
-=item def_label - Optional description of the field in the context of service definitions
-
-=item type - Currently "text", "select", "disabled", or "radius_usergroup_selector"
-
-=item disable_default - This field should not allow a default value in service definitions
-
-=item disable_fixed - This field should not allow a fixed value in service definitions
-
-=item disable_inventory - This field should not allow inventory values in service definitions
-
-=item select_list - If type is "text", this can be a listref of possible values.
-
-=item select_table - An alternative to select_list, this defines a database table with the possible choices.
-
-=item select_key - Used with select_table, this is the field name of keys
-
-=item select_label - Used with select_table, this is the field name of labels
-
-=back
-
-=cut
-
-#maybe this should move and be a class method in svc_Common.pm
-sub svc_table_fields {
- my($class, $table) = @_;
- my $svc_defs = $class->_svc_defs;
- my $def = $svc_defs->{$table};
-
- foreach ( grep !ref($def->{$_}), keys %$def ) {
-
- #normalize the shortcut in %info hash
- $def->{$_} = { 'label' => $def->{$_} };
-
- $def->{$_}{'type'} ||= 'text';
-
- }
-
- $def;
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item process
-
-Job-queue processor for web interface adds/edits
-
-=cut
-
-use Storable qw(thaw);
-use Data::Dumper;
-use MIME::Base64;
-sub process {
- my $job = shift;
-
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- my $old = qsearchs('part_svc', { 'svcpart' => $param->{'svcpart'} })
- if $param->{'svcpart'};
-
- $param->{'svc_acct__usergroup'} =
- 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->{$_};
- # } qw(svcpart svc svcdb)
- } ( fields('part_svc'),
- map { my $svcdb = $_;
- my @fields = fields($svcdb);
- push @fields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge
-
- map {
- my $f = $svcdb.'__'.$_;
- if ( $param->{ $f.'_flag' } =~ /^[MA]$/ ) {
- $param->{ $f } = delete( $param->{ $f.'_classnum' } );
- }
- if ( $param->{ $f.'_flag' } =~ /^S$/ ) {
- $param->{ $f } = ref($param->{ $f })
- ? join(',', @{$param->{ $f }} )
- : $param->{ $f };
- }
- ( $f, $f.'_flag', $f.'_label' );
- }
- @fields;
-
- } FS::part_svc->svc_tables()
- )
- } );
-
- my %exportnums =
- map { $_->exportnum => ( $param->{'exportnum'.$_->exportnum} || '') }
- qsearch('part_export', {} );
-
- my $error;
- if ( $param->{'svcpart'} ) {
- $error = $new->replace( $old,
- '1.3-COMPAT', #totally bunk, as jeff noted
- [ 'usergroup' ],
- \%exportnums,
- $job
- );
- } else {
- $error = $new->insert( [ 'usergroup' ],
- \%exportnums,
- $job,
- );
- $param->{'svcpart'} = $new->getfield('svcpart');
- }
-
- die "$error\n" if $error;
-}
-
-=item process_bulk_cust_svc
-
-Job-queue processor for web interface bulk customer service changes
-
-=cut
-
-use Storable qw(thaw);
-use Data::Dumper;
-use MIME::Base64;
-sub process_bulk_cust_svc {
- my $job = shift;
-
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- my $old_part_svc =
- qsearchs('part_svc', { 'svcpart' => $param->{'old_svcpart'} } );
-
- die "Must select a new service definition\n" unless $param->{'new_svcpart'};
-
- #the rest should be abstracted out to to its own subroutine?
-
- 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;
-
- local( $FS::cust_svc::ignore_quantity ) = 1;
-
- my $total = $old_part_svc->num_cust_svc( $param->{'pkgpart'} );
-
- my $n = 0;
- foreach my $old_cust_svc ( $old_part_svc->cust_svc( $param->{'pkgpart'} ) ) {
-
- my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
-
- $new_cust_svc->svcpart( $param->{'new_svcpart'} );
- my $error = $new_cust_svc->replace($old_cust_svc);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die "$error\n" if $error;
- }
-
- $error = $job->update_statustext( int( 100 * ++$n / $total ) );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- die $error if $error;
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=head1 BUGS
-
-Delete is unimplemented.
-
-The list of svc_* tables is no longer hardcoded, but svc_acct_pop is skipped
-as a special case until it is renamed.
-
-all_part_svc_column methods should be documented
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::part_svc_column>, L<FS::part_pkg>, L<FS::pkg_svc>,
-L<FS::cust_svc>, L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_svc_column.pm b/FS/FS/part_svc_column.pm
deleted file mode 100644
index f5b39c0..0000000
--- a/FS/FS/part_svc_column.pm
+++ /dev/null
@@ -1,123 +0,0 @@
-package FS::part_svc_column;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( fields );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::part_svc_column - Object methods for part_svc_column objects
-
-=head1 SYNOPSIS
-
- use FS::part_svc_column;
-
- $record = new FS::part_svc_column \%hash
- $record = new FS::part_svc_column { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_svc_column record represents a service definition column
-constraint. FS::part_svc_column inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item columnnum - primary key (assigned automatcially for new records)
-
-=item svcpart - service definition (see L<FS::part_svc>)
-
-=item columnname - column name in part_svc.svcdb table
-
-=item columnlabel - label for the column
-
-=item columnvalue - default or fixed value for the column
-
-=item columnflag - null or empty (no default), `D' for default, `F' for fixed (unchangeable), `S' for selectable choice, `M' for manual selection from inventory, or `A' for automatic selection from inventory. For virtual fields, can also be 'X' for excluded.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new column constraint. To add the column constraint to the database, see L<"insert">.
-
-=cut
-
-sub table { 'part_svc_column'; }
-
-=item insert
-
-Adds this service definition to the database. If there is an error, returns
-the error, otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('columnnum')
- || $self->ut_number('svcpart')
- || $self->ut_alpha('columnname')
- || $self->ut_textn('columnlabel')
- || $self->ut_anything('columnvalue')
- ;
- return $error if $error;
-
- $self->columnflag =~ /^([DFSMAX]?)$/
- or return "illegal columnflag ". $self->columnflag;
- $self->columnflag(uc($1));
-
- if ( $self->columnflag =~ /^[MA]$/ ) {
- $error =
- $self->ut_foreign_key( 'columnvalue', 'inventory_class', 'classnum' );
- return $error if $error;
- }
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::part_svc>, L<FS::part_pkg>, L<FS::pkg_svc>,
-L<FS::cust_svc>, L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_svc_router.pm b/FS/FS/part_svc_router.pm
deleted file mode 100755
index df04cc9..0000000
--- a/FS/FS/part_svc_router.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FS::part_svc_router;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw(qsearchs);
-use FS::router;
-use FS::part_svc;
-
-@ISA = qw(FS::Record);
-
-sub table { 'part_svc_router'; }
-
-sub check {
- my $self = shift;
- my $error =
- $self->ut_numbern('svcrouternum')
- || $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart')
- || $self->ut_foreign_key('routernum', 'router', 'routernum');
- return $error if $error;
- ''; #no error
-}
-
-sub router {
- my $self = shift;
- return qsearchs('router', { routernum => $self->routernum });
-}
-
-sub part_svc {
- my $self = shift;
- return qsearchs('part_svc', { svcpart => $self->svcpart });
-}
-
-1;
diff --git a/FS/FS/part_tag.pm b/FS/FS/part_tag.pm
deleted file mode 100644
index 0229e3a..0000000
--- a/FS/FS/part_tag.pm
+++ /dev/null
@@ -1,132 +0,0 @@
-package FS::part_tag;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::part_tag - Object methods for part_tag records
-
-=head1 SYNOPSIS
-
- use FS::part_tag;
-
- $record = new FS::part_tag \%hash;
- $record = new FS::part_tag { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_tag object represents a tag. FS::part_tag inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item tagnum
-
-primary key
-
-=item tagname
-
-tagname
-
-=item tagdesc
-
-tagdesc
-
-=item tagcolor
-
-tagcolor
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new tag. To add the tag 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 { 'part_tag'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid tag. 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('tagnum')
- || $self->ut_text('tagname')
- || $self->ut_textn('tagdesc')
- || $self->ut_textn('tagcolor')
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/part_virtual_field.pm b/FS/FS/part_virtual_field.pm
deleted file mode 100755
index f5a4161..0000000
--- a/FS/FS/part_virtual_field.pm
+++ /dev/null
@@ -1,301 +0,0 @@
-package FS::part_virtual_field;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record;
-use FS::Schema qw( dbdef );
-use CGI qw(escapeHTML);
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::part_virtual_field - Object methods for part_virtual_field records
-
-=head1 SYNOPSIS
-
- use FS::part_virtual_field;
-
- $record = new FS::part_virtual_field \%hash;
- $record = new FS::part_virtual_field { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_virtual_field object represents the definition of a virtual field
-(see the BACKGROUND section). FS::part_virtual_field contains the name and
-base table of the field, as well as validation rules and UI hints about the
-display of the field. The actual data is stored in FS::virtual_field; see
-its manpage for details.
-
-FS::part_virtual_field inherits from FS::Record. The following fields are
-currently supported:
-
-=over 2
-
-=item vfieldpart - primary key (assigned automatically)
-
-=item name - name of the field
-
-=item dbtable - table for which this virtual field is defined
-
-=item check_block - Perl code to validate/normalize data
-
-=item list_source - Perl code to generate a list of values (UI hint)
-
-=item length - expected length of the value (UI hint)
-
-=item label - descriptive label for the field (UI hint)
-
-=item sequence - sort key (UI hint; unimplemented)
-
-=back
-
-=head1 BACKGROUND
-
-"Form is none other than emptiness,
- and emptiness is none other than form."
--- Heart Sutra
-
-The virtual field mechanism allows site admins to make trivial changes to
-the Freeside database schema without modifying the code. Specifically, the
-user can add custom-defined 'fields' to the set of data tracked by Freeside
-about objects such as customers and services. These fields are not associated
-with any logic in the core Freeside system, but may be referenced in peripheral
-code such as exports, price calculations, or alternate interfaces, or may just
-be stored in the database for future reference.
-
-This system was originally devised for svc_broadband, which (by necessity)
-comprises such a wide range of access technologies that no static set of fields
-could contain all the information needed by the exports. In an appalling
-display of False Laziness, a parallel mechanism was implemented for the
-router table, to store properties such as passwords to configure routers.
-
-The original system treated svc_broadband custom fields (sb_fields) as records
-in a completely separate table. Any code that accessed or manipulated these
-fields had to be aware that they were I<not> fields in svc_broadband, but
-records in sb_field. For example, code that inserted a svc_broadband with
-several custom fields had to create an FS::svc_broadband object, call its
-insert() method, and then create several FS::sb_field objects and call I<their>
-insert() methods.
-
-This created a problem for exports. The insert method on any FS::svc_Common
-object (including svc_broadband) automatically triggers exports after the
-record has been inserted. However, at this point, the sb_fields had not yet
-been inserted, so the export could not rely on their presence, which was the
-original purpose of sb_fields.
-
-Hence the new system. Virtual fields are appended to the field list of every
-record at the FS::Record level, whether the object is created ex nihilo with
-new() or fetched with qsearch(). The fields() method now returns a list of
-both real and virtual fields. The insert(), replace(), and delete() methods
-now update both the base table and the virtual fields, in a single transaction.
-
-A new method is provided, virtual_fields(), which gives only the virtual
-fields. UI code that dynamically generates form widgets to edit virtual field
-data should use this to figure out what fields are defined. (See below.)
-
-Subclasses may override virtual_fields() to restrict the set of virtual
-fields available. Some discipline and sanity on the part of the programmer
-are required; in particular, this function should probably not depend on any
-fields in the record other than the primary key, since the others may change
-after the object is instantiated. (Making it depend on I<virtual> fields is
-just asking for pain.) One use of this is seen in FS::svc_Common; another
-possibility is field-level access control based on FS::UID::getotaker().
-
-As a trivial case, a subclass may opt out of supporting virtual fields with
-the following code:
-
-sub virtual_fields { () }
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Create a new record. To add the record to the database, see "insert".
-
-=cut
-
-sub table { 'part_virtual_field'; }
-sub virtual_fields { () }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-If there is an error, returns the error, otherwise returns false.
-Called by the insert and replace methods.
-
-=back
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error = $self->ut_text('name') ||
- $self->ut_text('dbtable') ||
- $self->ut_number('length')
- ;
- return $error if $error;
-
- # Make sure it's a real table with a numeric primary key
- my ($table, $pkey);
- if($table = dbdef->table($self->dbtable)) {
- if($pkey = $table->primary_key) {
- if($table->column($pkey)->type =~ /int/i) {
- # this is what it should be
- } else {
- $error = "$table.$pkey is not an integer";
- }
- } else {
- $error = "$table does not have a single-field primary key";
- }
- } else {
- $error = "$table does not exist in the schema";
- }
- return $error if $error;
-
- # Possibly some sanity checks for check_block and list_source?
-
- $self->SUPER::check;
-}
-
-=item list
-
-Evaluates list_source.
-
-=cut
-
-sub list {
- my $self = shift;
- return () unless $self->list_source;
-
- my @opts = eval($self->list_source);
- if($@) {
- warn $@;
- return ();
- } else {
- return @opts;
- }
-}
-
-=item widget UI_TYPE MODE [ VALUE ]
-
-Generates UI code for a widget suitable for editing/viewing the field, based on
-list_source and length.
-
-The only UI_TYPE currently supported is 'HTML', and the only MODE is 'view'.
-Others will be added later.
-
-In HTML, all widgets are assumed to be table rows. View widgets look like
-<TR><TD ALIGN="right">Label</TD><TD BGCOLOR="#ffffff">Value</TD></TR>
-
-(Most of the display style stuff, such as the colors, should probably go into
-a separate module specific to the UI. That can wait, though. The API for
-this function won't change.)
-
-VALUE (optional) is the current value of the field.
-
-=cut
-
-sub widget {
- my $self = shift;
- my ($ui_type, $mode, $value) = @_;
- my $text;
- my $label = $self->label || $self->name;
-
- if ($ui_type eq 'HTML') {
- if ($mode eq 'view') {
- $text = q!<TR><TD ALIGN="right">! . $label .
- q!</TD><TD BGCOLOR="#ffffff">! . $value .
- q!</TD></TR>! . "\n";
- } elsif ($mode eq 'edit') {
- $text = q!<TR><TD ALIGN="right">! . $label .
- q!</TD><TD>!;
- if ($self->list_source) {
- $text .= q!<SELECT NAME="! . $self->name .
- q!" SIZE=1>! . "\n";
- foreach ($self->list) {
- $text .= q!<OPTION VALUE="! . $_ . q!"!;
- $text .= ' SELECTED' if ($_ eq $value);
- $text .= '>' . $_ . '</OPTION>' . "\n";
- }
- } else {
- $text .= q!<INPUT NAME="! . $self->name .
- q!" VALUE="! . escapeHTML($value) . q!"!;
- if ($self->length) {
- $text .= q! SIZE="! . $self->length . q!"!;
- }
- $text .= '>';
- }
- $text .= q!</TD></TR>! . "\n";
- } else {
- return '';
- }
- } else {
- return '';
- }
- return $text;
-}
-
-=head1 NOTES
-
-=head2 Semantics of check_block:
-
-This has been changed from the sb_field implementation to make check_blocks
-simpler and more natural to Perl programmers who work on things other than
-Freeside.
-
-The check_block is eval'd with the (proposed) new value of the field in $_,
-and the object to be updated in $self. Its return value is ignored. The
-check_block may change the value of $_ to override the proposed value, or
-call die() (with an appropriate error message) to reject the update entirely;
-the error string will be returned as the output of the check() method.
-
-This makes check_blocks like
-
-C<s/foo/bar/>
-
-do what you expect.
-
-The check_block is expected NOT to do anything freaky to $self, like modifying
-other fields or calling $self->check(). You have been warned.
-
-(FIXME: Rewrite some of the warnings from part_sb_field and insert here.)
-
-=head1 BUGS
-
-None. It's absolutely falwless.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::virtual_field>
-
-=cut
-
-1;
-
-
diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm
deleted file mode 100644
index 5cd40cd..0000000
--- a/FS/FS/pay_batch.pm
+++ /dev/null
@@ -1,589 +0,0 @@
-package FS::pay_batch;
-
-use strict;
-use vars qw( @ISA $DEBUG %import_info %export_info $conf );
-use Time::Local;
-use Text::CSV_XS;
-use FS::Record qw( dbh qsearch qsearchs );
-use FS::cust_pay;
-use FS::Conf;
-use Date::Parse qw(str2time);
-use Business::CreditCard qw(cardtype);
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::pay_batch - Object methods for pay_batch records
-
-=head1 SYNOPSIS
-
- use FS::pay_batch;
-
- $record = new FS::pay_batch \%hash;
- $record = new FS::pay_batch { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::pay_batch object represents an payment batch. FS::pay_batch inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item batchnum - primary key
-
-=item payby - CARD or CHEK
-
-=item status - O (Open), I (In-transit), or R (Resolved)
-
-=item download -
-
-=item upload -
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new batch. To add the batch 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 { 'pay_batch'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid batch. 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('batchnum')
- || $self->ut_enum('payby', [ 'CARD', 'CHEK' ])
- || $self->ut_enum('status', [ 'O', 'I', 'R' ])
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item rebalance
-
-=cut
-
-sub rebalance {
- my $self = shift;
-}
-
-=item set_status
-
-=cut
-
-sub set_status {
- my $self = shift;
- $self->status(shift);
- $self->download(time)
- if $self->status eq 'I' && ! $self->download;
- $self->upload(time)
- if $self->status eq 'R' && ! $self->upload;
- $self->replace();
-}
-
-# further false laziness
-
-%import_info = %export_info = ();
-foreach my $INC (@INC) {
- warn "globbing $INC/FS/pay_batch/*.pm\n" if $DEBUG;
- foreach my $file ( glob("$INC/FS/pay_batch/*.pm")) {
- warn "attempting to load batch format from $file\n" if $DEBUG;
- $file =~ /\/(\w+)\.pm$/;
- next if !$1;
- my $mod = $1;
- my ($import, $export, $name) =
- eval "use FS::pay_batch::$mod;
- ( \\%FS::pay_batch::$mod\::import_info,
- \\%FS::pay_batch::$mod\::export_info,
- \$FS::pay_batch::$mod\::name)";
- $name ||= $mod; # in case it's not defined
- if( $@) {
- # in FS::cdr this is a die, not a warn. That's probably a bug.
- warn "error using FS::pay_batch::$mod (skipping): $@\n";
- next;
- }
- if(!keys(%$import)) {
- warn "no \%import_info found in FS::pay_batch::$mod (skipping)\n";
- }
- else {
- $import_info{$name} = $import;
- }
- if(!keys(%$export)) {
- warn "no \%export_info found in FS::pay_batch::$mod (skipping)\n";
- }
- else {
- $export_info{$name} = $export;
- }
- }
-}
-
-=item import_results OPTION => VALUE, ...
-
-Import batch results.
-
-Options are:
-
-I<filehandle> - open filehandle of results file.
-
-I<format> - "csv-td_canada_trust-merchant_pc_batch", "csv-chase_canada-E-xactBatch", "ach-spiritone", or "PAP"
-
-=cut
-
-sub import_results {
- my $self = shift;
-
- my $param = ref($_[0]) ? shift : { @_ };
- my $fh = $param->{'filehandle'};
- my $format = $param->{'format'};
- my $info = $import_info{$format}
- or die "unknown format $format";
-
- my $job = $param->{'job'};
- $job->update_statustext(0) if $job;
-
- my $conf = new FS::Conf;
-
- my $filetype = $info->{'filetype'}; # CSV, fixed, variable
- my @fields = @{ $info->{'fields'}};
- my $formatre = $info->{'formatre'}; # for fixed
- my $parse = $info->{'parse'}; # for variable
- my @all_values;
- my $begin_condition = $info->{'begin_condition'};
- my $end_condition = $info->{'end_condition'};
- my $end_hook = $info->{'end_hook'};
- my $skip_condition = $info->{'skip_condition'};
- my $hook = $info->{'hook'};
- my $approved_condition = $info->{'approved'};
- my $declined_condition = $info->{'declined'};
- my $close_condition = $info->{'close_condition'};
-
- my $csv = new Text::CSV_XS;
-
- 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 $reself = $self->select_for_update;
-
- unless ( $reself->status eq 'I' ) {
- $dbh->rollback if $oldAutoCommit;
- return "batchnum ". $self->batchnum. "no longer in transit";
- }
-
- my $error = $self->set_status('R');
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- my $total = 0;
- my $line;
-
- # Order of operations has been changed here.
- # We now slurp everything into @all_values, then
- # process one line at a time.
-
- if ($filetype eq 'XML') {
- eval "use XML::Simple";
- die $@ if $@;
- my @xmlkeys = @{ $info->{'xmlkeys'} }; # for XML
- my $xmlrow = $info->{'xmlrow'}; # also for XML
-
- # Do everything differently.
- my $data = XML::Simple::XMLin($fh, KeepRoot => 1);
- my $rows = $data;
- # $xmlrow = [ RootKey, FirstLevelKey, SecondLevelKey... ]
- $rows = $rows->{$_} foreach( @$xmlrow );
- if(!defined($rows)) {
- $dbh->rollback if $oldAutoCommit;
- return "can't find rows in XML file";
- }
- $rows = [ $rows ] if ref($rows) ne 'ARRAY';
- foreach my $row (@$rows) {
- push @all_values, [ @{$row}{@xmlkeys}, $row ];
- }
- }
- else {
- while ( defined($line=<$fh>) ) {
-
- next if $line =~ /^\s*$/; #skip blank lines
-
- if ($filetype eq "CSV") {
- $csv->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $csv->error_input();
- };
- push @all_values, [ $csv->fields(), $line ];
- }elsif ($filetype eq 'fixed'){
- my @values = ( $line =~ /$formatre/ );
- unless (@values) {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $line;
- };
- push @values, $line;
- push @all_values, \@values;
- }
- elsif ($filetype eq 'variable') {
- my @values = ( eval { $parse->($self, $line) } );
- if( $@ ) {
- $dbh->rollback if $oldAutoCommit;
- return $@;
- };
- push @values, $line;
- push @all_values, \@values;
- }
- else {
- $dbh->rollback if $oldAutoCommit;
- return "Unknown file type $filetype";
- }
- }
- }
-
- my $num = 0;
- foreach (@all_values) {
- if($job) {
- $num++;
- $job->update_statustext(int(100 * $num/scalar(@all_values)));
- }
- my @values = @$_;
-
- my %hash;
- my $line = pop @values;
- foreach my $field ( @fields ) {
- my $value = shift @values;
- next unless $field;
- $hash{$field} = $value;
- }
-
- if ( defined($begin_condition) ) {
- if ( &{$begin_condition}(\%hash, $line) ) {
- undef $begin_condition;
- }
- else {
- next;
- }
- }
-
- if ( defined($end_condition) and &{$end_condition}(\%hash, $line) ) {
- my $error;
- $error = &{$end_hook}(\%hash, $total, $line) if defined($end_hook);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- last;
- }
-
- if ( defined($skip_condition) and &{$skip_condition}(\%hash, $line) ) {
- next;
- }
-
- my $cust_pay_batch =
- qsearchs('cust_pay_batch', { 'paybatchnum' => $hash{'paybatchnum'}+0 } );
- unless ( $cust_pay_batch ) {
- return "unknown paybatchnum $hash{'paybatchnum'}\n";
- }
- my $custnum = $cust_pay_batch->custnum,
- my $payby = $cust_pay_batch->payby,
-
- my $new_cust_pay_batch = new FS::cust_pay_batch { $cust_pay_batch->hash };
-
- &{$hook}(\%hash, $cust_pay_batch->hashref);
-
- my $error = '';
- if ( &{$approved_condition}(\%hash) ) {
-
- $error = $new_cust_pay_batch->approve($hash{'paybatch'} || $self->batchnum);
- $total += $hash{'paid'};
-
- } elsif ( &{$declined_condition}(\%hash) ) {
-
- $error = $new_cust_pay_batch->decline;
-
- }
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- # purge CVV when the batch is processed
- if ( $payby =~ /^(CARD|DCRD)$/ ) {
- my $payinfo = $hash{'payinfo'} || $cust_pay_batch->payinfo;
- if ( ! grep { $_ eq cardtype($payinfo) }
- $conf->config('cvv-save') ) {
- $new_cust_pay_batch->cust_main->remove_cvv;
- }
-
- }
-
- } # foreach (@all_values)
-
- if ( defined($close_condition) ) {
- # Allow the module to decide whether to close the batch.
- # $close_condition can also die() to abort the whole import.
- my $close = eval { $close_condition->($self) };
- if ( $@ ) {
- $dbh->rollback;
- die $@;
- }
- $self->set_status('I') if !$close;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-use MIME::Base64;
-use Storable 'thaw';
-use Data::Dumper;
-sub process_import_results {
- my $job = shift;
- my $param = thaw(decode_base64(shift));
- $param->{'job'} = $job;
- warn Dumper($param) if $DEBUG;
- my $batchnum = delete $param->{'batchnum'} or die "no batchnum specified\n";
- my $batch = FS::pay_batch->by_key($batchnum) or die "batchnum '$batchnum' not found\n";
-
- my $file = $param->{'uploaded_files'} or die "no files provided\n";
- $file =~ s/^(\w+):([\.\w]+)$/$2/;
- my $dir = '%%%FREESIDE_CACHE%%%/cache.' . $FS::UID::datasrc;
- open( $param->{'filehandle'},
- '<',
- "$dir/$file" )
- or die "unable to open '$file'.\n";
- my $error = $batch->import_results($param);
- unlink $file;
- die $error if $error;
-}
-
-# Formerly httemplate/misc/download-batch.cgi
-sub export_batch {
- my $self = shift;
- my $conf = new FS::Conf;
- my $format = shift || $conf->config('batch-default_format')
- or die "No batch format configured\n";
- my $info = $export_info{$format} or die "Format not found: '$format'\n";
- &{$info->{'init'}}($conf) if exists($info->{'init'});
-
- my $curuser = $FS::CurrentUser::CurrentUser;
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $first_download;
- my $status = $self->status;
- if ($status eq 'O') {
- $first_download = 1;
- my $error = $self->set_status('I');
- die "error updating pay_batch status: $error\n" if $error;
- } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) {
- $first_download = 0;
- } else {
- die "No pending batch.\n";
- }
-
- my $batch = '';
- my $batchtotal = 0;
- my $batchcount = 0;
-
- my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum }
- qsearch('cust_pay_batch', { batchnum => $self->batchnum } );
-
- # handle batch-increment_expiration option
- if ( $self->payby eq 'CARD' ) {
- my ($cmon, $cyear) = (localtime(time))[4,5];
- foreach (@cust_pay_batch) {
- my $etime = str2time($_->exp) or next;
- my ($day, $mon, $year) = (localtime($etime))[3,4,5];
- if( $conf->exists('batch-increment_expiration') ) {
- $year++ while( $year < $cyear or ($year == $cyear and $mon <= $cmon) );
- $_->exp( sprintf('%4u-%02u-%02u', $year + 1900, $mon+1, $day) );
- }
- $_->setfield('expmmyy', sprintf('%02u%02u', $mon+1, $year % 100));
- }
- }
- my $h = $info->{'header'};
- if(ref($h) eq 'CODE') {
- $batch .= &$h($self, \@cust_pay_batch) . "\n";
- }
- else {
- $batch .= $h . "\n";
- }
- foreach my $cust_pay_batch (@cust_pay_batch) {
-
- if ($first_download) {
- my $balance = $cust_pay_batch->cust_main->balance;
- if ($balance <= 0) { # then don't charge this customer
- my $error = $cust_pay_batch->delete;
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
- next;
- } elsif ($balance < $cust_pay_batch->amount) {
- # reduce the charge to the remaining balance
- $cust_pay_batch->amount($balance);
- my $error = $cust_pay_batch->replace;
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
- }
- # else $balance >= $cust_pay_batch->amount
- }
-
- $batchcount++;
- $batchtotal += $cust_pay_batch->amount;
- $batch .= &{$info->{'row'}}($cust_pay_batch, $self, $batchcount, $batchtotal) . "\n";
-
- }
-
- my $f = $info->{'footer'};
- if(ref($f) eq 'CODE') {
- $batch .= &$f($self, $batchcount, $batchtotal) . "\n";
- }
- else {
- $batch .= $f . "\n";
- }
-
- if ($info->{'autopost'}) {
- my $error = &{$info->{'autopost'}}($self, $batch);
- if($error) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return $batch;
-}
-
-sub manual_approve {
- my $self = shift;
- my $date = time;
- my %opt = @_;
- my $paybatch = $opt{'paybatch'} || $self->batchnum;
- my $conf = FS::Conf->new;
- return 'manual batch approval disabled'
- if ( ! $conf->exists('batch-manual_approval') );
- return 'batch already resolved' if $self->status eq 'R';
- return 'batch not yet submitted' if $self->status eq 'O';
-
- 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 $payments = 0;
- foreach my $cust_pay_batch (
- qsearch('cust_pay_batch', { batchnum => $self->batchnum,
- status => '' })
- ) {
- my $new_cust_pay_batch = new FS::cust_pay_batch {
- $cust_pay_batch->hash,
- 'paid' => $cust_pay_batch->amount,
- '_date' => $date,
- };
- my $error = $new_cust_pay_batch->approve($paybatch);
- if ( $error ) {
- $dbh->rollback;
- return 'paybatchnum '.$cust_pay_batch->paybatchnum.": $error";
- }
- $payments++;
- }
- return 'no unresolved payments in batch' if $payments == 0;
- $self->set_status('R');
-
- $dbh->commit;
- return;
-}
-
-=back
-
-=head1 BUGS
-
-status is somewhat redundant now that download and upload exist
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/pay_batch/BoM.pm b/FS/FS/pay_batch/BoM.pm
deleted file mode 100644
index 7bfc22a..0000000
--- a/FS/FS/pay_batch/BoM.pm
+++ /dev/null
@@ -1,73 +0,0 @@
-package FS::pay_batch::BoM;
-
-use strict;
-use vars qw(@ISA %import_info %export_info $name);
-use Time::Local 'timelocal';
-use FS::Conf;
-
-my $conf;
-my ($origid, $datacenter, $typecode, $shortname, $longname, $mybank, $myacct);
-
-$name = 'BoM';
-
-%import_info = (
- 'filetype' => 'CSV',
- 'fields' => [],
- 'hook' => sub { die "Can't import BoM" },
- 'approved' => sub { 1 },
- 'declined' => sub { 0 },
-);
-
-%export_info = (
- init => sub {
- $conf = shift;
- ($origid,
- $datacenter,
- $typecode,
- $shortname,
- $longname,
- $mybank,
- $myacct) = $conf->config("batchconfig-BoM");
- },
- header => sub {
- my $pay_batch = shift;
- sprintf( "A%10s%04u%06u%05u%54s\n",
- $origid,
- $pay_batch->batchnum,
- jdate($pay_batch->download),
- $datacenter,
- "") .
- sprintf( "XD%03u%06u%-15s%-30s%09u%-12s \n",
- $typecode,
- jdate($pay_batch->download),
- $shortname,
- $longname,
- $mybank,
- $myacct);
- },
- row => sub {
- my ($cust_pay_batch, $pay_batch) = @_;
- my ($account, $aba) = split('@', $cust_pay_batch->payinfo);
- sprintf( "D%010.0f%09u%-12s%-29s%-19s\n",
- $cust_pay_batch->amount * 100,
- $aba,
- $account,
- $cust_pay_batch->payname,
- $cust_pay_batch->paybatchnum
- );
- },
- footer => sub {
- my ($pay_batch, $batchcount, $batchtotal) = @_;
- sprintf( "YD%08u%014.0f%56s\n", $batchcount, $batchtotal*100, "").
- sprintf( "Z%014u%04u%014u%05u%41s\n",
- $batchtotal*100, $batchcount, "0", "0", "");
- },
-);
-
-sub jdate {
- my (@date) = localtime(shift);
- sprintf("%03d%03d", $date[5] % 100, $date[7] + 1);
-}
-
-1;
-
diff --git a/FS/FS/pay_batch/PAP.pm b/FS/FS/pay_batch/PAP.pm
deleted file mode 100644
index 432ef07..0000000
--- a/FS/FS/pay_batch/PAP.pm
+++ /dev/null
@@ -1,103 +0,0 @@
-package FS::pay_batch::PAP;
-
-use strict;
-use vars qw(@ISA %import_info %export_info $name);
-use Time::Local 'timelocal';
-use FS::Conf;
-
-my $conf;
-my ($origid, $datacenter, $typecode, $shortname, $longname, $mybank, $myacct);
-
-$name = 'PAP';
-
-%import_info = (
- 'filetype' => 'fixed',
- 'formatre' => '^(.).{19}(.{4})(.{3})(.{10})(.{6})(.{9})(.{12}).{110}(.{19}).{71}$',
- 'fields' => [
- 'recordtype',
- 'batchnum',
- 'datacenter',
- 'paid',
- '_date',
- 'bank',
- 'payinfo',
- 'paybatchnum',
- ],
- 'hook' => sub {
- my $hash = shift;
- $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 );
- my $tmpdate = timelocal( 0,0,1,1,0,substr($hash->{'_date'}, 0, 3)+2000);
- $tmpdate += 86400*(substr($hash->{'_date'}, 3, 3)-1) ;
- $hash->{'_date'} = $tmpdate;
- $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'bank'};
- },
- 'approved' => sub { 1 },
- 'declined' => sub { 0 },
-# Why does pay_batch.pm have approved_condition and declined_condition?
-# It doesn't even try to handle the case of neither condition being met.
- 'end_hook' => sub {
- my( $hash, $total) = @_;
- $total = sprintf("%.2f", $total);
- my $batch_total = $hash->{'datacenter'}.$hash->{'paid'}.
- substr($hash->{'_date'},0,1); # YUCK!
- $batch_total = sprintf("%.2f", $batch_total / 100 );
- return "Our total $total does not match bank total $batch_total!"
- if $total != $batch_total;
- '';
- },
- 'end_condition' => sub {
- my $hash = shift;
- $hash->{recordtype} eq 'W';
- },
-);
-
-%export_info = (
- init => sub {
- $conf = shift;
- ($origid,
- $datacenter,
- $typecode,
- $shortname,
- $longname,
- $mybank,
- $myacct) = $conf->config("batchconfig-PAP");
- },
- header => sub {
- my $pay_batch = shift;
- sprintf( "H%10sD%3s%06u%-15s%09u%-12s%04u%19s\n",
- $origid,
- $typecode,
- cdate($pay_batch->download),
- $shortname,
- $mybank,
- $myacct,
- $pay_batch->batchnum,
- "" )
- },
- row => sub {
- my ($cust_pay_batch, $pay_batch) = @_;
- my ($account, $aba) = split('@', $cust_pay_batch->payinfo);
- sprintf( "D%-23s%06u%-19s%09u%-12s%010.0f\n",
- $cust_pay_batch->payname,
- cdate($pay_batch->download),
- $cust_pay_batch->paybatchnum,
- $aba,
- $account,
- $cust_pay_batch->amount*100 );
- },
- footer => sub {
- my ($pay_batch, $batchcount, $batchtotal) = @_;
- sprintf( "T%08u%014.0f%57s\n",
- $batchcount,
- $batchtotal*100,
- "" );
- },
-);
-
-sub cdate {
- my (@date) = localtime(shift);
- sprintf("%02d%02d%02d", $date[3], $date[4] + 1, $date[5] % 100);
-}
-
-1;
-
diff --git a/FS/FS/pay_batch/RBC.pm b/FS/FS/pay_batch/RBC.pm
deleted file mode 100644
index 6ee5771..0000000
--- a/FS/FS/pay_batch/RBC.pm
+++ /dev/null
@@ -1,143 +0,0 @@
-package FS::pay_batch::RBC;
-
-use strict;
-use vars qw(@ISA %import_info %export_info $name);
-use Date::Format 'time2str';
-use FS::Conf;
-
-my $conf;
-my ($client_num, $shortname, $longname, $trans_code, $i);
-
-$name = 'RBC';
-# Royal Bank of Canada ACH Direct Payments Service
-
-%import_info = (
- 'filetype' => 'fixed',
- 'formatre' =>
- '^(.).{18}(.{4}).{3}(.).{11}(.{19}).{6}(.{30}).{17}(.{9})(.{18}).{6}(.{14}).{23}(.).{9}\r?$',
- 'fields' => [ qw(
- recordtype
- batchnum
- subtype
- paybatchnum
- custname
- bank
- payinfo
- paid
- status
- ) ],
- 'hook' => sub {
- my $hash = shift;
- $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 );
- $hash->{'_date'} = time;
- $hash->{'payinfo'} =~ s/^(\S+).*/$1/; # these often have trailing spaces
- $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'bank'};
- },
- 'approved' => sub {
- my $hash = shift;
- $hash->{'status'} eq ' '
- },
- 'declined' => sub {
- my $hash = shift;
- grep { $hash->{'status'} eq $_ } ('E', 'R', 'U', 'T');
- },
- 'begin_condition' => sub {
- my $hash = shift;
- $hash->{recordtype} eq '1'; # Detail Record
- },
- 'end_hook' => sub {
- my( $hash, $total, $line ) = @_;
- $total = sprintf("%.2f", $total);
- # We assume here that this is an 'All Records' or 'Input Records'
- # report.
- my $batch_total = sprintf("%.2f", substr($line, 59, 18) / 100);
- return "Our total $total does not match bank total $batch_total!"
- if $total != $batch_total;
- '';
- },
- 'end_condition' => sub {
- my $hash = shift;
- $hash->{recordtype} eq '4'; # Client Trailer Record
- },
- 'skip_condition' => sub {
- my $hash = shift;
- $hash->{'subtype'} ne '0';
- },
-);
-
-%export_info = (
- init => sub {
- $conf = shift;
- ($client_num,
- $shortname,
- $longname,
- $trans_code,
- ) = $conf->config("batchconfig-RBC");
- $i = 1;
- },
- header => sub {
- my $pay_batch = shift;
- '$$AAPASTD0152[PROD[NL$$'."\n".
- '000001'.
- 'A'.
- 'HDR'.
- sprintf("%10s", $client_num).
- sprintf("%-30s", $longname).
- sprintf("%04u", $pay_batch->batchnum).
- time2str("%Y%j", $pay_batch->download).
- 'CAD'.
- '1'.
- ' ' x 87 # filler/reserved fields
- ;
- },
- row => sub {
- my ($cust_pay_batch, $pay_batch) = @_;
- my ($account, $aba) = split('@', $cust_pay_batch->payinfo);
- $i++;
- sprintf("%06u", $i).
- 'D'.
- sprintf("%3s",$trans_code).
- sprintf("%10s",$client_num).
- ' '.
- sprintf("%-19s", $cust_pay_batch->paybatchnum).
- '00'.
- sprintf("%09u", $aba).
- sprintf("%-18s", $account).
- ' '.
- sprintf("%010.0f",$cust_pay_batch->amount*100).
- ' '.
- time2str("%Y%j", $pay_batch->download).
- sprintf("%-30s", $cust_pay_batch->cust_main->first . ' ' .
- $cust_pay_batch->cust_main->last).
- 'E'. # English
- ' '.
- sprintf("%-15s", $shortname).
- 'CAD'.
- ' '.
- 'CAN'.
- ' '.
- 'N' # no customer optional information follows
- ;
-# Note: IAT Address Information and Remittance records are not
-# supported. This means you probably can't process payments
-# destined to U.S. bank accounts. If you need this feature, contact
-# Freeside Internet Services.
- },
- footer => sub {
- my ($pay_batch, $batchcount, $batchtotal) = @_;
- sprintf("%06u", $i + 1).
- 'Z'.
- 'TRL'.
- sprintf("%10s", $client_num).
- ' ' x 20 .
- sprintf("%06u", $batchcount).
- sprintf("%014.0f", $batchtotal*100).
- '00' .
- '000000' . # total number of customer information records
- ' ' x 84
- ;
- },
-);
-
-1;
-
diff --git a/FS/FS/pay_batch/ach_spiritone.pm b/FS/FS/pay_batch/ach_spiritone.pm
deleted file mode 100644
index bd3bb14..0000000
--- a/FS/FS/pay_batch/ach_spiritone.pm
+++ /dev/null
@@ -1,65 +0,0 @@
-package FS::pay_batch::ach_spiritone;
-
-use strict;
-use vars qw(@ISA %import_info %export_info $name);
-use Time::Local 'timelocal';
-use FS::Conf;
-use File::Temp;
-
-my $conf;
-my ($origid, $datacenter, $typecode, $shortname, $longname, $mybank, $myacct);
-
-$name = 'ach-spiritone'; # note spelling
-
-%import_info = (
- 'filetype' => 'CSV',
- 'fields' => [
- '', #name
- 'paybatchnum',
- 'aba',
- 'payinfo',
- '', #transaction type
- 'paid',
- '', #default transaction type
- '', #default amount
- ],
- 'hook' => sub {
- my $hash = shift;
- $hash->{'_date'} = time;
- $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'aba'};
- },
- 'approved' => sub { 1 },
- 'declined' => sub { 0 },
-);
-
-%export_info = (
-# This is the simplest case.
- row => sub {
- my ($cust_pay_batch, $pay_batch) = @_;
- my ($account, $aba) = split('@', $cust_pay_batch->payinfo);
- my $payname = $cust_pay_batch->first . ' ' . $cust_pay_batch->last;
- $payname =~ tr/",/ /;
- qq!"$payname","!.$cust_pay_batch->paybatchnum.
- qq!","$aba","$account","27","!.$cust_pay_batch->amount.
- qq!","27","0.00"!; #"
- },
- autopost => sub {
- my ($pay_batch, $batch) = @_;
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- my $fh = new File::Temp(
- TEMPLATE => 'paybatch.'. $pay_batch->batchnum .'.XXXXXXXX',
- DIR => $dir,
- ) or return "can't open temp file: $!\n";
-
- print $fh $batch;
- seek $fh, 0, 0;
-
- my $error = $pay_batch->import_results( 'filehandle' => $fh,
- 'format' => $name,
- );
- return $error if $error;
- },
-);
-
-1;
-
diff --git a/FS/FS/pay_batch/chase_canada.pm b/FS/FS/pay_batch/chase_canada.pm
deleted file mode 100644
index 5d8437d..0000000
--- a/FS/FS/pay_batch/chase_canada.pm
+++ /dev/null
@@ -1,89 +0,0 @@
-package FS::pay_batch::chase_canada;
-
-use strict;
-use vars qw(@ISA %import_info %export_info $name);
-use Time::Local 'timelocal';
-use FS::Conf;
-
-my $conf;
-my $origid;
-
-$name = 'csv-chase_canada-E-xactBatch';
-
-%import_info = (
- 'filetype' => 'CSV',
- 'fields' => [
- '',
- '',
- '',
- 'paid',
- 'auth',
- 'payinfo',
- '',
- '',
- 'bankcode',
- 'bankmess',
- 'etgcode',
- 'etgmess',
- '',
- 'paybatchnum',
- '',
- 'result',
- ],
- 'hook' => sub {
- my $hash = shift;
- my $cpb = shift;
- $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} );
- $hash->{'_date'} = time;
- $hash->{'payinfo'} = $cpb->{'payinfo'}
- if( substr($hash->{'payinfo'}, -4) eq substr($cpb->{'payinfo'}, -4) );
- },
- 'approved' => sub {
- my $hash = shift;
- $hash->{'etgcode'} eq '00' && $hash->{'result'} eq 'Approved';
- },
- 'declined' => sub {
- my $hash = shift;
- $hash->{'etgcode'} ne '00' || $hash->{'result'} eq 'Declined';
- },
-);
-
-%export_info = (
- init => sub {
- $conf = shift;
- ($origid) = $conf->config("batchconfig-$name");
- },
- header => sub {
- my $pay_batch = shift;
- sprintf( '$$E-xactBatchFileV1.0$$%s:%03u$$%s',
- sdate($pay_batch->download),
- $pay_batch->batchnum,
- $origid );
- },
- row => sub {
- my ($cust_pay_batch, $pay_batch) = @_;
- my $payname = $cust_pay_batch->payname;
- $payname =~ tr/",/ /;
-
- join(',',
- $cust_pay_batch->paybatchnum,
- $cust_pay_batch->custnum,
- $cust_pay_batch->invnum,
- qq!"$payname"!,
- '00',
- $cust_pay_batch->payinfo,
- $cust_pay_batch->amount,
- $cust_pay_batch->expmmyy,
- '',
- ''
- );
- },
- # no footer
-);
-
-sub sdate {
- my (@date) = localtime(shift);
- sprintf('%02d/%02d/%02d', $date[5] % 100, $date[4] + 1, $date[3]);
-}
-
-1;
diff --git a/FS/FS/pay_batch/paymentech.pm b/FS/FS/pay_batch/paymentech.pm
deleted file mode 100644
index f22a80f..0000000
--- a/FS/FS/pay_batch/paymentech.pm
+++ /dev/null
@@ -1,144 +0,0 @@
-package FS::pay_batch::paymentech;
-
-use strict;
-use vars qw(@ISA %import_info %export_info $name);
-use FS::Record 'qsearchs';
-use Time::Local;
-use Date::Format 'time2str';
-use Date::Parse 'str2time';
-use Tie::IxHash;
-use FS::Conf;
-
-my $conf;
-my ($bin, $merchantID, $terminalID, $username);
-$name = 'paymentech';
-
-my $gateway;
-
-%import_info = (
- filetype => 'XML',
- xmlrow => [ qw(transResponse newOrderResp) ],
- fields => [
- 'paybatchnum',
- '_date',
- 'approvalStatus',
- 'order_number',
- 'authorization',
- ],
- xmlkeys => [
- 'orderID',
- 'respDateTime',
- 'approvalStatus',
- 'txRefNum',
- 'authorizationCode',
- ],
- 'hook' => sub {
- if ( !$gateway ) {
- # find a gateway configuration that has the same merchantID
- # as the batch config, if there is one. If not, leave
- # gateway out entirely.
- my $merchant = (FS::Conf->new->config('batchconfig-paymentech'))[2];
- my $g = qsearchs({
- 'table' => 'payment_gateway',
- 'addl_from' => ' JOIN payment_gateway_option USING (gatewaynum) ',
- 'hashref' => { disabled => '',
- optionname => 'merchant_id',
- optionvalue => $merchant,
- },
- });
- $gateway = ($g ? $g->gatewaynum . '-' : '') . 'PaymenTech';
- }
- my ($hash, $oldhash) = @_;
- my ($mon, $day, $year, $hour, $min, $sec) =
- $hash->{'_date'} =~ /^(..)(..)(....)(..)(..)(..)$/;
- $hash->{'_date'} = timelocal($sec, $min, $hour, $day, $mon-1, $year);
- $hash->{'paid'} = $oldhash->{'amount'};
- $hash->{'paybatch'} = join(':',
- $gateway,
- $hash->{'authorization'},
- $hash->{'order_number'},
- );
- },
- 'approved' => sub { my $hash = shift;
- $hash->{'approvalStatus'}
- },
- 'declined' => sub { my $hash = shift;
- ! $hash->{'approvalStatus'}
- },
-);
-
-my %paytype = (
- 'personal checking' => 'C',
- 'personal savings' => 'S',
- 'business checking' => 'X',
- 'business savings' => 'X',
- );
-
-%export_info = (
- init => sub {
-# Load this at run time
- eval "use XML::Writer";
- die $@ if $@;
- my $conf = shift;
- ($bin, $terminalID, $merchantID, $username) =
- $conf->config('batchconfig-paymentech');
- },
-# Here we do all the work in the header function.
- header => sub {
- my $pay_batch = shift;
- my @cust_pay_batch = @{(shift)};
- my $count = 1;
- my $output;
- my $xml = new XML::Writer(OUTPUT => \$output, DATA_MODE => 1, DATA_INDENT => 2);
- $xml->startTag('transRequest', RequestCount => scalar(@cust_pay_batch) + 1);
- $xml->startTag('batchFileID');
- $xml->dataElement(userID => $username);
- $xml->dataElement(fileDateTime => time2str('%Y%m%d%H%M%S', time));
- $xml->dataElement(fileID => 'FILEID');
- $xml->endTag('batchFileID');
-
- foreach (@cust_pay_batch) {
- $xml->startTag('newOrder', BatchRequestNo => $count++);
- tie my %order, 'Tie::IxHash', (
- industryType => 'EC',
- transType => 'AC',
- bin => $bin,
- merchantID => $merchantID,
- terminalID => $terminalID,
- ($_->payby eq 'CARD') ? (
- ccAccountNum => $_->payinfo,
- ccExp => $_->expmmyy,
- ) : (
- ecpCheckRT => ($_->payinfo =~ /@(\d+)/),
- ecpCheckDDA => ($_->payinfo =~ /(\d+)@/),
- ecpBankAcctType => $paytype{lc($_->cust_main->paytype)},
- ecpDelvMethod => 'A',
- ),
- avsZip => substr($_->zip, 0, 10),
- avsAddress1 => substr($_->address1, 0, 30),
- avsAddress2 => substr($_->address2, 0, 30),
- avsCity => substr($_->city, 0, 20),
- avsState => $_->state,
- avsName => substr($_->first . ' ' . $_->last, 0, 30),
- avsCountryCode => $_->country,
- orderID => $_->paybatchnum,
- amount => $_->amount * 100,
- );
- foreach my $key (keys %order) {
- $xml->dataElement($key, $order{$key})
- }
- $xml->endTag('newOrder');
- }
- $xml->startTag('endOfDay', BatchRequestNo => $count);
- $xml->dataElement(bin => $bin);
- $xml->dataElement(merchantID => $merchantID);
- $xml->dataElement(terminalID => $terminalID);
- $xml->endTag('endOfDay');
- $xml->endTag('transRequest');
- return $output;
- },
- row => sub {},
-);
-
-1;
-
diff --git a/FS/FS/pay_batch/td_canada_trust.pm b/FS/FS/pay_batch/td_canada_trust.pm
deleted file mode 100644
index e80441e..0000000
--- a/FS/FS/pay_batch/td_canada_trust.pm
+++ /dev/null
@@ -1,90 +0,0 @@
-package FS::pay_batch::td_canada_trust;
-
-# Formerly known as csv-td_canada_trust-merchant_pc_batch,
-# which I'm sure we can all agree is both a terrible name
-# and an illegal Perl identifier.
-
-use strict;
-use vars qw(@ISA %import_info %export_info $name);
-use Time::Local 'timelocal';
-use FS::Conf;
-
-my $conf;
-my ($origid, $datacenter, $typecode, $shortname, $longname, $mybank, $myacct);
-
-$name = 'csv-td_canada_trust-merchant_pc_batch';
-
-%import_info = (
- 'filetype' => 'CSV',
- 'fields' => [
- 'paybatchnum',
- 'paid',
- '', # card type
- '_date',
- 'time',
- 'payinfo',
- '', # expiry date
- '', # auth number
- 'type', # transaction type
- 'result', # processing result
- '', # terminal ID
- ],
- 'hook' => sub {
- my $hash = shift;
- my $date = $hash->{'_date'};
- my $time = $hash->{'time'};
- $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100);
- $hash->{'_date'} = timelocal( substr($time, 4, 2),
- substr($time, 2, 2),
- substr($time, 0, 2),
- substr($date, 6, 2),
- substr($date, 4, 2)-1,
- substr($date, 0, 4)-1900 );
- },
- 'approved' => sub {
- my $hash = shift;
- $hash->{'type'} eq '0' && $hash->{'result'} == 3
- },
- 'declined' => sub {
- my $hash = shift;
- $hash->{'type'} eq '0' && ( $hash->{'result'} == 4
- || $hash->{'result'} == 5 )
- },
- 'end_condition' => sub {
- my $hash = shift;
- $hash->{'type'} eq '0BC';
- },
- 'end_hook' => sub {
- my ($hash, $total) = @_;
- $total = sprintf("%.2f", $total);
- my $batch_total = sprintf("%.2f", $hash->{'paybatchnum'} / 100);
- return "Our total $total does not match bank total $batch_total!"
- if $total != $batch_total;
- },
-);
-
-%export_info = (
- init => sub {
- $conf = shift;
- },
- # no header
- row => sub {
- my ($cust_pay_batch, $pay_batch) = @_;
-
- return join(',',
- '',
- '',
- '',
- '',
- $cust_pay_batch->payinfo,
- $cust_pay_batch->expmmyy,
- $cust_pay_batch->amount,
- $cust_pay_batch->paybatchnum
- );
- },
-# no footer
-);
-
-
-1;
-
diff --git a/FS/FS/pay_batch/td_eft1464.pm b/FS/FS/pay_batch/td_eft1464.pm
deleted file mode 100644
index 7f58ab5..0000000
--- a/FS/FS/pay_batch/td_eft1464.pm
+++ /dev/null
@@ -1,156 +0,0 @@
-package FS::pay_batch::td_eft1464;
-
-use strict;
-use vars qw(@ISA %import_info %export_info $name);
-use Date::Format 'time2str';
-use FS::Conf;
-use FS::Record qw(qsearch);
-
-=head1 NAME
-
-td_eft1464 - TD Commercial Banking EFT1464 format
-
-=head1 CONFIGURATION
-
-The Freeside option 'batchconfig-td_eft1464' must be set
-with the following values on separate lines:
-
-=over 4
-
-=item Originator ID
-
-=item TD Datacenter Location
-
-00400 - Vancouver
-00410 - Montreal
-00420 - Toronto
-00430 - Halifax
-00470 - Winnipeg
-00490 - Calgary
-
-=item Short Name
-
-=item Long Name
-
-=item Returned Payment Branch (5 digits)
-
-=item Returned Payment Account
-
-=item Transaction Type Code - defaults to "437" (Internet access)
-
-=back
-
-=cut
-
-my $conf;
-my %opt;
-my $i;
-
-$name = 'td_eft1464';
-# TD Bank EFT 1464 Byte format
-
-%import_info = ( filetype => 'NONE' );
-# just to suppress warning; importing this format is a fatal error
-
-%export_info = (
- init => sub {
- $conf = shift;
- @opt{
- 'origid',
- 'datacenter',
- 'shortname',
- 'longname',
- 'retbranch',
- 'retacct',
- 'cpacode',
- } = $conf->config("batchconfig-td_eft1464");
- $opt{'origid'} = sprintf('%-10s', $opt{'origid'});
- $opt{'shortname'} = sprintf('%-15s', $opt{'shortname'});
- $opt{'longname'} = sprintf('%-30s', $opt{'longname'});
- $opt{'retbranch'} = '0004'.sprintf('%5s',$opt{'retbranch'});
- $opt{'retacct'} = sprintf('%-11s', $opt{'retacct'}). ' ';
- $i = 1;
- },
- header => sub {
- my $pay_batch = shift;
- my @cust_pay_batch = @{(shift)};
- my $time = $pay_batch->download || time;
- my $now = sprintf("%03u%03u",
- (localtime(time))[5] % 100,#year since 1900
- (localtime(time))[7]+1);#day of year
-
- # Request settlement the next day
- my $duedate = time+86400;
- $opt{'due'} = sprintf("%03u%03u",
- (localtime($duedate))[5] % 100,
- (localtime($duedate))[7]+1);
-
- $opt{'fcn'} =
- sprintf('%04u', ($pay_batch->batchnum % 9999)+1), # file creation number
- join('',
- 'A', #record type
- sprintf('%09u', 1), #record number
- $opt{'origid'},
- $opt{'fcn'},
- $now,
- $opt{'datacenter'},
- ' ' x 1429, #filler
- "\r"
- );
- },
- row => sub {
- my ($cust_pay_batch, $pay_batch) = @_;
- my ($account, $aba) = split('@', $cust_pay_batch->payinfo);
- $i++;
- # The 1464 byte format supports up to 5 payments per line,
- # but we're only going to send 1.
- my $control = join('',
- 'D', # for 'debit'
- sprintf("%09u", $i), #record number
- $opt{'origid'},
- $opt{'fcn'},
- );
- my $payment = join('',
- $opt{'cpacode'} || 437, # CPA code, defaults to "Internet access"
- sprintf('%010.0f', $cust_pay_batch->amount*100),
- $opt{'due'}, #due date...? XXX
- sprintf('%09u', $aba),
- sprintf('%-12s', $account),
- ' ' x 22,
- '0' x 3,
- $opt{'shortname'},
- sprintf('%-30s',
- join(' ',
- $cust_pay_batch->first, $cust_pay_batch->last)
- ),
- $opt{'longname'},
- $opt{'origid'},
- sprintf('%-19s', $cust_pay_batch->paybatchnum), # originator reference num
- $opt{'retbranch'},
- $opt{'retacct'},
- ' ' x 15,
- ' ' x 22,
- ' ' x 2,
- '0' x 11,
- );
- return sprintf('%-1464s',$control . $payment) . "\r";
- },
- footer => sub {
- my ($pay_batch, $batchcount, $batchtotal) = @_;
- join('',
- 'Z',
- sprintf('%09u', $batchcount + 2),
- $opt{'origid'},
- $opt{'fcn'},
- sprintf('%014.0f', $batchtotal*100), # total of debit txns
- sprintf('%08u', $batchcount), # number of debit txns
- '0' x 14, # total of credit txns
- '0' x 8, # total of credit txns
- ' ' x 1396,
- "\r"
- )
- },
-);
-
-1;
-
diff --git a/FS/FS/pay_batch/td_eftack264.pm b/FS/FS/pay_batch/td_eftack264.pm
deleted file mode 100644
index 9ab16ef..0000000
--- a/FS/FS/pay_batch/td_eftack264.pm
+++ /dev/null
@@ -1,59 +0,0 @@
-package FS::pay_batch::td_eftack264;
-
-use strict;
-use vars qw(@ISA %import_info %export_info $name);
-use Date::Format 'time2str';
-use FS::Conf;
-use FS::Record qw(qsearch);
-
-=head1 NAME
-
-td_eftack264 - TD Commercial Banking EFT 264 byte acknowledgement file
-
-=cut
-
-$name = 'td_eftack264';
-
-%import_info = (
- 'filetype' => 'fixed',
- 'formatre' =>
- '^(.)(.{9})(.{10})(.{4})(.{3})(.{10})(.{6})(.{9})(.{12}).{25}(.{15})(.{30})(.{30})(.{10})(.{19})(.{9})(.{12}).{15}.{22}(..)(.{11})$',
- 'fields' => [ qw(
- recordtype
- count
- origid
- fcn
- cpacode
- paid
- duedate
- bank
- payinfo
- shortname
- custname
- longname
- origid2
- paybatchnum
- retbranch
- retacct
- usdcode
- invfield
- ) ],
- 'hook' => sub {
- my $hash = shift;
- $hash->{'_date'} = time;
- $hash->{'paid'} = sprintf('%.2f', $hash->{'paid'} / 100);
- $hash->{'payinfo'} =~ s/^(\S+).*/$1/; # remove trailing spaces
- $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'bank'};
- },
- 'approved' => sub { 0 },
- 'declined' => sub { 1 },
- 'skip_condition' => sub {
- my $hash = shift;
- $hash->{'recordtype'} ne 'D'; # Debit Detail record
- },
- 'close_condition' => sub { 0 },
-);
-
-%export_info = ( filetype => 'NONE' );
-1;
-
diff --git a/FS/FS/pay_batch/td_eftret80.pm b/FS/FS/pay_batch/td_eftret80.pm
deleted file mode 100644
index b8c5e27..0000000
--- a/FS/FS/pay_batch/td_eftret80.pm
+++ /dev/null
@@ -1,46 +0,0 @@
-package FS::pay_batch::td_eftret80;
-
-use strict;
-use vars qw(@ISA %import_info %export_info $name);
-
-=head1 NAME
-
-td_eftret80 - TD Commercial Banking EFT 80 byte returned item file
-
-=cut
-
-$name = 'td_eftret80';
-
-%import_info = (
- 'filetype' => 'fixed',
- 'formatre' => '^(.)(.{20})(..)(.)(.{6})(.{19})(.{9})(.{12})(.{10})$',
- 'fields' => [ qw(
- recordtype
- custname
- reason
- verified
- duedate
- paybatchnum
- bank
- payinfo
- amount
- ) ],
- 'hook' => sub {
- my $hash = shift;
- $hash->{'_date'} = time;
- $hash->{'paid'} = sprintf('%.2f', $hash->{'paid'} / 100);
- $hash->{'payinfo'} =~ s/^(\S+).*/$1/; # these often have trailing spaces
- $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'bank'};
- },
- 'approved' => sub { 0 },
- 'declined' => sub { 1 },
- 'skip_condition' => sub {
- my $hash = shift;
- $hash->{'recordtype'} ne 'D'; #Detail record
- },
- 'close_condition' => sub { 0 }, # never close just from this
-);
-
-%export_info = ( filetype => 'NONE' );
-1;
-
diff --git a/FS/FS/payby.pm b/FS/FS/payby.pm
deleted file mode 100644
index 30a03dd..0000000
--- a/FS/FS/payby.pm
+++ /dev/null
@@ -1,209 +0,0 @@
-package FS::payby;
-
-use strict;
-use vars qw(%hash %payby2bop);
-use Tie::IxHash;
-use Business::CreditCard;
-
-
-=head1 NAME
-
-FS::payby - Object methods for payment type records
-
-=head1 SYNOPSIS
-
- use FS::payby;
-
- #for now...
-
- my @payby = FS::payby->payby;
-
- my $bool = FS::payby->can_payby('cust_main', 'CARD');
-
- tie my %payby, 'Tie::IxHash', FS::payby->payby2longname
-
- my @cust_payby = FS::payby->cust_payby;
-
- tie my %payby, 'Tie::IxHash', FS::payby->cust_payby2longname
-
-=head1 DESCRIPTION
-
-Payment types.
-
-=head1 METHODS
-
-=over 4
-
-=item
-
-=cut
-
-# paybys can be any/all of:
-# - a customer payment type (cust_main.payby)
-# - a payment or refund type (cust_pay.payby, cust_pay_batch.payby, cust_refund.payby)
-# - an event type (part_bill_event.payby)
-
-tie %hash, 'Tie::IxHash',
- 'CARD' => {
- tinyname => 'card',
- shortname => 'Credit card',
- longname => 'Credit card (automatic)',
- realtime => 1,
- },
- 'DCRD' => {
- tinyname => 'card',
- shortname => 'Credit card',
- longname => 'Credit card (on-demand)',
- cust_pay => 'CARD', #this is a customer type only, payments are CARD...
- realtime => 1,
- },
- 'CHEK' => {
- tinyname => 'check',
- shortname => 'Electronic check',
- longname => 'Electronic check (automatic)',
- realtime => 1,
- },
- 'DCHK' => {
- tinyname => 'check',
- shortname => 'Electronic check',
- longname => 'Electronic check (on-demand)',
- cust_pay => 'CHEK', #this is a customer type only, payments are CHEK...
- realtime => 1,
- },
- 'LECB' => {
- tinyname => 'phone bill',
- shortname => 'Phone bill billing',
- longname => 'Phone bill billing',
- realtime => 1,
- },
- 'BILL' => {
- tinyname => 'billing',
- shortname => 'Billing',
- payname => 'Check',
- longname => 'Billing',
- },
- 'PREP' => {
- tinyname => 'prepaid card',
- shortname => 'Prepaid card',
- longname => 'Prepaid card',
- cust_main => 'BILL', #this is a payment type only, customers go to BILL...
- },
- 'CASH' => {
- tinyname => 'cash',
- shortname => 'Cash', # initial payment, then billing
- longname => 'Cash',
- cust_main => 'BILL', #this is a payment type only, customers go to BILL...
- },
- 'WEST' => {
- tinyname => 'western union',
- shortname => 'Western Union', # initial payment, then billing
- longname => 'Western Union',
- cust_main => 'BILL', #this is a payment type only, customers go to BILL...
- },
- 'MCRD' => { #not the same as DCRD
- tinyname => 'card',
- shortname => 'Manual credit card', # initial payment, then billing
- longname => 'Manual credit card',
- cust_main => 'BILL', #this is a payment type only, customers go to BILL...
- },
- 'COMP' => {
- tinyname => 'comp',
- shortname => 'Complimentary',
- longname => 'Complimentary',
- cust_pay => '', # (free) is depricated as a payment type in cust_pay
- },
- 'CBAK' => {
- tinyname => 'chargeback',
- shortname => 'Chargeback',
- longname => 'Chargeback',
- cust_main => '', # not a customer type
- },
-;
-
-sub payby {
- keys %hash;
-}
-
-sub can_payby {
- my( $self, $table, $payby ) = @_;
-
- #return "Illegal payby" unless $hash{$payby};
- return 0 unless $hash{$payby};
-
- $table = 'cust_pay' if $table =~ /^cust_(pay_pending|pay_batch|pay_void|refund)$/;
- return 0 if exists( $hash{$payby}->{$table} );
-
- return 1;
-}
-
-sub realtime { # can use realtime payment facilities
- my( $self, $payby ) = @_;
-
- return 0 unless $hash{$payby};
- return 0 unless exists( $hash{$payby}->{realtime} );
-
- return $hash{$payby}->{realtime};
-}
-
-sub payby2longname {
- my $self = shift;
- map { $_ => $hash{$_}->{longname} } $self->payby;
-}
-
-sub shortname {
- my( $self, $payby ) = @_;
- $hash{$payby}->{shortname};
-}
-
-sub payname {
- my( $self, $payby ) = @_;
- #$hash{$payby}->{payname} || $hash{$payby}->{shortname};
- exists($hash{$payby}->{payname})
- ? $hash{$payby}->{payname}
- : $hash{$payby}->{shortname};
-}
-
-sub longname {
- my( $self, $payby ) = @_;
- $hash{$payby}->{longname};
-}
-
-%payby2bop = (
- 'CARD' => 'CC',
- 'CHEK' => 'ECHECK',
- 'MCRD' => 'CC',
-);
-
-sub payby2bop {
- my( $self, $payby ) = @_;
- $payby2bop{ $self->payby2payment($payby) };
-}
-
-sub payby2payment {
- my( $self, $payby ) = @_;
- $hash{$payby}{'cust_pay'} || $payby;
-}
-
-sub cust_payby {
- my $self = shift;
- grep { ! exists $hash{$_}->{cust_main} } $self->payby;
-}
-
-sub cust_payby2longname {
- my $self = shift;
- map { $_ => $hash{$_}->{longname} } $self->cust_payby;
-}
-
-=back
-
-=head1 BUGS
-
-This should eventually be an actual database table, and all tables that
-currently have a char payby field should have a foreign key into here instead.
-
-=head1 SEE ALSO
-
-=cut
-
-1;
-
diff --git a/FS/FS/payinfo_Mixin.pm b/FS/FS/payinfo_Mixin.pm
deleted file mode 100644
index 9995183..0000000
--- a/FS/FS/payinfo_Mixin.pm
+++ /dev/null
@@ -1,268 +0,0 @@
-package FS::payinfo_Mixin;
-
-use strict;
-use Business::CreditCard;
-use FS::payby;
-
-=head1 NAME
-
-FS::payinfo_Mixin - Mixin class for records in tables that contain payinfo.
-
-=head1 SYNOPSIS
-
-package FS::some_table;
-use vars qw(@ISA);
-@ISA = qw( FS::payinfo_Mixin FS::Record );
-
-=head1 DESCRIPTION
-
-This is a mixin class for records that contain payinfo.
-
-=head1 FIELDS
-
-=over 4
-
-=item payby
-
-The following payment types (payby) are supported:
-
-For Customers (cust_main):
-'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
-'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
-'LECB' (Phone bill billing), 'BILL' (billing), 'COMP' (free), or
-'PREPAY' (special billing type: applies a credit and sets billing type to I<BILL> - see L<FS::prepay_credit>)
-
-For Refunds (cust_refund):
-'CARD' (credit cards), 'CHEK' (electronic check/ACH),
-'LECB' (Phone bill billing), 'BILL' (billing), 'CASH' (cash),
-'WEST' (Western Union), 'MCRD' (Manual credit card), 'CBAK' Chargeback, or 'COMP' (free)
-
-
-For Payments (cust_pay):
-'CARD' (credit cards), 'CHEK' (electronic check/ACH),
-'LECB' (phone bill billing), 'BILL' (billing), 'PREP' (prepaid card),
-'CASH' (cash), 'WEST' (Western Union), or 'MCRD' (Manual credit card)
-'COMP' (free) is depricated as a payment type in cust_pay
-
-=cut
-
-# was this supposed to do something?
-
-#sub payby {
-# my($self,$payby) = @_;
-# if ( defined($payby) ) {
-# $self->setfield('payby', $payby);
-# }
-# return $self->getfield('payby')
-#}
-
-=item payinfo
-
-Payment information (payinfo) can be one of the following types:
-
-Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
-
-=cut
-
-sub payinfo {
- my($self,$payinfo) = @_;
-
- if ( defined($payinfo) ) {
- $self->setfield('payinfo', $payinfo);
- $self->paymask($self->mask_payinfo) unless $payinfo =~ /^99\d{14}$/; #token
- } else {
- $self->getfield('payinfo');
- }
-}
-
-=item paycvv
-
-Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
-
-=cut
-
-sub paycvv {
- my($self,$paycvv) = @_;
- # This is only allowed in cust_main... Even then it really shouldn't be stored...
- if ($self->table eq 'cust_main') {
- if ( defined($paycvv) ) {
- $self->setfield('paycvv', $paycvv); # This is okay since we are the 'setter'
- } else {
- $paycvv = $self->getfield('paycvv'); # This is okay since we are the 'getter'
- return $paycvv;
- }
- } else {
-# warn "This doesn't work for other tables besides cust_main
- '';
- }
-}
-
-=item paymask
-
-=cut
-
-sub paymask {
- my($self, $paymask) = @_;
-
- if ( defined($paymask) ) {
- $self->setfield('paymask', $paymask);
- } else {
- $self->getfield('paymask') || $self->mask_payinfo;
- }
-}
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item mask_payinfo [ PAYBY, PAYINFO ]
-
-This method converts the payment info (credit card, bank account, etc.) into a
-masked string.
-
-Optionally, an arbitrary payby and payinfo can be passed.
-
-=cut
-
-sub mask_payinfo {
- my $self = shift;
- my $payby = scalar(@_) ? shift : $self->payby;
- my $payinfo = scalar(@_) ? shift : $self->payinfo;
-
- # Check to see if it's encrypted...
- my $paymask;
- if ( $self->is_encrypted($payinfo) ) {
- $paymask = 'N/A';
- } elsif ( $payinfo =~ /^99\d{14}$/ || $payinfo eq 'N/A' ) { #token
- $paymask = 'N/A (tokenized)'; #?
- } else {
- # if not, mask it...
- if ($payby eq 'CARD' || $payby eq 'DCRD' || $payby eq 'MCRD') {
- # Credit Cards
- my $conf = new FS::Conf;
- my $mask_method = $conf->config('card_masking_method') || 'first6last4';
- $mask_method =~ /^first(\d+)last(\d+)$/
- or die "can't parse card_masking_method $mask_method";
- my($first, $last) = ($1, $2);
-
- $paymask = substr($payinfo,0,$first).
- 'x'x(length($payinfo)-$first-$last).
- substr($payinfo,(length($payinfo)-$last));
- } elsif ($payby eq 'CHEK' || $payby eq 'DCHK' ) {
- # Checks (Show last 2 @ bank)
- my( $account, $aba ) = split('@', $payinfo );
- $paymask = 'x'x(length($account)-2).
- substr($account,(length($account)-2))."@".$aba;
- } else { # Tie up loose ends
- $paymask = $payinfo;
- }
- }
- $paymask;
-}
-
-=item payinfo_check
-
-Checks payby and payinfo.
-
-For Customers (cust_main):
-'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
-'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
-'LECB' (Phone bill billing), 'BILL' (billing), 'COMP' (free), or
-'PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
-
-For Refunds (cust_refund):
-'CARD' (credit cards), 'CHEK' (electronic check/ACH),
-'LECB' (Phone bill billing), 'BILL' (billing), 'CASH' (cash),
-'WEST' (Western Union), 'MCRD' (Manual credit card), 'CBAK' (Chargeback), or 'COMP' (free)
-
-For Payments (cust_pay):
-'CARD' (credit cards), 'CHEK' (electronic check/ACH),
-'LECB' (phone bill billing), 'BILL' (billing), 'PREP' (prepaid card),
-'CASH' (cash), 'WEST' (Western Union), or 'MCRD' (Manual credit card)
-'COMP' (free) is depricated as a payment type in cust_pay
-
-=cut
-
-sub payinfo_check {
- my $self = shift;
-
- FS::payby->can_payby($self->table, $self->payby)
- or return "Illegal payby: ". $self->payby;
-
- if ( $self->payby eq 'CARD' && ! $self->is_encrypted($self->payinfo) ) {
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\D//g;
- $self->payinfo($payinfo);
- if ( $self->payinfo ) {
- $self->payinfo =~ /^(\d{13,16})$/
- or return "Illegal (mistyped?) credit card number (payinfo)";
- $self->payinfo($1);
- validate($self->payinfo) or return "Illegal credit card number";
- return "Unknown card type" if $self->payinfo !~ /^99\d{14}$/ #token
- && cardtype($self->payinfo) eq "Unknown";
- } else {
- $self->payinfo('N/A'); #???
- }
- } else {
- if ( $self->is_encrypted($self->payinfo) ) {
- #something better? all it would cause is a decryption error anyway?
- my $error = $self->ut_anything('payinfo');
- return $error if $error;
- } else {
- my $error = $self->ut_textn('payinfo');
- return $error if $error;
- }
- }
-
- '';
-
-}
-
-=item payby_payinfo_pretty
-
-Returns payment method and information (suitably masked, if applicable) as
-a human-readable string, such as:
-
- Card #54xxxxxxxxxxxx32
-
-or
-
- Check #119006
-
-=cut
-
-sub payby_payinfo_pretty {
- my $self = shift;
- if ( $self->payby eq 'CARD' ) {
- 'Card #'. $self->paymask;
- } elsif ( $self->payby eq 'CHEK' ) {
- 'E-check acct#'. $self->payinfo;
- } elsif ( $self->payby eq 'BILL' ) {
- 'Check #'. $self->payinfo;
- } elsif ( $self->payby eq 'PREP' ) {
- 'Prepaid card #'. $self->payinfo;
- } elsif ( $self->payby eq 'CASH' ) {
- 'Cash '. $self->payinfo;
- } elsif ( $self->payby eq 'WEST' ) {
- 'Western Union'; #. $self->payinfo;
- } elsif ( $self->payby eq 'MCRD' ) {
- 'Manual credit card'; #. $self->payinfo;
- } else {
- $self->payby. ' '. $self->payinfo;
- }
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::payby>, L<FS::Record>
-
-=cut
-
-1;
-
diff --git a/FS/FS/payinfo_transaction_Mixin.pm b/FS/FS/payinfo_transaction_Mixin.pm
deleted file mode 100644
index 19419de..0000000
--- a/FS/FS/payinfo_transaction_Mixin.pm
+++ /dev/null
@@ -1,123 +0,0 @@
-package FS::payinfo_transaction_Mixin;
-
-use strict;
-use vars qw( @ISA );
-use FS::payby;
-use FS::payinfo_Mixin;
-use FS::Record qw(qsearchs);
-use FS::cust_main;
-use FS::payment_gateway;
-
-@ISA = qw( FS::payinfo_Mixin );
-
-=head1 NAME
-
-FS::payinfo_transaction_Mixin - Mixin class for records in tables that represent transactions.
-
-=head1 SYNOPSIS
-
-package FS::some_table;
-use vars qw(@ISA);
-@ISA = qw( FS::payinfo_transaction_Mixin FS::Record );
-
-=head1 DESCRIPTION
-
-This is a mixin class for records that represent transactions: that contain
-payinfo and paybatch. Currently FS::cust_pay and FS::cust_refund
-
-=head1 METHODS
-
-=over 4
-
-=item cust_main
-
-Returns the parent customer object (see L<FS::cust_main>).
-
-=cut
-
-sub cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
-=item payby_name
-
-Returns a name for the payby field.
-
-=cut
-
-sub payby_name {
- my $self = shift;
- if ( $self->payby eq 'BILL' ) { #kludge
- 'Check';
- } else {
- FS::payby->shortname( $self->payby );
- }
-}
-
-=item gatewaynum
-
-Returns a gatewaynum for the processing gateway.
-
-=item processor
-
-Returns a name for the processing gateway.
-
-=item authorization
-
-Returns a name for the processing gateway.
-
-=item order_number
-
-Returns a name for the processing gateway.
-
-=cut
-
-sub gatewaynum { shift->_parse_paybatch->{'gatewaynum'}; }
-sub processor { shift->_parse_paybatch->{'processor'}; }
-sub authorization { shift->_parse_paybatch->{'authorization'}; }
-sub order_number { shift->_parse_paybatch->{'order_number'}; }
-
-#sucks that this stuff is in paybatch like this in the first place,
-#but at least other code can start to use new field names
-#(code nicked from FS::cust_main::realtime_refund_bop)
-sub _parse_paybatch {
- my $self = shift;
-
- $self->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
- or return {};
- #"Can't parse paybatch for paynum $options{'paynum'}: ".
- # $cust_pay->paybatch;
-
- my( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
-
- if ( $gatewaynum ) { #gateway for the payment to be refunded
-
- my $payment_gateway =
- qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
-
- die "payment gateway $gatewaynum not found" #?
- unless $payment_gateway;
-
- $processor = $payment_gateway->gateway_module;
-
- }
-
- {
- 'gatewaynum' => $gatewaynum,
- 'processor' => $processor,
- 'authorization' => $auth,
- 'order_number' => $order_number,
- };
-
-}
-
-=back
-
-=head1 SEE ALSO
-
-L<FS::payinfo_Mixin>
-
-=cut
-
-1;
diff --git a/FS/FS/payment_gateway.pm b/FS/FS/payment_gateway.pm
deleted file mode 100644
index bc8b875..0000000
--- a/FS/FS/payment_gateway.pm
+++ /dev/null
@@ -1,247 +0,0 @@
-package FS::payment_gateway;
-
-use strict;
-use vars qw( @ISA $me $DEBUG );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::option_Common;
-use FS::agent_payment_gateway;
-
-@ISA = qw( FS::option_Common );
-$me = '[ FS::payment_gateway ]';
-$DEBUG=0;
-
-=head1 NAME
-
-FS::payment_gateway - Object methods for payment_gateway records
-
-=head1 SYNOPSIS
-
- use FS::payment_gateway;
-
- $record = new FS::payment_gateway \%hash;
- $record = new FS::payment_gateway { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::payment_gateway object represents an payment gateway.
-FS::payment_gateway inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item gatewaynum - primary key
-
-=item gateway_namespace - Business::OnlinePayment or Business::OnlineThirdPartyPayment
-
-=item gateway_module - Business::OnlinePayment:: module name
-
-=item gateway_username - payment gateway username
-
-=item gateway_password - payment gateway password
-
-=item gateway_action - optional action or actions (multiple actions are separated with `,': for example: `Authorization Only, Post Authorization'). Defaults to `Normal Authorization'.
-
-=item disabled - Disabled flag, empty or 'Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new payment gateway. To add the payment gateway 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 { 'payment_gateway'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid payment gateway. 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('gatewaynum')
- || $self->ut_alpha('gateway_module')
- || $self->ut_enum('gateway_namespace', ['Business::OnlinePayment',
- 'Business::OnlineThirdPartyPayment',
- ] )
- || $self->ut_textn('gateway_username')
- || $self->ut_anything('gateway_password')
- || $self->ut_textn('gateway_callback_url') # a bit too permissive
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- #|| $self->ut_textn('gateway_action')
- ;
- return $error if $error;
-
- if ( $self->gateway_action ) {
- my @actions = split(/,\s*/, $self->gateway_action);
- $self->gateway_action(
- join( ',', map { /^(Normal Authorization|Authorization Only|Credit|Post Authorization)$/
- or return "Unknown action $_";
- $1
- }
- @actions
- )
- );
- } else {
- $self->gateway_action('Normal Authorization');
- }
-
- # this little kludge mimics FS::CGI::popurl
- $self->gateway_callback_url($self->gateway_callback_url. '/')
- if ( $self->gateway_callback_url && $self->gateway_callback_url !~ /\/$/ );
-
- $self->SUPER::check;
-}
-
-=item agent_payment_gateway
-
-Returns any agent overrides for this payment gateway.
-
-=cut
-
-sub agent_payment_gateway {
- my $self = shift;
- qsearch('agent_payment_gateway', { 'gatewaynum' => $self->gatewaynum } );
-}
-
-=item disable
-
-Disables this payment gateway: deletes all associated agent_payment_gateway
-overrides and sets the I<disabled> field to "B<Y>".
-
-=cut
-
-sub disable {
- 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 $agent_payment_gateway ( $self->agent_payment_gateway ) {
- my $error = $agent_payment_gateway->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error deleting agent_payment_gateway override: $error";
- }
- }
-
- $self->disabled('Y');
- my $error = $self->replace();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error disabling payment_gateway: $error";
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item namespace_description
-
-returns a friendly name for the namespace
-
-=cut
-
-my %namespace2description = (
- '' => 'Direct',
- 'Business::OnlinePayment' => 'Direct',
- 'Business::OnlineThirdPartyPayment' => 'Hosted',
-);
-
-sub namespace_description {
- $namespace2description{shift->gateway_namespace} || 'Unknown';
-}
-
-# _upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-#
-#
-
-sub _upgrade_data {
- my ($class, %opts) = @_;
- my $dbh = dbh;
-
- warn "$me upgrading $class\n" if $DEBUG;
-
- foreach ( qsearch( 'payment_gateway', { 'gateway_namespace' => '' } ) ) {
- $_->gateway_namespace('Business::OnlinePayment'); #defaulting
- my $error = $_->replace;
- die "$class had error during upgrade replacement: $error" if $error;
- }
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/payment_gateway_option.pm b/FS/FS/payment_gateway_option.pm
deleted file mode 100644
index 0576022..0000000
--- a/FS/FS/payment_gateway_option.pm
+++ /dev/null
@@ -1,126 +0,0 @@
-package FS::payment_gateway_option;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::payment_gateway_option - Object methods for payment_gateway_option records
-
-=head1 SYNOPSIS
-
- use FS::payment_gateway_option;
-
- $record = new FS::payment_gateway_option \%hash;
- $record = new FS::payment_gateway_option { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::payment_gateway_option object represents an option key and value for
-a payment gateway. FS::payment_gateway_option inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item optionnum - primary key
-
-=item gatewaynum -
-
-=item optionname -
-
-=item optionvalue -
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new option. To add the option 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 { 'payment_gateway_option'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid option. 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('optionnum')
- || $self->ut_foreign_key('gatewaynum', 'payment_gateway', 'gatewaynum')
- || $self->ut_text('optionname')
- || $self->ut_textn('optionvalue')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/phone_avail.pm b/FS/FS/phone_avail.pm
deleted file mode 100644
index 967d717..0000000
--- a/FS/FS/phone_avail.pm
+++ /dev/null
@@ -1,217 +0,0 @@
-package FS::phone_avail;
-
-use strict;
-use vars qw( @ISA $DEBUG $me );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::cust_svc;
-
-@ISA = qw(FS::cust_main_Mixin FS::Record);
-
-$me = '[FS::phone_avail]';
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::phone_avail - Phone number availability cache
-
-=head1 SYNOPSIS
-
- use FS::phone_avail;
-
- $record = new FS::phone_avail \%hash;
- $record = new FS::phone_avail { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::phone_avail object represents availability of phone service.
-FS::phone_avail inherits from FS::Record. The following fields are currently
-supported:
-
-=over 4
-
-=item availnum
-
-primary key
-
-=item exportnum
-
-exportnum
-
-=item countrycode
-
-countrycode
-
-=item state
-
-state
-
-=item npa
-
-npa
-
-=item nxx
-
-nxx
-
-=item station
-
-station
-
-=item name
-
-Optional name
-
-=item svcnum
-
-svcnum
-
-=item availbatch
-
-availbatch
-
-=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 { 'phone_avail'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('availnum')
- || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum' )
- || $self->ut_number('countrycode')
- || $self->ut_alphan('state')
- || $self->ut_number('npa')
- || $self->ut_numbern('nxx')
- || $self->ut_numbern('station')
- || $self->ut_foreign_keyn('svcnum', 'cust_svc', 'svcnum' )
- || $self->ut_textn('availbatch')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item cust_svc
-
-=cut
-
-sub cust_svc {
- my $self = shift;
- return '' unless $self->svcnum;
- qsearchs('cust_svc', { 'svcnum' => $self->svcnum });
-}
-
-sub process_batch_import {
- my $job = shift;
-
- my $numsub = sub {
- my( $phone_avail, $value ) = @_;
- $value =~ s/\D//g;
- $value =~ /^(\d{3})(\d{3})(\d+)$/ or die "unparsable number $value\n";
- #( $hash->{npa}, $hash->{nxx}, $hash->{station} ) = ( $1, $2, $3 );
- $phone_avail->npa($1);
- $phone_avail->nxx($2);
- $phone_avail->station($3);
- };
-
- my $opt = { 'table' => 'phone_avail',
- 'params' => [ 'availbatch', 'exportnum', 'countrycode' ],
- 'formats' => { 'default' => [ 'state', $numsub ] },
- };
-
- FS::Record::process_batch_import( $job, $opt, @_ );
-
-}
-
-# Used by FS::Upgrade to migrate to a new database.
-sub _upgrade_data {
- my ($class, %opts) = @_;
-
- warn "$me upgrading $class\n" if $DEBUG;
-
- my $sth = dbh->prepare(
- 'UPDATE phone_avail SET svcnum = NULL
- WHERE svcnum IS NOT NULL
- AND 0 = ( SELECT COUNT(*) FROM svc_phone
- WHERE phone_avail.svcnum = svc_phone.svcnum )'
- ) or die dbh->errstr;
-
- $sth->execute or die $sth->errstr;
-
-}
-
-=back
-
-=head1 BUGS
-
-Sparse documentation.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/phone_device.pm b/FS/FS/phone_device.pm
deleted file mode 100644
index ba765e0..0000000
--- a/FS/FS/phone_device.pm
+++ /dev/null
@@ -1,299 +0,0 @@
-package FS::phone_device;
-
-use strict;
-use base qw( FS::Record );
-use Scalar::Util qw( blessed );
-use FS::Record qw( dbh qsearchs ); # qsearch );
-use FS::part_device;
-use FS::svc_phone;
-
-=head1 NAME
-
-FS::phone_device - Object methods for phone_device records
-
-=head1 SYNOPSIS
-
- use FS::phone_device;
-
- $record = new FS::phone_device \%hash;
- $record = new FS::phone_device { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::phone_device object represents a specific customer phone device, such as
-a SIP phone or ATA. FS::phone_device inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item devicenum
-
-primary key
-
-=item devicepart
-
-devicepart
-
-=item svcnum
-
-svcnum
-
-=item mac_addr
-
-mac_addr
-
-
-=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 { 'phone_device'; }
-
-=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;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $self->export('device_insert');
-
- $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;
-
- $self->export('device_delete');
-
- 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 = 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);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $new->export('device_replace', $old);
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
-=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 $mac = $self->mac_addr;
- $mac =~ s/\s+//g;
- $mac =~ s/://g;
- $self->mac_addr($mac);
-
- my $error =
- $self->ut_numbern('devicenum')
- || $self->ut_foreign_key('devicepart', 'part_device', 'devicepart')
- || $self->ut_foreign_key('svcnum', 'svc_phone', 'svcnum' ) #cust_svc?
- || $self->ut_hexn('mac_addr')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item part_device
-
-Returns the device type record (see L<FS::part_device>) associated with this
-customer device.
-
-=cut
-
-sub part_device {
- my $self = shift;
- qsearchs( 'part_device', { 'devicepart' => $self->devicepart } );
-}
-
-=item svc_phone
-
-Returns the phone number (see L<FS::svc_phone>) associated with this customer
-device.
-
-=cut
-
-sub svc_phone {
- my $self = shift;
- qsearchs( 'svc_phone', { 'svcnum' => $self->svcnum } );
-}
-
-=item export HOOK [ EXPORT_ARGS ]
-
-Runs the provided export hook (i.e. "device_insert") for this service.
-
-=cut
-
-sub export {
- my( $self, $method ) = ( shift, 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 $svc_phone = $self->svc_phone;
- my $error = $svc_phone->export($method, $self, @_); #call device export
- if ( $error ) { #netsapiens at least
- $dbh->rollback if $oldAutoCommit;
- return "error exporting $method event to svc_phone ". $svc_phone->svcnum.
- " (transaction rolled back): $error";
- }
-
- $method = "export_$method" unless $method =~ /^export_/;
-
- foreach my $part_export ( $self->part_device->part_export ) {
- next unless $part_export->can($method);
- my $error = $part_export->$method($svc_phone, $self, @_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error exporting $method event to ". $part_export->exporttype.
- " (transaction rolled back): $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item export_links
-
-Returns a list of html elements associated with this device's exports.
-
-=cut
-
-sub export_links {
- my $self = shift;
- my $return = [];
- $self->export('export_device_links', $return);
- $return;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/phone_type.pm b/FS/FS/phone_type.pm
deleted file mode 100644
index d2ef465..0000000
--- a/FS/FS/phone_type.pm
+++ /dev/null
@@ -1,137 +0,0 @@
-package FS::phone_type;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch ); # qsearchs );
-
-=head1 NAME
-
-FS::phone_type - Object methods for phone_type records
-
-=head1 SYNOPSIS
-
- use FS::phone_type;
-
- $record = new FS::phone_type \%hash;
- $record = new FS::phone_type { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::phone_type object represents an phone number type (for example: Work,
-Home, Mobile, Fax). FS::phone_type inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item phonetypenum
-
-Primary key
-
-=item typename
-
-Type name
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new type. To add the type 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 { 'phone_type'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Delete this record from the database.
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid type. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('phonetypenum')
- || $self->ut_number('weight')
- || $self->ut_text('typename')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-# Used by FS::Setup to initialize a new database.
-sub _populate_initial_data {
- my ($class, %opts) = @_;
-
- my $weight = 10;
-
- foreach ("Work", "Home", "Mobile", "Fax") {
- my $object = $class->new({ 'typename' => $_,
- 'weight' => $weight,
- });
- my $error = $object->insert;
- die "error inserting $class into database: $error\n"
- if $error;
-
- $weight += 10;
- }
-
- '';
-
-}
-
-# Used by FS::Upgrade to migrate to a new database.
-sub _upgrade_data {
- my $class = shift;
-
- return $class->_populate_initial_data(@_)
- unless scalar( qsearch( 'phone_type', {} ) );
-
- '';
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::contact_phone>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/pkg_category.pm b/FS/FS/pkg_category.pm
deleted file mode 100644
index cd875d1..0000000
--- a/FS/FS/pkg_category.pm
+++ /dev/null
@@ -1,132 +0,0 @@
-package FS::pkg_category;
-
-use strict;
-use base qw( FS::category_Common );
-use vars qw( @ISA $me $DEBUG );
-use FS::Record qw( qsearch dbh );
-use FS::pkg_class;
-use FS::part_pkg;
-
-$DEBUG = 0;
-$me = '[FS::pkg_category]';
-
-=head1 NAME
-
-FS::pkg_category - Object methods for pkg_category records
-
-=head1 SYNOPSIS
-
- use FS::pkg_category;
-
- $record = new FS::pkg_category \%hash;
- $record = new FS::pkg_category { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::pkg_category object represents an package category. Every package class
-(see L<FS::pkg_class>) has, optionally, a package category. FS::pkg_category
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item categorynum
-
-primary key (assigned automatically for new package categoryes)
-
-=item categoryname
-
-Text name of this package category
-
-=item weight
-
-Weight
-
-=item disabled
-
-Disabled flag, empty or 'Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new package category. To add the package category to the database,
-see L<"insert">.
-
-=cut
-
-sub table { 'pkg_category'; }
-
-=item insert
-
-Adds this package category to the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item delete
-
-Deletes this package category from the database. Only package categoryes with
-no associated package definitions can be deleted. If there is an error,
-returns the error, otherwise returns false.
-
-=item replace [ OLD_RECORD ]
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid package category. If there is an
-error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-# _ upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-
-sub _upgrade_data {
- my ($class, %opts) = @_;
- my $dbh = dbh;
-
- warn "$me upgrading $class\n" if $DEBUG;
-
- my @pkg_category =
- qsearch('pkg_category', { weight => { op => '!=', value => '' } } );
-
- unless( scalar(@pkg_category) ) {
- my @pkg_category = qsearch('pkg_category', {} );
- my $weight = 0;
- foreach ( sort { $a->description cmp $b->description } @pkg_category ) {
- $_->weight($weight);
- my $error = $_->replace;
- die "error setting pkg_category weight: $error\n" if $error;
- $weight += 10;
- }
- }
- '';
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::category_Common>, L<FS::Record>
-
-=cut
-
-1;
-
diff --git a/FS/FS/pkg_class.pm b/FS/FS/pkg_class.pm
deleted file mode 100644
index 51d0455..0000000
--- a/FS/FS/pkg_class.pm
+++ /dev/null
@@ -1,119 +0,0 @@
-package FS::pkg_class;
-
-use strict;
-use FS::class_Common;
-use base qw( FS::class_Common );
-use FS::part_pkg;
-use FS::pkg_category;
-
-=head1 NAME
-
-FS::pkg_class - Object methods for pkg_class records
-
-=head1 SYNOPSIS
-
- use FS::pkg_class;
-
- $record = new FS::pkg_class \%hash;
- $record = new FS::pkg_class { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::pkg_class object represents an package class. Every package definition
-(see L<FS::part_pkg>) has, optionally, a package class. FS::pkg_class inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item classnum
-
-primary key (assigned automatically for new package classes)
-
-=item classname
-
-Text name of this package class
-
-=item categorynum
-
-Number of associated pkg_category (see L<FS::pkg_category>)
-
-=item disabled
-
-Disabled flag, empty or 'Y'
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new package class. To add the package class to the database, see
-L<"insert">.
-
-=cut
-
-sub table { 'pkg_class'; }
-sub _target_table { 'part_pkg'; }
-
-=item insert
-
-Adds this package class to the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item delete
-
-Deletes this package class from the database. Only package classes with no
-associated package definitions can be deleted. If there is an error, returns
-the error, otherwise returns false.
-
-=item replace [ OLD_RECORD ]
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid package class. If there is an
-error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-=item pkg_category
-
-=item category
-
-Returns the pkg_category record associated with this class, or false if there
-is none.
-
-=cut
-
-sub pkg_category {
- my $self = shift;
- $self->category;
-}
-
-=item categoryname
-
-Returns the category name associated with this class, or false if there
-is none.
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::part_pkg>, L<FS::Record>
-
-=cut
-
-1;
diff --git a/FS/FS/pkg_referral.pm b/FS/FS/pkg_referral.pm
deleted file mode 100644
index 333c2bf..0000000
--- a/FS/FS/pkg_referral.pm
+++ /dev/null
@@ -1,126 +0,0 @@
-package FS::pkg_referral;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::pkg_referral - Object methods for pkg_referral records
-
-=head1 SYNOPSIS
-
- use FS::pkg_referral;
-
- $record = new FS::pkg_referral \%hash;
- $record = new FS::pkg_referral { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::pkg_referral object represents the association of an advertising source
-with a specific customer package (purchase). FS::pkg_referral inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item pkgrefnum - primary key
-
-=item pkgnum - Customer package. See L<FS::cust_pkg>
-
-=item refnum - Advertising source. See L<FS::part_referral>
-
-=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 { 'pkg_referral'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('pkgrefnum')
- || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum' )
- || $self->ut_foreign_key('refnum', 'part_referral', 'refnum' )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-Multiple pkg_referral records for a single package (configured off by default)
-still seems weird.
-
-=head1 SEE ALSO
-
-L<FS::part_referral>, L<FS::cust_pkg>, L<FS::Record>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/pkg_svc.pm b/FS/FS/pkg_svc.pm
deleted file mode 100644
index f79bb5e..0000000
--- a/FS/FS/pkg_svc.pm
+++ /dev/null
@@ -1,163 +0,0 @@
-package FS::pkg_svc;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs );
-use FS::part_pkg;
-use FS::part_svc;
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::pkg_svc - Object methods for pkg_svc records
-
-=head1 SYNOPSIS
-
- use FS::pkg_svc;
-
- $record = new FS::pkg_svc \%hash;
- $record = new FS::pkg_svc { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $part_pkg = $record->part_pkg;
-
- $part_svc = $record->part_svc;
-
-=head1 DESCRIPTION
-
-An FS::pkg_svc record links a billing item definition (see L<FS::part_pkg>) to
-a service definition (see L<FS::part_svc>). FS::pkg_svc inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item pkgsvcnum - primary key
-
-=item pkgpart - Billing item definition (see L<FS::part_pkg>)
-
-=item svcpart - Service definition (see L<FS::part_svc>)
-
-=item quantity - Quantity of this service definition that this billing item
-definition includes
-
-=item primary_svc - primary flag, empty or 'Y'
-
-=item hidden - 'Y' to hide this service on invoices, null otherwise.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Create a new record. To add the record to the database, see L<"insert">.
-
-=cut
-
-sub table { 'pkg_svc'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces 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 );
-
- $old = $new->replace_old unless defined($old);
-
- return "Can't change pkgpart!" if $old->pkgpart != $new->pkgpart;
- return "Can't change svcpart!" if $old->svcpart != $new->svcpart;
-
- $new->SUPER::replace($old);
-}
-
-=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
-
-sub check {
- my $self = shift;
-
- my $error;
- $error =
- $self->ut_numbern('pkgsvcnum')
- || $self->ut_number('pkgpart')
- || $self->ut_number('svcpart')
- || $self->ut_number('quantity')
- || $self->ut_enum('hidden', [ '', 'Y' ] )
- ;
- return $error if $error;
-
- return "Unknown pkgpart!" unless $self->part_pkg;
- return "Unknown svcpart!" unless $self->part_svc;
-
- if ( $self->dbdef_table->column('primary_svc') ) {
- $error = $self->ut_enum('primary_svc', [ '', 'Y' ] );
- return $error if $error;
- }
-
- $self->SUPER::check;
-}
-
-=item part_pkg
-
-Returns the FS::part_pkg object (see L<FS::part_pkg>).
-
-=cut
-
-sub part_pkg {
- my $self = shift;
- qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
-}
-
-=item part_svc
-
-Returns the FS::part_svc object (see L<FS::part_svc>).
-
-=cut
-
-sub part_svc {
- my $self = shift;
- qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::part_pkg>, L<FS::part_svc>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/port.pm b/FS/FS/port.pm
deleted file mode 100644
index c26ca85..0000000
--- a/FS/FS/port.pm
+++ /dev/null
@@ -1,154 +0,0 @@
-package FS::port;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs );
-use FS::nas;
-use FS::session;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::port - Object methods for port records
-
-=head1 SYNOPSIS
-
- use FS::port;
-
- $record = new FS::port \%hash;
- $record = new FS::port { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $session = $port->session;
-
-=head1 DESCRIPTION
-
-An FS::port object represents an individual port on a NAS. FS::port inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item portnum - primary key
-
-=item ip - IP address of this port
-
-=item nasport - port number on the NAS
-
-=item nasnum - NAS this port is on - see L<FS::nas>
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new port. To add the port 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 { 'port'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid port. 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('portnum')
- || $self->ut_ipn('ip')
- || $self->ut_numbern('nasport')
- || $self->ut_number('nasnum');
- ;
- return $error if $error;
- return "Either ip or nasport must be specified"
- unless $self->ip || $self->nasport;
- return "Unknown nasnum"
- unless qsearchs('nas', { 'nasnum' => $self->nasnum } );
- $self->SUPER::check;
-}
-
-=item session
-
-Returns the currently open session on this port, or if no session is currently
-open, the most recent session. See L<FS::session>.
-
-=cut
-
-sub session {
- my $self = shift;
- qsearchs('session', { 'portnum' => $self->portnum }, '*',
- 'ORDER BY login DESC LIMIT 1' );
-}
-
-=back
-
-=head1 BUGS
-
-The session method won't deal well if you have multiple open sessions on a
-port, for example if your RADIUS server drops B<stop> records. Suggestions for
-how to deal with this sort of lossage welcome; should we close the session
-when we get a new session on that port? Tag it as invalid somehow? Close it
-one second after it was opened? *sigh* Maybe FS::session shouldn't let you
-create overlapping sessions, at least folks will find out their logging is
-dropping records.
-
-If you think the above refers multiple user logins you need to read the
-manpages again.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/prepay_credit.pm b/FS/FS/prepay_credit.pm
deleted file mode 100644
index e5773ae..0000000
--- a/FS/FS/prepay_credit.pm
+++ /dev/null
@@ -1,203 +0,0 @@
-package FS::prepay_credit;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw(qsearchs dbh);
-use FS::agent;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::prepay_credit - Object methods for prepay_credit records
-
-=head1 SYNOPSIS
-
- use FS::prepay_credit;
-
- $record = new FS::prepay_credit \%hash;
- $record = new FS::prepay_credit {
- 'identifier' => '4198123455512121'
- 'amount' => '19.95',
- };
-
- $record = new FS::prepay_credit {
- 'identifier' => '4198123455512121'
- 'seconds' => '7200',
- };
-
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::prepay_credit object represents a pre-paid card. FS::prepay_credit
-inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item field - description
-
-=item identifier - identifier entered by the user to receive the credit
-
-=item amount - amount of the credit
-
-=item seconds - time amount of credit (see L<FS::svc_acct/seconds>)
-
-=item agentnum - optional agent (see L<FS::agent>) for this prepaid card
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new pre-paid credit. To add the pre-paid credit 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 { 'prepay_credit'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid pre-paid credit. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $identifier = $self->identifier;
- $identifier =~ s/\W//g; #anything else would just confuse things
- $self->identifier($identifier);
-
- $self->ut_numbern('prepaynum')
- || $self->ut_alpha('identifier')
- || $self->ut_money('amount')
- || $self->ut_numbern('seconds')
- || $self->ut_numbern('upbytes')
- || $self->ut_numbern('downbytes')
- || $self->ut_numbern('totalbytes')
- || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
- || $self->SUPER::check
- ;
-
-}
-
-=item agent
-
-Returns the agent (see L<FS::agent>) for this prepaid card, if any.
-
-=cut
-
-sub agent {
- my $self = shift;
- qsearchs('agent', { 'agentnum' => $self->agentnum } );
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item generate NUM TYPE LENGTH HASHREF
-
-Generates the specified number of prepaid cards. Returns an array reference of
-the newly generated card identifiers, or a scalar error message.
-
-=cut
-
-#false laziness w/agent::generate_reg_codes
-sub generate {
- my( $num, $type, $length, $hashref ) = @_;
-
- my @codeset = ();
- push @codeset, ( 'A'..'Z' ) if $type =~ /alpha/;
- push @codeset, ( '1'..'9' ) if $type =~ /numeric/;
- $length ||= 8;
-
- 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 $condup = 0; #don't retry forever
-
- my @cards = ();
- for ( 1 ... $num ) {
-
- my $identifier = join('', map($codeset[int(rand $#codeset)], (1..$length) ) );
-
- redo if qsearchs('prepay_credit',{identifier=>$identifier}) && $condup++<23;
- $condup = 0;
-
- my $prepay_credit = new FS::prepay_credit {
- 'identifier' => $identifier,
- %$hashref,
- };
- my $error = $prepay_credit->check || $prepay_credit->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "(inserting prepay_credit) $error";
- }
- push @cards, $prepay_credit->identifier;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- \@cards;
-
-}
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::svc_acct>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/prospect_main.pm b/FS/FS/prospect_main.pm
deleted file mode 100644
index 369029b..0000000
--- a/FS/FS/prospect_main.pm
+++ /dev/null
@@ -1,292 +0,0 @@
-package FS::prospect_main;
-
-use strict;
-use base qw( FS::o2m_Common FS::Record );
-use vars qw( $DEBUG );
-use Scalar::Util qw( blessed );
-use FS::Record qw( dbh qsearch ); #qsearchs );
-use FS::agent;
-use FS::cust_location;
-use FS::contact;
-
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::prospect_main - Object methods for prospect_main records
-
-=head1 SYNOPSIS
-
- use FS::prospect_main;
-
- $record = new FS::prospect_main \%hash;
- $record = new FS::prospect_main { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::prospect_main object represents a prospect. FS::prospect_main inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item prospectnum
-
-primary key
-
-=item company
-
-company
-
-=item locationnum
-
-locationnum
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new prospect. To add the prospect 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 { 'prospect_main'; }
-
-=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;
- my %options = @_;
- warn "FS::prospect_main::insert called on $self with options ".
- join(', ', map "$_=>$options{$_}", keys %options)
- if $DEBUG;
-
- 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;
-
- warn " inserting prospect_main record" if $DEBUG;
- my $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $options{'cust_location'} ) {
- warn " inserting cust_location record" if $DEBUG;
- my $cust_location = $options{'cust_location'};
- $cust_location->prospectnum($self->prospectnum);
- $error = $cust_location->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- warn " commiting transaction" if $DEBUG;
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-#delete dangling locations?
-
-=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;
-
- my %options = @_;
-
- warn "FS::prospect_main::replace called on $new to replace $old with options".
- " ". join(', ', map "$_ => ". $options{$_}, keys %options)
- if $DEBUG;
-
- 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;
-
- warn " replacing prospect_main record" if $DEBUG;
- my $error = $new->SUPER::replace($old);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $options{'cust_location'} ) {
- my $cust_location = $options{'cust_location'};
- $cust_location->prospectnum($new->prospectnum);
- my $method = $cust_location->locationnum ? 'replace' : 'insert';
- warn " ${method}ing cust_location record" if $DEBUG;
- $error = $cust_location->$method();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- } elsif ( exists($options{'cust_location'}) ) {
- foreach my $cust_location (
- qsearch('cust_location', { 'prospectnum' => $new->prospectnum } )
- ) {
- $error = $cust_location->delete();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- warn " commiting transaction" if $DEBUG;
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-=item check
-
-Checks all fields to make sure this is a valid prospect. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('prospectnum')
- || $self->ut_foreign_key('agentnum', 'agent', 'agentnum' )
- || $self->ut_text('company')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item contact
-
-Returns the contacts (see L<FS::contact>) associated with this prospect.
-
-=cut
-
-sub contact {
- my $self = shift;
- qsearch( 'contact', { 'prospectnum' => $self->prospectnum } );
-}
-
-=item search HASHREF
-
-(Class method)
-
-Returns a qsearch hash expression to search for the parameters specified in
-HASHREF. Valid parameters are:
-
-=over 4
-
-=item agentnum
-
-=back
-
-=cut
-
-sub search {
- my( $class, $params ) = @_;
-
- my @where = ();
- my $orderby;
-
- ##
- # parse agent
- ##
-
- if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
- push @where,
- "prospect_main.agentnum = $1";
- }
-
- ##
- # setup queries, subs, etc. for the search
- ##
-
- $orderby ||= 'ORDER BY prospectnum';
-
- # here is the agent virtualization
- push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
-
- my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
-
- my $count_query = "SELECT COUNT(*) FROM prospect_main $extra_sql";
-
- my $sql_query = {
- 'table' => 'prospect_main',
- #'select' => $select,
- 'hashref' => {},
- 'extra_sql' => $extra_sql,
- 'order_by' => $orderby,
- 'count_query' => $count_query,
- #'extra_headers' => \@extra_headers,
- #'extra_fields' => \@extra_fields,
- };
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/qual.pm b/FS/FS/qual.pm
deleted file mode 100644
index 23a8272..0000000
--- a/FS/FS/qual.pm
+++ /dev/null
@@ -1,191 +0,0 @@
-package FS::qual;
-
-use strict;
-use base qw( FS::option_Common );
-use FS::Record qw( qsearch qsearchs );
-
-=head1 NAME
-
-FS::qual - Object methods for qual records
-
-=head1 SYNOPSIS
-
- use FS::qual;
-
- $record = new FS::qual \%hash;
- $record = new FS::qual { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::qual object represents a qualification for service. FS::qual inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item qualnum - primary key
-
-=item prospectnum
-
-=item custnum
-
-=item locationnum
-
-=item phonenum - Service Telephone Number
-
-=item exportnum - export instance providing service-qualification capabilities,
-see L<FS::part_export>
-
-=item vendor_qual_id - qualification id from vendor/telco
-
-=item status - qualification status (e.g. (N)ew, (P)ending, (Q)ualifies)
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new qualification. To add the qualification 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 { 'qual'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid qualification. 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('qualnum')
- || $self->ut_foreign_keyn('custnum', 'cust_main', 'qualnum')
- || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
- || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
- || $self->ut_numbern('phonenum')
- || $self->ut_foreign_keyn('exportnum', 'part_export', 'exportnum')
- || $self->ut_textn('vendor_qual_id')
- || $self->ut_alpha('status')
- ;
- return $error if $error;
-
- return "Invalid prospect/customer/location combination" if (
- ( $self->locationnum && $self->prospectnum && $self->custnum ) ||
- ( !$self->locationnum && !$self->prospectnum && !$self->custnum )
- );
-
- $self->SUPER::check;
-}
-
-sub part_export {
- my $self = shift;
- if ( $self->exportnum ) {
- return qsearchs('part_export', { exportnum => $self->exportnum } )
- or die 'invalid exportnum';
- }
- '';
-}
-
-sub location {
- my $self = shift;
- if ( $self->locationnum ) {
- my $l = qsearchs( 'cust_location',
- { 'locationnum' => $self->locationnum });
- return $l->location_hash if $l;
- }
- if ( $self->custnum ) {
- my $c = qsearchs( 'cust_main', { 'custnum' => $self->custnum });
- return $c->location_hash if $c;
- }
- # prospectnum does not imply any particular address! must specify locationnum
-
- '';
-}
-
-sub cust_or_prospect {
- my $self = shift;
- if ( $self->locationnum ) {
- my $l = qsearchs( 'cust_location',
- { 'locationnum' => $self->locationnum });
- return qsearchs('cust_main',{ 'custnum' => $l->custnum })
- if $l->custnum;
- return qsearchs('prospect_main',{ 'prospectnum' => $l->prospectnum })
- if $l->prospectnum;
- }
- return qsearchs('cust_main', { 'custnum' => $self->custnum })
- if $self->custnum;
- return qsearchs('prospect_main', { 'prospectnum' => $self->prospectnum })
- if $self->prospectnum;
-}
-
-sub status_long {
- my $self = shift;
- my $s = {
- 'Q' => 'Qualified',
- 'D' => 'Does not Qualify',
- 'N' => 'New',
- };
- return $s->{$self->status} if defined $s->{$self->status};
- return 'Unknown';
-}
-
-=back
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/qual_option.pm b/FS/FS/qual_option.pm
deleted file mode 100644
index c8b7547..0000000
--- a/FS/FS/qual_option.pm
+++ /dev/null
@@ -1,128 +0,0 @@
-package FS::qual_option;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::qual;
-
-=head1 NAME
-
-FS::qual_option - Object methods for qual_option records
-
-=head1 SYNOPSIS
-
- use FS::qual_option;
-
- $record = new FS::qual_option \%hash;
- $record = new FS::qual_option { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::qual_option object represents a qualification option.
-FS::qual_option inherits from FS::Record. The following fields are currently
-supported:
-
-=over 4
-
-=item optionnum - primary key
-
-=item qualnum - qualification (see L<FS::qual>)
-
-=item optionname - option name
-
-=item optionvalue - option value
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new qualification option. To add the qualification option 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 { 'qual_option'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid qualification option. 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('optionnum')
- || $self->ut_foreign_key('qualnum', 'qual', 'qualnum')
- || $self->ut_alpha('optionname')
- || $self->ut_textn('optionvalue')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-This doesn't do anything yet.
-
-=head1 SEE ALSO
-
-L<FS::qual>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm
deleted file mode 100644
index 3f8763d..0000000
--- a/FS/FS/queue.pm
+++ /dev/null
@@ -1,526 +0,0 @@
-package FS::queue;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK $DEBUG $conf $jobnums);
-use Exporter;
-use MIME::Base64;
-use Storable qw( nfreeze thaw );
-use FS::UID qw(myconnect);
-use FS::Conf;
-use FS::Record qw( qsearch qsearchs dbh );
-#use FS::queue;
-use FS::queue_arg;
-use FS::queue_depend;
-use FS::cust_svc;
-use FS::CGI qw(rooturl);
-
-@ISA = qw(FS::Record);
-@EXPORT_OK = qw( joblisting );
-
-$DEBUG = 0;
-
-$FS::UID::callback{'FS::queue'} = sub {
- $conf = new FS::Conf;
-};
-
-$jobnums = '';
-
-=head1 NAME
-
-FS::queue - Object methods for queue records
-
-=head1 SYNOPSIS
-
- use FS::queue;
-
- $record = new FS::queue \%hash;
- $record = new FS::queue { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::queue object represents an queued job. FS::queue inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item jobnum
-
-Primary key
-
-=item job
-
-Fully-qualified subroutine name
-
-=item status
-
-Job status (new, locked, or failed)
-
-=item statustext
-
-Freeform text status message
-
-=cut
-
-sub statustext {
- my $self = shift;
- if ( defined ( $_[0] ) ) {
- $self->SUPER::statustext(@_);
- } else {
- my $value = $self->SUPER::statustext();
- my $rooturl = rooturl();
- $value =~ s/%%%ROOTURL%%%/$rooturl/g;
- $value;
- }
-}
-
-=item _date
-
-UNIX timestamp
-
-=item svcnum
-
-Optional link to service (see L<FS::cust_svc>).
-
-=item custnum
-
-Optional link to customer (see L<FS::cust_main>).
-
-=item secure
-
-Secure flag, 'Y' indicates that when using encryption, the job needs to be
-run on a machine with the private key.
-
-=cut
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new job. To add the job 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 { 'queue'; }
-
-=item insert [ ARGUMENT, ARGUMENT... ]
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-If any arguments are supplied, a queue_arg record for each argument is also
-created (see L<FS::queue_arg>).
-
-=cut
-
-#false laziness w/part_export.pm
-sub insert {
- my( $self, @args ) = @_;
-
- 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 %args = ();
- {
- no warnings "misc";
- %args = @args;
- }
-
- $self->custnum( $args{'custnum'} ) if $args{'custnum'};
-
- my $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- foreach my $arg ( @args ) {
- my $freeze = ref($arg) ? 'Y' : '';
- my $queue_arg = new FS::queue_arg ( {
- 'jobnum' => $self->jobnum,
- 'frozen' => $freeze,
- 'arg' => $freeze ? encode_base64(nfreeze($arg)) : $arg,# always freeze?
- } );
- $error = $queue_arg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- if ( $jobnums ) {
- warn "jobnums global is active: $jobnums\n" if $DEBUG;
- push @$jobnums, $self->jobnum;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-
-}
-
-=item delete
-
-Delete this record from the database. Any corresponding queue_arg records are
-deleted as well
-
-=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 @del = qsearch( 'queue_arg', { 'jobnum' => $self->jobnum } );
- push @del, qsearch( 'queue_depend', { 'depend_jobnum' => $self->jobnum } );
-
- my $reportname = '';
- if ( $self->status =~/^done/ ) {
- my $dropstring = rooturl(). '/misc/queued_report\?report=';
- if ($self->statustext =~ /.*$dropstring([.\w]+)\>/) {
- $reportname = "$FS::UID::cache_dir/cache.$FS::UID::datasrc/report.$1";
- }
- }
-
- my $error = $self->SUPER::delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- foreach my $del ( @del ) {
- $error = $del->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- unlink $reportname if $reportname;
-
- '';
-
-}
-
-=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 job. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
- my $error =
- $self->ut_numbern('jobnum')
- || $self->ut_anything('job')
- || $self->ut_numbern('_date')
- || $self->ut_enum('status',['', qw( new locked failed done )])
- || $self->ut_anything('statustext')
- || $self->ut_numbern('svcnum')
- ;
- return $error if $error;
-
- $error = $self->ut_foreign_keyn('svcnum', 'cust_svc', 'svcnum');
- $self->svcnum('') if $error;
-
- $self->status('new') unless $self->status;
- $self->_date(time) unless $self->_date;
-
- $self->SUPER::check;
-}
-
-=item args
-
-Returns a list of the arguments associated with this job.
-
-=cut
-
-sub args {
- my $self = shift;
- map { $_->frozen ? thaw(decode_base64($_->arg)) : $_->arg }
- qsearch( 'queue_arg',
- { 'jobnum' => $self->jobnum },
- '',
- 'ORDER BY argnum'
- );
-}
-
-=item cust_svc
-
-Returns the FS::cust_svc object associated with this job, if any.
-
-=cut
-
-sub cust_svc {
- my $self = shift;
- qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
-}
-
-=item queue_depend
-
-Returns the FS::queue_depend objects associated with this job, if any.
-(Dependancies that must complete before this job can be run).
-
-=cut
-
-sub queue_depend {
- my $self = shift;
- qsearch('queue_depend', { 'jobnum' => $self->jobnum } );
-}
-
-=item depend_insert OTHER_JOBNUM
-
-Inserts a dependancy for this job - it will not be run until the other job
-specified completes. If there is an error, returns the error, otherwise
-returns false.
-
-When using job dependancies, you should wrap the insertion of all relevant jobs
-in a database transaction.
-
-=cut
-
-sub depend_insert {
- my($self, $other_jobnum) = @_;
- my $queue_depend = new FS::queue_depend ( {
- 'jobnum' => $self->jobnum,
- 'depend_jobnum' => $other_jobnum,
- } );
- $queue_depend->insert;
-}
-
-=item queue_depended
-
-Returns the FS::queue_depend objects that associate other jobs with this job,
-if any. (The jobs that are waiting for this job to complete before they can
-run).
-
-=cut
-
-sub queue_depended {
- my $self = shift;
- qsearch('queue_depend', { 'depend_jobnum' => $self->jobnum } );
-}
-
-=item depended_delete
-
-Deletes the other queued jobs (FS::queue objects) that are waiting for this
-job, if any. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub depended_delete {
- my $self = shift;
- my $error;
- foreach my $job (
- map { qsearchs('queue', { 'jobnum' => $_->jobnum } ) } $self->queue_depended
- ) {
- $error = $job->depended_delete;
- return $error if $error;
- $error = $job->delete;
- return $error if $error
- }
-}
-
-=item update_statustext VALUE
-
-Updates the statustext value of this job to supplied value, in the database.
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-use vars qw($_update_statustext_dbh);
-sub update_statustext {
- my( $self, $statustext ) = @_;
- return '' if $statustext eq $self->get('statustext'); #avoid rooturl expansion
- warn "updating statustext for $self to $statustext" if $DEBUG;
-
- $_update_statustext_dbh ||= myconnect;
-
- my $sth = $_update_statustext_dbh->prepare(
- 'UPDATE queue set statustext = ? WHERE jobnum = ?'
- ) or return $_update_statustext_dbh->errstr;
-
- $sth->execute($statustext, $self->jobnum) or return $sth->errstr;
- $_update_statustext_dbh->commit or die $_update_statustext_dbh->errstr;
- $self->set('statustext', $statustext); #avoid rooturl expansion
- '';
-
- #my $new = new FS::queue { $self->hash };
- #$new->statustext($statustext);
- #my $error = $new->replace($self);
- #return $error if $error;
- #$self->statustext($statustext);
- #'';
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item joblisting HASHREF NOACTIONS
-
-=cut
-
-sub joblisting {
- my($hashref, $noactions) = @_;
-
- use Date::Format;
- use HTML::Entities;
- use FS::CGI;
-
- my @queue = qsearch( 'queue', $hashref );
- return '' unless scalar(@queue);
-
- my $p = FS::CGI::popurl(2);
-
- my $html = qq!<FORM ACTION="$p/misc/queue.cgi" METHOD="POST">!.
- FS::CGI::table(). <<END;
- <TR>
- <TH COLSPAN=2>Job</TH>
- <TH>Args</TH>
- <TH>Date</TH>
- <TH>Status</TH>
-END
- $html .= '<TH>Account</TH>' unless $hashref->{svcnum};
- $html .= '</TR>';
-
- my $dangerous = $conf->exists('queue_dangerous_controls');
-
- my $areboxes = 0;
-
- foreach my $queue ( sort {
- $a->getfield('jobnum') <=> $b->getfield('jobnum')
- } @queue ) {
- my $queue_hashref = $queue->hashref;
- my $jobnum = $queue->jobnum;
-
- my $args;
- if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) {
- $args = encode_entities( join(' ', $queue->args) );
- } else {
- $args = '';
- }
-
- my $date = time2str( "%a %b %e %T %Y", $queue->_date );
- my $status = $queue->status;
- $status .= ': '. $queue->statustext if $queue->statustext;
- my @queue_depend = $queue->queue_depend;
- $status .= ' (waiting for '.
- join(', ', map { $_->depend_jobnum } @queue_depend ).
- ')'
- if @queue_depend;
- my $changable = $dangerous
- || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ );
- if ( $changable ) {
- $status .=
- qq! (&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=new">retry</A>&nbsp;|!.
- qq!&nbsp;<A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=del">remove</A>&nbsp;)!;
- }
- my $cust_svc = $queue->cust_svc;
-
- $html .= <<END;
- <TR>
- <TD>$jobnum</TD>
- <TD>$queue_hashref->{job}</TD>
- <TD>$args</TD>
- <TD>$date</TD>
- <TD>$status</TD>
-END
-
- unless ( $hashref->{svcnum} ) {
- my $account;
- if ( $cust_svc ) {
- my $table = $cust_svc->part_svc->svcdb;
- my $label = ( $cust_svc->label )[1];
- $account = qq!<A HREF="../view/$table.cgi?!. $queue->svcnum.
- qq!">$label</A>!;
- } else {
- $account = '';
- }
- $html .= "<TD>$account</TD>";
- }
-
- if ( $changable ) {
- $areboxes=1;
- $html .=
- qq!<TD><INPUT NAME="jobnum$jobnum" TYPE="checkbox" VALUE="1"></TD>!;
-
- }
-
- $html .= '</TR>';
-
-}
-
- $html .= '</TABLE>';
-
- if ( $areboxes ) {
- $html .= '<BR><INPUT TYPE="submit" NAME="action" VALUE="retry selected">'.
- '<INPUT TYPE="submit" NAME="action" VALUE="remove selected"><BR>';
- }
-
- $html;
-
-}
-
-=back
-
-=head1 BUGS
-
-$jobnums global
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/queue_arg.pm b/FS/FS/queue_arg.pm
deleted file mode 100644
index 8e9a10d..0000000
--- a/FS/FS/queue_arg.pm
+++ /dev/null
@@ -1,120 +0,0 @@
-package FS::queue_arg;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::queue_arg - Object methods for queue_arg records
-
-=head1 SYNOPSIS
-
- use FS::queue_arg;
-
- $record = new FS::queue_arg \%hash;
- $record = new FS::queue_arg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::queue_arg object represents job argument. FS::queue_arg inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item argnum - primary key
-
-=item jobnum - see L<FS::queue>
-
-=item frozen - argument is frozen with Storable
-
-=item arg - argument
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new argument. To add the argument 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 { 'queue_arg'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid argument. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
- my $error =
- $self->ut_numbern('argnum')
- || $self->ut_numbern('jobnum')
- || $self->ut_enum('frozen', [ '', 'Y' ])
- || $self->ut_anything('arg')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::queue>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/queue_depend.pm b/FS/FS/queue_depend.pm
deleted file mode 100644
index 99a22c5..0000000
--- a/FS/FS/queue_depend.pm
+++ /dev/null
@@ -1,121 +0,0 @@
-package FS::queue_depend;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::queue;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::queue_depend - Object methods for queue_depend records
-
-=head1 SYNOPSIS
-
- use FS::queue_depend;
-
- $record = new FS::queue_depend \%hash;
- $record = new FS::queue_depend { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::queue_depend object represents an job dependancy. FS::queue_depend
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item dependnum - primary key
-
-=item jobnum - source jobnum (see L<FS::queue>).
-
-=item depend_jobnum - dependancy jobnum (see L<FS::queue>)
-
-=back
-
-The job specified by B<jobnum> depends on the job specified B<depend_jobnum> -
-the B<jobnum> job will not be run until the B<depend_jobnum> job has completed
-successfully (or manually removed).
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new dependancy. To add the dependancy 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 { 'queue_depend'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid dependancy. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->ut_numbern('dependnum')
- || $self->ut_foreign_key('jobnum', 'queue', 'jobnum')
- || $self->ut_foreign_key('depend_jobnum', 'queue', 'jobnum')
- || $self->SUPER::check
- ;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::queue>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/raddb.pm b/FS/FS/raddb.pm
deleted file mode 100644
index 506b325..0000000
--- a/FS/FS/raddb.pm
+++ /dev/null
@@ -1,1912 +0,0 @@
-package FS::raddb;
-use vars qw(%attrib);
-
-%attrib = (
- '3com_user_access_level' => '3Com-User-Access-Level',
- '3gpp2_accounting_contain' => '3GPP2-Accounting-Container',
- '3gpp2_acct_stop_trigger' => '3GPP2-Acct-Stop-Trigger',
- '3gpp2_active_time' => '3GPP2-Active-Time',
- '3gpp2_airlink_priority' => '3GPP2-Airlink-Priority',
- '3gpp2_airlink_record_typ' => '3GPP2-Airlink-Record-Type',
- '3gpp2_airlink_sequence_n' => '3GPP2-Airlink-Sequence-Number',
- '3gpp2_allowed_diffserv_m' => '3GPP2-Allowed-Diffserv-Marking',
- '3gpp2_allowed_persistent' => '3GPP2-Allowed-Persistent-TFTs',
- '3gpp2_bad_ppp_frame_coun' => '3GPP2-Bad-PPP-Frame-Count',
- '3gpp2_begin_session' => '3GPP2-Begin-Session',
- '3gpp2_bsid' => '3GPP2-BSID',
- '3gpp2_compulsory_tunnel_' => '3GPP2-Compulsory-Tunnel-Indicator',
- '3gpp2_correlation_id' => '3GPP2-Correlation-Id',
- '3gpp2_dcch_frame_size' => '3GPP2-DCCH-Frame-Size',
- '3gpp2_diffserv_class_opt' => '3GPP2-Diffserv-Class-Option',
- '3gpp2_disconnect_reason' => '3GPP2-Disconnect-Reason',
- '3gpp2_dns_update_capabil' => '3GPP2-DNS-Update-Capability',
- '3gpp2_dns_update_require' => '3GPP2-DNS-Update-Required',
- '3gpp2_esn' => '3GPP2-ESN',
- '3gpp2_fch_frame_size' => '3GPP2-FCH-Frame-Size',
- '3gpp2_foreign_agent_addr' => '3GPP2-Foreign-Agent-Address',
- '3gpp2_forward_dcch_mux_o' => '3GPP2-Forward-DCCH-Mux-Option',
- '3gpp2_forward_dcch_rc' => '3GPP2-Forward-DCCH-RC',
- '3gpp2_forward_fch_mux_op' => '3GPP2-Forward-FCH-Mux-Option',
- '3gpp2_forward_fch_rc' => '3GPP2-Forward-FCH-RC',
- '3gpp2_forward_pdch_rc' => '3GPP2-Forward-PDCH-RC',
- '3gpp2_forward_traffic_ty' => '3GPP2-Forward-Traffic-Type',
- '3gpp2_home_agent_ip_addr' => '3GPP2-Home-Agent-IP-Address',
- '3gpp2_ike_preshared_secr' => '3GPP2-Ike-Preshared-Secret-Request',
- '3gpp2_inbound_mobile_ip_' => '3GPP2-Inbound-Mobile-IP-Sig-Octets',
- '3gpp2_ip_qos' => '3GPP2-IP-QoS',
- '3gpp2_ip_technology' => '3GPP2-IP-Technology',
- '3gpp2_keyid' => '3GPP2-KeyID',
- '3gpp2_last_user_activity' => '3GPP2-Last-User-Activity-Time',
- '3gpp2_mip_lifetime' => '3GPP2-MIP-Lifetime',
- '3gpp2_mn_aaa_removal_ind' => '3GPP2-MN-AAA-Removal-Indication',
- '3gpp2_mn_ha_shared_key' => '3GPP2-MN-HA-Shared-Key',
- '3gpp2_mn_ha_spi' => '3GPP2-MN-HA-SPI',
- '3gpp2_module_orig_term_i' => '3GPP2-Module-Orig-Term-Indicator',
- '3gpp2_number_active_tran' => '3GPP2-Number-Active-Transitions',
- '3gpp2_originating_number' => '3GPP2-Originating-Number-SDBs',
- '3gpp2_originating_sdb_oc' => '3GPP2-Originating-SDB-OCtet-Count',
- '3gpp2_outbound_mobile_ip' => '3GPP2-Outbound-Mobile-IP-Sig-Octets',
- '3gpp2_pcf_ip_address' => '3GPP2-PCF-IP-Address',
- '3gpp2_pre_shared_secret' => '3GPP2-Pre-Shared-Secret',
- '3gpp2_prepaid_acct_capab' => '3GPP2-Prepaid-acct-Capability',
- '3gpp2_prepaid_acct_quota' => '3GPP2-Prepaid-Acct-Quota',
- '3gpp2_prepaid_tariff_swi' => '3GPP2-PrePaid-Tariff-Switching',
- '3gpp2_received_hdlc_octe' => '3GPP2-Received-HDLC-Octets',
- '3gpp2_release_indicator' => '3GPP2-Release-Indicator',
- '3gpp2_remote_address_tab' => '3GPP2-Remote-Address-Table-Index',
- '3gpp2_remote_ip_address' => '3GPP2-Remote-IP-Address',
- '3gpp2_remote_ipv4_addr_o' => '3GPP2-Remote-IPv4-Addr-Octet-Count',
- '3gpp2_remote_ipv6_addres' => '3GPP2-Remote-IPv6-Address',
- '3gpp2_remote_ipv6_octet_' => '3GPP2-Remote-IPv6-Octet-Count',
- '3gpp2_reverse_dcch_mux_o' => '3GPP2-Reverse-DCCH-Mux-Option',
- '3gpp2_reverse_dhhc_rc' => '3GPP2-Reverse-DHHC-RC',
- '3gpp2_reverse_fch_mux_op' => '3GPP2-Reverse-FCH-Mux-Option',
- '3gpp2_reverse_fch_rc' => '3GPP2-Reverse-FCH-RC',
- '3gpp2_reverse_traffic_ty' => '3GPP2-Reverse-Traffic-Type',
- '3gpp2_reverse_tunnel_spe' => '3GPP2-Reverse-Tunnel-Spec',
- '3gpp2_rn_packet_data_ina' => '3GPP2-RN-Packet-Data-Inactivity-Timer',
- '3gpp2_s_key' => '3GPP2-S-Key',
- '3gpp2_s_lifetime' => '3GPP2-S-Lifetime',
- '3gpp2_s_request' => '3GPP2-S-Request',
- '3gpp2_security_level' => '3GPP2-Security-Level',
- '3gpp2_service_option' => '3GPP2-Service-Option',
- '3gpp2_service_option_pro' => '3GPP2-Service-Option-Profile',
- '3gpp2_service_reference_' => '3GPP2-Service-Reference-Id',
- '3gpp2_session_continue' => '3GPP2-Session-Continue',
- '3gpp2_session_terminatio' => '3GPP2-Session-Termination-Capability',
- '3gpp2_terminating_number' => '3GPP2-Terminating-Number-SDBs',
- '3gpp2_terminating_sdb_oc' => '3GPP2-Terminating-SDB-Octet-Count',
- '3gpp2_user_id' => '3GPP2-User-Id',
- '3gpp_charging_characteri' => '3GPP-Charging-Characteristics',
- '3gpp_charging_gateway_ad' => '3GPP-Charging-Gateway-Address',
- '3gpp_charging_gateway_ip' => '3GPP-Charging-Gateway-IPv6-Address',
- '3gpp_charging_id' => '3GPP-Charging-ID',
- '3gpp_ggsn_address' => '3GPP-GGSN-Address',
- '3gpp_ggsn_ipv6_address' => '3GPP-GGSN-IPv6-Address',
- '3gpp_ggsn_mcc_mnc' => '3GPP-GGSN-MCC-MNC',
- '3gpp_gprs_negotiated_qos' => '3GPP-GPRS-Negotiated-QoS-profile',
- '3gpp_imsi' => '3GPP-IMSI',
- '3gpp_imsi_mcc_mnc' => '3GPP-IMSI-MCC-MNC',
- '3gpp_ipv6_dns_servers' => '3GPP-IPv6-DNS-Servers',
- '3gpp_nsapi' => '3GPP-NSAPI',
- '3gpp_pdp_type' => '3GPP-PDP-Type',
- '3gpp_selection_mode' => '3GPP-Selection-Mode',
- '3gpp_session_stop_indica' => '3GPP-Session-Stop-Indicator',
- '3gpp_sgsn_address' => '3GPP-SGSN-Address',
- '3gpp_sgsn_ipv6_address' => '3GPP-SGSN-IPv6-Address',
- 'aat_assign_ip_pool' => 'AAT-Assign-IP-Pool',
- 'aat_atm_direct' => 'AAT-ATM-Direct',
- 'aat_atm_traffic_profile' => 'AAT-ATM-Traffic-Profile',
- 'aat_atm_vci' => 'AAT-ATM-VCI',
- 'aat_atm_vpi' => 'AAT-ATM-VPI',
- 'aat_client_primary_dns' => 'AAT-Client-Primary-DNS',
- 'aat_client_primary_wins_' => 'AAT-Client-Primary-WINS-NBNS',
- 'aat_client_secondary_win' => 'AAT-Client-Secondary-WINS-NBNS',
- 'aat_data_filter' => 'AAT-Data-Filter',
- 'aat_input_octets_diff' => 'AAT-Input-Octets-Diff',
- 'aat_ip_pool_definition' => 'AAT-IP-Pool-Definition',
- 'aat_ip_tos' => 'AAT-IP-TOS',
- 'aat_ip_tos_apply_to' => 'AAT-IP-TOS-Apply-To',
- 'aat_ip_tos_precedence' => 'AAT-IP-TOS-Precedence',
- 'aat_mcast_client' => 'AAT-MCast-Client',
- 'aat_output_octets_diff' => 'AAT-Output-Octets-Diff',
- 'aat_ppp_address' => 'AAT-PPP-Address',
- 'aat_require_auth' => 'AAT-Require-Auth',
- 'aat_source_ip_check' => 'AAT-Source-IP-Check',
- 'aat_user_mac_address' => 'AAT-User-MAC-Address',
- 'aat_vrouter_name' => 'AAT-Vrouter-Name',
- 'acc_access_community' => 'Acc-Access-Community',
- 'acc_access_partition' => 'Acc-Access-Partition',
- 'acc_acct_on_off_reason' => 'Acc-Acct-On-Off-Reason',
- 'acc_ace_token' => 'Acc-Ace-Token',
- 'acc_ace_token_ttl' => 'Acc-Ace-Token-Ttl',
- 'acc_apsm_oversubscribed' => 'Acc-Apsm-Oversubscribed',
- 'acc_bridging_support' => 'Acc-Bridging-Support',
- 'acc_callback_cbcp_type' => 'Acc-Callback-CBCP-Type',
- 'acc_callback_delay' => 'Acc-Callback-Delay',
- 'acc_callback_mode' => 'Acc-Callback-Mode',
- 'acc_callback_num_valid' => 'Acc-Callback-Num-Valid',
- 'acc_ccp_option' => 'Acc-Ccp-Option',
- 'acc_clearing_cause' => 'Acc-Clearing-Cause',
- 'acc_clearing_location' => 'Acc-Clearing-Location',
- 'acc_connect_rx_speed' => 'Acc-Connect-Rx-Speed',
- 'acc_connect_tx_speed' => 'Acc-Connect-Tx-Speed',
- 'acc_customer_id' => 'Acc-Customer-Id',
- 'acc_dial_port_index' => 'Acc-Dial-Port-Index',
- 'acc_dialout_auth_mode' => 'Acc-Dialout-Auth-Mode',
- 'acc_dialout_auth_passwor' => 'Acc-Dialout-Auth-Password',
- 'acc_dialout_auth_usernam' => 'Acc-Dialout-Auth-Username',
- 'acc_dns_server_pri' => 'Acc-Dns-Server-Pri',
- 'acc_dns_server_sec' => 'Acc-Dns-Server-Sec',
- 'acc_igmp_admin_state' => 'Acc-Igmp-Admin-State',
- 'acc_igmp_version' => 'Acc-Igmp-Version',
- 'acc_input_errors' => 'Acc-Input-Errors',
- 'acc_ip_compression' => 'Acc-Ip-Compression',
- 'acc_ip_gateway_pri' => 'Acc-Ip-Gateway-Pri',
- 'acc_ip_gateway_sec' => 'Acc-Ip-Gateway-Sec',
- 'acc_ip_pool_name' => 'Acc-Ip-Pool-Name',
- 'acc_ipx_compression' => 'Acc-Ipx-Compression',
- 'acc_ml_call_threshold' => 'Acc-ML-Call-Threshold',
- 'acc_ml_clear_threshold' => 'Acc-ML-Clear-Threshold',
- 'acc_ml_damping_factor' => 'Acc-ML-Damping-Factor',
- 'acc_ml_mlx_admin_state' => 'Acc-ML-MLX-Admin-State',
- 'acc_modem_error_protocol' => 'Acc-Modem-Error-Protocol',
- 'acc_modem_modulation_typ' => 'Acc-Modem-Modulation-Type',
- 'acc_nbns_server_pri' => 'Acc-Nbns-Server-Pri',
- 'acc_nbns_server_sec' => 'Acc-Nbns-Server-Sec',
- 'acc_output_errors' => 'Acc-Output-Errors',
- 'acc_reason_code' => 'Acc-Reason-Code',
- 'acc_request_type' => 'Acc-Request-Type',
- 'acc_route_policy' => 'Acc-Route-Policy',
- 'acc_service_profile' => 'Acc-Service-Profile',
- 'acc_tunnel_port' => 'Acc-Tunnel-Port',
- 'acc_tunnel_secret' => 'Acc-Tunnel-Secret',
- 'acc_vpsm_reject_cause' => 'Acc-Vpsm-Reject-Cause',
- 'acct_authentic' => 'Acct-Authentic',
- 'acct_delay_time' => 'Acct-Delay-Time',
- 'acct_dyn_ac_ent' => 'Acct_Dyn_Ac_Ent',
- 'acct_dyn_ac_enu' => 'Acct-Dyn-Ac-Ent',
- 'acct_input_gigawords' => 'Acct-Input-Gigawords',
- 'acct_input_octets' => 'Acct-Input-Octets',
- 'acct_input_octets_64' => 'Acct_Input_Octets_64',
- 'acct_input_octets_65' => 'Acct-Input-Octets-64',
- 'acct_input_packets' => 'Acct-Input-Packets',
- 'acct_input_packets_64' => 'Acct_Input_Packets_64',
- 'acct_input_packets_65' => 'Acct-Input-Packets-64',
- 'acct_interim_interval' => 'Acct-Interim-Interval',
- 'acct_link_count' => 'Acct-Link-Count',
- 'acct_mcast_in_octets' => 'Acct_Mcast_In_Octets',
- 'acct_mcast_in_octett' => 'Acct-Mcast-In-Octets',
- 'acct_mcast_in_packets' => 'Acct_Mcast_In_Packets',
- 'acct_mcast_in_packett' => 'Acct-Mcast-In-Packets',
- 'acct_mcast_out_octets' => 'Acct_Mcast_Out_Octets',
- 'acct_mcast_out_octett' => 'Acct-Mcast-Out-Octets',
- 'acct_mcast_out_packets' => 'Acct_Mcast_Out_Packets',
- 'acct_mcast_out_packett' => 'Acct-Mcast-Out-Packets',
- 'acct_multi_session_id' => 'Acct-Multi-Session-Id',
- 'acct_output_gigawords' => 'Acct-Output-Gigawords',
- 'acct_output_octets' => 'Acct-Output-Octets',
- 'acct_output_octets_64' => 'Acct_Output_Octets_64',
- 'acct_output_octets_65' => 'Acct-Output-Octets-64',
- 'acct_output_packets' => 'Acct-Output-Packets',
- 'acct_output_packets_64' => 'Acct_Output_Packets_64',
- 'acct_output_packets_65' => 'Acct-Output-Packets-64',
- 'acct_session_gigawords' => 'Acct-Session-Gigawords',
- 'acct_session_id' => 'Acct-Session-Id',
- 'acct_session_input_gigaw' => 'Acct-Session-Input-Gigawords',
- 'acct_session_input_octet' => 'Acct-Session-Input-Octets',
- 'acct_session_octets' => 'Acct-Session-Octets',
- 'acct_session_output_giga' => 'Acct-Session-Output-Gigawords',
- 'acct_session_output_octe' => 'Acct-Session-Output-Octets',
- 'acct_session_start_time' => 'Acct-Session-Start-Time',
- 'acct_session_time' => 'Acct-Session-Time',
- 'acct_status_type' => 'Acct-Status-Type',
- 'acct_terminate_cause' => 'Acct-Terminate-Cause',
- 'acct_tunnel_connection' => 'Acct-Tunnel-Connection',
- 'acct_tunnel_packets_lost' => 'Acct-Tunnel-Packets-Lost',
- 'acct_type' => 'Acct-Type',
- 'acct_unique_session_id' => 'Acct-Unique-Session-Id',
- 'add_prefix' => 'Add-Prefix',
- 'add_suffix' => 'Add-Suffix',
- 'alteon_service_type' => 'Alteon-Service-Type',
- 'altiga_access_hours_g_u' => 'Altiga-Access-Hours-G/U',
- 'altiga_allow_alpha_only_' => 'Altiga-Allow-Alpha-Only-Passwords-G',
- 'altiga_ipsec_allow_passw' => 'Altiga-IPSec-Allow-Passwd-Store-G/U',
- 'altiga_ipsec_authenticat' => 'Altiga-IPSec-Authentication-G',
- 'altiga_ipsec_banner_g' => 'Altiga-IPSec-Banner-G',
- 'altiga_ipsec_default_dom' => 'Altiga-IPSec-Default-Domain-G',
- 'altiga_ipsec_l2l_keepali' => 'Altiga-IPSec-L2L-Keepalives-G',
- 'altiga_ipsec_mode_config' => 'Altiga-IPSec-Mode-Config-G',
- 'altiga_ipsec_over_nat_g' => 'Altiga-IPSec-Over-NAT-G',
- 'altiga_ipsec_over_nat_po' => 'Altiga-IPSec-Over-NAT-Port-Num-G',
- 'altiga_ipsec_sec_associa' => 'Altiga-IPSec-Sec-Association-G/U',
- 'altiga_ipsec_secondary_d' => 'Altiga-IPSec-Secondary-Domains-G',
- 'altiga_ipsec_split_tunne' => 'Altiga-IPSec-Split-Tunnel-List-G',
- 'altiga_ipsec_tunnel_type' => 'Altiga-IPSec-Tunnel-Type-G',
- 'altiga_ipsec_user_group_' => 'Altiga-IPSec-User-Group-Lock-G',
- 'altiga_l2tp_encryption_g' => 'Altiga-L2TP-Encryption-G',
- 'altiga_l2tp_min_authenti' => 'Altiga-L2TP-Min-Authentication-G/U',
- 'altiga_min_password_leng' => 'Altiga-Min-Password-Length-G',
- 'altiga_pptp_encryption_g' => 'Altiga-PPTP-Encryption-G',
- 'altiga_pptp_min_authenti' => 'Altiga-PPTP-Min-Authentication-G/U',
- 'altiga_primary_dns_g' => 'Altiga-Primary-DNS-G',
- 'altiga_primary_wins_g' => 'Altiga-Primary-WINS-G',
- 'altiga_priority_on_sep_g' => 'Altiga-Priority-on-SEP-G/U',
- 'altiga_secondary_dns_g' => 'Altiga-Secondary-DNS-G',
- 'altiga_secondary_wins_g' => 'Altiga-Secondary-WINS-G',
- 'altiga_sep_card_assignme' => 'Altiga-SEP-Card-Assignment-G/U',
- 'altiga_simultaneous_logi' => 'Altiga-Simultaneous-Logins-G/U',
- 'altiga_tunneling_protoco' => 'Altiga-Tunneling-Protocols-G/U',
- 'altiga_use_client_addres' => 'Altiga-Use-Client-Address-G/U',
- 'annex_acct_servers' => 'Annex-Acct-Servers',
- 'annex_addr_resolution_pr' => 'Annex-Addr-Resolution-Protocol',
- 'annex_addr_resolution_se' => 'Annex-Addr-Resolution-Servers',
- 'annex_audit_level' => 'Annex-Audit-Level',
- 'annex_authen_servers' => 'Annex-Authen-Servers',
- 'annex_begin_modulation' => 'Annex-Begin-Modulation',
- 'annex_begin_receive_line' => 'Annex-Begin-Receive-Line-Level',
- 'annex_callback_portlist' => 'Annex-Callback-Portlist',
- 'annex_cli_command' => 'Annex-CLI-Command',
- 'annex_cli_filter' => 'Annex-CLI-Filter',
- 'annex_compression_protoc' => 'Annex-Compression-Protocol',
- 'annex_connect_progress' => 'Annex-Connect-Progress',
- 'annex_disconnect_reason' => 'Annex-Disconnect-Reason',
- 'annex_domain_name' => 'Annex-Domain-Name',
- 'annex_edo' => 'Annex-EDO',
- 'annex_end_modulation' => 'Annex-End-Modulation',
- 'annex_end_receive_line_l' => 'Annex-End-Receive-Line-Level',
- 'annex_error_correction_p' => 'Annex-Error-Correction-Prot',
- 'annex_filter' => 'Annex-Filter',
- 'annex_host_allow' => 'Annex-Host-Allow',
- 'annex_host_restrict' => 'Annex-Host-Restrict',
- 'annex_input_filter' => 'Annex-Input-Filter',
- 'annex_keypress_timeout' => 'Annex-Keypress-Timeout',
- 'annex_local_ip_address' => 'Annex-Local-IP-Address',
- 'annex_local_username' => 'Annex-Local-Username',
- 'annex_logical_channel_nu' => 'Annex-Logical-Channel-Number',
- 'annex_maximum_call_durat' => 'Annex-Maximum-Call-Duration',
- 'annex_modem_disc_reason' => 'Annex-Modem-Disc-Reason',
- 'annex_mrru' => 'Annex-MRRU',
- 'annex_multicast_rate_lim' => 'Annex-Multicast-Rate-Limit',
- 'annex_multilink_id' => 'Annex-Multilink-Id',
- 'annex_num_in_multilink' => 'Annex-Num-In-Multilink',
- 'annex_output_filter' => 'Annex-Output-Filter',
- 'annex_pool_id' => 'Annex-Pool-Id',
- 'annex_port' => 'Annex-Port',
- 'annex_ppp_trace_level' => 'Annex-PPP-Trace-Level',
- 'annex_pre_input_octets' => 'Annex-Pre-Input-Octets',
- 'annex_pre_input_packets' => 'Annex-Pre-Input-Packets',
- 'annex_pre_output_octets' => 'Annex-Pre-Output-Octets',
- 'annex_pre_output_packets' => 'Annex-Pre-Output-Packets',
- 'annex_primary_dns_server' => 'Annex-Primary-DNS-Server',
- 'annex_primary_nbns_serve' => 'Annex-Primary-NBNS-Server',
- 'annex_product_name' => 'Annex-Product-Name',
- 'annex_rate_reneg_req_rcv' => 'Annex-Rate-Reneg-Req-Rcvd',
- 'annex_rate_reneg_req_sen' => 'Annex-Rate-Reneg-Req-Sent',
- 'annex_re_chap_timeout' => 'Annex-Re-CHAP-Timeout',
- 'annex_receive_speed' => 'Annex-Receive-Speed',
- 'annex_retrain_requests_r' => 'Annex-Retrain-Requests-Rcvd',
- 'annex_retrain_requests_s' => 'Annex-Retrain-Requests-Sent',
- 'annex_retransmitted_pack' => 'Annex-Retransmitted-Packets',
- 'annex_sec_profile_index' => 'Annex-Sec-Profile-Index',
- 'annex_secondary_dns_serv' => 'Annex-Secondary-DNS-Server',
- 'annex_secondary_nbns_ser' => 'Annex-Secondary-NBNS-Server',
- 'annex_signal_to_noise_ra' => 'Annex-Signal-to-Noise-Ratio',
- 'annex_sw_version' => 'Annex-SW-Version',
- 'annex_syslog_tap' => 'Annex-Syslog-Tap',
- 'annex_system_disc_reason' => 'Annex-System-Disc-Reason',
- 'annex_transmit_speed' => 'Annex-Transmit-Speed',
- 'annex_transmitted_packet' => 'Annex-Transmitted-Packets',
- 'annex_tunnel_authen_mode' => 'Annex-Tunnel-Authen-Mode',
- 'annex_tunnel_authen_type' => 'Annex-Tunnel-Authen-Type',
- 'annex_unauthenticated_ti' => 'Annex-Unauthenticated-Time',
- 'annex_user_level' => 'Annex-User-Level',
- 'annex_user_server_locati' => 'Annex-User-Server-Location',
- 'annex_wan_number' => 'Annex-Wan-Number',
- 'arap_challenge_response' => 'ARAP-Challenge-Response',
- 'arap_features' => 'ARAP-Features',
- 'arap_password' => 'ARAP-Password',
- 'arap_security' => 'ARAP-Security',
- 'arap_security_data' => 'ARAP-Security-Data',
- 'arap_zone_access' => 'ARAP-Zone-Access',
- 'ascend_access_intercept_' => 'Ascend-Access-Intercept-LEA',
- 'ascend_access_intercepta' => 'Ascend-Access-Intercept-Log',
- 'ascend_add_seconds' => 'Ascend-Add-Seconds',
- 'ascend_appletalk_peer_mo' => 'Ascend-Appletalk-Peer-Mode',
- 'ascend_appletalk_route' => 'Ascend-Appletalk-Route',
- 'ascend_ara_pw' => 'Ascend-Ara-PW',
- 'ascend_assign_ip_client' => 'Ascend-Assign-IP-Client',
- 'ascend_assign_ip_global_' => 'Ascend-Assign-IP-Global-Pool',
- 'ascend_assign_ip_pool' => 'Ascend-Assign-IP-Pool',
- 'ascend_assign_ip_server' => 'Ascend-Assign-IP-Server',
- 'ascend_atm_connect_group' => 'Ascend-ATM-Connect-Group',
- 'ascend_atm_connect_vci' => 'Ascend-ATM-Connect-Vci',
- 'ascend_atm_connect_vpi' => 'Ascend-ATM-Connect-Vpi',
- 'ascend_atm_direct' => 'Ascend-ATM-Direct',
- 'ascend_atm_direct_profil' => 'Ascend-ATM-Direct-Profile',
- 'ascend_atm_fault_managem' => 'Ascend-ATM-Fault-Management',
- 'ascend_atm_group' => 'Ascend-ATM-Group',
- 'ascend_atm_loopback_cell' => 'Ascend-ATM-Loopback-Cell-Loss',
- 'ascend_atm_vci' => 'Ascend-ATM-Vci',
- 'ascend_atm_vpi' => 'Ascend-ATM-Vpi',
- 'ascend_auth_delay' => 'Ascend-Auth-Delay',
- 'ascend_auth_type' => 'Ascend-Auth-Type',
- 'ascend_authen_alias' => 'Ascend-Authen-Alias',
- 'ascend_backup' => 'Ascend-Backup',
- 'ascend_bacp_enable' => 'Ascend-BACP-Enable',
- 'ascend_base_channel_coun' => 'Ascend-Base-Channel-Count',
- 'ascend_bi_directional_au' => 'Ascend-Bi-Directional-Auth',
- 'ascend_billing_number' => 'Ascend-Billing-Number',
- 'ascend_bir_bridge_group' => 'Ascend-BIR-Bridge-Group',
- 'ascend_bir_enable' => 'Ascend-BIR-Enable',
- 'ascend_bir_proxy' => 'Ascend-BIR-Proxy',
- 'ascend_bridge' => 'Ascend-Bridge',
- 'ascend_bridge_address' => 'Ascend-Bridge-Address',
- 'ascend_bridge_non_pppoe' => 'Ascend-Bridge-Non-PPPoE',
- 'ascend_cache_refresh' => 'Ascend-Cache-Refresh',
- 'ascend_cache_time' => 'Ascend-Cache-Time',
- 'ascend_call_attempt_limi' => 'Ascend-Call-Attempt-Limit',
- 'ascend_call_block_durati' => 'Ascend-Call-Block-Duration',
- 'ascend_call_by_call' => 'Ascend-Call-By-Call',
- 'ascend_call_direction' => 'Ascend-Call-Direction',
- 'ascend_call_filter' => 'Ascend-Call-Filter',
- 'ascend_call_type' => 'Ascend-Call-Type',
- 'ascend_callback' => 'Ascend-Callback',
- 'ascend_callback_delay' => 'Ascend-Callback-Delay',
- 'ascend_calling_id_number' => 'Ascend-Calling-Id-Number-Plan',
- 'ascend_calling_id_presen' => 'Ascend-Calling-Id-Presentatn',
- 'ascend_calling_id_screen' => 'Ascend-Calling-Id-Screening',
- 'ascend_calling_id_type_o' => 'Ascend-Calling-Id-Type-Of-Num',
- 'ascend_calling_subaddres' => 'Ascend-Calling-Subaddress',
- 'ascend_cbcp_delay' => 'Ascend-CBCP-Delay',
- 'ascend_cbcp_enable' => 'Ascend-CBCP-Enable',
- 'ascend_cbcp_mode' => 'Ascend-CBCP-Mode',
- 'ascend_cbcp_trunk_group' => 'Ascend-CBCP-Trunk-Group',
- 'ascend_cir_timer' => 'Ascend-CIR-Timer',
- 'ascend_ckt_type' => 'Ascend-Ckt-Type',
- 'ascend_client_assign_dns' => 'Ascend-Client-Assign-DNS',
- 'ascend_client_assign_win' => 'Ascend-Client-Assign-WINS',
- 'ascend_client_gateway' => 'Ascend-Client-Gateway',
- 'ascend_client_primary_dn' => 'Ascend-Client-Primary-DNS',
- 'ascend_client_primary_wi' => 'Ascend-Client-Primary-WINS',
- 'ascend_client_secondary_' => 'Ascend-Client-Secondary-WINS',
- 'ascend_client_secondarya' => 'Ascend-Client-Secondary-DNS',
- 'ascend_connect_progress' => 'Ascend-Connect-Progress',
- 'ascend_data_filter' => 'Ascend-Data-Filter',
- 'ascend_data_rate' => 'Ascend-Data-Rate',
- 'ascend_data_svc' => 'Ascend-Data-Svc',
- 'ascend_dba_monitor' => 'Ascend-DBA-Monitor',
- 'ascend_dec_channel_count' => 'Ascend-Dec-Channel-Count',
- 'ascend_destination_nas_p' => 'Ascend-Destination-Nas-Port',
- 'ascend_dhcp_maximum_leas' => 'Ascend-DHCP-Maximum-Leases',
- 'ascend_dhcp_pool_number' => 'Ascend-DHCP-Pool-Number',
- 'ascend_dhcp_reply' => 'Ascend-DHCP-Reply',
- 'ascend_dial_number' => 'Ascend-Dial-Number',
- 'ascend_dialed_number' => 'Ascend-Dialed-Number',
- 'ascend_dialout_allowed' => 'Ascend-Dialout-Allowed',
- 'ascend_disconnect_cause' => 'Ascend-Disconnect-Cause',
- 'ascend_dropped_octets' => 'Ascend-Dropped-Octets',
- 'ascend_dropped_packets' => 'Ascend-Dropped-Packets',
- 'ascend_dsl_cir_recv_limi' => 'Ascend-Dsl-CIR-Recv-Limit',
- 'ascend_dsl_cir_xmit_limi' => 'Ascend-Dsl-CIR-Xmit-Limit',
- 'ascend_dsl_downstream_li' => 'Ascend-Dsl-Downstream-Limit',
- 'ascend_dsl_rate_mode' => 'Ascend-Dsl-Rate-Mode',
- 'ascend_dsl_rate_type' => 'Ascend-Dsl-Rate-Type',
- 'ascend_dsl_upstream_limi' => 'Ascend-Dsl-Upstream-Limit',
- 'ascend_egress_enabled' => 'Ascend-Egress-Enabled',
- 'ascend_endpoint_disc' => 'Ascend-Endpoint-Disc',
- 'ascend_event_type' => 'Ascend-Event-Type',
- 'ascend_expect_callback' => 'Ascend-Expect-Callback',
- 'ascend_fcp_parameter' => 'Ascend-FCP-Parameter',
- 'ascend_filter' => 'Ascend-Filter',
- 'ascend_filter_required' => 'Ascend-Filter-Required',
- 'ascend_first_dest' => 'Ascend-First-Dest',
- 'ascend_force_56' => 'Ascend-Force-56',
- 'ascend_fr_08_mode' => 'Ascend-FR-08-Mode',
- 'ascend_fr_circuit_name' => 'Ascend-FR-Circuit-Name',
- 'ascend_fr_dce_n392' => 'Ascend-FR-DCE-N392',
- 'ascend_fr_dce_n393' => 'Ascend-FR-DCE-N393',
- 'ascend_fr_direct' => 'Ascend-FR-Direct',
- 'ascend_fr_direct_dlci' => 'Ascend-FR-Direct-DLCI',
- 'ascend_fr_direct_profile' => 'Ascend-FR-Direct-Profile',
- 'ascend_fr_dlci' => 'Ascend-FR-DLCI',
- 'ascend_fr_dte_n392' => 'Ascend-FR-DTE-N392',
- 'ascend_fr_dte_n393' => 'Ascend-FR-DTE-N393',
- 'ascend_fr_link_mgt' => 'Ascend-FR-Link-Mgt',
- 'ascend_fr_link_status_dl' => 'Ascend-FR-Link-Status-DLCI',
- 'ascend_fr_linkup' => 'Ascend-FR-LinkUp',
- 'ascend_fr_n391' => 'Ascend-FR-N391',
- 'ascend_fr_nailed_grp' => 'Ascend-FR-Nailed-Grp',
- 'ascend_fr_profile_name' => 'Ascend-FR-Profile-Name',
- 'ascend_fr_svc_addr' => 'Ascend-FR-SVC-Addr',
- 'ascend_fr_t391' => 'Ascend-FR-T391',
- 'ascend_fr_t392' => 'Ascend-FR-T392',
- 'ascend_fr_type' => 'Ascend-FR-Type',
- 'ascend_ft1_caller' => 'Ascend-FT1-Caller',
- 'ascend_global_call_id' => 'Ascend-Global-Call-Id',
- 'ascend_group' => 'Ascend-Group',
- 'ascend_h323_conference_i' => 'Ascend-H323-Conference-Id',
- 'ascend_h323_dialed_time' => 'Ascend-H323-Dialed-Time',
- 'ascend_h323_fegw_address' => 'Ascend-H323-Fegw-Address',
- 'ascend_h323_gatekeeper' => 'Ascend-H323-Gatekeeper',
- 'ascend_handle_ipx' => 'Ascend-Handle-IPX',
- 'ascend_history_weigh_typ' => 'Ascend-History-Weigh-Type',
- 'ascend_home_agent_ip_add' => 'Ascend-Home-Agent-IP-Addr',
- 'ascend_home_agent_passwo' => 'Ascend-Home-Agent-Password',
- 'ascend_home_agent_udp_po' => 'Ascend-Home-Agent-UDP-Port',
- 'ascend_home_network_name' => 'Ascend-Home-Network-Name',
- 'ascend_host_info' => 'Ascend-Host-Info',
- 'ascend_idle_limit' => 'Ascend-Idle-Limit',
- 'ascend_if_netmask' => 'Ascend-IF-Netmask',
- 'ascend_inc_channel_count' => 'Ascend-Inc-Channel-Count',
- 'ascend_inter_arrival_jit' => 'Ascend-Inter-Arrival-Jitter',
- 'ascend_ip_direct' => 'Ascend-IP-Direct',
- 'ascend_ip_pool_chaining' => 'Ascend-IP-Pool-Chaining',
- 'ascend_ip_pool_definitio' => 'Ascend-IP-Pool-Definition',
- 'ascend_ip_tos' => 'Ascend-IP-TOS',
- 'ascend_ip_tos_apply_to' => 'Ascend-IP-TOS-Apply-To',
- 'ascend_ip_tos_precedence' => 'Ascend-IP-TOS-Precedence',
- 'ascend_ipsec_profile' => 'Ascend-IPSEC-Profile',
- 'ascend_ipx_alias' => 'Ascend-IPX-Alias',
- 'ascend_ipx_header_compre' => 'Ascend-IPX-Header-Compression',
- 'ascend_ipx_node_addr' => 'Ascend-IPX-Node-Addr',
- 'ascend_ipx_peer_mode' => 'Ascend-IPX-Peer-Mode',
- 'ascend_ipx_route' => 'Ascend-IPX-Route',
- 'ascend_link_compression' => 'Ascend-Link-Compression',
- 'ascend_max_shared_users' => 'Ascend-Max-Shared-Users',
- 'ascend_maximum_call_dura' => 'Ascend-Maximum-Call-Duration',
- 'ascend_maximum_channels' => 'Ascend-Maximum-Channels',
- 'ascend_maximum_time' => 'Ascend-Maximum-Time',
- 'ascend_menu_item' => 'Ascend-Menu-Item',
- 'ascend_menu_selector' => 'Ascend-Menu-Selector',
- 'ascend_metric' => 'Ascend-Metric',
- 'ascend_minimum_channels' => 'Ascend-Minimum-Channels',
- 'ascend_modem_portno' => 'Ascend-Modem-PortNo',
- 'ascend_modem_shelfno' => 'Ascend-Modem-ShelfNo',
- 'ascend_modem_slotno' => 'Ascend-Modem-SlotNo',
- 'ascend_mpp_idle_percent' => 'Ascend-MPP-Idle-Percent',
- 'ascend_mtu' => 'Ascend-MTU',
- 'ascend_multicast_client' => 'Ascend-Multicast-Client',
- 'ascend_multicast_gleave_' => 'Ascend-Multicast-GLeave-Delay',
- 'ascend_multicast_rate_li' => 'Ascend-Multicast-Rate-Limit',
- 'ascend_multilink_id' => 'Ascend-Multilink-ID',
- 'ascend_nas_port_format' => 'Ascend-NAS-Port-Format',
- 'ascend_netware_timeout' => 'Ascend-Netware-timeout',
- 'ascend_num_in_multilink' => 'Ascend-Num-In-Multilink',
- 'ascend_number_sessions' => 'Ascend-Number-Sessions',
- 'ascend_numbering_plan_id' => 'Ascend-Numbering-Plan-ID',
- 'ascend_owner_ip_addr' => 'Ascend-Owner-IP-Addr',
- 'ascend_port_redir_portnu' => 'Ascend-Port-Redir-Portnum',
- 'ascend_port_redir_protoc' => 'Ascend-Port-Redir-Protocol',
- 'ascend_port_redir_server' => 'Ascend-Port-Redir-Server',
- 'ascend_ppp_address' => 'Ascend-PPP-Address',
- 'ascend_ppp_async_map' => 'Ascend-PPP-Async-Map',
- 'ascend_ppp_vj_1172' => 'Ascend-PPP-VJ-1172',
- 'ascend_ppp_vj_slot_comp' => 'Ascend-PPP-VJ-Slot-Comp',
- 'ascend_pppoe_enable' => 'Ascend-PPPoE-Enable',
- 'ascend_pre_input_octets' => 'Ascend-Pre-Input-Octets',
- 'ascend_pre_input_packets' => 'Ascend-Pre-Input-Packets',
- 'ascend_pre_output_octets' => 'Ascend-Pre-Output-Octets',
- 'ascend_pre_output_packet' => 'Ascend-Pre-Output-Packets',
- 'ascend_preempt_limit' => 'Ascend-Preempt-Limit',
- 'ascend_presession_time' => 'Ascend-PreSession-Time',
- 'ascend_pri_number_type' => 'Ascend-PRI-Number-Type',
- 'ascend_primary_home_agen' => 'Ascend-Primary-Home-Agent',
- 'ascend_private_route' => 'Ascend-Private-Route',
- 'ascend_private_route_req' => 'Ascend-Private-Route-Required',
- 'ascend_private_route_tab' => 'Ascend-Private-Route-Table-ID',
- 'ascend_pw_lifetime' => 'Ascend-PW-Lifetime',
- 'ascend_pw_warntime' => 'Ascend-PW-Warntime',
- 'ascend_qos_downstream' => 'Ascend-QOS-Downstream',
- 'ascend_qos_upstream' => 'Ascend-QOS-Upstream',
- 'ascend_receive_secret' => 'Ascend-Receive-Secret',
- 'ascend_recv_name' => 'Ascend-Recv-Name',
- 'ascend_redirect_number' => 'Ascend-Redirect-Number',
- 'ascend_remote_addr' => 'Ascend-Remote-Addr',
- 'ascend_remote_fw' => 'Ascend-Remote-FW',
- 'ascend_remove_seconds' => 'Ascend-Remove-Seconds',
- 'ascend_require_auth' => 'Ascend-Require-Auth',
- 'ascend_route_appletalk' => 'Ascend-Route-Appletalk',
- 'ascend_route_ip' => 'Ascend-Route-IP',
- 'ascend_route_ipx' => 'Ascend-Route-IPX',
- 'ascend_secondary_home_ag' => 'Ascend-Secondary-Home-Agent',
- 'ascend_seconds_of_histor' => 'Ascend-Seconds-Of-History',
- 'ascend_send_auth' => 'Ascend-Send-Auth',
- 'ascend_send_passwd' => 'Ascend-Send-Passwd',
- 'ascend_send_secret' => 'Ascend-Send-Secret',
- 'ascend_service_type' => 'Ascend-Service-Type',
- 'ascend_session_svr_key' => 'Ascend-Session-Svr-Key',
- 'ascend_session_type' => 'Ascend-Session-Type',
- 'ascend_shared_profile_en' => 'Ascend-Shared-Profile-Enable',
- 'ascend_source_auth' => 'Ascend-Source-Auth',
- 'ascend_source_ip_check' => 'Ascend-Source-IP-Check',
- 'ascend_svc_enabled' => 'Ascend-SVC-Enabled',
- 'ascend_target_util' => 'Ascend-Target-Util',
- 'ascend_telnet_profile' => 'Ascend-Telnet-Profile',
- 'ascend_temporary_rtes' => 'Ascend-Temporary-Rtes',
- 'ascend_third_prompt' => 'Ascend-Third-Prompt',
- 'ascend_token_expiry' => 'Ascend-Token-Expiry',
- 'ascend_token_idle' => 'Ascend-Token-Idle',
- 'ascend_token_immediate' => 'Ascend-Token-Immediate',
- 'ascend_traffic_shaper' => 'Ascend-Traffic-Shaper',
- 'ascend_transit_number' => 'Ascend-Transit-Number',
- 'ascend_ts_idle_limit' => 'Ascend-TS-Idle-Limit',
- 'ascend_ts_idle_mode' => 'Ascend-TS-Idle-Mode',
- 'ascend_tunnel_vrouter_na' => 'Ascend-Tunnel-VRouter-Name',
- 'ascend_tunneling_protoco' => 'Ascend-Tunneling-Protocol',
- 'ascend_user_acct_base' => 'Ascend-User-Acct-Base',
- 'ascend_user_acct_host' => 'Ascend-User-Acct-Host',
- 'ascend_user_acct_key' => 'Ascend-User-Acct-Key',
- 'ascend_user_acct_port' => 'Ascend-User-Acct-Port',
- 'ascend_user_acct_time' => 'Ascend-User-Acct-Time',
- 'ascend_user_acct_type' => 'Ascend-User-Acct-Type',
- 'ascend_uu_info' => 'Ascend-UU-Info',
- 'ascend_vrouter_name' => 'Ascend-VRouter-Name',
- 'ascend_x25_cug' => 'Ascend-X25-Cug',
- 'ascend_x25_nui' => 'Ascend-X25-Nui',
- 'ascend_x25_nui_password_' => 'Ascend-X25-Nui-Password-Prompt',
- 'ascend_x25_nui_prompt' => 'Ascend-X25-Nui-Prompt',
- 'ascend_x25_pad_alias_1' => 'Ascend-X25-Pad-Alias-1',
- 'ascend_x25_pad_alias_2' => 'Ascend-X25-Pad-Alias-2',
- 'ascend_x25_pad_alias_3' => 'Ascend-X25-Pad-Alias-3',
- 'ascend_x25_pad_banner' => 'Ascend-X25-Pad-Banner',
- 'ascend_x25_pad_prompt' => 'Ascend-X25-Pad-Prompt',
- 'ascend_x25_pad_x3_parame' => 'Ascend-X25-Pad-X3-Parameters',
- 'ascend_x25_pad_x3_profil' => 'Ascend-X25-Pad-X3-Profile',
- 'ascend_x25_profile_name' => 'Ascend-X25-Profile-Name',
- 'ascend_x25_reverse_charg' => 'Ascend-X25-Reverse-Charging',
- 'ascend_x25_rpoa' => 'Ascend-X25-Rpoa',
- 'ascend_x25_x121_address' => 'Ascend-X25-X121-Address',
- 'ascend_xmit_rate' => 'Ascend-Xmit-Rate',
- 'assigned_ip_address' => 'Assigned_IP_Address',
- 'assigned_ip_addrest' => 'Assigned-IP-Address',
- 'auth_type' => 'Auth-Type',
- 'autz_type' => 'Autz-Type',
- 'bg_aging_time' => 'BG_Aging_Time',
- 'bg_aging_timf' => 'BG-Aging-Time',
- 'bg_path_cost' => 'BG_Path_Cost',
- 'bg_path_cosu' => 'BG-Path-Cost',
- 'bg_span_dis' => 'BG_Span_Dis',
- 'bg_span_dit' => 'BG-Span-Dis',
- 'bg_trans_bpdu' => 'BG_Trans_BPDU',
- 'bg_trans_bpdv' => 'BG-Trans-BPDU',
- 'bind_auth_context' => 'Bind_Auth_Context',
- 'bind_auth_contexu' => 'Bind-Auth-Context',
- 'bind_auth_max_sessions' => 'Bind_Auth_Max_Sessions',
- 'bind_auth_max_sessiont' => 'Bind-Auth-Max-Sessions',
- 'bind_auth_protocol' => 'Bind_Auth_Protocol',
- 'bind_auth_protocom' => 'Bind-Auth-Protocol',
- 'bind_auth_service_grp' => 'Bind_Auth_Service_Grp',
- 'bind_auth_service_grq' => 'Bind-Auth-Service-Grp',
- 'bind_bypass_bypass' => 'Bind_Bypass_Bypass',
- 'bind_bypass_bypast' => 'Bind-Bypass-Bypass',
- 'bind_bypass_context' => 'Bind_Bypass_Context',
- 'bind_bypass_contexu' => 'Bind-Bypass-Context',
- 'bind_dot1q_port' => 'Bind_Dot1q_Port',
- 'bind_dot1q_poru' => 'Bind-Dot1q-Port',
- 'bind_dot1q_slot' => 'Bind_Dot1q_Slot',
- 'bind_dot1q_slou' => 'Bind-Dot1q-Slot',
- 'bind_dot1q_vlan_tag_id' => 'Bind_Dot1q_Vlan_Tag_Id',
- 'bind_dot1q_vlan_tag_ie' => 'Bind-Dot1q-Vlan-Tag-Id',
- 'bind_int_context' => 'Bind_Int_Context',
- 'bind_int_contexu' => 'Bind-Int-Context',
- 'bind_int_interface_name' => 'Bind_Int_Interface_Name',
- 'bind_int_interface_namf' => 'Bind-Int-Interface-Name',
- 'bind_l2tp_flow_control' => 'Bind_L2TP_Flow_Control',
- 'bind_l2tp_flow_controm' => 'Bind-L2TP-Flow-Control',
- 'bind_l2tp_tunnel_name' => 'Bind_L2TP_Tunnel_Name',
- 'bind_l2tp_tunnel_namf' => 'Bind-L2TP-Tunnel-Name',
- 'bind_ses_context' => 'Bind_Ses_Context',
- 'bind_ses_contexu' => 'Bind-Ses-Context',
- 'bind_sub_password' => 'Bind_Sub_Password',
- 'bind_sub_passwore' => 'Bind-Sub-Password',
- 'bind_sub_user_at_context' => 'Bind_Sub_User_At_Context',
- 'bind_sub_user_at_contexu' => 'Bind-Sub-User-At-Context',
- 'bind_tun_context' => 'Bind_Tun_Context',
- 'bind_tun_contexu' => 'Bind-Tun-Context',
- 'bind_type' => 'Bind_Type',
- 'bind_typf' => 'Bind-Type',
- 'bintec_bibodialtable' => 'BinTec-biboDialTable',
- 'bintec_biboppptable' => 'BinTec-biboPPPTable',
- 'bintec_ipextiftable' => 'BinTec-ipExtIfTable',
- 'bintec_ipextrttable' => 'BinTec-ipExtRtTable',
- 'bintec_ipfiltertable' => 'BinTec-ipFilterTable',
- 'bintec_ipnatpresettable' => 'BinTec-ipNatPresetTable',
- 'bintec_ipqostable' => 'BinTec-ipQoSTable',
- 'bintec_iproutetable' => 'BinTec-ipRouteTable',
- 'bintec_ipxcirctable' => 'BinTec-ipxCircTable',
- 'bintec_ipxstaticroutetab' => 'BinTec-ipxStaticRouteTable',
- 'bintec_ipxstaticservtabl' => 'BinTec-ipxStaticServTable',
- 'bintec_ospfiftable' => 'BinTec-ospfIfTable',
- 'bintec_pppextiftable' => 'BinTec-pppExtIfTable',
- 'bintec_qosiftable' => 'BinTec-qosIfTable',
- 'bintec_qospolicytable' => 'BinTec-qosPolicyTable',
- 'bintec_ripcirctable' => 'BinTec-ripCircTable',
- 'bintec_sapcirctable' => 'BinTec-sapCircTable',
- 'bridge_group' => 'Bridge_Group',
- 'bridge_grouq' => 'Bridge-Group',
- 'cabletron_protocol_calla' => 'Cabletron-Protocol-Callable',
- 'cabletron_protocol_enabl' => 'Cabletron-Protocol-Enable',
- 'call_id' => 'call-id',
- 'callback_id' => 'Callback-Id',
- 'callback_number' => 'Callback-Number',
- 'called_station_id' => 'Called-Station-Id',
- 'caller_id' => 'Caller-ID',
- 'calling_station_id' => 'Calling-Station-Id',
- 'cbbsm_bandwidth' => 'CBBSM-Bandwidth',
- 'challenge_state' => 'Challenge-State',
- 'chap_challenge' => 'CHAP-Challenge',
- 'chap_password' => 'CHAP-Password',
- 'char_noecho' => 'Char-Noecho',
- 'cisco_abort_cause' => 'Cisco-Abort-Cause',
- 'cisco_account_info' => 'Cisco-Account-Info',
- 'cisco_assign_ip_pool' => 'Cisco-Assign-IP-Pool',
- 'cisco_avpair' => 'Cisco-AVPair',
- 'cisco_call_filter' => 'Cisco-Call-Filter',
- 'cisco_call_type' => 'Cisco-Call-Type',
- 'cisco_command_code' => 'Cisco-Command-Code',
- 'cisco_control_info' => 'Cisco-Control-Info',
- 'cisco_data_filter' => 'Cisco-Data-Filter',
- 'cisco_data_rate' => 'Cisco-Data-Rate',
- 'cisco_disconnect_cause' => 'Cisco-Disconnect-Cause',
- 'cisco_email_server_ack_f' => 'Cisco-Email-Server-Ack-Flag',
- 'cisco_email_server_addre' => 'Cisco-Email-Server-Address',
- 'cisco_fax_account_id_ori' => 'Cisco-Fax-Account-Id-Origin',
- 'cisco_fax_auth_status' => 'Cisco-Fax-Auth-Status',
- 'cisco_fax_connect_speed' => 'Cisco-Fax-Connect-Speed',
- 'cisco_fax_coverpage_flag' => 'Cisco-Fax-Coverpage-Flag',
- 'cisco_fax_dsn_address' => 'Cisco-Fax-Dsn-Address',
- 'cisco_fax_dsn_flag' => 'Cisco-Fax-Dsn-Flag',
- 'cisco_fax_mdn_address' => 'Cisco-Fax-Mdn-Address',
- 'cisco_fax_mdn_flag' => 'Cisco-Fax-Mdn-Flag',
- 'cisco_fax_modem_time' => 'Cisco-Fax-Modem-Time',
- 'cisco_fax_msg_id' => 'Cisco-Fax-Msg-Id',
- 'cisco_fax_pages' => 'Cisco-Fax-Pages',
- 'cisco_fax_process_abort_' => 'Cisco-Fax-Process-Abort-Flag',
- 'cisco_fax_recipient_coun' => 'Cisco-Fax-Recipient-Count',
- 'cisco_gateway_id' => 'Cisco-Gateway-Id',
- 'cisco_idle_limit' => 'Cisco-Idle-Limit',
- 'cisco_ip_direct' => 'Cisco-IP-Direct',
- 'cisco_ip_pool_definition' => 'Cisco-IP-Pool-Definition',
- 'cisco_link_compression' => 'Cisco-Link-Compression',
- 'cisco_maximum_channels' => 'Cisco-Maximum-Channels',
- 'cisco_maximum_time' => 'Cisco-Maximum-Time',
- 'cisco_multilink_id' => 'Cisco-Multilink-ID',
- 'cisco_nas_port' => 'Cisco-NAS-Port',
- 'cisco_num_in_multilink' => 'Cisco-Num-In-Multilink',
- 'cisco_port_used' => 'Cisco-Port-Used',
- 'cisco_ppp_async_map' => 'Cisco-PPP-Async-Map',
- 'cisco_ppp_vj_slot_comp' => 'Cisco-PPP-VJ-Slot-Comp',
- 'cisco_pre_input_octets' => 'Cisco-Pre-Input-Octets',
- 'cisco_pre_input_packets' => 'Cisco-Pre-Input-Packets',
- 'cisco_pre_output_octets' => 'Cisco-Pre-Output-Octets',
- 'cisco_pre_output_packets' => 'Cisco-Pre-Output-Packets',
- 'cisco_presession_time' => 'Cisco-PreSession-Time',
- 'cisco_pw_lifetime' => 'Cisco-PW-Lifetime',
- 'cisco_route_ip' => 'Cisco-Route-IP',
- 'cisco_service_info' => 'Cisco-Service-Info',
- 'cisco_target_util' => 'Cisco-Target-Util',
- 'cisco_xmit_rate' => 'Cisco-Xmit-Rate',
- 'class' => 'Class',
- 'client_dns_pri' => 'Client_DNS_Pri',
- 'client_dns_prj' => 'Client-DNS-Pri',
- 'client_dns_sec' => 'Client_DNS_Sec',
- 'client_dns_sed' => 'Client-DNS-Sec',
- 'client_id' => 'Client-Id',
- 'client_ip_address' => 'Client-IP-Address',
- 'client_port_dnis' => 'Client-Port-DNIS',
- 'client_port_id' => 'Client-Port-Id',
- 'colubris_avpair' => 'Colubris-AVPair',
- 'configuration_token' => 'Configuration-Token',
- 'connect_info' => 'Connect-Info',
- 'connect_rate' => 'Connect-Rate',
- 'context_name' => 'Context_Name',
- 'context_namf' => 'Context-Name',
- 'crypt_password' => 'Crypt-Password',
- 'current_time' => 'Current-Time',
- 'cvpn3000_access_hours' => 'CVPN3000-Access-Hours',
- 'cvpn3000_allow_network_e' => 'CVPN3000-Allow-Network-Extension-Mode',
- 'cvpn3000_auth_server_pas' => 'CVPN3000-Auth-Server-Password',
- 'cvpn3000_auth_server_pri' => 'CVPN3000-Auth-Server-Priority',
- 'cvpn3000_auth_server_typ' => 'CVPN3000-Auth-Server-Type',
- 'cvpn3000_authd_user_idle' => 'CVPN3000-Authd-User-Idle-Timeout',
- 'cvpn3000_cisco_ip_phone_' => 'CVPN3000-Cisco-IP-Phone-Bypass',
- 'cvpn3000_dhcp_network_sc' => 'CVPN3000-DHCP-Network-Scope',
- 'cvpn3000_ike_keep_alives' => 'CVPN3000-IKE-Keep-Alives',
- 'cvpn3000_ipsec_allow_pas' => 'CVPN3000-IPSec-Allow-Passwd-Store',
- 'cvpn3000_ipsec_auth_on_r' => 'CVPN3000-IPSec-Auth-On-Rekey',
- 'cvpn3000_ipsec_authentic' => 'CVPN3000-IPSec-Authentication',
- 'cvpn3000_ipsec_authoriza' => 'CVPN3000-IPSec-Authorization-Type',
- 'cvpn3000_ipsec_authorizb' => 'CVPN3000-IPSec-Authorization-Required',
- 'cvpn3000_ipsec_backup_se' => 'CVPN3000-IPSec-Backup-Servers',
- 'cvpn3000_ipsec_backup_sf' => 'CVPN3000-IPSec-Backup-Server-List',
- 'cvpn3000_ipsec_banner1' => 'CVPN3000-IPSec-Banner1',
- 'cvpn3000_ipsec_banner2' => 'CVPN3000-IPSec-Banner2',
- 'cvpn3000_ipsec_client_fw' => 'CVPN3000-IPSec-Client-Fw-Filter-Name',
- 'cvpn3000_ipsec_client_fx' => 'CVPN3000-IPSec-Client-Fw-Filter-Opt',
- 'cvpn3000_ipsec_confidenc' => 'CVPN3000-IPSec-Confidence-Level',
- 'cvpn3000_ipsec_default_d' => 'CVPN3000-IPSec-Default-Domain',
- 'cvpn3000_ipsec_dn_field' => 'CVPN3000-IPSec-DN-Field',
- 'cvpn3000_ipsec_group_nam' => 'CVPN3000-IPSec-Group-Name',
- 'cvpn3000_ipsec_ike_peer_' => 'CVPN3000-IPSec-IKE-Peer-ID-Check',
- 'cvpn3000_ipsec_ip_compre' => 'CVPN3000-IPSec-IP-Compression',
- 'cvpn3000_ipsec_ltl_keepa' => 'CVPN3000-IPSec-LTL-Keepalives',
- 'cvpn3000_ipsec_mode_conf' => 'CVPN3000-IPSec-Mode-Config',
- 'cvpn3000_ipsec_over_udp' => 'CVPN3000-IPSec-Over-UDP',
- 'cvpn3000_ipsec_over_udp_' => 'CVPN3000-IPSec-Over-UDP-Port',
- 'cvpn3000_ipsec_reqrd_cli' => 'CVPN3000-IPSec-Reqrd-Client-Fw-Cap',
- 'cvpn3000_ipsec_sec_assoc' => 'CVPN3000-IPSec-Sec-Association',
- 'cvpn3000_ipsec_split_dns' => 'CVPN3000-IPSec-Split-DNS-Names',
- 'cvpn3000_ipsec_split_tun' => 'CVPN3000-IPSec-Split-Tunnel-List',
- 'cvpn3000_ipsec_split_tuo' => 'CVPN3000-IPSec-Split-Tunneling-Policy',
- 'cvpn3000_ipsec_tunnel_ty' => 'CVPN3000-IPSec-Tunnel-Type',
- 'cvpn3000_ipsec_user_grou' => 'CVPN3000-IPSec-User-Group-Lock',
- 'cvpn3000_l2tp_encryption' => 'CVPN3000-L2TP-Encryption',
- 'cvpn3000_l2tp_min_auth_p' => 'CVPN3000-L2TP-Min-Auth-Protocol',
- 'cvpn3000_l2tp_mppc_compr' => 'CVPN3000-L2TP-MPPC-Compression',
- 'cvpn3000_leap_bypass' => 'CVPN3000-LEAP-Bypass',
- 'cvpn3000_ms_client_icpt_' => 'CVPN3000-MS-Client-Icpt-DHCP-Conf-Msg',
- 'cvpn3000_ms_client_subne' => 'CVPN3000-MS-Client-Subnet-Mask',
- 'cvpn3000_partition_max_s' => 'CVPN3000-Partition-Max-Sessions',
- 'cvpn3000_partition_mobil' => 'CVPN3000-Partition-Mobile-IP-Key',
- 'cvpn3000_partition_mobim' => 'CVPN3000-Partition-Mobile-IP-Address',
- 'cvpn3000_partition_mobin' => 'CVPN3000-Partition-Mobile-IP-SPI',
- 'cvpn3000_partition_premi' => 'CVPN3000-Partition-Premise-Router',
- 'cvpn3000_partition_prima' => 'CVPN3000-Partition-Primary-DHCP',
- 'cvpn3000_partition_secon' => 'CVPN3000-Partition-Secondary-DHCP',
- 'cvpn3000_pptp_encryption' => 'CVPN3000-PPTP-Encryption',
- 'cvpn3000_pptp_min_auth_p' => 'CVPN3000-PPTP-Min-Auth-Protocol',
- 'cvpn3000_pptp_mppc_compr' => 'CVPN3000-PPTP-MPPC-Compression',
- 'cvpn3000_primary_dns' => 'CVPN3000-Primary-DNS',
- 'cvpn3000_primary_wins' => 'CVPN3000-Primary-WINS',
- 'cvpn3000_priority_on_sep' => 'CVPN3000-Priority-On-SEP',
- 'cvpn3000_reqrd_client_fw' => 'CVPN3000-Reqrd-Client-Fw-Vendor-Code',
- 'cvpn3000_reqrd_client_fx' => 'CVPN3000-Reqrd-Client-Fw-Product-Code',
- 'cvpn3000_reqrd_client_fy' => 'CVPN3000-Reqrd-Client-Fw-Description',
- 'cvpn3000_request_auth_ve' => 'CVPN3000-Request-Auth-Vector',
- 'cvpn3000_require_hw_clie' => 'CVPN3000-Require-HW-Client-Auth',
- 'cvpn3000_require_individ' => 'CVPN3000-Require-Individual-User-Auth',
- 'cvpn3000_secondary_dns' => 'CVPN3000-Secondary-DNS',
- 'cvpn3000_secondary_wins' => 'CVPN3000-Secondary-WINS',
- 'cvpn3000_sep_card_assign' => 'CVPN3000-SEP-Card-Assignment',
- 'cvpn3000_simultaneous_lo' => 'CVPN3000-Simultaneous-Logins',
- 'cvpn3000_strip_realm' => 'CVPN3000-Strip-Realm',
- 'cvpn3000_tunneling_proto' => 'CVPN3000-Tunneling-Protocols',
- 'cvpn3000_use_client_addr' => 'CVPN3000-Use-Client-Address',
- 'cvpn3000_user_auth_serve' => 'CVPN3000-User-Auth-Server-Name',
- 'cvpn3000_user_auth_servf' => 'CVPN3000-User-Auth-Server-Port',
- 'cvpn3000_user_auth_servg' => 'CVPN3000-User-Auth-Server-Secret',
- 'cvpn5000_client_assigned' => 'CVPN5000-Client-Assigned-IP',
- 'cvpn5000_client_assignee' => 'CVPN5000-Client-Assigned-IPX',
- 'cvpn5000_client_real_ip' => 'CVPN5000-Client-Real-IP',
- 'cvpn5000_echo' => 'CVPN5000-Echo',
- 'cvpn5000_tunnel_throughp' => 'CVPN5000-Tunnel-Throughput',
- 'cvpn5000_vpn_groupinfo' => 'CVPN5000-VPN-GroupInfo',
- 'cvpn5000_vpn_password' => 'CVPN5000-VPN-Password',
- 'cvx_assign_ip_pool' => 'CVX-Assign-IP-Pool',
- 'cvx_client_assign_dns' => 'CVX-Client-Assign-DNS',
- 'cvx_data_filter' => 'CVX-Data-Filter',
- 'cvx_data_rate' => 'CVX-Data-Rate',
- 'cvx_disconnect_cause' => 'CVX-Disconnect-Cause',
- 'cvx_identification' => 'CVX-Identification',
- 'cvx_idle_limit' => 'CVX-Idle-Limit',
- 'cvx_ipsvc_aznlvl' => 'CVX-IPSVC-AZNLVL',
- 'cvx_ipsvc_mask' => 'CVX-IPSVC-Mask',
- 'cvx_maximum_channels' => 'CVX-Maximum-Channels',
- 'cvx_modem_begin_modulati' => 'CVX-Modem-Begin-Modulation',
- 'cvx_modem_begin_recv_lin' => 'CVX-Modem-Begin-Recv-Line-Lvl',
- 'cvx_modem_data_compressi' => 'CVX-Modem-Data-Compression',
- 'cvx_modem_end_modulation' => 'CVX-Modem-End-Modulation',
- 'cvx_modem_end_recv_line_' => 'CVX-Modem-End-Recv-Line-Lvl',
- 'cvx_modem_error_correcti' => 'CVX-Modem-Error-Correction',
- 'cvx_modem_local_rate_neg' => 'CVX-Modem-Local-Rate-Negs',
- 'cvx_modem_local_retrains' => 'CVX-Modem-Local-Retrains',
- 'cvx_modem_remote_rate_ne' => 'CVX-Modem-Remote-Rate-Negs',
- 'cvx_modem_remote_retrain' => 'CVX-Modem-Remote-Retrains',
- 'cvx_modem_retx_packets' => 'CVX-Modem-ReTx-Packets',
- 'cvx_modem_snr' => 'CVX-Modem-SNR',
- 'cvx_modem_tx_packets' => 'CVX-Modem-Tx-Packets',
- 'cvx_multicast_client' => 'CVX-Multicast-Client',
- 'cvx_multicast_rate_limit' => 'CVX-Multicast-Rate-Limit',
- 'cvx_multilink_group_numb' => 'CVX-Multilink-Group-Number',
- 'cvx_multilink_match_info' => 'CVX-Multilink-Match-Info',
- 'cvx_ppp_address' => 'CVX-PPP-Address',
- 'cvx_ppp_log_mask' => 'CVX-PPP-Log-Mask',
- 'cvx_presession_time' => 'CVX-PreSession-Time',
- 'cvx_primary_dns' => 'CVX-Primary-DNS',
- 'cvx_radius_redirect' => 'CVX-Radius-Redirect',
- 'cvx_secondary_dns' => 'CVX-Secondary-DNS',
- 'cvx_ss7_session_id_type' => 'CVX-SS7-Session-ID-Type',
- 'cvx_vpop_id' => 'CVX-VPOP-ID',
- 'cvx_xmit_rate' => 'CVX-Xmit-Rate',
- 'dhcp_max_leases' => 'DHCP_Max_Leases',
- 'dhcp_max_leaset' => 'DHCP-Max-Leases',
- 'dialback_name' => 'Dialback-Name',
- 'dialback_no' => 'Dialback-No',
- 'digest_algorithm' => 'Digest-Algorithm',
- 'digest_attributes' => 'Digest-Attributes',
- 'digest_body_digest' => 'Digest-Body-Digest',
- 'digest_cnonce' => 'Digest-CNonce',
- 'digest_method' => 'Digest-Method',
- 'digest_nonce' => 'Digest-Nonce',
- 'digest_nonce_count' => 'Digest-Nonce-Count',
- 'digest_qop' => 'Digest-QOP',
- 'digest_realm' => 'Digest-Realm',
- 'digest_response' => 'Digest-Response',
- 'digest_uri' => 'Digest-URI',
- 'digest_user_name' => 'Digest-User-Name',
- 'eap_code' => 'EAP-Code',
- 'eap_id' => 'EAP-Id',
- 'eap_md5_password' => 'EAP-MD5-Password',
- 'eap_message' => 'EAP-Message',
- 'eap_sim_any_id_req' => 'EAP-Sim-ANY_ID_REQ',
- 'eap_sim_checkcode' => 'EAP-Sim-CHECKCODE',
- 'eap_sim_counter' => 'EAP-Sim-COUNTER',
- 'eap_sim_counter_too_smal' => 'EAP-Sim-COUNTER_TOO_SMALL',
- 'eap_sim_encr_data' => 'EAP-Sim-ENCR_DATA',
- 'eap_sim_extra' => 'EAP-Sim-EXTRA',
- 'eap_sim_fullauth_id_req' => 'EAP-Sim-FULLAUTH_ID_REQ',
- 'eap_sim_hmac' => 'EAP-Sim-HMAC',
- 'eap_sim_identity' => 'EAP-Sim-IDENTITY',
- 'eap_sim_imsi' => 'EAP-Sim-IMSI',
- 'eap_sim_iv' => 'EAP-Sim-IV',
- 'eap_sim_kc1' => 'EAP-Sim-KC1',
- 'eap_sim_kc2' => 'EAP-Sim-KC2',
- 'eap_sim_kc3' => 'EAP-Sim-KC3',
- 'eap_sim_key' => 'EAP-Sim-KEY',
- 'eap_sim_mac' => 'EAP-Sim-MAC',
- 'eap_sim_next_pseudonum' => 'EAP-Sim-NEXT_PSEUDONUM',
- 'eap_sim_next_reauth_id' => 'EAP-Sim-NEXT_REAUTH_ID',
- 'eap_sim_nonce_mt' => 'EAP-Sim-NONCE_MT',
- 'eap_sim_nonce_s' => 'EAP-Sim-NONCE_S',
- 'eap_sim_notification' => 'EAP-Sim-NOTIFICATION',
- 'eap_sim_padding' => 'EAP-Sim-PADDING',
- 'eap_sim_permanent_id_req' => 'EAP-Sim-PERMANENT_ID_REQ',
- 'eap_sim_rand' => 'EAP-Sim-RAND',
- 'eap_sim_rand1' => 'EAP-Sim-Rand1',
- 'eap_sim_rand2' => 'EAP-Sim-Rand2',
- 'eap_sim_rand3' => 'EAP-Sim-Rand3',
- 'eap_sim_selected_version' => 'EAP-Sim-SELECTED_VERSION',
- 'eap_sim_sres1' => 'EAP-Sim-SRES1',
- 'eap_sim_sres2' => 'EAP-Sim-SRES2',
- 'eap_sim_sres3' => 'EAP-Sim-SRES3',
- 'eap_sim_state' => 'EAP-Sim-State',
- 'eap_sim_subtype' => 'EAP-Sim-Subtype',
- 'eap_sim_version_list' => 'EAP-Sim-VERSION_LIST',
- 'eap_tls_require_client_c' => 'EAP-TLS-Require-Client-Cert',
- 'eap_type' => 'EAP-Type',
- 'eap_type_gtc' => 'EAP-Type-GTC',
- 'eap_type_identity' => 'EAP-Type-Identity',
- 'eap_type_leap' => 'EAP-Type-LEAP',
- 'eap_type_md5' => 'EAP-Type-MD5',
- 'eap_type_nak' => 'EAP-Type-NAK',
- 'eap_type_notification' => 'EAP-Type-Notification',
- 'eap_type_otp' => 'EAP-Type-OTP',
- 'eap_type_peap' => 'EAP-Type-PEAP',
- 'eap_type_sim' => 'EAP-Type-SIM',
- 'eap_type_sim2' => 'EAP-Type-SIM2',
- 'eap_type_tls' => 'EAP-Type-TLS',
- 'eap_type_ttls' => 'EAP-Type-TTLS',
- 'error_cause' => 'Error-Cause',
- 'erx_address_pool_name' => 'ERX-Address-Pool-Name',
- 'erx_alternate_cli_access' => 'ERX-Alternate-Cli-Access-Level',
- 'erx_alternate_cli_vroute' => 'ERX-Alternate-Cli-Vrouter-Name',
- 'erx_atm_mbs' => 'ERX-Atm-MBS',
- 'erx_atm_pcr' => 'ERX-Atm-PCR',
- 'erx_atm_scr' => 'ERX-Atm-SCR',
- 'erx_atm_service_category' => 'ERX-Atm-Service-Category',
- 'erx_bearer_type' => 'ERX-Bearer-Type',
- 'erx_cli_allow_all_vr_acc' => 'ERX-Cli-Allow-All-VR-Access',
- 'erx_cli_initial_access_l' => 'ERX-Cli-Initial-Access-Level',
- 'erx_dial_out_number' => 'ERX-Dial-Out-Number',
- 'erx_egress_policy_name' => 'ERX-Egress-Policy-Name',
- 'erx_egress_statistics' => 'ERX-Egress-Statistics',
- 'erx_framed_ip_route_tag' => 'ERX-Framed-Ip-Route-Tag',
- 'erx_igmp_enable' => 'ERX-Igmp-Enable',
- 'erx_ingress_policy_name' => 'ERX-Ingress-Policy-Name',
- 'erx_ingress_statistics' => 'ERX-Ingress-Statistics',
- 'erx_input_gigapkts' => 'ERX-Input-Gigapkts',
- 'erx_ipv6_local_interface' => 'ERX-IpV6-Local-Interface',
- 'erx_ipv6_primary_dns' => 'ERX-Ipv6-Primary-Dns',
- 'erx_ipv6_secondary_dns' => 'ERX-Ipv6-Secondary-Dns',
- 'erx_ipv6_virtual_router' => 'ERX-IpV6-Virtual-Router',
- 'erx_local_loopback_inter' => 'ERX-Local-Loopback-Interface',
- 'erx_maximum_bps' => 'ERX-Maximum-BPS',
- 'erx_minimum_bps' => 'ERX-Minimum-BPS',
- 'erx_output_gigapkts' => 'ERX-Output-Gigapkts',
- 'erx_ppp_auth_protocol' => 'ERX-PPP-Auth-Protocol',
- 'erx_ppp_password' => 'ERX-PPP-Password',
- 'erx_ppp_username' => 'ERX-PPP-Username',
- 'erx_pppoe_description' => 'ERX-Pppoe-Description',
- 'erx_pppoe_max_sessions' => 'ERX-Pppoe-Max-Sessions',
- 'erx_pppoe_url' => 'ERX-Pppoe-Url',
- 'erx_primary_dns' => 'ERX-Primary-Dns',
- 'erx_primary_wins' => 'ERX-Primary-Wins',
- 'erx_qos_profile_interfac' => 'ERX-Qos-Profile-Interface-Type',
- 'erx_qos_profile_name' => 'ERX-Qos-Profile-Name',
- 'erx_redirect_vr_name' => 'ERX-Redirect-VR-Name',
- 'erx_sa_validate' => 'ERX-Sa-Validate',
- 'erx_secondary_dns' => 'ERX-Secondary-Dns',
- 'erx_secondary_wins' => 'ERX-Secondary-Wins',
- 'erx_service_bundle' => 'ERX-Service-Bundle',
- 'erx_tunnel_interface_id' => 'ERX-Tunnel-Interface-Id',
- 'erx_tunnel_maximum_sessi' => 'ERX-Tunnel-Maximum-Sessions',
- 'erx_tunnel_nas_port_meth' => 'ERX-Tunnel-Nas-Port-Method',
- 'erx_tunnel_password' => 'ERX-Tunnel-Password',
- 'erx_tunnel_tos' => 'ERX-Tunnel-Tos',
- 'erx_tunnel_virtual_route' => 'ERX-Tunnel-Virtual-Router',
- 'erx_virtual_router_name' => 'ERX-Virtual-Router-Name',
- 'event_timestamp' => 'Event-Timestamp',
- 'exec_program' => 'Exec-Program',
- 'exec_program_wait' => 'Exec-Program-Wait',
- 'expiration' => 'Expiration',
- 'extreme_netlogin_only' => 'Extreme-Netlogin-Only',
- 'extreme_netlogin_url' => 'Extreme-Netlogin-Url',
- 'extreme_netlogin_url_des' => 'Extreme-Netlogin-Url-Desc',
- 'extreme_netlogin_vlan' => 'Extreme-Netlogin-Vlan',
- 'fall_through' => 'Fall-Through',
- 'filter_id' => 'Filter-Id',
- 'foundry_command_exceptio' => 'Foundry-Command-Exception-Flag',
- 'foundry_command_string' => 'Foundry-Command-String',
- 'foundry_inm_privilege' => 'Foundry-INM-Privilege',
- 'foundry_privilege_level' => 'Foundry-Privilege-Level',
- 'framed_address' => 'Framed-Address',
- 'framed_appletalk_link' => 'Framed-AppleTalk-Link',
- 'framed_appletalk_network' => 'Framed-AppleTalk-Network',
- 'framed_appletalk_zone' => 'Framed-AppleTalk-Zone',
- 'framed_callback_id' => 'Framed-Callback-Id',
- 'framed_compression' => 'Framed-Compression',
- 'framed_filter_id' => 'Framed-Filter-Id',
- 'framed_interface_id' => 'Framed-Interface-Id',
- 'framed_ip_address' => 'Framed-IP-Address',
- 'framed_ip_netmask' => 'Framed-IP-Netmask',
- 'framed_ipv6_pool' => 'Framed-IPv6-Pool',
- 'framed_ipv6_prefix' => 'Framed-IPv6-Prefix',
- 'framed_ipv6_route' => 'Framed-IPv6-Route',
- 'framed_ipx_network' => 'Framed-IPX-Network',
- 'framed_mtu' => 'Framed-MTU',
- 'framed_netmask' => 'Framed-Netmask',
- 'framed_pool' => 'Framed-Pool',
- 'framed_protocol' => 'Framed-Protocol',
- 'framed_route' => 'Framed-Route',
- 'framed_routing' => 'Framed-Routing',
- 'freeradius_proxied_to' => 'FreeRADIUS-Proxied-To',
- 'gandalf_around_the_corne' => 'Gandalf-Around-The-Corner',
- 'gandalf_authentication_s' => 'Gandalf-Authentication-String',
- 'gandalf_calling_line_id_' => 'Gandalf-Calling-Line-ID-1',
- 'gandalf_calling_line_ida' => 'Gandalf-Calling-Line-ID-2',
- 'gandalf_channel_group_na' => 'Gandalf-Channel-Group-Name-1',
- 'gandalf_channel_group_nb' => 'Gandalf-Channel-Group-Name-2',
- 'gandalf_compression_stat' => 'Gandalf-Compression-Status',
- 'gandalf_dial_prefix_name' => 'Gandalf-Dial-Prefix-Name-1',
- 'gandalf_dial_prefix_namf' => 'Gandalf-Dial-Prefix-Name-2',
- 'gandalf_fwd_broadcast_in' => 'Gandalf-Fwd-Broadcast-In',
- 'gandalf_fwd_broadcast_ou' => 'Gandalf-Fwd-Broadcast-Out',
- 'gandalf_fwd_multicast_in' => 'Gandalf-Fwd-Multicast-In',
- 'gandalf_fwd_multicast_ou' => 'Gandalf-Fwd-Multicast-Out',
- 'gandalf_fwd_unicast_in' => 'Gandalf-Fwd-Unicast-In',
- 'gandalf_fwd_unicast_out' => 'Gandalf-Fwd-Unicast-Out',
- 'gandalf_hunt_group' => 'Gandalf-Hunt-Group',
- 'gandalf_ipx_spoofing_sta' => 'Gandalf-IPX-Spoofing-State',
- 'gandalf_ipx_watchdog_spo' => 'Gandalf-IPX-Watchdog-Spoof',
- 'gandalf_min_outgoing_bea' => 'Gandalf-Min-Outgoing-Bearer',
- 'gandalf_modem_mode' => 'Gandalf-Modem-Mode',
- 'gandalf_modem_required_1' => 'Gandalf-Modem-Required-1',
- 'gandalf_modem_required_2' => 'Gandalf-Modem-Required-2',
- 'gandalf_operational_mode' => 'Gandalf-Operational-Modes',
- 'gandalf_phone_number_1' => 'Gandalf-Phone-Number-1',
- 'gandalf_phone_number_2' => 'Gandalf-Phone-Number-2',
- 'gandalf_ppp_authenticati' => 'Gandalf-PPP-Authentication',
- 'gandalf_ppp_ncp_type' => 'Gandalf-PPP-NCP-Type',
- 'gandalf_remote_lan_name' => 'Gandalf-Remote-LAN-Name',
- 'gandalf_sap_group_name_1' => 'Gandalf-SAP-Group-Name-1',
- 'gandalf_sap_group_name_2' => 'Gandalf-SAP-Group-Name-2',
- 'gandalf_sap_group_name_3' => 'Gandalf-SAP-Group-Name-3',
- 'gandalf_sap_group_name_4' => 'Gandalf-SAP-Group-Name-4',
- 'gandalf_sap_group_name_5' => 'Gandalf-SAP-Group-Name-5',
- 'garderos_location_name' => 'Garderos-Location-Name',
- 'garderos_service_name' => 'Garderos-Service-Name',
- 'group' => 'Group',
- 'group_name' => 'Group-Name',
- 'gw_final_xlated_cdn' => 'gw-final-xlated-cdn',
- 'gw_rxd_cdn' => 'gw-rxd-cdn',
- 'h323_billing_model' => 'h323-billing-model',
- 'h323_call_origin' => 'h323-call-origin',
- 'h323_call_type' => 'h323-call-type',
- 'h323_conf_id' => 'h323-conf-id',
- 'h323_connect_time' => 'h323-connect-time',
- 'h323_credit_amount' => 'h323-credit-amount',
- 'h323_credit_time' => 'h323-credit-time',
- 'h323_currency' => 'h323-currency',
- 'h323_disconnect_cause' => 'h323-disconnect-cause',
- 'h323_disconnect_time' => 'h323-disconnect-time',
- 'h323_gw_id' => 'h323-gw-id',
- 'h323_incoming_conf_id' => 'h323-incoming-conf-id',
- 'h323_preferred_lang' => 'h323-preferred-lang',
- 'h323_prompt_id' => 'h323-prompt-id',
- 'h323_redirect_ip_address' => 'h323-redirect-ip-address',
- 'h323_redirect_number' => 'h323-redirect-number',
- 'h323_remote_address' => 'h323-remote-address',
- 'h323_return_code' => 'h323-return-code',
- 'h323_setup_time' => 'h323-setup-time',
- 'h323_time_and_day' => 'h323-time-and-day',
- 'h323_voice_quality' => 'h323-voice-quality',
- 'hint' => 'Hint',
- 'huntgroup_name' => 'Huntgroup-Name',
- 'idle_timeout' => 'Idle-Timeout',
- 'incoming_req_uri' => 'incoming-req-uri',
- 'initial_modulation_type' => 'Initial-Modulation-Type',
- 'ip3_ip_option' => 'IP3-IP-Option',
- 'ip3_rdata_rate' => 'IP3-RData-Rate',
- 'ip3_xdata_rate' => 'IP3-XData-Rate',
- 'ip_address_pool_name' => 'Ip_Address_Pool_Name',
- 'ip_address_pool_namf' => 'Ip-Address-Pool-Name',
- 'ip_host_addr' => 'Ip_Host_Addr',
- 'ip_host_adds' => 'Ip-Host-Addr',
- 'ip_tos_field' => 'IP_TOS_Field',
- 'ip_tos_fiele' => 'IP-TOS-Field',
- 'itk_acct_serv_ip' => 'ITK-Acct-Serv-IP',
- 'itk_acct_serv_prot' => 'ITK-Acct-Serv-Prot',
- 'itk_auth_req_type' => 'ITK-Auth-Req-Type',
- 'itk_auth_serv_ip' => 'ITK-Auth-Serv-IP',
- 'itk_auth_serv_prot' => 'ITK-Auth-Serv-Prot',
- 'itk_banner' => 'ITK-Banner',
- 'itk_channel_binding' => 'ITK-Channel-Binding',
- 'itk_ddi' => 'ITK-DDI',
- 'itk_dest_no' => 'ITK-Dest-No',
- 'itk_dialout_type' => 'ITK-Dialout-Type',
- 'itk_filter_rule' => 'ITK-Filter-Rule',
- 'itk_ftp_auth_ip' => 'ITK-Ftp-Auth-IP',
- 'itk_ip_pool' => 'ITK-IP-Pool',
- 'itk_isdn_prot' => 'ITK-ISDN-Prot',
- 'itk_modem_init_string' => 'ITK-Modem-Init-String',
- 'itk_modem_pool_id' => 'ITK-Modem-Pool-Id',
- 'itk_nas_name' => 'ITK-NAS-Name',
- 'itk_password_prompt' => 'ITK-Password-Prompt',
- 'itk_ppp_auth_type' => 'ITK-PPP-Auth-Type',
- 'itk_ppp_client_server_mo' => 'ITK-PPP-Client-Server-Mode',
- 'itk_ppp_compression_prot' => 'ITK-PPP-Compression-Prot',
- 'itk_prompt' => 'ITK-Prompt',
- 'itk_provider_id' => 'ITK-Provider-Id',
- 'itk_start_delay' => 'ITK-Start-Delay',
- 'itk_tunnel_ip' => 'ITK-Tunnel-IP',
- 'itk_tunnel_prot' => 'ITK-Tunnel-Prot',
- 'itk_usergroup' => 'ITK-Usergroup',
- 'itk_username' => 'ITK-Username',
- 'itk_username_prompt' => 'ITK-Username-Prompt',
- 'itk_users_default_entry' => 'ITK-Users-Default-Entry',
- 'itk_users_default_pw' => 'ITK-Users-Default-Pw',
- 'itk_welcome_message' => 'ITK-Welcome-Message',
- 'juniper_allow_commands' => 'Juniper-Allow-Commands',
- 'juniper_allow_configurat' => 'Juniper-Allow-Configuration',
- 'juniper_deny_commands' => 'Juniper-Deny-Commands',
- 'juniper_deny_configurati' => 'Juniper-Deny-Configuration',
- 'juniper_local_user_name' => 'Juniper-Local-User-Name',
- 'karlnet_turbocell_name' => 'KarlNet-TurboCell-Name',
- 'karlnet_turbocell_opmode' => 'KarlNet-TurboCell-OpMode',
- 'karlnet_turbocell_opstat' => 'KarlNet-TurboCell-OpState',
- 'karlnet_turbocell_txrate' => 'KarlNet-TurboCell-TxRate',
- 'lac_port' => 'LAC_Port',
- 'lac_port_type' => 'LAC_Port_Type',
- 'lac_port_typf' => 'LAC-Port-Type',
- 'lac_poru' => 'LAC-Port',
- 'lac_real_port' => 'LAC_Real_Port',
- 'lac_real_port_type' => 'LAC_Real_Port_Type',
- 'lac_real_port_typf' => 'LAC-Real-Port-Type',
- 'lac_real_poru' => 'LAC-Real-Port',
- 'ldap_group' => 'Ldap-Group',
- 'ldap_userdn' => 'Ldap-UserDn',
- 'le_admin_group' => 'LE-Admin-Group',
- 'le_advice_of_charge' => 'LE-Advice-of-Charge',
- 'le_connect_detail' => 'LE-Connect-Detail',
- 'le_ip_gateway' => 'LE-IP-Gateway',
- 'le_ip_pool' => 'LE-IP-Pool',
- 'le_ipsec_active_profile' => 'LE-IPSec-Active-Profile',
- 'le_ipsec_deny_action' => 'LE-IPSec-Deny-Action',
- 'le_ipsec_log_options' => 'LE-IPSec-Log-Options',
- 'le_ipsec_outsource_profi' => 'LE-IPSec-Outsource-Profile',
- 'le_ipsec_passive_profile' => 'LE-IPSec-Passive-Profile',
- 'le_modem_info' => 'LE-Modem-Info',
- 'le_multicast_client' => 'LE-Multicast-Client',
- 'le_nat_inmap' => 'LE-NAT-Inmap',
- 'le_nat_log_options' => 'LE-NAT-Log-Options',
- 'le_nat_other_session_tim' => 'LE-NAT-Other-Session-Timeout',
- 'le_nat_outmap' => 'LE-NAT-Outmap',
- 'le_nat_outsource_inmap' => 'LE-NAT-Outsource-Inmap',
- 'le_nat_outsource_outmap' => 'LE-NAT-Outsource-Outmap',
- 'le_nat_sess_dir_fail_act' => 'LE-NAT-Sess-Dir-Fail-Action',
- 'le_nat_tcp_session_timeo' => 'LE-NAT-TCP-Session-Timeout',
- 'le_terminate_detail' => 'LE-Terminate-Detail',
- 'lm_password' => 'LM-Password',
- 'local_web_acct_duration' => 'Local-Web-Acct-Duration',
- 'local_web_acct_interim_r' => 'Local-Web-Acct-Interim-Rx-Bytes',
- 'local_web_acct_interim_s' => 'Local-Web-Acct-Interim-Rx-Gigawords',
- 'local_web_acct_interim_t' => 'Local-Web-Acct-Interim-Tx-Bytes',
- 'local_web_acct_interim_u' => 'Local-Web-Acct-Interim-Tx-Gigawords',
- 'local_web_acct_interim_v' => 'Local-Web-Acct-Interim-Tx-Mgmt',
- 'local_web_acct_interim_w' => 'Local-Web-Acct-Interim-Rx-Mgmt',
- 'local_web_acct_rx_mgmt' => 'Local-Web-Acct-Rx-Mgmt',
- 'local_web_acct_time' => 'Local-Web-Acct-Time',
- 'local_web_acct_tx_mgmt' => 'Local-Web-Acct-Tx-Mgmt',
- 'local_web_border_router' => 'Local-Web-Border-Router',
- 'local_web_client_ip' => 'Local-Web-Client-Ip',
- 'local_web_reauth_counter' => 'Local-Web-Reauth-Counter',
- 'local_web_rx_limit' => 'Local-Web-Rx-Limit',
- 'local_web_tx_limit' => 'Local-Web-Tx-Limit',
- 'login_callback_number' => 'Login-Callback-Number',
- 'login_host' => 'Login-Host',
- 'login_ip_host' => 'Login-IP-Host',
- 'login_ipv6_host' => 'Login-IPv6-Host',
- 'login_lat_group' => 'Login-LAT-Group',
- 'login_lat_node' => 'Login-LAT-Node',
- 'login_lat_port' => 'Login-LAT-Port',
- 'login_lat_service' => 'Login-LAT-Service',
- 'login_port' => 'Login-Port',
- 'login_service' => 'Login-Service',
- 'login_tcp_port' => 'Login-TCP-Port',
- 'login_time' => 'Login-Time',
- 'mcast_maxgroups' => 'Mcast_MaxGroups',
- 'mcast_maxgroupt' => 'Mcast-MaxGroups',
- 'mcast_receive' => 'Mcast_Receive',
- 'mcast_receivf' => 'Mcast-Receive',
- 'mcast_send' => 'Mcast_Send',
- 'mcast_sene' => 'Mcast-Send',
- 'medium_type' => 'Medium_Type',
- 'medium_typf' => 'Medium-Type',
- 'menu' => 'Menu',
- 'merit_proxy_action' => 'Merit-Proxy-Action',
- 'merit_user_id' => 'Merit-User-Id',
- 'merit_user_realm' => 'Merit-User-Realm',
- 'message_authenticator' => 'Message-Authenticator',
- 'method' => 'method',
- 'mikrotik_group' => 'Mikrotik-Group',
- 'mikrotik_recv_limit' => 'Mikrotik-Recv-Limit',
- 'mikrotik_xmit_limit' => 'Mikrotik-Xmit-Limit',
- 'module_failure_message' => 'Module-Failure-Message',
- 'module_success_message' => 'Module-Success-Message',
- 'motorola_canopy_cirenabl' => 'Motorola-Canopy-CIRENABLE',
- 'motorola_canopy_dlba' => 'Motorola-Canopy-DLBA',
- 'motorola_canopy_enable' => 'Motorola-Canopy-Enable',
- 'motorola_canopy_higherbw' => 'Motorola-Canopy-HIGHERBW',
- 'motorola_canopy_hpcenabl' => 'Motorola-Canopy-HPCENABLE',
- 'motorola_canopy_hpsdldr' => 'Motorola-Canopy-HPSDLDR',
- 'motorola_canopy_hpsuldr' => 'Motorola-Canopy-HPSULDR',
- 'motorola_canopy_lpsdldr' => 'Motorola-Canopy-LPSDLDR',
- 'motorola_canopy_lpsuldr' => 'Motorola-Canopy-LPSULDR',
- 'motorola_canopy_sdldr' => 'Motorola-Canopy-SDLDR',
- 'motorola_canopy_shared_s' => 'Motorola-Canopy-Shared-Secret',
- 'motorola_canopy_suldr' => 'Motorola-Canopy-SULDR',
- 'motorola_canopy_ulba' => 'Motorola-Canopy-ULBA',
- 'ms_acct_auth_type' => 'MS-Acct-Auth-Type',
- 'ms_acct_eap_type' => 'MS-Acct-EAP-Type',
- 'ms_arap_pw_change_reason' => 'MS-ARAP-PW-Change-Reason',
- 'ms_bap_usage' => 'MS-BAP-Usage',
- 'ms_chap2_cpw' => 'MS-CHAP2-CPW',
- 'ms_chap2_response' => 'MS-CHAP2-Response',
- 'ms_chap2_success' => 'MS-CHAP2-Success',
- 'ms_chap_challenge' => 'MS-CHAP-Challenge',
- 'ms_chap_cpw_1' => 'MS-CHAP-CPW-1',
- 'ms_chap_cpw_2' => 'MS-CHAP-CPW-2',
- 'ms_chap_domain' => 'MS-CHAP-Domain',
- 'ms_chap_error' => 'MS-CHAP-Error',
- 'ms_chap_lm_enc_pw' => 'MS-CHAP-LM-Enc-PW',
- 'ms_chap_mppe_keys' => 'MS-CHAP-MPPE-Keys',
- 'ms_chap_nt_enc_pw' => 'MS-CHAP-NT-Enc-PW',
- 'ms_chap_response' => 'MS-CHAP-Response',
- 'ms_chap_use_ntlm_auth' => 'MS-CHAP-Use-NTLM-Auth',
- 'ms_filter' => 'MS-Filter',
- 'ms_link_drop_time_limit' => 'MS-Link-Drop-Time-Limit',
- 'ms_link_utilization_thre' => 'MS-Link-Utilization-Threshold',
- 'ms_mppe_encryption_polic' => 'MS-MPPE-Encryption-Policy',
- 'ms_mppe_encryption_type' => 'MS-MPPE-Encryption-Type',
- 'ms_mppe_encryption_types' => 'MS-MPPE-Encryption-Types',
- 'ms_mppe_recv_key' => 'MS-MPPE-Recv-Key',
- 'ms_mppe_send_key' => 'MS-MPPE-Send-Key',
- 'ms_new_arap_password' => 'MS-New-ARAP-Password',
- 'ms_old_arap_password' => 'MS-Old-ARAP-Password',
- 'ms_primary_dns_server' => 'MS-Primary-DNS-Server',
- 'ms_primary_nbns_server' => 'MS-Primary-NBNS-Server',
- 'ms_ras_vendor' => 'MS-RAS-Vendor',
- 'ms_ras_version' => 'MS-RAS-Version',
- 'ms_secondary_dns_server' => 'MS-Secondary-DNS-Server',
- 'ms_secondary_nbns_server' => 'MS-Secondary-NBNS-Server',
- 'multi_link_flag' => 'Multi-Link-Flag',
- 'nas_identifier' => 'NAS-Identifier',
- 'nas_ip_address' => 'NAS-IP-Address',
- 'nas_ipv6_address' => 'NAS-IPv6-Address',
- 'nas_port' => 'NAS-Port',
- 'nas_port_id' => 'NAS-Port-Id',
- 'nas_port_type' => 'NAS-Port-Type',
- 'nas_real_port' => 'NAS_Real_Port',
- 'nas_real_poru' => 'NAS-Real-Port',
- 'navini_avpair' => 'Navini-AVPair',
- 'next_hop_dn' => 'next-hop-dn',
- 'next_hop_ip' => 'next-hop-ip',
- 'nn_data_rate' => 'NN-Data-Rate',
- 'nn_data_rate_ceiling' => 'NN-Data-Rate-Ceiling',
- 'nn_homenode' => 'NN-Homenode',
- 'nn_homeservice' => 'NN-Homeservice',
- 'nn_homeservice_name' => 'NN-Homeservice-Name',
- 'no_such_attribute' => 'No-Such-Attribute',
- 'nokia_charging_id' => 'Nokia-Charging-Id',
- 'nokia_ggsn_ip_address' => 'Nokia-GGSN-IP-Address',
- 'nokia_imsi' => 'Nokia-IMSI',
- 'nokia_prepaid_ind' => 'Nokia-Prepaid-Ind',
- 'nokia_sgsn_ip_address' => 'Nokia-SGSN-IP-Address',
- 'nomadix_bw_down' => 'Nomadix-Bw-Down',
- 'nomadix_bw_up' => 'Nomadix-Bw-Up',
- 'nomadix_config_url' => 'Nomadix-Config-URL',
- 'nomadix_endofsession' => 'Nomadix-EndofSession',
- 'nomadix_expiration' => 'Nomadix-Expiration',
- 'nomadix_goodbye_url' => 'Nomadix-Goodbye-URL',
- 'nomadix_ip_upsell' => 'Nomadix-IP-Upsell',
- 'nomadix_logoff_url' => 'Nomadix-Logoff-URL',
- 'nomadix_maxbytesdown' => 'Nomadix-MaxBytesDown',
- 'nomadix_maxbytesup' => 'Nomadix-MaxBytesUp',
- 'nomadix_net_vlan' => 'Nomadix-Net-VLAN',
- 'nomadix_subnet' => 'Nomadix-Subnet',
- 'nomadix_url_redirection' => 'Nomadix-URL-Redirection',
- 'ns_admin_privilege' => 'NS-Admin-Privilege',
- 'ns_mta_md5_password' => 'NS-MTA-MD5-Password',
- 'ns_primary_dns' => 'NS-Primary-DNS',
- 'ns_primary_wins' => 'NS-Primary-WINS',
- 'ns_secondary_dns' => 'NS-Secondary-DNS',
- 'ns_secondary_wins' => 'NS-Secondary-WINS',
- 'ns_user_group' => 'NS-User-Group',
- 'ns_vsys_name' => 'NS-VSYS-Name',
- 'nt_password' => 'NT-Password',
- 'ntlm_user_name' => 'NTLM-User-Name',
- 'old_password' => 'Old-Password',
- 'outgoing_req_uri' => 'outgoing-req-uri',
- 'packet_dst_port' => 'Packet-Dst-Port',
- 'packet_type' => 'Packet-Type',
- 'pam_auth' => 'Pam-Auth',
- 'password' => 'Password',
- 'password_retry' => 'Password-Retry',
- 'police_burst' => 'Police_Burst',
- 'police_bursu' => 'Police-Burst',
- 'police_rate' => 'Police_Rate',
- 'police_ratf' => 'Police-Rate',
- 'pool_name' => 'Pool-Name',
- 'port_limit' => 'Port-Limit',
- 'port_message' => 'Port-Message',
- 'post_auth_type' => 'Post-Auth-Type',
- 'post_proxy_type' => 'Post-Proxy-Type',
- 'postauth_type' => 'PostAuth-Type',
- 'pppoe_motm' => 'PPPOE_MOTM',
- 'pppoe_motn' => 'PPPOE-MOTM',
- 'pppoe_url' => 'PPPOE_URL',
- 'pppoe_urm' => 'PPPOE-URL',
- 'pre_acct_type' => 'Pre-Acct-Type',
- 'pre_proxy_type' => 'Pre-Proxy-Type',
- 'prefix' => 'Prefix',
- 'prev_hop_ip' => 'prev-hop-ip',
- 'prev_hop_via' => 'prev-hop-via',
- 'prompt' => 'Prompt',
- 'propel_accelerate' => 'Propel-Accelerate',
- 'propel_client_ip_address' => 'Propel-Client-IP-Address',
- 'propel_client_nas_ip_add' => 'Propel-Client-NAS-IP-Address',
- 'propel_client_source_id' => 'Propel-Client-Source-ID',
- 'propel_dialed_digits' => 'Propel-Dialed-Digits',
- 'proxy_state' => 'Proxy-State',
- 'proxy_to_realm' => 'Proxy-To-Realm',
- 'pvc_circuit_padding' => 'PVC_Circuit_Padding',
- 'pvc_circuit_paddinh' => 'PVC-Circuit-Padding',
- 'pvc_encapsulation_type' => 'PVC_Encapsulation_Type',
- 'pvc_encapsulation_typf' => 'PVC-Encapsulation-Type',
- 'pvc_profile_name' => 'PVC_Profile_Name',
- 'pvc_profile_namf' => 'PVC-Profile-Name',
- 'quintum_avpair' => 'Quintum-AVPair',
- 'quintum_h323_billing_mod' => 'Quintum-h323-billing-model',
- 'quintum_h323_call_origin' => 'Quintum-h323-call-origin',
- 'quintum_h323_call_type' => 'Quintum-h323-call-type',
- 'quintum_h323_conf_id' => 'Quintum-h323-conf-id',
- 'quintum_h323_connect_tim' => 'Quintum-h323-connect-time',
- 'quintum_h323_credit_amou' => 'Quintum-h323-credit-amount',
- 'quintum_h323_credit_time' => 'Quintum-h323-credit-time',
- 'quintum_h323_currency_ty' => 'Quintum-h323-currency-type',
- 'quintum_h323_disconnect_' => 'Quintum-h323-disconnect-time',
- 'quintum_h323_disconnecta' => 'Quintum-h323-disconnect-cause',
- 'quintum_h323_gw_id' => 'Quintum-h323-gw-id',
- 'quintum_h323_incoming_co' => 'Quintum-h323-incoming-conf-id',
- 'quintum_h323_preferred_l' => 'Quintum-h323-preferred-lang',
- 'quintum_h323_prompt_id' => 'Quintum-h323-prompt-id',
- 'quintum_h323_redirect_ip' => 'Quintum-h323-redirect-ip-address',
- 'quintum_h323_redirect_nu' => 'Quintum-h323-redirect-number',
- 'quintum_h323_remote_addr' => 'Quintum-h323-remote-address',
- 'quintum_h323_return_code' => 'Quintum-h323-return-code',
- 'quintum_h323_setup_time' => 'Quintum-h323-setup-time',
- 'quintum_h323_time_and_da' => 'Quintum-h323-time-and-day',
- 'quintum_h323_voice_quali' => 'Quintum-h323-voice-quality',
- 'quintum_nas_port' => 'Quintum-NAS-Port',
- 'rate_limit_burst' => 'Rate_Limit_Burst',
- 'rate_limit_bursu' => 'Rate-Limit-Burst',
- 'rate_limit_rate' => 'Rate_Limit_Rate',
- 'rate_limit_ratf' => 'Rate-Limit-Rate',
- 'realm' => 'Realm',
- 'redcreek_tunneled_dns_se' => 'RedCreek-Tunneled-DNS-Server',
- 'redcreek_tunneled_domain' => 'RedCreek-Tunneled-DomainName',
- 'redcreek_tunneled_gatewa' => 'RedCreek-Tunneled-Gateway',
- 'redcreek_tunneled_hostna' => 'RedCreek-Tunneled-HostName',
- 'redcreek_tunneled_ip_add' => 'RedCreek-Tunneled-IP-Addr',
- 'redcreek_tunneled_ip_net' => 'RedCreek-Tunneled-IP-Netmask',
- 'redcreek_tunneled_search' => 'RedCreek-Tunneled-Search-List',
- 'redcreek_tunneled_wins_s' => 'RedCreek-Tunneled-WINS-Server1',
- 'redcreek_tunneled_wins_t' => 'RedCreek-Tunneled-WINS-Server2',
- 'replicate_to_realm' => 'Replicate-To-Realm',
- 'reply_message' => 'Reply-Message',
- 'response_packet_type' => 'Response-Packet-Type',
- 'rewrite_rule' => 'Rewrite-Rule',
- 'sdx_service_name' => 'Sdx-Service-Name',
- 'sdx_session_volume_quota' => 'Sdx-Session-Volume-Quota',
- 'sdx_tunnel_disconnect_ca' => 'Sdx-Tunnel-Disconnect-Cause-Info',
- 'service_type' => 'Service-Type',
- 'session' => 'Session',
- 'session_error_code' => 'Session_Error_Code',
- 'session_error_codf' => 'Session-Error-Code',
- 'session_error_msg' => 'Session_Error_Msg',
- 'session_error_msh' => 'Session-Error-Msg',
- 'session_protocol' => 'session-protocol',
- 'session_timeout' => 'Session-Timeout',
- 'session_type' => 'Session-Type',
- 'shasta_service_profile' => 'Shasta-Service-Profile',
- 'shasta_user_privilege' => 'Shasta-User-Privilege',
- 'shasta_vpn_name' => 'Shasta-VPN-Name',
- 'shiva_acct_serv_switch' => 'Shiva-Acct-Serv-Switch',
- 'shiva_called_number' => 'Shiva-Called-Number',
- 'shiva_calling_number' => 'Shiva-Calling-Number',
- 'shiva_compression_type' => 'Shiva-Compression-Type',
- 'shiva_connect_reason' => 'Shiva-Connect-Reason',
- 'shiva_customer_id' => 'Shiva-Customer-Id',
- 'shiva_disconnect_reason' => 'Shiva-Disconnect-Reason',
- 'shiva_event_flags' => 'Shiva-Event-Flags',
- 'shiva_function' => 'Shiva-Function',
- 'shiva_link_protocol' => 'Shiva-Link-Protocol',
- 'shiva_link_speed' => 'Shiva-Link-Speed',
- 'shiva_links_in_bundle' => 'Shiva-Links-In-Bundle',
- 'shiva_network_protocols' => 'Shiva-Network-Protocols',
- 'shiva_session_id' => 'Shiva-Session-Id',
- 'shiva_type_of_service' => 'Shiva-Type-Of-Service',
- 'shiva_user_attributes' => 'Shiva-User-Attributes',
- 'simultaneous_use' => 'Simultaneous-Use',
- 'sip_from' => 'Sip-From',
- 'sip_hdr' => 'sip-hdr',
- 'sip_method' => 'Sip-Method',
- 'sip_to' => 'Sip-To',
- 'sip_translated_request_u' => 'Sip-Translated-Request-URI',
- 'smb_account_ctrl' => 'SMB-Account-CTRL',
- 'smb_account_ctrl_text' => 'SMB-Account-CTRL-TEXT',
- 'sonicwall_user_group' => 'SonicWall-User-Group',
- 'sonicwall_user_privilege' => 'SonicWall-User-Privilege',
- 'source_validation' => 'Source_Validation',
- 'source_validatioo' => 'Source-Validation',
- 'sql_group' => 'Sql-Group',
- 'sql_user_name' => 'SQL-User-Name',
- 'ss3_firewall_user_privil' => 'SS3-Firewall-User-Privilege',
- 'st_acct_vc_connection_id' => 'ST-Acct-VC-Connection-Id',
- 'st_policy_name' => 'ST-Policy-Name',
- 'st_primary_dns_server' => 'ST-Primary-DNS-Server',
- 'st_primary_nbns_server' => 'ST-Primary-NBNS-Server',
- 'st_secondary_dns_server' => 'ST-Secondary-DNS-Server',
- 'st_secondary_nbns_server' => 'ST-Secondary-NBNS-Server',
- 'st_service_domain' => 'ST-Service-Domain',
- 'st_service_name' => 'ST-Service-Name',
- 'state' => 'State',
- 'strip_user_name' => 'Strip-User-Name',
- 'stripped_user_name' => 'Stripped-User-Name',
- 'subscriber' => 'subscriber',
- 'suffix' => 'Suffix',
- 'telebit_accounting_info' => 'Telebit-Accounting-Info',
- 'telebit_activate_command' => 'Telebit-Activate-Command',
- 'telebit_login_command' => 'Telebit-Login-Command',
- 'telebit_port_name' => 'Telebit-Port-Name',
- 'termination_action' => 'Termination-Action',
- 'termination_menu' => 'Termination-Menu',
- 'trapeze_encryption_type' => 'Trapeze-Encryption-Type',
- 'trapeze_end_date' => 'Trapeze-End-Date',
- 'trapeze_mobility_profile' => 'Trapeze-Mobility-Profile',
- 'trapeze_ssid' => 'Trapeze-SSID',
- 'trapeze_start_date' => 'Trapeze-Start-Date',
- 'trapeze_time_of_day' => 'Trapeze-Time-Of-Day',
- 'trapeze_url' => 'Trapeze-URL',
- 'trapeze_vlan_name' => 'Trapeze-VLAN-Name',
- 'tty_level_max' => 'TTY_Level_Max',
- 'tty_level_may' => 'TTY-Level-Max',
- 'tty_level_start' => 'TTY_Level_Start',
- 'tty_level_staru' => 'TTY-Level-Start',
- 'tunnel_algorithm' => 'Tunnel_Algorithm',
- 'tunnel_algorithn' => 'Tunnel-Algorithm',
- 'tunnel_assignment_id' => 'Tunnel-Assignment-Id',
- 'tunnel_client_auth_id' => 'Tunnel-Client-Auth-Id',
- 'tunnel_client_endpoint' => 'Tunnel-Client-Endpoint',
- 'tunnel_cmd_timeout' => 'Tunnel_Cmd_Timeout',
- 'tunnel_cmd_timeouu' => 'Tunnel-Cmd-Timeout',
- 'tunnel_connection_id' => 'Tunnel-Connection-Id',
- 'tunnel_context' => 'Tunnel_Context',
- 'tunnel_contexu' => 'Tunnel-Context',
- 'tunnel_deadtime' => 'Tunnel_Deadtime',
- 'tunnel_deadtimf' => 'Tunnel-Deadtime',
- 'tunnel_dnis' => 'Tunnel_DNIS',
- 'tunnel_dnit' => 'Tunnel-DNIS',
- 'tunnel_domain' => 'Tunnel_Domain',
- 'tunnel_domaio' => 'Tunnel-Domain',
- 'tunnel_function' => 'Tunnel_Function',
- 'tunnel_functioo' => 'Tunnel-Function',
- 'tunnel_group' => 'Tunnel_Group',
- 'tunnel_grouq' => 'Tunnel-Group',
- 'tunnel_l2f_second_passwo' => 'Tunnel_L2F_Second_Password',
- 'tunnel_l2f_second_passwp' => 'Tunnel-L2F-Second-Password',
- 'tunnel_local_name' => 'Tunnel_Local_Name',
- 'tunnel_local_namf' => 'Tunnel-Local-Name',
- 'tunnel_max_sessions' => 'Tunnel_Max_Sessions',
- 'tunnel_max_sessiont' => 'Tunnel-Max-Sessions',
- 'tunnel_max_tunnels' => 'Tunnel_Max_Tunnels',
- 'tunnel_max_tunnelt' => 'Tunnel-Max-Tunnels',
- 'tunnel_medium_type' => 'Tunnel-Medium-Type',
- 'tunnel_password' => 'Tunnel-Password',
- 'tunnel_police_burst' => 'Tunnel_Police_Burst',
- 'tunnel_police_bursu' => 'Tunnel-Police-Burst',
- 'tunnel_police_rate' => 'Tunnel_Police_Rate',
- 'tunnel_police_ratf' => 'Tunnel-Police-Rate',
- 'tunnel_preference' => 'Tunnel-Preference',
- 'tunnel_private_group_id' => 'Tunnel-Private-Group-Id',
- 'tunnel_rate_limit_burst' => 'Tunnel_Rate_Limit_Burst',
- 'tunnel_rate_limit_bursu' => 'Tunnel-Rate-Limit-Burst',
- 'tunnel_rate_limit_rate' => 'Tunnel_Rate_Limit_Rate',
- 'tunnel_rate_limit_ratf' => 'Tunnel-Rate-Limit-Rate',
- 'tunnel_remote_name' => 'Tunnel_Remote_Name',
- 'tunnel_remote_namf' => 'Tunnel-Remote-Name',
- 'tunnel_retransmit' => 'Tunnel_Retransmit',
- 'tunnel_retransmiu' => 'Tunnel-Retransmit',
- 'tunnel_server_auth_id' => 'Tunnel-Server-Auth-Id',
- 'tunnel_server_endpoint' => 'Tunnel-Server-Endpoint',
- 'tunnel_session_auth' => 'Tunnel_Session_Auth',
- 'tunnel_session_auth_ctx' => 'Tunnel_Session_Auth_Ctx',
- 'tunnel_session_auth_cty' => 'Tunnel-Session-Auth-Ctx',
- 'tunnel_session_auth_serv' => 'Tunnel_Session_Auth_Service_Grp',
- 'tunnel_session_auth_serw' => 'Tunnel-Session-Auth-Service-Grp',
- 'tunnel_session_auti' => 'Tunnel-Session-Auth',
- 'tunnel_type' => 'Tunnel-Type',
- 'tunnel_window' => 'Tunnel_Window',
- 'tunnel_windox' => 'Tunnel-Window',
- 'unix_ftp_gid' => 'Unix-FTP-GID',
- 'unix_ftp_group_ids' => 'Unix-FTP-Group-Ids',
- 'unix_ftp_group_names' => 'Unix-FTP-Group-Names',
- 'unix_ftp_home' => 'Unix-FTP-Home',
- 'unix_ftp_shell' => 'Unix-FTP-Shell',
- 'unix_ftp_uid' => 'Unix-FTP-UID',
- 'user_category' => 'User-Category',
- 'user_name' => 'User-Name',
- 'user_name_is_star' => 'User-Name-Is-Star',
- 'user_password' => 'User-Password',
- 'user_profile' => 'User-Profile',
- 'user_service_type' => 'User-Service-Type',
- 'usr_accm_type' => 'USR-ACCM-Type',
- 'usr_acct_reason_code' => 'USR-Acct-Reason-Code',
- 'usr_actual_voltage' => 'USR-Actual-Voltage',
- 'usr_appletalk' => 'USR-Appletalk',
- 'usr_appletalk_network_ra' => 'USR-Appletalk-Network-Range',
- 'usr_at_call_input_filter' => 'USR-AT-Call-Input-Filter',
- 'usr_at_call_output_filte' => 'USR-AT-Call-Output-Filter',
- 'usr_at_input_filter' => 'USR-AT-Input-Filter',
- 'usr_at_output_filter' => 'USR-AT-Output-Filter',
- 'usr_at_rtmp_input_filter' => 'USR-AT-RTMP-Input-Filter',
- 'usr_at_rtmp_output_filte' => 'USR-AT-RTMP-Output-Filter',
- 'usr_at_zip_input_filter' => 'USR-AT-Zip-Input-Filter',
- 'usr_at_zip_output_filter' => 'USR-AT-Zip-Output-Filter',
- 'usr_auth_mode' => 'USR-Auth-Mode',
- 'usr_back_channel_data_ra' => 'USR-Back-Channel-Data-Rate',
- 'usr_bearer_capabilities' => 'USR-Bearer-Capabilities',
- 'usr_block_error_count_li' => 'USR-Block-Error-Count-Limit',
- 'usr_blocks_received' => 'USR-Blocks-Received',
- 'usr_blocks_resent' => 'USR-Blocks-Resent',
- 'usr_blocks_sent' => 'USR-Blocks-Sent',
- 'usr_bridging' => 'USR-Bridging',
- 'usr_call_arrival_in_gmt' => 'USR-Call-Arrival-in-GMT',
- 'usr_call_arrival_time' => 'USR-Call-Arrival-Time',
- 'usr_call_connect_in_gmt' => 'USR-Call-Connect-in-GMT',
- 'usr_call_connecting_time' => 'USR-Call-Connecting-Time',
- 'usr_call_end_date_time' => 'USR-Call-End-Date-Time',
- 'usr_call_end_time' => 'USR-Call-End-Time',
- 'usr_call_error_code' => 'USR-Call-Error-Code',
- 'usr_call_event_code' => 'USR-Call-Event-Code',
- 'usr_call_reference_numbe' => 'USR-Call-Reference-Number',
- 'usr_call_start_date_time' => 'USR-Call-Start-Date-Time',
- 'usr_call_terminate_in_gm' => 'USR-Call-Terminate-in-GMT',
- 'usr_call_type' => 'USR-Call-Type',
- 'usr_callback_type' => 'USR-Callback-Type',
- 'usr_called_party_number' => 'USR-Called-Party-Number',
- 'usr_calling_party_number' => 'USR-Calling-Party-Number',
- 'usr_card_type' => 'USR-Card-Type',
- 'usr_ccp_algorithm' => 'USR-CCP-Algorithm',
- 'usr_cdma_call_reference_' => 'USR-CDMA-Call-Reference-Number',
- 'usr_channel' => 'USR-Channel',
- 'usr_channel_connected_to' => 'USR-Channel-Connected-To',
- 'usr_channel_decrement' => 'USR-Channel-Decrement',
- 'usr_channel_expansion' => 'USR-Channel-Expansion',
- 'usr_characters_received' => 'USR-Characters-Received',
- 'usr_characters_sent' => 'USR-Characters-Sent',
- 'usr_chassis_call_channel' => 'USR-Chassis-Call-Channel',
- 'usr_chassis_call_slot' => 'USR-Chassis-Call-Slot',
- 'usr_chassis_call_span' => 'USR-Chassis-Call-Span',
- 'usr_chassis_slot' => 'USR-Chassis-Slot',
- 'usr_chassis_temp_thresho' => 'USR-Chassis-Temp-Threshold',
- 'usr_chassis_temperature' => 'USR-Chassis-Temperature',
- 'usr_chat_script_name' => 'USR-Chat-Script-Name',
- 'usr_compression_algorith' => 'USR-Compression-Algorithm',
- 'usr_compression_reset_mo' => 'USR-Compression-Reset-Mode',
- 'usr_compression_type' => 'USR-Compression-Type',
- 'usr_connect_speed' => 'USR-Connect-Speed',
- 'usr_connect_term_reason' => 'USR-Connect-Term-Reason',
- 'usr_connect_time' => 'USR-Connect-Time',
- 'usr_connect_time_limit' => 'USR-Connect-Time-Limit',
- 'usr_cusr_hat_script_rule' => 'USR-CUSR-hat-Script-Rules',
- 'usr_default_dte_data_rat' => 'USR-Default-DTE-Data-Rate',
- 'usr_device_connected_to' => 'USR-Device-Connected-To',
- 'usr_disconnect_cause_ind' => 'USR-Disconnect-Cause-Indicator',
- 'usr_dnis_reauthenticatio' => 'USR-DNIS-ReAuthentication',
- 'usr_ds0' => 'USR-DS0',
- 'usr_ds0s' => 'USR-DS0s',
- 'usr_dte_data_idle_timout' => 'USR-DTE-Data-Idle-Timout',
- 'usr_dte_ring_no_answer_l' => 'USR-DTE-Ring-No-Answer-Limit',
- 'usr_dtr_false_timeout' => 'USR-DTR-False-Timeout',
- 'usr_dtr_true_timeout' => 'USR-DTR-True-Timeout',
- 'usr_end_time' => 'USR-End-Time',
- 'usr_equalization_type' => 'USR-Equalization-Type',
- 'usr_esn' => 'USR-ESN',
- 'usr_et_bridge_call_outpu' => 'USR-ET-Bridge-Call-Output-Filte',
- 'usr_et_bridge_input_filt' => 'USR-ET-Bridge-Input-Filter',
- 'usr_et_bridge_output_fil' => 'USR-ET-Bridge-Output-Filter',
- 'usr_event_date_time' => 'USR-Event-Date-Time',
- 'usr_event_id' => 'USR-Event-Id',
- 'usr_expansion_algorithm' => 'USR-Expansion-Algorithm',
- 'usr_expected_voltage' => 'USR-Expected-Voltage',
- 'usr_failure_to_connect_r' => 'USR-Failure-to-Connect-Reason',
- 'usr_fallback_enabled' => 'USR-Fallback-Enabled',
- 'usr_fallback_limit' => 'USR-Fallback-Limit',
- 'usr_filter_zones' => 'USR-Filter-Zones',
- 'usr_final_rx_link_data_r' => 'USR-Final-Rx-Link-Data-Rate',
- 'usr_final_tx_link_data_r' => 'USR-Final-Tx-Link-Data-Rate',
- 'usr_framed_ip_address_po' => 'USR-Framed_IP_Address_Pool_Name',
- 'usr_framed_ipx_route' => 'USR-Framed-IPX-Route',
- 'usr_gateway_ip_address' => 'USR-Gateway-IP-Address',
- 'usr_harc_disconnect_code' => 'USR-HARC-Disconnect-Code',
- 'usr_host_type' => 'USR-Host-Type',
- 'usr_ids0_call_type' => 'USR-IDS0-Call-Type',
- 'usr_igmp_maximum_respons' => 'USR-IGMP-Maximum-Response-Time',
- 'usr_igmp_query_interval' => 'USR-IGMP-Query-Interval',
- 'usr_igmp_robustness' => 'USR-IGMP-Robustness',
- 'usr_igmp_routing' => 'USR-IGMP-Routing',
- 'usr_igmp_version' => 'USR-IGMP-Version',
- 'usr_imsi' => 'USR-IMSI',
- 'usr_initial_rx_link_data' => 'USR-Initial-Rx-Link-Data-Rate',
- 'usr_initial_tx_link_data' => 'USR-Initial-Tx-Link-Data-Rate',
- 'usr_interface_index' => 'USR-Interface-Index',
- 'usr_ip' => 'USR-IP',
- 'usr_ip_call_input_filter' => 'USR-IP-Call-Input-Filter',
- 'usr_ip_call_output_filte' => 'USR-IP-Call-Output-Filter',
- 'usr_ip_default_route_opt' => 'USR-IP-Default-Route-Option',
- 'usr_ip_rip_input_filter' => 'USR-IP-RIP-Input-Filter',
- 'usr_ip_rip_output_filter' => 'USR-IP-RIP-Output-Filter',
- 'usr_ip_rip_policies' => 'USR-IP-RIP-Policies',
- 'usr_ip_rip_simple_auth_p' => 'USR-IP-RIP-Simple-Auth-Password',
- 'usr_ip_saa_filter' => 'USR-IP-SAA-Filter',
- 'usr_ipx' => 'USR-IPX',
- 'usr_ipx_call_input_filte' => 'USR-IPX-Call-Input-Filter',
- 'usr_ipx_call_output_filt' => 'USR-IPX-Call-Output-Filter',
- 'usr_ipx_rip_input_filter' => 'USR-IPX-RIP-Input-Filter',
- 'usr_ipx_rip_output_filte' => 'USR-IPX-RIP-Output-Filter',
- 'usr_ipx_routing' => 'USR-IPX-Routing',
- 'usr_ipx_wan' => 'USR-IPX-WAN',
- 'usr_iwf_call_identifier' => 'USR-IWF-Call-Identifier',
- 'usr_iwf_ip_address' => 'USR-IWF-IP-Address',
- 'usr_keypress_timeout' => 'USR-Keypress-Timeout',
- 'usr_last_callers_number_' => 'USR-Last-Callers-Number-ANI',
- 'usr_last_number_dialed_i' => 'USR-Last-Number-Dialed-In-DNIS',
- 'usr_last_number_dialed_o' => 'USR-Last-Number-Dialed-Out',
- 'usr_line_reversals' => 'USR-Line-Reversals',
- 'usr_local_framed_ip_addr' => 'USR-Local-Framed-IP-Addr',
- 'usr_local_ip_address' => 'USR-Local-IP-Address',
- 'usr_log_filter_packets' => 'USR-Log-Filter-Packets',
- 'usr_max_channels' => 'USR-Max-Channels',
- 'usr_mbi_ct_bchannel_used' => 'USR-Mbi_Ct_BChannel_Used',
- 'usr_mbi_ct_pri_card_slot' => 'USR-Mbi_Ct_PRI_Card_Slot',
- 'usr_mbi_ct_pri_card_span' => 'USR-Mbi_Ct_PRI_Card_Span_Line',
- 'usr_mbi_ct_tdm_time_slot' => 'USR-Mbi_Ct_TDM_Time_Slot',
- 'usr_mic' => 'USR-MIC',
- 'usr_min_compression_size' => 'USR-Min-Compression-Size',
- 'usr_mobile_ip_address' => 'USR-Mobile-IP-Address',
- 'usr_mobile_numbytes_rxed' => 'USR-Mobile-NumBytes-Rxed',
- 'usr_mobile_numbytes_txed' => 'USR-Mobile-NumBytes-Txed',
- 'usr_mobileip_home_agent_' => 'USR-MobileIP-Home-Agent-Address',
- 'usr_modem_group' => 'USR-Modem-Group',
- 'usr_modem_setup_time' => 'USR-Modem-Setup-Time',
- 'usr_modem_training_time' => 'USR-Modem-Training-Time',
- 'usr_modulation_type' => 'USR-Modulation-Type',
- 'usr_mp_edo' => 'USR-MP-EDO',
- 'usr_mp_edo_hiper' => 'USR-MP-EDO-HIPER',
- 'usr_mp_mrru' => 'USR-MP-MRRU',
- 'usr_mpip_tunnel_originat' => 'USR-MPIP-Tunnel-Originator',
- 'usr_multicast_forwarding' => 'USR-Multicast-Forwarding',
- 'usr_multicast_proxy' => 'USR-Multicast-Proxy',
- 'usr_multicast_receive' => 'USR-Multicast-Receive',
- 'usr_nas_type' => 'USR-NAS-Type',
- 'usr_nfas_id' => 'USR-NFAS-ID',
- 'usr_num_fax_pages_proces' => 'USR-Num-Fax-Pages-Processed',
- 'usr_number_of_blers' => 'USR-Number-of-Blers',
- 'usr_number_of_characters' => 'USR-Number-Of-Characters-Lost',
- 'usr_number_of_fallbacks' => 'USR-Number-of-Fallbacks',
- 'usr_number_of_link_naks' => 'USR-Number-of-Link-NAKs',
- 'usr_number_of_link_timeo' => 'USR-Number-of-Link-Timeouts',
- 'usr_number_of_rings_limi' => 'USR-Number-of-Rings-Limit',
- 'usr_number_of_upshifts' => 'USR-Number-of-Upshifts',
- 'usr_orig_nas_type' => 'USR-Orig-NAS-Type',
- 'usr_originate_answer_mod' => 'USR-Originate-Answer-Mode',
- 'usr_ospf_addressless_ind' => 'USR-OSPF-Addressless-Index',
- 'usr_packet_bus_session' => 'USR-Packet-Bus-Session',
- 'usr_physical_state' => 'USR-Physical-State',
- 'usr_port_tap' => 'USR-Port-Tap',
- 'usr_port_tap_address' => 'USR-Port-Tap-Address',
- 'usr_port_tap_facility' => 'USR-Port-Tap-Facility',
- 'usr_port_tap_format' => 'USR-Port-Tap-Format',
- 'usr_port_tap_output' => 'USR-Port-Tap-Output',
- 'usr_port_tap_priority' => 'USR-Port-Tap-Priority',
- 'usr_power_supply_number' => 'USR-Power-Supply-Number',
- 'usr_primary_dns_server' => 'USR-Primary_DNS_Server',
- 'usr_primary_nbns_server' => 'USR-Primary_NBNS_Server',
- 'usr_pw_cutoff' => 'USR-PW_Cutoff',
- 'usr_pw_framed_routing_v2' => 'USR-PW_Framed_Routing_V2',
- 'usr_pw_index' => 'USR-PW_Index',
- 'usr_pw_packet' => 'USR-PW_Packet',
- 'usr_pw_tunnel_authentica' => 'USR-PW_Tunnel_Authentication',
- 'usr_pw_usr_ifilter_ip' => 'USR-PW_USR_IFilter_IP',
- 'usr_pw_usr_ifilter_ipx' => 'USR-PW_USR_IFilter_IPX',
- 'usr_pw_usr_ofilter_ip' => 'USR-PW_USR_OFilter_IP',
- 'usr_pw_usr_ofilter_ipx' => 'USR-PW_USR_OFilter_IPX',
- 'usr_pw_usr_ofilter_sap' => 'USR-PW_USR_OFilter_SAP',
- 'usr_pw_vpn_gateway' => 'USR-PW_VPN_Gateway',
- 'usr_pw_vpn_id' => 'USR-PW_VPN_ID',
- 'usr_pw_vpn_name' => 'USR-PW_VPN_Name',
- 'usr_pw_vpn_neighbor' => 'USR-PW_VPN_Neighbor',
- 'usr_q931_call_reference_' => 'USR-Q931-Call-Reference-Value',
- 'usr_rad_dvmrp_metric' => 'USR-Rad-Dvmrp-Metric',
- 'usr_rad_location_type' => 'USR-Rad-Location-Type',
- 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Ttl',
- 'usr_rad_multicast_routio' => 'USR-Rad-Multicast-Routing-RtLim',
- 'usr_rad_multicast_routip' => 'USR-Rad-Multicast-Routing-Proto',
- 'usr_rad_multicast_routiq' => 'USR-Rad-Multicast-Routing-Bound',
- 'usr_re_chap_timeout' => 'USR-Re-Chap-Timeout',
- 'usr_receive_acc_map' => 'USR-Receive-Acc-Map',
- 'usr_reply_script1' => 'USR-Reply-Script1',
- 'usr_reply_script2' => 'USR-Reply-Script2',
- 'usr_reply_script3' => 'USR-Reply-Script3',
- 'usr_reply_script4' => 'USR-Reply-Script4',
- 'usr_reply_script5' => 'USR-Reply-Script5',
- 'usr_reply_script6' => 'USR-Reply-Script6',
- 'usr_request_type' => 'USR-Request-Type',
- 'usr_retrains_granted' => 'USR-Retrains-Granted',
- 'usr_retrains_requested' => 'USR-Retrains-Requested',
- 'usr_rmmie_firmware_build' => 'USR-RMMIE-Firmware-Build-Date',
- 'usr_rmmie_firmware_versi' => 'USR-RMMIE-Firmware-Version',
- 'usr_rmmie_last_update_ev' => 'USR-RMMIE-Last-Update-Event',
- 'usr_rmmie_last_update_ti' => 'USR-RMMIE-Last-Update-Time',
- 'usr_rmmie_manufacturer_i' => 'USR-RMMIE-Manufacturer-ID',
- 'usr_rmmie_num_of_updates' => 'USR-RMMIE-Num-Of-Updates',
- 'usr_rmmie_planned_discon' => 'USR-RMMIE-Planned-Disconnect',
- 'usr_rmmie_product_code' => 'USR-RMMIE-Product-Code',
- 'usr_rmmie_pwrlvl_farecho' => 'USR-RMMIE-PwrLvl-FarEcho-Canc',
- 'usr_rmmie_pwrlvl_nearech' => 'USR-RMMIE-PwrLvl-NearEcho-Canc',
- 'usr_rmmie_pwrlvl_noise_l' => 'USR-RMMIE-PwrLvl-Noise-Lvl',
- 'usr_rmmie_pwrlvl_xmit_lv' => 'USR-RMMIE-PwrLvl-Xmit-Lvl',
- 'usr_rmmie_rcv_pwrlvl_330' => 'USR-RMMIE-Rcv-PwrLvl-3300Hz',
- 'usr_rmmie_rcv_pwrlvl_375' => 'USR-RMMIE-Rcv-PwrLvl-3750Hz',
- 'usr_rmmie_rcv_tot_pwrlvl' => 'USR-RMMIE-Rcv-Tot-PwrLvl',
- 'usr_rmmie_serial_number' => 'USR-RMMIE-Serial-Number',
- 'usr_rmmie_status' => 'USR-RMMIE-Status',
- 'usr_rmmie_x2_status' => 'USR-RMMIE-x2-Status',
- 'usr_routing_protocol' => 'USR-Routing-Protocol',
- 'usr_sap_filter_in' => 'USR-SAP-Filter-In',
- 'usr_secondary_dns_server' => 'USR-Secondary_DNS_Server',
- 'usr_secondary_nbns_serve' => 'USR-Secondary_NBNS_Server',
- 'usr_security_login_limit' => 'USR-Security-Login-Limit',
- 'usr_security_resp_limit' => 'USR-Security-Resp-Limit',
- 'usr_send_name' => 'USR-Send-Name',
- 'usr_send_password' => 'USR-Send-Password',
- 'usr_send_script1' => 'USR-Send-Script1',
- 'usr_send_script2' => 'USR-Send-Script2',
- 'usr_send_script3' => 'USR-Send-Script3',
- 'usr_send_script4' => 'USR-Send-Script4',
- 'usr_send_script5' => 'USR-Send-Script5',
- 'usr_send_script6' => 'USR-Send-Script6',
- 'usr_server_time' => 'USR-Server-Time',
- 'usr_service_option' => 'USR-Service-Option',
- 'usr_simplified_mnp_level' => 'USR-Simplified-MNP-Levels',
- 'usr_simplified_v42bis_us' => 'USR-Simplified-V42bis-Usage',
- 'usr_slot_connected_to' => 'USR-Slot-Connected-To',
- 'usr_speed_of_connection' => 'USR-Speed-Of-Connection',
- 'usr_spoofing' => 'USR-Spoofing',
- 'usr_start_time' => 'USR-Start-Time',
- 'usr_supports_tags' => 'USR-Supports-Tags',
- 'usr_sync_async_mode' => 'USR-Sync-Async-Mode',
- 'usr_syslog_tap' => 'USR-Syslog-Tap',
- 'usr_terminal_type' => 'USR-Terminal-Type',
- 'usr_transmit_acc_map' => 'USR-Transmit-Acc-Map',
- 'usr_tunnel_auth_hostname' => 'USR-Tunnel-Auth-Hostname',
- 'usr_tunnel_security' => 'USR-Tunnel-Security',
- 'usr_tunnel_switch_endpoi' => 'USR-Tunnel-Switch-Endpoint',
- 'usr_tunneled_mlpp' => 'USR-Tunneled-MLPP',
- 'usr_unauthenticated_time' => 'USR-Unauthenticated-Time',
- 'usr_vpn_encrypter' => 'USR-VPN-Encrypter',
- 'usr_vpn_gw_location_id' => 'USR-VPN-GW-Location-Id',
- 'usr_vts_session_key' => 'USR-VTS-Session-Key',
- 'vendor_specific' => 'Vendor-Specific',
- 'versanet_termination_cau' => 'Versanet-Termination-Cause',
- 'vnc_pppoe_cbq_rx' => 'VNC-PPPoE-CBQ-RX',
- 'vnc_pppoe_cbq_rx_fallbac' => 'VNC-PPPoE-CBQ-RX-Fallback',
- 'vnc_pppoe_cbq_tx' => 'VNC-PPPoE-CBQ-TX',
- 'vnc_pppoe_cbq_tx_fallbac' => 'VNC-PPPoE-CBQ-TX-Fallback',
- 'vnc_splash' => 'VNC-Splash',
- 'wispr_bandwidth_max_down' => 'WISPr-Bandwidth-Max-Down',
- 'wispr_bandwidth_max_up' => 'WISPr-Bandwidth-Max-Up',
- 'wispr_bandwidth_min_down' => 'WISPr-Bandwidth-Min-Down',
- 'wispr_bandwidth_min_up' => 'WISPr-Bandwidth-Min-Up',
- 'wispr_billing_class_of_s' => 'WISPr-Billing-Class-Of-Service',
- 'wispr_location_id' => 'WISPr-Location-ID',
- 'wispr_location_name' => 'WISPr-Location-Name',
- 'wispr_logoff_url' => 'WISPr-Logoff-URL',
- 'wispr_redirection_url' => 'WISPr-Redirection-URL',
- 'wispr_session_terminate_' => 'WISPr-Session-Terminate-Time',
- 'wispr_session_terminatea' => 'WISPr-Session-Terminate-End-Of-Day',
- 'x_ascend_add_seconds' => 'X-Ascend-Add-Seconds',
- 'x_ascend_ara_pw' => 'X-Ascend-Ara-PW',
- 'x_ascend_assign_ip_clien' => 'X-Ascend-Assign-IP-Client',
- 'x_ascend_assign_ip_globa' => 'X-Ascend-Assign-IP-Global-Pool',
- 'x_ascend_assign_ip_pool' => 'X-Ascend-Assign-IP-Pool',
- 'x_ascend_assign_ip_serve' => 'X-Ascend-Assign-IP-Server',
- 'x_ascend_authen_alias' => 'X-Ascend-Authen-Alias',
- 'x_ascend_backup' => 'X-Ascend-Backup',
- 'x_ascend_bacp_enable' => 'X-Ascend-BACP-Enable',
- 'x_ascend_base_channel_co' => 'X-Ascend-Base-Channel-Count',
- 'x_ascend_billing_number' => 'X-Ascend-Billing-Number',
- 'x_ascend_bridge' => 'X-Ascend-Bridge',
- 'x_ascend_bridge_address' => 'X-Ascend-Bridge-Address',
- 'x_ascend_call_attempt_li' => 'X-Ascend-Call-Attempt-Limit',
- 'x_ascend_call_block_dura' => 'X-Ascend-Call-Block-Duration',
- 'x_ascend_call_by_call' => 'X-Ascend-Call-By-Call',
- 'x_ascend_call_filter' => 'X-Ascend-Call-Filter',
- 'x_ascend_call_type' => 'X-Ascend-Call-Type',
- 'x_ascend_callback' => 'X-Ascend-Callback',
- 'x_ascend_client_assign_d' => 'X-Ascend-Client-Assign-DNS',
- 'x_ascend_client_gateway' => 'X-Ascend-Client-Gateway',
- 'x_ascend_client_primary_' => 'X-Ascend-Client-Primary-DNS',
- 'x_ascend_client_secondar' => 'X-Ascend-Client-Secondary-DNS',
- 'x_ascend_connect_progres' => 'X-Ascend-Connect-Progress',
- 'x_ascend_data_filter' => 'X-Ascend-Data-Filter',
- 'x_ascend_data_rate' => 'X-Ascend-Data-Rate',
- 'x_ascend_data_svc' => 'X-Ascend-Data-Svc',
- 'x_ascend_dba_monitor' => 'X-Ascend-DBA-Monitor',
- 'x_ascend_dec_channel_cou' => 'X-Ascend-Dec-Channel-Count',
- 'x_ascend_dhcp_maximum_le' => 'X-Ascend-DHCP-Maximum-Leases',
- 'x_ascend_dhcp_pool_numbe' => 'X-Ascend-DHCP-Pool-Number',
- 'x_ascend_dhcp_reply' => 'X-Ascend-DHCP-Reply',
- 'x_ascend_dial_number' => 'X-Ascend-Dial-Number',
- 'x_ascend_dialout_allowed' => 'X-Ascend-Dialout-Allowed',
- 'x_ascend_disconnect_caus' => 'X-Ascend-Disconnect-Cause',
- 'x_ascend_event_type' => 'X-Ascend-Event-Type',
- 'x_ascend_expect_callback' => 'X-Ascend-Expect-Callback',
- 'x_ascend_fcp_parameter' => 'X-Ascend-FCP-Parameter',
- 'x_ascend_first_dest' => 'X-Ascend-First-Dest',
- 'x_ascend_force_56' => 'X-Ascend-Force-56',
- 'x_ascend_fr_circuit_name' => 'X-Ascend-FR-Circuit-Name',
- 'x_ascend_fr_dce_n392' => 'X-Ascend-FR-DCE-N392',
- 'x_ascend_fr_dce_n393' => 'X-Ascend-FR-DCE-N393',
- 'x_ascend_fr_direct' => 'X-Ascend-FR-Direct',
- 'x_ascend_fr_direct_dlci' => 'X-Ascend-FR-Direct-DLCI',
- 'x_ascend_fr_direct_profi' => 'X-Ascend-FR-Direct-Profile',
- 'x_ascend_fr_dlci' => 'X-Ascend-FR-DLCI',
- 'x_ascend_fr_dte_n392' => 'X-Ascend-FR-DTE-N392',
- 'x_ascend_fr_dte_n393' => 'X-Ascend-FR-DTE-N393',
- 'x_ascend_fr_link_mgt' => 'X-Ascend-FR-Link-Mgt',
- 'x_ascend_fr_linkup' => 'X-Ascend-FR-LinkUp',
- 'x_ascend_fr_n391' => 'X-Ascend-FR-N391',
- 'x_ascend_fr_nailed_grp' => 'X-Ascend-FR-Nailed-Grp',
- 'x_ascend_fr_profile_name' => 'X-Ascend-FR-Profile-Name',
- 'x_ascend_fr_t391' => 'X-Ascend-FR-T391',
- 'x_ascend_fr_t392' => 'X-Ascend-FR-T392',
- 'x_ascend_fr_type' => 'X-Ascend-FR-Type',
- 'x_ascend_ft1_caller' => 'X-Ascend-FT1-Caller',
- 'x_ascend_group' => 'X-Ascend-Group',
- 'x_ascend_handle_ipx' => 'X-Ascend-Handle-IPX',
- 'x_ascend_history_weigh_t' => 'X-Ascend-History-Weigh-Type',
- 'x_ascend_home_agent_ip_a' => 'X-Ascend-Home-Agent-IP-Addr',
- 'x_ascend_home_agent_pass' => 'X-Ascend-Home-Agent-Password',
- 'x_ascend_home_agent_udp_' => 'X-Ascend-Home-Agent-UDP-Port',
- 'x_ascend_home_network_na' => 'X-Ascend-Home-Network-Name',
- 'x_ascend_host_info' => 'X-Ascend-Host-Info',
- 'x_ascend_idle_limit' => 'X-Ascend-Idle-Limit',
- 'x_ascend_if_netmask' => 'X-Ascend-IF-Netmask',
- 'x_ascend_inc_channel_cou' => 'X-Ascend-Inc-Channel-Count',
- 'x_ascend_ip_direct' => 'X-Ascend-IP-Direct',
- 'x_ascend_ip_pool_definit' => 'X-Ascend-IP-Pool-Definition',
- 'x_ascend_ipx_alias' => 'X-Ascend-IPX-Alias',
- 'x_ascend_ipx_node_addr' => 'X-Ascend-IPX-Node-Addr',
- 'x_ascend_ipx_peer_mode' => 'X-Ascend-IPX-Peer-Mode',
- 'x_ascend_ipx_route' => 'X-Ascend-IPX-Route',
- 'x_ascend_link_compressio' => 'X-Ascend-Link-Compression',
- 'x_ascend_maximum_call_du' => 'X-Ascend-Maximum-Call-Duration',
- 'x_ascend_maximum_channel' => 'X-Ascend-Maximum-Channels',
- 'x_ascend_maximum_time' => 'X-Ascend-Maximum-Time',
- 'x_ascend_menu_item' => 'X-Ascend-Menu-Item',
- 'x_ascend_menu_selector' => 'X-Ascend-Menu-Selector',
- 'x_ascend_metric' => 'X-Ascend-Metric',
- 'x_ascend_minimum_channel' => 'X-Ascend-Minimum-Channels',
- 'x_ascend_modem_portno' => 'X-Ascend-Modem-PortNo',
- 'x_ascend_modem_shelfno' => 'X-Ascend-Modem-ShelfNo',
- 'x_ascend_modem_slotno' => 'X-Ascend-Modem-SlotNo',
- 'x_ascend_mpp_idle_percen' => 'X-Ascend-MPP-Idle-Percent',
- 'x_ascend_multicast_clien' => 'X-Ascend-Multicast-Client',
- 'x_ascend_multicast_rate_' => 'X-Ascend-Multicast-Rate-Limit',
- 'x_ascend_multilink_id' => 'X-Ascend-Multilink-ID',
- 'x_ascend_netware_timeout' => 'X-Ascend-Netware-timeout',
- 'x_ascend_num_in_multilin' => 'X-Ascend-Num-In-Multilink',
- 'x_ascend_number_sessions' => 'X-Ascend-Number-Sessions',
- 'x_ascend_ppp_address' => 'X-Ascend-PPP-Address',
- 'x_ascend_ppp_async_map' => 'X-Ascend-PPP-Async-Map',
- 'x_ascend_ppp_vj_1172' => 'X-Ascend-PPP-VJ-1172',
- 'x_ascend_ppp_vj_slot_com' => 'X-Ascend-PPP-VJ-Slot-Comp',
- 'x_ascend_pre_input_octet' => 'X-Ascend-Pre-Input-Octets',
- 'x_ascend_pre_input_packe' => 'X-Ascend-Pre-Input-Packets',
- 'x_ascend_pre_output_octe' => 'X-Ascend-Pre-Output-Octets',
- 'x_ascend_pre_output_pack' => 'X-Ascend-Pre-Output-Packets',
- 'x_ascend_preempt_limit' => 'X-Ascend-Preempt-Limit',
- 'x_ascend_presession_time' => 'X-Ascend-PreSession-Time',
- 'x_ascend_pri_number_type' => 'X-Ascend-PRI-Number-Type',
- 'x_ascend_primary_home_ag' => 'X-Ascend-Primary-Home-Agent',
- 'x_ascend_pw_lifetime' => 'X-Ascend-PW-Lifetime',
- 'x_ascend_pw_warntime' => 'X-Ascend-PW-Warntime',
- 'x_ascend_receive_secret' => 'X-Ascend-Receive-Secret',
- 'x_ascend_remote_addr' => 'X-Ascend-Remote-Addr',
- 'x_ascend_remove_seconds' => 'X-Ascend-Remove-Seconds',
- 'x_ascend_require_auth' => 'X-Ascend-Require-Auth',
- 'x_ascend_route_ip' => 'X-Ascend-Route-IP',
- 'x_ascend_route_ipx' => 'X-Ascend-Route-IPX',
- 'x_ascend_secondary_home_' => 'X-Ascend-Secondary-Home-Agent',
- 'x_ascend_seconds_of_hist' => 'X-Ascend-Seconds-Of-History',
- 'x_ascend_send_auth' => 'X-Ascend-Send-Auth',
- 'x_ascend_send_passwd' => 'X-Ascend-Send-Passwd',
- 'x_ascend_send_secret' => 'X-Ascend-Send-Secret',
- 'x_ascend_session_svr_key' => 'X-Ascend-Session-Svr-Key',
- 'x_ascend_shared_profile_' => 'X-Ascend-Shared-Profile-Enable',
- 'x_ascend_target_util' => 'X-Ascend-Target-Util',
- 'x_ascend_temporary_rtes' => 'X-Ascend-Temporary-Rtes',
- 'x_ascend_third_prompt' => 'X-Ascend-Third-Prompt',
- 'x_ascend_token_expiry' => 'X-Ascend-Token-Expiry',
- 'x_ascend_token_idle' => 'X-Ascend-Token-Idle',
- 'x_ascend_token_immediate' => 'X-Ascend-Token-Immediate',
- 'x_ascend_transit_number' => 'X-Ascend-Transit-Number',
- 'x_ascend_ts_idle_limit' => 'X-Ascend-TS-Idle-Limit',
- 'x_ascend_ts_idle_mode' => 'X-Ascend-TS-Idle-Mode',
- 'x_ascend_tunneling_proto' => 'X-Ascend-Tunneling-Protocol',
- 'x_ascend_user_acct_base' => 'X-Ascend-User-Acct-Base',
- 'x_ascend_user_acct_host' => 'X-Ascend-User-Acct-Host',
- 'x_ascend_user_acct_key' => 'X-Ascend-User-Acct-Key',
- 'x_ascend_user_acct_port' => 'X-Ascend-User-Acct-Port',
- 'x_ascend_user_acct_time' => 'X-Ascend-User-Acct-Time',
- 'x_ascend_user_acct_type' => 'X-Ascend-User-Acct-Type',
- 'x_ascend_xmit_rate' => 'X-Ascend-Xmit-Rate',
- 'xedia_address_pool' => 'Xedia-Address-Pool',
- 'xedia_client_access_netw' => 'Xedia-Client-Access-Network',
- 'xedia_dns_server' => 'Xedia-DNS-Server',
- 'xedia_netbios_server' => 'Xedia-NetBios-Server',
- 'xedia_ppp_echo_interval' => 'Xedia-PPP-Echo-Interval',
- 'xedia_ssh_privileges' => 'Xedia-SSH-Privileges',
-
- #NETC.NET.AU (RADIATOR?)
- 'authentication_type' => 'Authentication-Type',
-
- #wtxs (dunno)
- #'radius_operator' => 'Radius-Operator',
-
-);
-
-1;
diff --git a/FS/FS/radius_usergroup.pm b/FS/FS/radius_usergroup.pm
deleted file mode 100644
index 9bba057..0000000
--- a/FS/FS/radius_usergroup.pm
+++ /dev/null
@@ -1,131 +0,0 @@
-package FS::radius_usergroup;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::svc_acct;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::radius_usergroup - Object methods for radius_usergroup records
-
-=head1 SYNOPSIS
-
- use FS::radius_usergroup;
-
- $record = new FS::radius_usergroup \%hash;
- $record = new FS::radius_usergroup { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::radius_usergroup object links an account (see L<FS::svc_acct>) with a
-RADIUS group. FS::radius_usergroup inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item usergroupnum - primary key
-
-=item svcnum - Account (see L<FS::svc_acct>).
-
-=item groupname - group name
-
-=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 { 'radius_usergroup'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-#inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-#inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-#inherited from FS::Record
-
-=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
-
-sub check {
- my $self = shift;
-
- $self->ut_numbern('usergroupnum')
- || $self->ut_number('svcnum')
- || $self->ut_foreign_key('svcnum','svc_acct','svcnum')
- || $self->ut_text('groupname')
- || $self->SUPER::check
- ;
-}
-
-=item svc_acct
-
-Returns the account associated with this record (see L<FS::svc_acct>).
-
-=cut
-
-sub svc_acct {
- my $self = shift;
- qsearchs('svc_acct', { svcnum => $self->svcnum } );
-}
-
-=back
-
-=head1 BUGS
-
-Don't let 'em get you down.
-
-=head1 SEE ALSO
-
-L<svc_acct>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm
deleted file mode 100644
index f30e4c7..0000000
--- a/FS/FS/rate.pm
+++ /dev/null
@@ -1,450 +0,0 @@
-package FS::rate;
-
-use strict;
-use vars qw( @ISA $DEBUG );
-use FS::Record qw( qsearch qsearchs dbh fields );
-use FS::rate_detail;
-
-@ISA = qw(FS::Record);
-
-$DEBUG = 0;
-
-=head1 NAME
-
-FS::rate - Object methods for rate records
-
-=head1 SYNOPSIS
-
- use FS::rate;
-
- $record = new FS::rate \%hash;
- $record = new FS::rate { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::rate object represents an rate plan. FS::rate inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item ratenum - primary key
-
-=item ratename
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new rate plan. To add the rate plan 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 { 'rate'; }
-
-=item insert [ , OPTION => VALUE ... ]
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-Currently available options are: I<rate_detail>
-
-If I<rate_detail> is set to an array reference of FS::rate_detail objects, the
-objects will have their ratenum field set and will be inserted after this
-record.
-
-=cut
-
-sub insert {
- my $self = shift;
- 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;
-
- my $error = $self->check;
- return $error if $error;
-
- $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $options{'rate_detail'} ) {
-
- my( $num, $last, $min_sec ) = (0, time, 5); #progressbar foo
-
- foreach my $rate_detail ( @{$options{'rate_detail'}} ) {
-
- $rate_detail->ratenum($self->ratenum);
- $error = $rate_detail->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $options{'job'} ) {
- $num++;
- if ( time - $min_sec > $last ) {
- my $error = $options{'job'}->update_statustext(
- int( 100 * $num / scalar( @{$options{'rate_detail'}} ) )
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $last = time;
- }
- }
-
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD [ , OPTION => VALUE ... ]
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-Currently available options are: I<rate_detail>
-
-If I<rate_detail> is set to an array reference of FS::rate_detail objects, the
-objects will have their ratenum field set and will be inserted after this
-record. Any existing rate_detail records associated with this record will be
-deleted.
-
-=cut
-
-sub replace {
- my ($new, $old) = (shift, shift);
- 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;
-
-# my @old_rate_detail = ();
-# @old_rate_detail = $old->rate_detail if $options{'rate_detail'};
-
- my $error = $new->SUPER::replace($old);
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
-# foreach my $old_rate_detail ( @old_rate_detail ) {
-#
-# my $error = $old_rate_detail->delete;
-# if ($error) {
-# $dbh->rollback if $oldAutoCommit;
-# return $error;
-# }
-#
-# if ( $options{'job'} ) {
-# $num++;
-# if ( time - $min_sec > $last ) {
-# my $error = $options{'job'}->update_statustext(
-# int( 50 * $num / scalar( @old_rate_detail ) )
-# );
-# if ( $error ) {
-# $dbh->rollback if $oldAutoCommit;
-# return $error;
-# }
-# $last = time;
-# }
-# }
-#
-# }
- if ( $options{'rate_detail'} ) {
- my $sth = $dbh->prepare('DELETE FROM rate_detail WHERE ratenum = ?') or do {
- $dbh->rollback if $oldAutoCommit;
- return $dbh->errstr;
- };
-
- $sth->execute($old->ratenum) or do {
- $dbh->rollback if $oldAutoCommit;
- return $sth->errstr;
- };
-
- my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
-# $num = 0;
- foreach my $rate_detail ( @{$options{'rate_detail'}} ) {
-
- $rate_detail->ratenum($new->ratenum);
- $error = $rate_detail->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $options{'job'} ) {
- $num++;
- if ( time - $min_sec > $last ) {
- my $error = $options{'job'}->update_statustext(
- int( 100 * $num / scalar( @{$options{'rate_detail'}} ) )
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $last = time;
- }
- }
-
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item check
-
-Checks all fields to make sure this is a valid rate plan. 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('ratenum')
- || $self->ut_text('ratename')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item dest_detail REGIONNUM | RATE_REGION_OBJECTD | HASHREF
-
-Returns the rate detail (see L<FS::rate_detail>) for this rate to the
-specificed destination, or the empty string if no rate can be found for
-the given destination.
-
-Destination can be specified as an FS::rate_detail object or regionnum
-(see L<FS::rate_detail>), or as a hashref with two keys: I<countrycode>
-and I<phonenum>.
-
-An optional third key, I<weektime>, will return a timed rate (one with
-a non-null I<ratetimenum>) if one exists for a call at that time. If
-no matching timed rate exists, the non-timed rate will be returned.
-
-=cut
-
-sub dest_detail {
- my $self = shift;
-
- my $regionnum;
- my $weektime;
- if ( ref($_[0]) eq 'HASH' ) {
-
- my $countrycode = $_[0]->{'countrycode'};
- my $phonenum = $_[0]->{'phonenum'};
- $weektime = $_[0]->{'weektime'};
-
- #find a rate prefix, first look at most specific, then fewer digits,
- # finally trying the country code only
- my $rate_prefix = '';
- for my $len ( reverse(1..10) ) {
- $rate_prefix = qsearchs('rate_prefix', {
- 'countrycode' => $countrycode,
- #'npa' => { op=> 'LIKE', value=> substr($number, 0, $len) }
- 'npa' => substr($phonenum, 0, $len),
- } ) and last;
- }
- $rate_prefix ||= qsearchs('rate_prefix', {
- 'countrycode' => $countrycode,
- 'npa' => '',
- });
-
- return '' unless $rate_prefix;
-
- $regionnum = $rate_prefix->regionnum;
-
- #$rate_region = $rate_prefix->rate_region;
-
- } else {
- $regionnum = ref($_[0]) ? shift->regionnum : shift;
- }
-
- if(!defined($weektime)) {
- return qsearchs( 'rate_detail',
- { 'ratenum' => $self->ratenum,
- 'dest_regionnum' => $regionnum,
- 'ratetimenum' => '',
- } );
- }
- else {
- my @details = grep { my $rate_time = $_->rate_time;
- $rate_time && $rate_time->contains($weektime) }
- qsearch( 'rate_detail',
- { 'ratenum' => $self->ratenum,
- 'dest_regionnum' => $regionnum, } );
- if(!@details) {
- # this may change at some point
- return $self->dest_detail($regionnum);
- }
- elsif(@details == 1) {
- return $details[0];
- }
- else {
- die "overlapping rate_detail times (region $regionnum, time $weektime)\n";
- }
- }
-}
-
-=item rate_detail
-
-Returns all region-specific details (see L<FS::rate_detail>) for this rate.
-
-=cut
-
-sub rate_detail {
- my $self = shift;
- qsearch( 'rate_detail', { 'ratenum' => $self->ratenum } );
-}
-
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item process
-
-Experimental job-queue processor for web interface adds/edits
-
-=cut
-
-use Storable qw(thaw);
-use Data::Dumper;
-use MIME::Base64;
-sub process {
- my $job = shift;
-
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- my $old = qsearchs('rate', { 'ratenum' => $param->{'ratenum'} } )
- if $param->{'ratenum'};
-
- my @rate_detail = map {
-
- my $regionnum = $_->regionnum;
- if ( $param->{"sec_granularity$regionnum"} ) {
-
- new FS::rate_detail {
- 'dest_regionnum' => $regionnum,
- map { $_ => $param->{"$_$regionnum"} }
- qw( min_included min_charge sec_granularity )
- #qw( min_included conn_charge conn_sec min_charge sec_granularity )
- };
-
- } else {
-
- new FS::rate_detail {
- 'dest_regionnum' => $regionnum,
- 'min_included' => 0,
- 'conn_charge' => 0,
- 'conn_sec' => 0,
- 'conn_charge' => 0,
- 'min_charge' => 0,
- 'sec_granularity' => '60'
- };
-
- }
-
- } qsearch('rate_region', {} );
-
- my $rate = new FS::rate {
- map { $_ => $param->{$_} }
- fields('rate')
- };
-
- my $error = '';
- if ( $param->{'ratenum'} ) {
- warn "$rate replacing $old (". $param->{'ratenum'}. ")\n" if $DEBUG;
-
- my @param = ( 'job'=>$job );
- push @param, 'rate_detail'=>\@rate_detail
- unless $param->{'preserve_rate_detail'};
-
- $error = $rate->replace( $old, @param );
-
- } else {
- warn "inserting $rate\n" if $DEBUG;
- $error = $rate->insert( 'rate_detail' => \@rate_detail,
- 'job' => $job,
- );
- #$ratenum = $rate->getfield('ratenum');
- }
-
- die "$error\n" if $error;
-
-}
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/rate_detail.pm b/FS/FS/rate_detail.pm
deleted file mode 100644
index 7b90452..0000000
--- a/FS/FS/rate_detail.pm
+++ /dev/null
@@ -1,640 +0,0 @@
-package FS::rate_detail;
-
-use strict;
-use vars qw( @ISA $DEBUG $me );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::rate;
-use FS::rate_region;
-use FS::rate_time;
-use Tie::IxHash;
-
-@ISA = qw(FS::Record);
-
-$DEBUG = 0;
-$me = '[FS::rate_detail]';
-
-=head1 NAME
-
-FS::rate_detail - Object methods for rate_detail records
-
-=head1 SYNOPSIS
-
- use FS::rate_detail;
-
- $record = new FS::rate_detail \%hash;
- $record = new FS::rate_detail { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::rate_detail object represents an call plan rate. FS::rate_detail
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item ratedetailnum - primary key
-
-=item ratenum - rate plan (see L<FS::rate>)
-
-=item orig_regionnum - call origination region
-
-=item dest_regionnum - call destination region
-
-=item min_included - included minutes
-
-=item min_charge - charge per minute
-
-=item sec_granularity - granularity in seconds, i.e. 6 or 60; 0 for per-call
-
-=item classnum - usage class (see L<FS::usage_class>) if any for this rate
-
-=item ratetimenum - rating time period (see L<FS::rate_time) if any
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new call plan rate. To add the call plan rate 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 { 'rate_detail'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid call plan rate. 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('ratedetailnum')
- || $self->ut_foreign_key('ratenum', 'rate', 'ratenum')
- || $self->ut_foreign_keyn('orig_regionnum', 'rate_region', 'regionnum' )
- || $self->ut_foreign_key('dest_regionnum', 'rate_region', 'regionnum' )
- || $self->ut_number('min_included')
-
- #|| $self->ut_money('min_charge')
- #good enough for now...
- || $self->ut_float('min_charge')
-
- || $self->ut_number('sec_granularity')
-
- || $self->ut_foreign_keyn('classnum', 'usage_class', 'classnum' )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item rate
-
-Returns the parent call plan (see L<FS::rate>) associated with this call plan
-rate.
-
-=cut
-
-sub rate {
- my $self = shift;
- qsearchs('rate', { 'ratenum' => $self->ratenum } );
-}
-
-=item orig_region
-
-Returns the origination region (see L<FS::rate_region>) associated with this
-call plan rate.
-
-=cut
-
-sub orig_region {
- my $self = shift;
- qsearchs('rate_region', { 'regionnum' => $self->orig_regionnum } );
-}
-
-=item dest_region
-
-Returns the destination region (see L<FS::rate_region>) associated with this
-call plan rate.
-
-=cut
-
-sub dest_region {
- my $self = shift;
- qsearchs('rate_region', { 'regionnum' => $self->dest_regionnum } );
-}
-
-=item dest_regionname
-
-Returns the name of the destination region (see L<FS::rate_region>) associated
-with this call plan rate.
-
-=cut
-
-sub dest_regionname {
- my $self = shift;
- $self->dest_region->regionname;
-}
-
-=item dest_regionname
-
-Returns a short list of the prefixes for the destination region
-(see L<FS::rate_region>) associated with this call plan rate.
-
-=cut
-
-sub dest_prefixes_short {
- my $self = shift;
- $self->dest_region->prefixes_short;
-}
-
-=item rate_time
-
-Returns the L<FS::rate_time> object associated with this call
-plan rate, if there is one.
-
-=cut
-
-sub rate_time {
- my $self = shift;
- $self->ratetimenum ? FS::rate_time->by_key($self->ratetimenum) : ();
-}
-
-=item rate_time_name
-
-Returns the I<ratetimename> field of the L<FS::rate_time> object
-associated with this rate plan.
-
-=cut
-
-sub rate_time_name {
- my $self = shift;
- $self->ratetimenum ? $self->rate_time->ratetimename : '(default)';
-}
-
-=item classname
-
-Returns the name of the usage class (see L<FS::usage_class>) associated with
-this call plan rate.
-
-=cut
-
-sub classname {
- my $self = shift;
- my $usage_class = qsearchs('usage_class', { classnum => $self->classnum });
- $usage_class ? $usage_class->classname : '';
-}
-
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item granularities
-
- Returns an (ordered) hash of granularity => name pairs
-
-=cut
-
-tie my %granularities, 'Tie::IxHash',
- '1', => '1 second',
- '6' => '6 second',
- '30' => '30 second', # '1/2 minute',
- '60' => 'minute',
- '0' => 'call',
-;
-
-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;
-sub process_edit_import {
- my $job = shift;
-
- #do we actually belong in rate_detail, like 'table' says? even though we
- # can possible create new rate records, that's a side effect, mostly we
- # do edit rate_detail records in batch...
-
- my $opt = { 'table' => 'rate_detail',
- 'params' => [], #required, apparantly
- 'formats' => { 'default' => [
- 'dest_regionnum',
- '', #regionname
- '', #country
- '', #prefixes
- #loop these
- 'min_included',
- 'min_charge',
- sub {
- my( $rate_detail, $g ) = @_;
- $g = 0 if $g =~ /^\s*(per-)?call\s*$/i;
- $g = 60 if $g =~ /^\s*minute\s*$/i;
- $g =~ /^(\d+)/ or die "can't parse granularity: $g".
- " for record ". Dumper($rate_detail);
- $rate_detail->sec_granularity($1);
- },
- 'classnum',
- ] },
- 'format_headers' => { 'default' => 1, },
- 'format_types' => { 'default' => 'xls' },
- };
-
- #false laziness w/
- #FS::Record::process_batch_import( $job, $opt, @_ );
-
- my $table = $opt->{table};
- my @pass_params = @{ $opt->{params} };
- my %formats = %{ $opt->{formats} };
-
- my $param = thaw(decode_base64(shift));
- warn Dumper($param) if $DEBUG;
-
- my $files = $param->{'uploaded_files'}
- or die "No files provided.\n";
-
- my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
-
- my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
- my $file = $dir. $files{'file'};
-
- my $error =
- #false laziness w/
- #FS::Record::batch_import( {
- FS::rate_detail::edit_import( {
- #class-static
- table => $table,
- formats => \%formats,
- format_types => $opt->{format_types},
- format_headers => $opt->{format_headers},
- format_sep_chars => $opt->{format_sep_chars},
- format_fixedlength_formats => $opt->{format_fixedlength_formats},
- #per-import
- job => $job,
- file => $file,
- #type => $type,
- format => $param->{format},
- params => { map { $_ => $param->{$_} } @pass_params },
- #?
- default_csv => $opt->{default_csv},
- } );
-
- unlink $file;
-
- die "$error\n" if $error;
-
-}
-
-=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;
-sub edit_import {
- my $param = shift;
-
- warn "$me edit_import call with params: \n". Dumper($param)
- if $DEBUG;
-
- my $table = $param->{table};
- my $formats = $param->{formats};
-
- my $job = $param->{job};
- my $file = $param->{file};
- my $format = $param->{'format'};
- my $params = $param->{params} || {};
-
- die "unknown format $format" unless exists $formats->{ $format };
-
- my $type = $param->{'format_types'}
- ? $param->{'format_types'}{ $format }
- : $param->{type} || 'csv';
-
- unless ( $type ) {
- if ( $file =~ /\.(\w+)$/i ) {
- $type = lc($1);
- } else {
- #or error out???
- warn "can't parse file type from filename $file; defaulting to CSV";
- $type = 'csv';
- }
- $type = 'csv'
- if $param->{'default_csv'} && $type ne 'xls';
- }
-
- my $header = $param->{'format_headers'}
- ? $param->{'format_headers'}{ $param->{'format'} }
- : 0;
-
- my $sep_char = $param->{'format_sep_chars'}
- ? $param->{'format_sep_chars'}{ $param->{'format'} }
- : ',';
-
- my $fixedlength_format =
- $param->{'format_fixedlength_formats'}
- ? $param->{'format_fixedlength_formats'}{ $param->{'format'} }
- : '';
-
- my @fields = @{ $formats->{ $format } };
-
- my $row = 0;
- my $count;
- my $parser;
- my @buffer = ();
- my @header = (); #edit_import
- if ( $type eq 'csv' || $type eq 'fixedlength' ) {
-
- if ( $type eq 'csv' ) {
-
- my %attr = ();
- $attr{sep_char} = $sep_char if $sep_char;
- $parser = new Text::CSV_XS \%attr;
-
- } elsif ( $type eq 'fixedlength' ) {
-
- eval "use Parse::FixedLength;";
- die $@ if $@;
- $parser = new Parse::FixedLength $fixedlength_format;
-
- } else {
- die "Unknown file type $type\n";
- }
-
- @buffer = split(/\r?\n/, slurp($file) );
- splice(@buffer, 0, ($header || 0) );
- $count = scalar(@buffer);
-
- } elsif ( $type eq 'xls' ) {
-
- eval "use Spreadsheet::ParseExcel;";
- die $@ if $@;
-
- eval "use DateTime::Format::Excel;";
- #for now, just let the error be thrown if it is used, since only CDR
- # formats bill_west and troop use it, not other excel-parsing things
- #die $@ if $@;
-
- my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($file);
-
- $parser = $excel->{Worksheet}[0]; #first sheet
-
- $count = $parser->{MaxRow} || $parser->{MinRow};
- $count++;
-
- $row = $header || 0;
-
- #edit_import - need some magic to parse the header
- if ( $header ) {
- my @header_row = @{ $parser->{Cells}[$0] };
- @header = map $_->{Val}, @header_row;
- }
-
- } else {
- die "Unknown file type $type\n";
- }
-
- #my $columns;
-
- 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;
-
- #edit_import - use the header to setup looping over different rates
- my @rate = ();
- if ( @header ) {
- splice(@header,0,4); # # Region Country Prefixes
- while ( my @next = splice(@header,0,4) ) {
- my $rate;
- if ( $next[0] =~ /^(\d+):\s*([^:]+):/ ) {
- $rate = qsearchs('rate', { 'ratenum' => $1 } )
- or die "unknown ratenum $1";
- } elsif ( $next[0] =~ /^(NEW:)?\s*([^:]+)/i ) {
- $rate = new FS::rate { 'ratename' => $2 };
- my $error = $rate->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting new rate: $error\n";
- }
- }
- push @rate, $rate;
- }
- }
- die unless @rate;
-
- my $line;
- my $imported = 0;
- my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
- while (1) {
-
- my @columns = ();
- if ( $type eq 'csv' ) {
-
- last unless scalar(@buffer);
- $line = shift(@buffer);
-
- $parser->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $parser->error_input();
- };
- @columns = $parser->fields();
-
- } elsif ( $type eq 'fixedlength' ) {
-
- @columns = $parser->parse($line);
-
- } elsif ( $type eq 'xls' ) {
-
- last if $row > ($parser->{MaxRow} || $parser->{MinRow})
- || ! $parser->{Cells}[$row];
-
- my @row = @{ $parser->{Cells}[$row] };
- @columns = map $_->{Val}, @row;
-
- #my $z = 'A';
- #warn $z++. ": $_\n" for @columns;
-
- } else {
- die "Unknown file type $type\n";
- }
-
- #edit_import loop
-
- my @repeat = @columns[0..3];
-
- foreach my $rate ( @rate ) {
-
- my @later = ();
- my %hash = %$params;
-
- foreach my $field ( @fields ) {
-
- my $value = shift @columns;
-
- if ( ref($field) eq 'CODE' ) {
- #&{$field}(\%hash, $value);
- push @later, $field, $value;
- #} else {
- } elsif ($field) { #edit_import
- #??? $hash{$field} = $value if length($value);
- $hash{$field} = $value if defined($value) && length($value);
- }
-
- }
-
- unshift @columns, @repeat; #edit_import put these back on for next time
-
- my $class = "FS::$table";
-
- my $record = $class->new( \%hash );
-
- $record->ratenum($rate->ratenum); #edit_import
-
- #edit_improt n/a my $param = {};
- while ( scalar(@later) ) {
- my $sub = shift @later;
- my $data = shift @later;
- #&{$sub}($record, $data, $conf, $param);# $record->&{$sub}($data, $conf);
- &{$sub}($record, $data); #edit_import - don't have $conf
- #edit_import wrong loop last if exists( $param->{skiprow} );
- }
- #edit_import wrong loop next if exists( $param->{skiprow} );
-
- #edit_import update or insert, not just insert
- my $old = qsearchs({
- 'table' => $table,
- 'hashref' => { map { $_ => $record->$_() } qw(ratenum dest_regionnum) },
- });
-
- my $error;
- if ( $old ) {
- $record->ratedetailnum($old->ratedetailnum);
- $error = $record->replace($old)
- } else {
- $record->insert;
- }
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert record". ( $line ? " for $line" : '' ). ": $error";
- }
-
- }
-
- $row++;
- $imported++;
-
- if ( $job && time - $min_sec > $last ) { #progress bar
- $job->update_statustext( int(100 * $imported / $count) );
- $last = time;
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
-
- return "Empty file!" unless $imported || $param->{empty_ok};
-
- ''; #no error
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::rate>, L<FS::rate_region>, L<FS::Record>,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/rate_prefix.pm b/FS/FS/rate_prefix.pm
deleted file mode 100644
index ce780fe..0000000
--- a/FS/FS/rate_prefix.pm
+++ /dev/null
@@ -1,160 +0,0 @@
-package FS::rate_prefix;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::rate_region;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::rate_prefix - Object methods for rate_prefix records
-
-=head1 SYNOPSIS
-
- use FS::rate_prefix;
-
- $record = new FS::rate_prefix \%hash;
- $record = new FS::rate_prefix { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::rate_prefix object represents an call rating prefix. FS::rate_prefix
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item prefixnum - primary key
-
-=item regionnum - call ration region (see L<FS::rate_region>)
-
-=item countrycode
-
-=item npa
-
-=item nxx
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new prefix. To add the prefix 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 { 'rate_prefix'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid prefix. 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('prefixnum')
- || $self->ut_foreign_key('regionnum', 'rate_region', 'regionnum' )
- || $self->ut_number('countrycode')
- || $self->ut_numbern('npa')
- || $self->ut_numbern('nxx')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item rate_region
-
-Returns the rate region (see L<FS::rate_region>) for this prefix.
-
-=cut
-
-sub rate_region {
- my $self = shift;
- qsearchs('rate_region', { 'regionnum' => $self->regionnum } );
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item all_countrycodes
-
-Returns a list of all countrycodes listed in rate_prefix
-
-=cut
-
-sub all_countrycodes {
- #my $class = shift;
- my $sql =
- "SELECT DISTINCT(countrycode) FROM rate_prefix ORDER BY countrycode";
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
- map $_->[0], @{ $sth->fetchall_arrayref };
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::rate_region>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/rate_region.pm b/FS/FS/rate_region.pm
deleted file mode 100644
index 0e65223..0000000
--- a/FS/FS/rate_region.pm
+++ /dev/null
@@ -1,315 +0,0 @@
-package FS::rate_region;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::rate_prefix;
-use FS::rate_detail;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::rate_region - Object methods for rate_region records
-
-=head1 SYNOPSIS
-
- use FS::rate_region;
-
- $record = new FS::rate_region \%hash;
- $record = new FS::rate_region { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::rate_region object represents an call rating region. FS::rate_region
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item regionnum - primary key
-
-=item regionname
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new region. To add the region 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 { 'rate_region'; }
-
-=item insert [ , OPTION => VALUE ... ]
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-Currently available options are: I<rate_prefix> and I<dest_detail>
-
-If I<rate_prefix> is set to an array reference of FS::rate_prefix objects, the
-objects will have their regionnum field set and will be inserted after this
-record.
-
-If I<dest_detail> is set to an array reference of FS::rate_detail objects, the
-objects will have their dest_regionnum field set and will be inserted after
-this record.
-
-
-=cut
-
-sub insert {
- my $self = shift;
- 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;
-
- my $error = $self->check;
- return $error if $error;
-
- $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $options{'rate_prefix'} ) {
- foreach my $rate_prefix ( @{$options{'rate_prefix'}} ) {
- $rate_prefix->regionnum($self->regionnum);
- $error = $rate_prefix->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- if ( $options{'dest_detail'} ) {
- foreach my $rate_detail ( @{$options{'dest_detail'}} ) {
- $rate_detail->dest_regionnum($self->regionnum);
- $error = $rate_detail->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
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD [ , OPTION => VALUE ... ]
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-Currently available options are: I<rate_prefix> and I<dest_detail>
-
-If I<rate_prefix> is set to an array reference of FS::rate_prefix objects, the
-objects will have their regionnum field set and will be inserted after this
-record. Any existing rate_prefix records associated with this record will be
-deleted.
-
-If I<dest_detail> is set to an array reference of FS::rate_detail objects, the
-objects will have their dest_regionnum field set and will be inserted after
-this record. Any existing rate_detail records associated with this record will
-be deleted.
-
-=cut
-
-sub replace {
- my ($new, $old) = (shift, shift);
- 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;
-
- my @old_rate_prefix = ();
- @old_rate_prefix = $old->rate_prefix if $options{'rate_prefix'};
- my @old_dest_detail = ();
- @old_dest_detail = $old->dest_detail if $options{'dest_detail'};
-
- my $error = $new->SUPER::replace($old);
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- foreach my $old_rate_prefix ( @old_rate_prefix ) {
- my $error = $old_rate_prefix->delete;
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- foreach my $old_dest_detail ( @old_dest_detail ) {
- my $error = $old_dest_detail->delete;
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- foreach my $rate_prefix ( @{$options{'rate_prefix'}} ) {
- $rate_prefix->regionnum($new->regionnum);
- $error = $rate_prefix->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- foreach my $rate_detail ( @{$options{'dest_detail'}} ) {
- $rate_detail->dest_regionnum($new->regionnum);
- $error = $rate_detail->insert;
- 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 region. 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('regionnum')
- || $self->ut_text('regionname')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item rate_prefix
-
-Returns all prefixes (see L<FS::rate_prefix>) for this region.
-
-=cut
-
-sub rate_prefix {
- my $self = shift;
-
- sort { $a->countrycode cmp $b->countrycode
- or $a->npa cmp $b->npa
- or $a->nxx cmp $b->nxx
- }
- qsearch( 'rate_prefix', { 'regionnum' => $self->regionnum } );
-}
-
-=item dest_detail
-
-Returns all rate details (see L<FS::rate_detail>) for this region as a
-destionation.
-
-=cut
-
-sub dest_detail {
- my $self = shift;
- qsearch( 'rate_detail', { 'dest_regionnum' => $self->regionnum, } );
-}
-
-=item prefixes_short
-
-Returns a string representing all the prefixes for this region.
-
-=cut
-
-sub prefixes_short {
- my $self = shift;
-
- my $countrycode = '';
- my $out = '';
-
- foreach my $rate_prefix ( $self->rate_prefix ) {
- if ( $countrycode ne $rate_prefix->countrycode ) {
- $out =~ s/, $//;
- $countrycode = $rate_prefix->countrycode;
- $out.= " +$countrycode ";
- }
- my $npa = $rate_prefix->npa;
- if ( $countrycode eq '1' ) {
- #$out .= '('. substr( $npa, 0, 3 ). ')';
- $out .= substr( $npa, 0, 3 );
- $out .= ' '. substr( $npa, 3 ) if length($npa) > 3;
- } else {
- $out .= $rate_prefix->npa;
- }
- $out .= '-'. $rate_prefix->nxx if $rate_prefix->nxx;
- $out .= ', ';
- }
- $out =~ s/, $//;
-
- $out;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/rate_time.pm b/FS/FS/rate_time.pm
deleted file mode 100644
index 40cd23e..0000000
--- a/FS/FS/rate_time.pm
+++ /dev/null
@@ -1,168 +0,0 @@
-package FS::rate_time;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use FS::rate_time_interval;
-
-=head1 NAME
-
-FS::rate_time - Object methods for rate_time records
-
-=head1 SYNOPSIS
-
- use FS::rate_time;
-
- $record = new FS::rate_time \%hash;
- $record = new FS::rate_time { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::rate_time object represents a time period for selection of CDR billing
-rates. FS::rate_time inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item ratetimenum
-
-primary key
-
-=item ratetimename
-
-A label (like "Daytime" or "Weekend").
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new example. To add the example 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 { 'rate_time'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid example. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('ratetimenum')
- || $self->ut_text('ratetimename')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item intervals
-
-Return the L<FS::rate_time_interval> objects included in this rating period.
-
-=cut
-
-sub intervals {
- my $self = shift;
- return qsearch({ table => 'rate_time_interval',
- hashref => { ratetimenum => $self->ratetimenum },
- order_by => 'ORDER BY stime ASC',
- });
-}
-
-=item contains TIME
-
-Return the L<FS::rate_time_interval> object that contains the specified
-time-of-week (in seconds from the start of Sunday). The primary use of
-this is to test whether that time falls within this rating period.
-
-=cut
-
-sub contains {
- my $self = shift;
- my $weektime = shift;
- return qsearchs('rate_time_interval', { ratetimenum => $self->ratetimenum,
- stime => { op => '<=',
- value => $weektime },
- etime => { op => '>',
- value => $weektime },
- } );
-}
-
-=item description
-
-Returns a list of arrayrefs containing the starting and
-ending times of each interval in this period, in a readable
-format.
-
-=cut
-
-sub description {
- my $self = shift;
- return map { [ $_->description ] } $self->intervals;
-}
-
-
-=back
-
-=head1 BUGS
-
-To be seen.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/rate_time_interval.pm b/FS/FS/rate_time_interval.pm
deleted file mode 100644
index 6a9986b..0000000
--- a/FS/FS/rate_time_interval.pm
+++ /dev/null
@@ -1,178 +0,0 @@
-package FS::rate_time_interval;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs );
-use List::Util 'first';
-
-=head1 NAME
-
-FS::rate_time_interval - Object methods for rate_time_interval records
-
-=head1 SYNOPSIS
-
- use FS::rate_time_interval;
-
- $record = new FS::rate_time_interval \%hash;
- $record = new FS::rate_time_interval { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::rate_time_interval object represents an interval of clock time during
-the week, such as "Monday, 7 AM to 8 PM". FS::rate_time_interval inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item intervalnum
-
-primary key
-
-=item stime
-
-Start of the interval, in seconds from midnight on Sunday.
-
-=item etime
-
-End of the interval.
-
-=item ratetimenum
-
-A foreign key to an L<FS::rate_time> object representing the set of intervals
-to which this belongs.
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new example. To add the example 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 { 'rate_time_interval'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid interval. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('intervalnum')
- || $self->ut_number('stime')
- || $self->ut_number('etime')
- || $self->ut_number('ratetimenum')
- ;
- return $error if $error;
- # Disallow backward intervals. As a special case, an etime of 0
- # should roll to the last second of the week.
- $self->etime(7*24*60*60) if $self->etime == 0;
- return "end of interval is before start" if ($self->etime < $self->stime);
-
- # Detect overlap between intervals within the same rate_time.
- # Since intervals are added one at a time, we only need to look
- # for an existing interval that contains one of the endpoints of
- # this one or that is completely inside this one.
- my $overlap = $self->rate_time->contains($self->stime + 1) ||
- $self->rate_time->contains($self->etime - 1) ||
- first { $self->stime <= $_->stime && $self->etime >= $_->etime }
- ( $self->rate_time->intervals );
- return "interval overlap: (".join('-',$self->description).') with ('.
- join('-',$overlap->description).')' if $overlap;
-
- $self->SUPER::check;
-}
-
-=item rate_time
-
-Returns the L<FS::rate_time> comprising this interval.
-
-=cut
-
-sub rate_time {
- my $self = shift;
- FS::rate_time->by_key($self->ratetimenum);
-}
-
-=item description
-
-Returns two strings containing stime and etime, formatted
-"Day HH:MM AM/PM". Example: "Mon 5:00 AM". Seconds are
-not displayed, so be careful.
-
-=cut
-
-my @days = qw(Sun Mon Tue Wed Thu Fri Sat);
-
-sub description {
- my $self = shift;
- return map {
- sprintf('%s %02d:%02d %s',
- $days[int($_/86400) % 7],
- (int($_/3600) % 12 || 12),
- int($_/60) % 60,
- (($_/3600) % 24 < 12) ? 'AM' : 'PM' )
- } ( $self->stime, $self->etime );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::rate_time>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm
deleted file mode 100644
index 377da49..0000000
--- a/FS/FS/reason.pm
+++ /dev/null
@@ -1,130 +0,0 @@
-package FS::reason;
-
-use strict;
-use vars qw( @ISA $DEBUG $me );
-use DBIx::DBSchema;
-use DBIx::DBSchema::Table;
-use DBIx::DBSchema::Column;
-use FS::Record qw( qsearch qsearchs dbh dbdef );
-use FS::reason_type;
-
-@ISA = qw(FS::Record);
-$DEBUG = 0;
-$me = '[FS::reason]';
-
-=head1 NAME
-
-FS::reason - Object methods for reason records
-
-=head1 SYNOPSIS
-
- use FS::reason;
-
- $record = new FS::reason \%hash;
- $record = new FS::reason { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::reason object represents a reason message. FS::reason inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item reasonnum - primary key
-
-=item reason_type - index into FS::reason_type
-
-=item reason - text of the reason
-
-=item disabled - 'Y' or ''
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new reason. To add the example 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 { 'reason'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid reason. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('reasonnum')
- || $self->ut_text('reason')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item reasontype
-
-Returns the reason_type (see <I>FS::reason_type</I>) associated with this reason.
-
-=cut
-
-sub reasontype {
- qsearchs( 'reason_type', { 'typenum' => shift->reason_type } );
-}
-
-=back
-
-=head1 BUGS
-
-Here be termintes. Don't use on wooden computers.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/reason_type.pm b/FS/FS/reason_type.pm
deleted file mode 100644
index 4425c64..0000000
--- a/FS/FS/reason_type.pm
+++ /dev/null
@@ -1,209 +0,0 @@
-package FS::reason_type;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-our %class_name = (
- 'C' => 'cancel',
- 'R' => 'credit',
- 'S' => 'suspend',
-);
-
-our %class_purpose = (
- 'C' => 'explain why a customer package was cancelled',
- 'R' => 'explain why a customer was credited',
- 'S' => 'explain why a customer package was suspended',
-);
-
-=head1 NAME
-
-FS::reason_type - Object methods for reason_type records
-
-=head1 SYNOPSIS
-
- use FS::reason_type;
-
- $record = new FS::reason_type \%hash;
- $record = new FS::reason_type { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::reason_type object represents a grouping of reasons. FS::reason_type
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item typenum - primary key
-
-=item class - currently 'C', 'R', or 'S' for cancel, credit, or suspend
-
-=item type - name of the type of reason
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new reason_type. To add the example 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 { 'reason_type'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid reason_type. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('typenum')
- || $self->ut_enum('class', [ keys %class_name ] )
- || $self->ut_text('type')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item reasons
-
-Returns a list of all reasons associated with this type.
-
-=cut
-
-sub reasons {
- qsearch( 'reason', { 'reason_type' => shift->typenum } );
-}
-
-=item enabled_reasons
-
-Returns a list of enabled reasons associated with this type.
-
-=cut
-
-sub enabled_reasons {
- qsearch( 'reason', { 'reason_type' => shift->typenum,
- 'enabled' => '',
- } );
-}
-
-# _populate_initial_data
-#
-# Used by FS::Setup to initialize a new database.
-#
-#
-
-sub _populate_initial_data { # class method
- my ($self, %opts) = @_;
-
- my $conf = new FS::Conf;
-
- foreach ( keys %class_name ) {
- my $object = $self->new( {'class' => $_,
- 'type' => ucfirst($class_name{$_}). ' Reason',
- } );
- my $error = $object->insert();
- die "error inserting $self into database: $error\n"
- if $error;
- }
-
- my $object = qsearchs('reason_type', { 'class' => 'R' });
- die "can't find credit reason type just inserted!\n"
- unless $object;
-
- foreach ( keys %FS::cust_credit::reasontype_map ) {
-# my $object = $self->new( {'class' => 'R',
-# 'type' => $FS::cust_credit::reasontype_map{$_},
-# } );
-# my $error = $object->insert();
-# die "error inserting $self into database: $error\n"
-# if $error;
- $conf->set($_, $object->typenum);
- }
-
- '';
-
-}
-
-# _upgrade_data
-#
-# Used by FS::Upgrade to migrate to a new database.
-#
-#
-
-sub _upgrade_data { # class method
- my ($self, %opts) = @_;
-
- foreach ( keys %class_name ) {
- unless (scalar(qsearch('reason_type', { 'class' => $_ }))) {
- my $object = $self->new( {'class' => $_,
- 'type' => ucfirst($class_name{$_}),
- } );
- my $error = $object->insert();
- die "error inserting $self into database: $error\n"
- if $error;
- }
- }
-
- '';
-
-}
-
-=back
-
-=head1 BUGS
-
-Here be termintes. Don't use on wooden computers.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/reg_code.pm b/FS/FS/reg_code.pm
deleted file mode 100644
index f48ccf0..0000000
--- a/FS/FS/reg_code.pm
+++ /dev/null
@@ -1,223 +0,0 @@
-package FS::reg_code;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw(qsearch dbh);
-use FS::agent;
-use FS::reg_code_pkg;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::reg_code - One-time registration codes
-
-=head1 SYNOPSIS
-
- use FS::reg_code;
-
- $record = new FS::reg_code \%hash;
- $record = new FS::reg_code { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::reg_code object is a one-time registration code. FS::reg_code inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item codenum - primary key
-
-=item code - registration code string
-
-=item agentnum - Agent (see L<FS::agent>)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new registration code. To add the code 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 { 'reg_code'; }
-
-=item insert [ PKGPART_ARRAYREF ]
-
-Adds this record to the database. If an arrayref of pkgparts
-(see L<FS::part_pkg>) is specified, the appropriate reg_code_pkg records
-(see L<FS::reg_code_pkg>) will be inserted.
-
-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;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( @_ ) {
- my $pkgparts = shift;
- foreach my $pkgpart ( @$pkgparts ) {
- my $reg_code_pkg = new FS::reg_code_pkg ( {
- 'codenum' => $self->codenum,
- 'pkgpart' => $pkgpart,
- } );
- $error = $reg_code_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item delete
-
-Delete this record (and all associated reg_code_pkg records) 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 $reg_code_pkg ( $self->reg_code_pkg ) {
- my $error = $reg_code_pkg->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 registration code. 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('codenum')
- || $self->ut_alpha('code')
- || $self->ut_foreign_key('agentnum', 'agent', 'agentnum')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item part_pkg
-
-Returns all package definitions (see L<FS::part_pkg> for this registration
-code.
-
-=cut
-
-sub part_pkg {
- my $self = shift;
- map { $_->part_pkg } $self->reg_code_pkg;
-}
-
-=item reg_code_pkg
-
-Returns all FS::reg_code_pkg records for this registration code.
-
-=cut
-
-sub reg_code_pkg {
- my $self = shift;
- qsearch('reg_code_pkg', { 'codenum' => $self->codenum } );
-}
-
-
-=back
-
-=head1 BUGS
-
-Feeping creaturitis.
-
-=head1 SEE ALSO
-
-L<FS::reg_code_pkg>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
-
diff --git a/FS/FS/reg_code_pkg.pm b/FS/FS/reg_code_pkg.pm
deleted file mode 100644
index 837b755..0000000
--- a/FS/FS/reg_code_pkg.pm
+++ /dev/null
@@ -1,139 +0,0 @@
-package FS::reg_code_pkg;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw(qsearchs);
-use FS::reg_code;
-use FS::part_pkg;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::reg_code_pkg - Class linking registration codes (see L<FS::reg_code>) with package definitions (see L<FS::part_pkg>)
-
-=head1 SYNOPSIS
-
- use FS::reg_code_pkg;
-
- $record = new FS::reg_code_pkg \%hash;
- $record = new FS::reg_code_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::reg_code_pkg object links a registration code to a package definition.
-FS::table_name inherits from FS::Record. The following fields are currently
-supported:
-
-=over 4
-
-=item codepkgnum - primary key
-
-=item codenum - registration code (see L<FS::reg_code>)
-
-=item pkgpart - package definition (see L<FS::part_pkg>)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new registration code. To add the registration code 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 { 'reg_code_pkg'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid 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('codepkgnum')
- || $self->ut_foreign_key('codenum', 'reg_code', 'codenum')
- || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item part_pkg
-
-Returns the package definition (see L<FS::part_pkg>)
-
-=cut
-
-sub part_pkg {
- my $self = shift;
- qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart } );
-}
-
-=back
-
-=head1 BUGS
-
-Feeping creaturitis.
-
-=head1 SEE ALSO
-
-L<FS::reg_code_pkg>, L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
-
diff --git a/FS/FS/registrar.pm b/FS/FS/registrar.pm
deleted file mode 100644
index cf5dc49..0000000
--- a/FS/FS/registrar.pm
+++ /dev/null
@@ -1,119 +0,0 @@
-package FS::registrar;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::registrar - Object methods for registrar records
-
-=head1 SYNOPSIS
-
- use FS::registrar;
-
- $record = new FS::registrar \%hash;
- $record = new FS::registrar { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::registrar object represents a registrar. FS::registrar inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item registrarnum - primary key
-
-=item registrarname -
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new registrar. To add the registrar to the database, see L<"insert">.
-
-Note that this stores the hash reference, not a distinct copy of the hash it
-points to. You can ask the object for a copy with the I<hash> method.
-
-=cut
-
-# the new method can be inherited from FS::Record, if a table method is defined
-
-sub table { 'registrar'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid registrar. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-# the check method should currently be supplied - FS::Record contains some
-# data checking routines
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('registrarnum')
- || $self->ut_text('registrarname')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/router.pm b/FS/FS/router.pm
deleted file mode 100755
index 7a9fda3..0000000
--- a/FS/FS/router.pm
+++ /dev/null
@@ -1,152 +0,0 @@
-package FS::router;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs qsearch );
-use FS::addr_block;
-
-@ISA = qw( FS::Record FS::m2m_Common );
-
-=head1 NAME
-
-FS::router - Object methods for router records
-
-=head1 SYNOPSIS
-
- use FS::router;
-
- $record = new FS::router \%hash;
- $record = new FS::router { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::router record describes a broadband router, such as a DSLAM or a wireless
- access point. FS::router inherits from FS::Record. The following
-fields are currently supported:
-
-=over 4
-
-=item routernum - primary key
-
-=item routername - descriptive name for the router
-
-=item svcnum - svcnum of the owning FS::svc_broadband, if appropriate
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Create a new record. To add the record to the database, see "insert".
-
-=cut
-
-sub table { 'router'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('routernum')
- || $self->ut_text('routername')
- || $self->ut_agentnum_acl('agentnum', 'Broadband global configuration')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item addr_block
-
-Returns a list of FS::addr_block objects (address blocks) associated
-with this object.
-
-=cut
-
-sub addr_block {
- my $self = shift;
- return qsearch('addr_block', { routernum => $self->routernum });
-}
-
-=item part_svc_router
-
-Returns a list of FS::part_svc_router objects associated with this
-object. This is unlikely to be useful for any purpose other than retrieving
-the associated FS::part_svc objects. See below.
-
-=cut
-
-sub part_svc_router {
- my $self = shift;
- return qsearch('part_svc_router', { routernum => $self->routernum });
-}
-
-=item part_svc
-
-Returns a list of FS::part_svc objects associated with this object.
-
-=cut
-
-sub part_svc {
- my $self = shift;
- return map { qsearchs('part_svc', { svcpart => $_->svcpart }) }
- $self->part_svc_router;
-}
-
-=item agent
-
-Returns the agent associated with this router, if any.
-
-=cut
-
-sub agent {
- qsearchs('agent', { 'agentnum' => shift->agentnum });
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-FS::svc_broadband, FS::router, FS::addr_block, FS::part_svc,
-schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/session.pm b/FS/FS/session.pm
deleted file mode 100644
index 615c8ae..0000000
--- a/FS/FS/session.pm
+++ /dev/null
@@ -1,265 +0,0 @@
-package FS::session;
-
-use strict;
-use vars qw( @ISA $conf $start $stop );
-use FS::UID qw( dbh );
-use FS::Record qw( qsearchs );
-use FS::svc_acct;
-use FS::port;
-use FS::nas;
-
-@ISA = qw(FS::Record);
-
-$FS::UID::callback{'FS::session'} = sub {
- $conf = new FS::Conf;
- $start = $conf->exists('session-start') ? $conf->config('session-start') : '';
- $stop = $conf->exists('session-stop') ? $conf->config('session-stop') : '';
-};
-
-=head1 NAME
-
-FS::session - Object methods for session records
-
-=head1 SYNOPSIS
-
- use FS::session;
-
- $record = new FS::session \%hash;
- $record = new FS::session {
- 'portnum' => 1,
- 'svcnum' => 2,
- 'login' => $timestamp,
- 'logout' => $timestamp,
- };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->nas_heartbeat($timestamp);
-
-=head1 DESCRIPTION
-
-An FS::session object represents an user login session. FS::session inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item sessionnum - primary key
-
-=item portnum - NAS port for this session - see L<FS::port>
-
-=item svcnum - User for this session - see L<FS::svc_acct>
-
-=item login - timestamp indicating the beginning of this user session.
-
-=item logout - timestamp indicating the end of this user session. May be null,
- which indicates a currently open session.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new session. To add the session 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 { 'session'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false. If the `login' field is empty, it is replaced with
-the current time.
-
-=cut
-
-sub insert {
- my $self = shift;
- my $error;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- $error = $self->check;
- return $error if $error;
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- if ( qsearchs('session', { 'portnum' => $self->portnum, 'logout' => '' } ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "a session on that port is already open!";
- }
-
- $self->setfield('login', time()) unless $self->getfield('login');
-
- $error = $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $self->nas_heartbeat($self->getfield('login'));
-
- #session-starting callback
- #redundant with heartbeat, yuck
- my $port = qsearchs('port',{'portnum'=>$self->portnum});
- my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
- #kcuy
- my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
- system( eval qq("$start") ) if $start;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false. If the `logout' field is empty,
-it is replaced with the current time.
-
-=cut
-
-sub replace {
- my($self, $old) = @_;
- my $error;
-
- 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;
-
- $error = $self->check;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $self->setfield('logout', time()) unless $self->getfield('logout');
-
- $error = $self->SUPER::replace($old);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $self->nas_heartbeat($self->getfield('logout'));
-
- #session-ending callback
- #redundant with heartbeat, yuck
- my $port = qsearchs('port',{'portnum'=>$self->portnum});
- my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
- #kcuy
- my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
- system( eval qq("$stop") ) if $stop;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-=item check
-
-Checks all fields to make sure this is a valid session. 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('sessionnum')
- || $self->ut_number('portnum')
- || $self->ut_number('svcnum')
- || $self->ut_numbern('login')
- || $self->ut_numbern('logout')
- ;
- return $error if $error;
- return "Unknown svcnum"
- unless qsearchs('svc_acct', { 'svcnum' => $self->svcnum } );
- $self->SUPER::check;
-}
-
-=item nas_heartbeat
-
-Heartbeats the nas associated with this session (see L<FS::nas>).
-
-=cut
-
-sub nas_heartbeat {
- my $self = shift;
- my $port = qsearchs('port',{'portnum'=>$self->portnum});
- my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
- $nas->heartbeat(shift);
-}
-
-=item svc_acct
-
-Returns the svc_acct record associated with this session (see L<FS::svc_acct>).
-
-=cut
-
-sub svc_acct {
- my $self = shift;
- qsearchs('svc_acct', { 'svcnum' => $self->svcnum } );
-}
-
-=back
-
-=head1 BUGS
-
-Maybe you shouldn't be able to insert a session if there's currently an open
-session on that port. Or maybe the open session on that port should be flagged
-as problematic? autoclosed? *sigh*
-
-Hmm, sessions refer to current svc_acct records... probably need to constrain
-deletions to svc_acct records such that no svc_acct records are deleted which
-have a session (even if long-closed).
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/svc_CGPRule_Mixin.pm b/FS/FS/svc_CGPRule_Mixin.pm
deleted file mode 100644
index cf2eca7..0000000
--- a/FS/FS/svc_CGPRule_Mixin.pm
+++ /dev/null
@@ -1,61 +0,0 @@
-package FS::svc_CGPRule_Mixin;
-
-use strict;
-use FS::Record qw(qsearch);
-use FS::cgp_rule;
-
-=head1 NAME
-
-FS::svc_CGPRule_Mixin - Mixin class for svc_classes which can be related to cgp_rule
-
-=head1 SYNOPSIS
-
-package FS::svc_table;
-use base qw( FS::svc_CGPRule_Mixin FS::svc_Common );
-
-=head1 DESCRIPTION
-
-This is a mixin class for svc_ classes that can have Communigate Pro rules
-(currently, domains and accounts).
-
-=head1 METHODS
-
-=over 4
-
-=item cgp_rule
-
-Returns the rules associated with this service, as FS::cgp_rule objects.
-
-=cut
-
-sub cgp_rule {
- my $self = shift;
- qsearch({
- 'table' => 'cgp_rule',
- 'hashref' => { 'svcnum' => $self->svcnum },
- 'order_by' => 'ORDER BY priority ASC',
- });
-}
-
-=item cgp_rule_arrayref
-
-Returns an arrayref of rules suitable for Communigate Pro API commands.
-
-=cut
-
-sub cgp_rule_arrayref {
- my $self = shift;
- [ map $_->arrayref, $self->cgp_rule ];
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::cgp_rule>
-
-=cut
-
-1;
diff --git a/FS/FS/svc_CGP_Mixin.pm b/FS/FS/svc_CGP_Mixin.pm
deleted file mode 100644
index 2eee37a..0000000
--- a/FS/FS/svc_CGP_Mixin.pm
+++ /dev/null
@@ -1,160 +0,0 @@
-package FS::svc_CGP_Mixin;
-
-use strict;
-
-=head1 NAME
-
-FS::svc_CGP_Mixin - Mixin class for svc_classes which can be related to cgp_rule
-
-=head1 SYNOPSIS
-
-package FS::svc_table;
-use base qw( FS::svc_CGP_Mixin FS::svc_Common );
-
-=head1 DESCRIPTION
-
-This is a mixin class for svc_ classes that are exported to Communigate Pro.
-
-It currently contains timezone data for domains and accounts.
-
-=head1 METHODS
-
-=over 4
-
-=item cgp_timezone
-
-Returns an arrayref of Communigate time zones.
-
-=cut
-
-#http://www.communigate.com/pub/client/TimeZones.data
-#http://www.communigate.com/cgatepro/WebMail.html#Settings
-
-sub cgp_timezone_values {
- #my $self = shift; #i'm used as a class and object method but just return data
-
- [ '',
- 'HostOS',
- '(+0100) Algeria/Congo',
- '(+0200) Egypt/South Africa',
- '(+0300) Saudi Arabia',
- '(+0400) Oman',
- '(+0500) Pakistan',
- '(+0600) Bangladesh',
- '(+0700) Thailand/Vietnam',
- '(+0800) China/Malaysia',
- '(+0900) Japan/Korea',
- '(+1000) Queensland',
- '(+1100) Micronesia',
- '(+1200) Fiji',
- '(+1300) Tonga/Kiribati',
- '(+1400) Christmas Islands',
- '(-0100) Azores/Cape Verde',
- '(-0200) Fernando de Noronha',
- '(-0300) Argentina/Uruguay',
- '(-0400) Venezuela/Guyana',
- '(-0500) Haiti/Peru',
- '(-0600) Central America',
- '(-0700) Arisona', #Arizona?
- '(-0800) Adamstown',
- '(-0900) Marquesas Islands',
- '(-1000) Hawaii/Tahiti',
- '(-1100) Samoa',
- 'Asia/Afghanistan',
- 'Asia/India',
- 'Asia/Iran',
- 'Asia/Iraq',
- 'Asia/Israel',
- 'Asia/Jordan',
- 'Asia/Lebanon',
- 'Asia/Syria',
- 'Australia/Adelaide',
- 'Australia/East',
- 'Australia/NorthernTerritory',
- 'Europe/Central',
- 'Europe/Eastern',
- 'Europe/Moscow',
- 'Europe/Western',
- 'GMT (+0000)',
- 'Newfoundland',
- 'NewZealand/Auckland',
- 'NorthAmerica/Alaska',
- 'NorthAmerica/Atlantic',
- 'NorthAmerica/Central',
- 'NorthAmerica/Eastern',
- 'NorthAmerica/Mountain',
- 'NorthAmerica/Pacific',
- 'Russia/Ekaterinburg',
- 'Russia/Irkutsk',
- 'Russia/Kamchatka',
- 'Russia/Krasnoyarsk',
- 'Russia/Magadan',
- 'Russia/Novosibirsk',
- 'Russia/Vladivostok',
- 'Russia/Yakutsk',
- 'SouthAmerica/Brasil',
- 'SouthAmerica/Chile',
- 'SouthAmerica/Paraguay',
- ];
-}
-
-=item cgp_emptytrash_values
-
-Returns an arrayref of possible EmptyTrash values.
-
-=cut
-
-#http://www.communigate.com/cgatepro/WebMail.html#Trash
-
-sub cgp_emptytrash_values {
- #my $self = shift; #i'm used as a class and object method but just return data
-
- [ '', #<option value="-1">default(92 days)
- '0 seconds',
- '60 minutes',
- '2 hours',
- '3 hours',
- '6 hours',
- '12 hours',
- '24 hours',
- '2 days',
- '3 days',
- '7 days',
- '10 days',
- '2 weeks',
- '3 weeks',
- '30 days',
- '60 days',
- '90 days',
- '180 days',
- '360 days',
- ];
-}
-
-=item cgp_certificatetype_values
-
-Returns an arrayref of possible CertificateType values.
-
-=cut
-
-#http://www.communigate.com/cgatepro/PKI.html
-
-sub cgp_certificatetype_values {
-
- [ '', #<option value="-1">default(Test)
- 'Enabled',
- 'Disabled',
- 'Test',
- ];
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-=cut
-
-1;
diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm
deleted file mode 100644
index 3d8fe16..0000000
--- a/FS/FS/svc_Common.pm
+++ /dev/null
@@ -1,1106 +0,0 @@
-package FS::svc_Common;
-
-use strict;
-use vars qw( @ISA $noexport_hack $DEBUG $me
- $overlimit_missing_cust_svc_nonfatal_kludge );
-use Carp qw( cluck carp croak confess ); #specify cluck have to specify them all
-use Scalar::Util qw( blessed );
-use FS::Record qw( qsearch qsearchs fields dbh );
-use FS::cust_main_Mixin;
-use FS::cust_svc;
-use FS::part_svc;
-use FS::queue;
-use FS::cust_main;
-use FS::inventory_item;
-use FS::inventory_class;
-
-@ISA = qw( FS::cust_main_Mixin FS::Record );
-
-$me = '[FS::svc_Common]';
-$DEBUG = 0;
-
-$overlimit_missing_cust_svc_nonfatal_kludge = 0;
-
-=head1 NAME
-
-FS::svc_Common - Object method for all svc_ records
-
-=head1 SYNOPSIS
-
-use FS::svc_Common;
-
-@ISA = qw( FS::svc_Common );
-
-=head1 DESCRIPTION
-
-FS::svc_Common is intended as a base class for table-specific classes to
-inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record.
-
-=head1 METHODS
-
-=over 4
-
-=item search_sql_field FIELD STRING
-
-Class method which returns an SQL fragment to search for STRING in FIELD.
-
-It is now case-insensitive by default.
-
-=cut
-
-sub search_sql_field {
- my( $class, $field, $string ) = @_;
- my $table = $class->table;
- my $q_string = dbh->quote($string);
- "LOWER($table.$field) = LOWER($q_string)";
-}
-
-#fallback for services that don't provide a search...
-sub search_sql {
- #my( $class, $string ) = @_;
- '1 = 0'; #false
-}
-
-=item new
-
-=cut
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self, $class);
-
- unless ( defined ( $self->table ) ) {
- $self->{'Table'} = shift;
- carp "warning: FS::Record::new called with table name ". $self->{'Table'};
- }
-
- #$self->{'Hash'} = shift;
- my $newhash = shift;
- $self->{'Hash'} = { map { $_ => $newhash->{$_} } qw(svcnum svcpart) };
-
- $self->setdefault( $self->_fieldhandlers )
- unless $self->svcnum;
-
- $self->{'Hash'}{$_} = $newhash->{$_}
- foreach grep { defined($newhash->{$_}) && length($newhash->{$_}) }
- keys %$newhash;
-
- foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
- $self->{'Hash'}{$field}='';
- }
-
- $self->_rebless if $self->can('_rebless');
-
- $self->{'modified'} = 0;
-
- $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
-
- $self;
-}
-
-#empty default
-sub _fieldhandlers { {}; }
-
-sub virtual_fields {
-
- # This restricts the fields based on part_svc_column and the svcpart of
- # the service. There are four possible cases:
- # 1. svcpart passed as part of the svc_x hash.
- # 2. svcpart fetched via cust_svc based on svcnum.
- # 3. No svcnum or svcpart. In this case, return ALL the fields with
- # dbtable eq $self->table.
- # 4. Called via "fields('svc_acct')" or something similar. In this case
- # there is no $self object.
-
- my $self = shift;
- my $svcpart;
- my @vfields = $self->SUPER::virtual_fields;
-
- return @vfields unless (ref $self); # Case 4
-
- if ($self->svcpart) { # Case 1
- $svcpart = $self->svcpart;
- } elsif ( $self->svcnum
- && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} )
- ) { #Case 2
- $svcpart = $self->cust_svc->svcpart;
- } else { # Case 3
- $svcpart = '';
- }
-
- if ($svcpart) { #Cases 1 and 2
- my %flags = map { $_->columnname, $_->columnflag } (
- qsearch ('part_svc_column', { svcpart => $svcpart } )
- );
- return grep { not ( defined($flags{$_}) && $flags{$_} eq 'X') } @vfields;
- } else { # Case 3
- return @vfields;
- }
- return ();
-}
-
-=item label
-
-svc_Common provides a fallback label subroutine that just returns the svcnum.
-
-=cut
-
-sub label {
- my $self = shift;
- cluck "warning: ". ref($self). " not loaded or missing label method; ".
- "using svcnum";
- $self->svcnum;
-}
-
-sub label_long {
- my $self = shift;
- $self->label(@_);
-}
-
-=item check
-
-Checks the validity of fields in this record.
-
-At present, this does nothing but call FS::Record::check (which, in turn,
-does nothing but run virtual field checks).
-
-=cut
-
-sub check {
- my $self = shift;
- $self->SUPER::check;
-}
-
-=item insert [ , OPTION => VALUE ... ]
-
-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.
-
-Currently available options are: I<jobnums>, I<child_objects> and
-I<depend_jobnum>.
-
-If I<jobnum> is set to an array reference, the jobnums of any export jobs will
-be added to the referenced array.
-
-If I<child_objects> is set to an array reference of FS::tablename objects (for
-example, FS::acct_snarf objects), they will have their svcnum field set and
-will be inserted after this record, but before any exports are run. Each
-element of the array can also optionally be a two-element array reference
-containing the child object and the name of an alternate field to be filled in
-with the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
-
-If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
-jobnums), all provisioning jobs will have a dependancy on the supplied
-jobnum(s) (they will not run until the specific job(s) complete(s)).
-
-If I<export_args> is set to an array reference, the referenced list will be
-passed to export commands.
-
-=cut
-
-sub insert {
- my $self = shift;
- my %options = @_;
- warn "[$me] insert called with options ".
- join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
- if $DEBUG;
-
- my @jobnums = ();
- local $FS::queue::jobnums = \@jobnums;
- warn "[$me] insert: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
- if $DEBUG;
- my $objects = $options{'child_objects'} || [];
- my $depend_jobnums = $options{'depend_jobnum'} || [];
- $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
-
- 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 $svcnum = $self->svcnum;
- my $cust_svc = $svcnum ? qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) : '';
- #unless ( $svcnum ) {
- if ( !$svcnum or !$cust_svc ) {
- $cust_svc = new FS::cust_svc ( {
- #hua?# 'svcnum' => $svcnum,
- 'svcnum' => $self->svcnum,
- 'pkgnum' => $self->pkgnum,
- 'svcpart' => $self->svcpart,
- } );
- my $error = $cust_svc->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $svcnum = $self->svcnum($cust_svc->svcnum);
- } else {
- #$cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
- unless ( $cust_svc ) {
- $dbh->rollback if $oldAutoCommit;
- return "no cust_svc record found for svcnum ". $self->svcnum;
- }
- $self->pkgnum($cust_svc->pkgnum);
- $self->svcpart($cust_svc->svcpart);
- }
-
- my $error = $self->preinsert_hook_first
- || $self->set_auto_inventory
- || $self->check
- || $self->_check_duplicate
- || $self->preinsert_hook
- || $self->SUPER::insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- foreach my $object ( @$objects ) {
- my($field, $obj);
- if ( ref($object) eq 'ARRAY' ) {
- ($obj, $field) = @$object;
- } else {
- $obj = $object;
- $field = 'svcnum';
- }
- $obj->$field($self->svcnum);
- $error = $obj->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- #new-style exports!
- unless ( $noexport_hack ) {
-
- warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
- if $DEBUG;
-
- my $export_args = $options{'export_args'} || [];
-
- foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
- my $error = $part_export->export_insert($self, @$export_args);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "exporting to ". $part_export->exporttype.
- " (transaction rolled back): $error";
- }
- }
-
- foreach my $depend_jobnum ( @$depend_jobnums ) {
- warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
- if $DEBUG;
- foreach my $jobnum ( @jobnums ) {
- my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
- warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
- if $DEBUG;
- my $error = $queue->depend_insert($depend_jobnum);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error queuing job dependancy: $error";
- }
- }
- }
-
- }
-
- if ( exists $options{'jobnums'} ) {
- push @{ $options{'jobnums'} }, @jobnums;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-#fallbacks
-sub preinsert_hook_first { ''; }
-sub _check_duplcate { ''; }
-sub preinsert_hook { ''; }
-sub table_dupcheck_fields { (); }
-sub predelete_hook { ''; }
-sub predelete_hook_first { ''; }
-
-=item delete [ , OPTION => VALUE ... ]
-
-Deletes this account from the database. If there is an error, returns the
-error, otherwise returns false.
-
-The corresponding FS::cust_svc record will be deleted as well.
-
-=cut
-
-sub delete {
- my $self = shift;
- my %options = @_;
- my $export_args = $options{'export_args'} || [];
-
- 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->predelete_hook_first
- || $self->SUPER::delete
- || $self->export('delete', @$export_args)
- || $self->return_inventory
- || $self->predelete_hook
- || $self->cust_svc->delete
- ;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-=item expire DATE
-
-Currently this will only run expire exports if any are attached
-
-=cut
-
-sub expire {
- my($self,$date) = (shift,shift);
-
- return 'Expire date must be specified' unless $date;
-
- 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 $export_args = [$date];
- my $error = $self->export('expire', @$export_args);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
-
-Replaces OLD_RECORD with this one. 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;
-
- my $options =
- ( ref($_[0]) eq 'HASH' )
- ? 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 = $new->set_auto_inventory($old);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- #redundant, but so any duplicate fields are maniuplated as appropriate
- # (svc_phone.phonenum)
- $error = $new->check;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
- if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
-
- $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
- $error = $new->_check_duplicate;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $error = $new->SUPER::replace($old);
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- #new-style exports!
- unless ( $noexport_hack ) {
-
- my $export_args = $options->{'export_args'} || [];
-
- #not quite false laziness, but same pattern as FS::svc_acct::replace and
- #FS::part_export::sqlradius::_export_replace. List::Compare or something
- #would be useful but too much of a pain in the ass to deploy
-
- my @old_part_export = $old->cust_svc->part_svc->part_export;
- my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
- my @new_part_export =
- $new->svcpart
- ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
- : $new->cust_svc->part_svc->part_export;
- my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
-
- foreach my $delete_part_export (
- grep { ! $new_exportnum{$_->exportnum} } @old_part_export
- ) {
- my $error = $delete_part_export->export_delete($old, @$export_args);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error deleting, export to ". $delete_part_export->exporttype.
- " (transaction rolled back): $error";
- }
- }
-
- foreach my $replace_part_export (
- grep { $old_exportnum{$_->exportnum} } @new_part_export
- ) {
- my $error =
- $replace_part_export->export_replace( $new, $old, @$export_args);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error exporting to ". $replace_part_export->exporttype.
- " (transaction rolled back): $error";
- }
- }
-
- foreach my $insert_part_export (
- grep { ! $old_exportnum{$_->exportnum} } @new_part_export
- ) {
- my $error = $insert_part_export->export_insert($new, @$export_args );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error inserting export to ". $insert_part_export->exporttype.
- " (transaction rolled back): $error";
- }
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
-=item setfixed
-
-Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
-error, returns the error, otherwise returns the FS::part_svc object (use ref()
-to test the return). Usually called by the check method.
-
-=cut
-
-sub setfixed {
- my $self = shift;
- $self->setx('F', @_);
-}
-
-=item setdefault
-
-Sets all fields to their defaults (see L<FS::part_svc>), overriding their
-current values. If there is an error, returns the error, otherwise returns
-the FS::part_svc object (use ref() to test the return).
-
-=cut
-
-sub setdefault {
- my $self = shift;
- $self->setx('D', @_ );
-}
-
-=item set_default_and_fixed
-
-=cut
-
-sub set_default_and_fixed {
- my $self = shift;
- $self->setx( [ 'D', 'F' ], @_ );
-}
-
-=item setx FLAG | FLAG_ARRAYREF , [ CALLBACK_HASHREF ]
-
-Sets fields according to the passed in flag or arrayref of flags.
-
-Optionally, a hashref of field names and callback coderefs can be passed.
-If a coderef exists for a given field name, instead of setting the field,
-the coderef is called with the column value (part_svc_column.columnvalue)
-as the single parameter.
-
-=cut
-
-sub setx {
- my $self = shift;
- my $x = shift;
- my @x = ref($x) ? @$x : ($x);
- my $coderef = scalar(@_) ? shift : $self->_fieldhandlers;
-
- my $error =
- $self->ut_numbern('svcnum')
- ;
- return $error if $error;
-
- my $part_svc = $self->part_svc;
- return "Unknown svcpart" unless $part_svc;
-
- #set default/fixed/whatever fields from part_svc
-
- foreach my $part_svc_column (
- grep { my $f = $_->columnflag; grep { $f eq $_ } @x } #columnflag in @x
- $part_svc->all_part_svc_column
- ) {
-
- my $columnname = $part_svc_column->columnname;
- my $columnvalue = $part_svc_column->columnvalue;
-
- $columnvalue = &{ $coderef->{$columnname} }( $self, $columnvalue )
- if exists( $coderef->{$columnname} );
- $self->setfield( $columnname, $columnvalue );
-
- }
-
- $part_svc;
-
-}
-
-sub part_svc {
- my $self = shift;
-
- #get part_svc
- my $svcpart;
- if ( $self->get('svcpart') ) {
- $svcpart = $self->get('svcpart');
- } elsif ( $self->svcnum && qsearchs('cust_svc', {'svcnum'=>$self->svcnum}) ) {
- my $cust_svc = $self->cust_svc;
- return "Unknown svcnum" unless $cust_svc;
- $svcpart = $cust_svc->svcpart;
- }
-
- qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
-
-}
-
-=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>), 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')
- ;
- return $error if $error;
-
- my $part_svc = $self->part_svc;
- return "Unkonwn svcpart" unless $part_svc;
-
- 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;
-
- #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);
- my $columnflag = $part_svc_column->columnflag;
- next unless $columnflag =~ /^[AM]$/;
-
- next if $columnflag eq 'A' && $self->$field() ne '';
-
- 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 $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
- 'null' => 1,
- 'table' => 'inventory_item',
- );
-
- my $inventory_item = qsearchs({
- 'table' => 'inventory_item',
- 'hashref' => \%hash,
- 'extra_sql' => "AND $agentnums_sql",
- 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
- ' 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 );
- #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;
-
- '';
-
-}
-
-=item return_inventory
-
-=cut
-
-sub return_inventory {
- 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 $inventory_item ( $self->inventory_item ) {
- $inventory_item->svcnum('');
- my $error = $inventory_item->replace();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error returning inventory: $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- '';
-}
-
-=item inventory_item
-
-Returns the inventory items associated with this svc_ record, as
-FS::inventory_item objects (see L<FS::inventory_item>.
-
-=cut
-
-sub inventory_item {
- my $self = shift;
- qsearch({
- 'table' => 'inventory_item',
- 'hashref' => { 'svcnum' => $self->svcnum, },
- });
-}
-
-=item cust_svc
-
-Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
-object (see L<FS::cust_svc>).
-
-=cut
-
-sub cust_svc {
- my $self = shift;
- qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
-}
-
-=item suspend
-
-Runs export_suspend callbacks.
-
-=cut
-
-sub suspend {
- my $self = shift;
- my %options = @_;
- my $export_args = $options{'export_args'} || [];
- $self->export('suspend', @$export_args);
-}
-
-=item unsuspend
-
-Runs export_unsuspend callbacks.
-
-=cut
-
-sub unsuspend {
- my $self = shift;
- my %options = @_;
- my $export_args = $options{'export_args'} || [];
- $self->export('unsuspend', @$export_args);
-}
-
-=item export_links
-
-Runs export_links callbacks and returns the links.
-
-=cut
-
-sub export_links {
- my $self = shift;
- my $return = [];
- $self->export('links', $return);
- $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.
-
-=cut
-
-sub export {
- my( $self, $method ) = ( shift, shift );
-
- $method = "export_$method" unless $method =~ /^export_/;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- #new-style exports!
- unless ( $noexport_hack ) {
- foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
- next unless $part_export->can($method);
- my $error = $part_export->$method($self, @_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error exporting $method event to ". $part_export->exporttype.
- " (transaction rolled back): $error";
- }
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-=item overlimit
-
-Sets or retrieves overlimit date.
-
-=cut
-
-sub overlimit {
- my $self = shift;
- #$self->cust_svc->overlimit(@_);
- my $cust_svc = $self->cust_svc;
- unless ( $cust_svc ) { #wtf?
- my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ".
- $self->svcnum;
- if ( $overlimit_missing_cust_svc_nonfatal_kludge ) {
- cluck "$error; continuing anyway as requested";
- return '';
- } else {
- confess $error;
- }
- }
- $cust_svc->overlimit(@_);
-}
-
-=item cancel
-
-Stub - returns false (no error) so derived classes don't need to define this
-methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-This method is called *before* the deletion step which actually deletes the
-services. This method should therefore only be used for "pre-deletion"
-cancellation steps, if necessary.
-
-=cut
-
-sub cancel { ''; }
-
-=item clone_suspended
-
-Constructor used by FS::part_export::_export_suspend fallback. Stub returning
-same object for svc_ classes which don't implement a suspension fallback
-(everything except svc_acct at the moment). Document better.
-
-=cut
-
-sub clone_suspended {
- shift;
-}
-
-=item clone_kludge_unsuspend
-
-Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
-same object for svc_ classes which don't implement a suspension fallback
-(everything except svc_acct at the moment). Document better.
-
-=cut
-
-sub clone_kludge_unsuspend {
- shift;
-}
-
-=item find_duplicates MODE FIELDS...
-
-Method used by _check_duplicate routines to find services with duplicate
-values in specified fields. Set MODE to 'global' to search across all
-services, or 'export' to limit to those that share one or more exports
-with this service. FIELDS is a list of field names; only services
-matching in all fields will be returned. Empty fields will be skipped.
-
-=cut
-
-sub find_duplicates {
- my $self = shift;
- my $mode = shift;
- my @fields = @_;
-
- my %search = map { $_ => $self->getfield($_) }
- grep { length($self->getfield($_)) } @fields;
- return () if !%search;
- my @dup = grep { ! $self->svcnum or $_->svcnum != $self->svcnum }
- qsearch( $self->table, \%search );
- return () if !@dup;
- return @dup if $mode eq 'global';
- die "incorrect find_duplicates mode '$mode'" if $mode ne 'export';
-
- my $exports = FS::part_export::export_info($self->table);
- my %conflict_svcparts;
- my $part_svc = $self->part_svc;
- foreach my $part_export ( $part_svc->part_export ) {
- %conflict_svcparts = map { $_->svcpart => 1 } $part_export->export_svc;
- }
- return grep { $conflict_svcparts{$_->cust_svc->svcpart} } @dup;
-}
-
-
-
-
-=back
-
-=head1 BUGS
-
-The setfixed method return value.
-
-B<export> method isn't used by insert and replace methods yet.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
-from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/svc_Domain_Mixin.pm b/FS/FS/svc_Domain_Mixin.pm
deleted file mode 100644
index 202899c..0000000
--- a/FS/FS/svc_Domain_Mixin.pm
+++ /dev/null
@@ -1,134 +0,0 @@
-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_External_Common.pm b/FS/FS/svc_External_Common.pm
deleted file mode 100644
index a5805aa..0000000
--- a/FS/FS/svc_External_Common.pm
+++ /dev/null
@@ -1,199 +0,0 @@
-package FS::svc_External_Common;
-
-use strict;
-use vars qw(@ISA);
-use FS::svc_Common;
-
-@ISA = qw( FS::svc_Common );
-
-=head1 NAME
-
-FS::svc_external - Object methods for svc_external records
-
-=head1 SYNOPSIS
-
- use FS::svc_external;
-
- $record = new FS::svc_external \%hash;
- $record = new FS::svc_external { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-=head1 DESCRIPTION
-
-FS::svc_External_Common is intended as a base class for table-specific classes
-to inherit from. FS::svc_External_Common is used for services which connect
-to externally tracked services via "id" and "table" fields.
-
-FS::svc_External_Common inherits from FS::svc_Common.
-
-The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key
-
-=item id - unique number of external record
-
-=item title - for invoice line items
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item search_sql
-
-Provides a default search_sql method which returns an SQL fragment to search
-the B<title> field.
-
-=cut
-
-sub search_sql {
- my($class, $string) = @_;
- $class->search_sql_field('title', $string);
-}
-
-=item new HASHREF
-
-Creates a new external service. To add the external service to the database,
-see L<"insert">.
-
-Note that this stores the hash reference, not a distinct copy of the hash it
-points to. You can ask the object for a copy with the I<hash> method.
-
-=cut
-
-=item label
-
-Returns a string identifying this external service in the form "id:title"
-
-=cut
-
-sub label {
- my $self = shift;
- $self->id. ':'. $self->title;
-}
-
-=item insert [ , OPTION => VALUE ... ]
-
-Adds this external service to the database. If there is an error, returns the
-error, otherwise returns false.
-
-The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-Currently available options are: I<depend_jobnum>
-
-If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
-jobnums), all provisioning jobs will have a dependancy on the supplied
-jobnum(s) (they will not run until the specific job(s) complete(s)).
-
-=cut
-
-#sub insert {
-# my $self = shift;
-# my $error;
-#
-# $error = $self->SUPER::insert(@_);
-# return $error if $error;
-#
-# '';
-#}
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-#sub delete {
-# my $self = shift;
-# my $error;
-#
-# $error = $self->SUPER::delete;
-# return $error if $error;
-#
-# '';
-#}
-
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-#sub replace {
-# my ( $new, $old ) = ( shift, shift );
-# my $error;
-#
-# $error = $new->SUPER::replace($old);
-# return $error if $error;
-#
-# '';
-#}
-
-=item suspend
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item unsuspend
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item cancel
-
-Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item check
-
-Checks all fields to make sure this is a valid external service. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $x = $self->setfixed;
- return $x unless ref($x);
- my $part_svc = $x;
-
- my $error =
- $self->ut_numbern('svcnum')
- || $self->ut_numbern('id')
- || $self->ut_textn('title')
- ;
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
-L<FS::cust_pkg>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/svc_Parent_Mixin.pm b/FS/FS/svc_Parent_Mixin.pm
deleted file mode 100644
index 4501baf..0000000
--- a/FS/FS/svc_Parent_Mixin.pm
+++ /dev/null
@@ -1,103 +0,0 @@
-package FS::svc_Parent_Mixin;
-
-use strict;
-use NEXT;
-use FS::Record qw(qsearch qsearchs);
-use FS::cust_svc;
-
-=head1 NAME
-
-FS::svc_Parent_Mixin - Mixin class for svc_ classes with a parent_svcnum field
-
-=head1 SYNOPSIS
-
-package FS::svc_table;
-use vars qw(@ISA);
-@ISA = qw( FS::svc_Parent_Mixin FS::svc_Common );
-
-=head1 DESCRIPTION
-
-This is a mixin class for svc_ classes that contain a parent_svcnum field.
-
-=cut
-
-=head1 METHODS
-
-=over 4
-
-=item parent_cust_svc
-
-Returns the parent FS::cust_svc object.
-
-=cut
-
-sub parent_cust_svc {
- my $self = shift;
- qsearchs('cust_svc', { 'svcnum' => $self->parent_svcnum } );
-}
-
-=item parent_svc_x
-
-Returns the corresponding parent FS::svc_ object.
-
-=cut
-
-sub parent_svc_x {
- my $self = shift;
- $self->parent_cust_svc->svc_x;
-}
-
-=item children_cust_svc
-
-Returns a list of any child FS::cust_svc objects.
-
-Note: This is not recursive; it only returns direct children.
-
-=cut
-
-sub children_cust_svc {
- my $self = shift;
- qsearch('cust_svc', { 'parent_svcnum' => $self->svcnum } );
-}
-
-=item children_svc_x
-
-Returns the corresponding list of child FS::svc_ objects.
-
-=cut
-
-sub children_svc_x {
- my $self = shift;
- map { $_->svc_x } $self->children_cust_svc;
-}
-
-=item check
-
-This class provides a check subroutine which takes care of checking the
-parent_svcnum field. The svc_ class which uses it will call SUPER::check at
-the end of its own checks, and this class will call NEXT::check to pass
-the check "up the chain" (see L<NEXT>).
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->ut_foreign_keyn('parent_svcnum', 'cust_svc', 'svcnum')
- || $self->NEXT::check;
-
-}
-
-=back
-
-=head1 BUGS
-
-Do we need a recursive child finder for multi-layered children?
-
-=head1 SEE ALSO
-
-L<FS::svc_Common>, L<FS::Record>
-
-=cut
-
-1;
diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
deleted file mode 100644
index ac336b8..0000000
--- a/FS/FS/svc_acct.pm
+++ /dev/null
@@ -1,3249 +0,0 @@
-package FS::svc_acct;
-
-use strict;
-use base qw( FS::svc_Domain_Mixin FS::svc_CGP_Mixin FS::svc_CGPRule_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
- $username_noperiod $username_nounderscore $username_nodash
- $username_uppercase $username_percent $username_colon
- $username_slash $username_equals
- $password_noampersand $password_noexclamation
- $warning_template $warning_from $warning_subject $warning_mimetype
- $warning_cc
- $smtpmachine
- $radius_password $radius_ip
- $dirhash
- @saltset @pw_set );
-use Scalar::Util qw( blessed );
-use Math::BigInt;
-use Carp;
-use Fcntl qw(:flock);
-use Date::Format;
-use Crypt::PasswdMD5 1.2;
-use Digest::SHA1 'sha1_base64';
-use Digest::MD5 'md5_base64';
-use Data::Dumper;
-use Text::Template;
-use Authen::Passphrase;
-use FS::UID qw( datasrc driver_name );
-use FS::Conf;
-use FS::Record qw( qsearch qsearchs fields dbh dbdef );
-use FS::Msgcat qw(gettext);
-use FS::UI::bytecount;
-use FS::UI::Web;
-use FS::part_pkg;
-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;
-use FS::export_svc;
-use FS::part_export;
-use FS::svc_forward;
-use FS::svc_www;
-use FS::cdr;
-use FS::acct_snarf;
-
-$DEBUG = 0;
-$me = '[FS::svc_acct]';
-
-#ask FS::UID to run this stuff for us later
-FS::UID->install_callback( sub {
- $conf = new FS::Conf;
- $dir_prefix = $conf->config('home');
- @shells = $conf->config('shells');
- $usernamemin = $conf->config('usernamemin') || 2;
- $usernamemax = $conf->config('usernamemax');
- $passwordmin = $conf->config('passwordmin'); # || 6;
- #blank->6, keep 0
- $passwordmin = ( defined($passwordmin) && $passwordmin =~ /\d+/ )
- ? $passwordmin
- : 6;
- $passwordmax = $conf->config('passwordmax') || 8;
- $username_letter = $conf->exists('username-letter');
- $username_letterfirst = $conf->exists('username-letterfirst');
- $username_noperiod = $conf->exists('username-noperiod');
- $username_nounderscore = $conf->exists('username-nounderscore');
- $username_nodash = $conf->exists('username-nodash');
- $username_uppercase = $conf->exists('username-uppercase');
- $username_ampersand = $conf->exists('username-ampersand');
- $username_percent = $conf->exists('username-percent');
- $username_colon = $conf->exists('username-colon');
- $username_slash = $conf->exists('username-slash');
- $username_equals = $conf->exists('username-equals');
- $password_noampersand = $conf->exists('password-noexclamation');
- $password_noexclamation = $conf->exists('password-noexclamation');
- $dirhash = $conf->config('dirhash') || 0;
- if ( $conf->exists('warning_email') ) {
- $warning_template = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", $conf->config('warning_email') ]
- ) or warn "can't create warning email template: $Text::Template::ERROR";
- $warning_from = $conf->config('warning_email-from'); # || 'your-isp-is-dum'
- $warning_subject = $conf->config('warning_email-subject') || 'Warning';
- $warning_mimetype = $conf->config('warning_email-mimetype') || 'text/plain';
- $warning_cc = $conf->config('warning_email-cc');
- } else {
- $warning_template = '';
- $warning_from = '';
- $warning_subject = '';
- $warning_mimetype = '';
- $warning_cc = '';
- }
- $smtpmachine = $conf->config('smtpmachine');
- $radius_password = $conf->config('radius-password') || 'Password';
- $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address';
- @pw_set = ( 'A'..'Z' ) if $conf->exists('password-generated-allcaps');
-}
-);
-
-@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '.', ',' );
-
-sub _cache {
- my $self = shift;
- my ( $hashref, $cache ) = @_;
- if ( $hashref->{'svc_acct_svcnum'} ) {
- $self->{'_domsvc'} = FS::svc_domain->new( {
- 'svcnum' => $hashref->{'domsvc'},
- 'domain' => $hashref->{'svc_acct_domain'},
- 'catchall' => $hashref->{'svc_acct_catchall'},
- } );
- }
-}
-
-=head1 NAME
-
-FS::svc_acct - Object methods for svc_acct records
-
-=head1 SYNOPSIS
-
- use FS::svc_acct;
-
- $record = new FS::svc_acct \%hash;
- $record = new FS::svc_acct { '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;
-
- %hash = $record->radius;
-
- %hash = $record->radius_reply;
-
- %hash = $record->radius_check;
-
- $domain = $record->domain;
-
- $svc_domain = $record->svc_domain;
-
- $email = $record->email;
-
- $seconds_since = $record->seconds_since($timestamp);
-
-=head1 DESCRIPTION
-
-An FS::svc_acct object represents an account. FS::svc_acct inherits from
-FS::svc_Common. The following fields are currently supported:
-
-=over 4
-
-=item svcnum
-
-Primary key (assigned automatcially for new accounts)
-
-=item username
-
-=item _password
-
-generated if blank
-
-=item _password_encoding
-
-plain, crypt, ldap (or empty for autodetection)
-
-=item sec_phrase
-
-security phrase
-
-=item popnum
-
-Point of presence (see L<FS::svc_acct_pop>)
-
-=item uid
-
-=item gid
-
-=item finger
-
-GECOS
-
-=item dir
-
-set automatically if blank (and uid is not)
-
-=item shell
-
-=item quota
-
-=item slipip
-
-IP address
-
-=item seconds
-
-=item upbytes
-
-=item downbyte
-
-=item totalbytes
-
-=item domsvc
-
-svcnum from svc_domain
-
-=item pbxsvc
-
-Optional svcnum from svc_pbx
-
-=item radius_I<Radius_Attribute>
-
-I<Radius-Attribute> (reply)
-
-=item rc_I<Radius_Attribute>
-
-I<Radius-Attribute> (check)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new account. To add the account to the database, see L<"insert">.
-
-=cut
-
-sub table_info {
- {
- 'name' => 'Account',
- 'longname_plural' => 'Access accounts and mailboxes',
- 'sorts' => [ 'username', 'uid', 'seconds', 'last_login' ],
- 'display_weight' => 10,
- 'cancel_weight' => 50,
- 'fields' => {
- 'dir' => 'Home directory',
- 'uid' => {
- label => 'UID',
- def_info => 'set to fixed and blank for no UIDs',
- type => 'text',
- },
- 'slipip' => 'IP address',
- # 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!,
- 'popnum' => {
- label => 'Access number',
- type => 'select',
- select_table => 'svc_acct_pop',
- select_key => 'popnum',
- select_label => 'city',
- disable_select => 1,
- },
- 'username' => {
- label => 'Username',
- type => 'text',
- disable_default => 1,
- disable_fixed => 1,
- disable_select => 1,
- },
- 'password_selfchange' => { label => 'Password modification',
- type => 'checkbox',
- },
- 'password_recover' => { label => 'Password recovery',
- type => 'checkbox',
- },
- '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,
- },
- '_password' => 'Password',
- 'gid' => {
- label => 'GID',
- def_info => 'when blank, defaults to UID',
- type => 'text',
- },
- 'shell' => {
- label => 'Shell',
- def_info => 'set to blank for no shell tracking',
- type => 'select',
- #select_list => [ $conf->config('shells') ],
- select_list => [ $conf ? $conf->config('shells') : () ],
- disable_inventory => 1,
- disable_select => 1,
- },
- 'finger' => 'Real name', # (GECOS)',
- 'domsvc' => {
- label => 'Domain',
- type => 'select',
- select_table => 'svc_domain',
- 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',
- type => 'radius_usergroup_selector',
- disable_inventory => 1,
- disable_select => 1,
- },
- 'seconds' => { label => 'Seconds',
- label_sort => 'with Time Remaining',
- type => 'text',
- disable_inventory => 1,
- disable_select => 1,
- disable_part_svc_column => 1,
- },
- 'upbytes' => { label => 'Upload',
- type => 'text',
- disable_inventory => 1,
- disable_select => 1,
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- disable_part_svc_column => 1,
- },
- 'downbytes' => { label => 'Download',
- type => 'text',
- disable_inventory => 1,
- disable_select => 1,
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- disable_part_svc_column => 1,
- },
- 'totalbytes'=> { label => 'Total up and download',
- type => 'text',
- disable_inventory => 1,
- disable_select => 1,
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- disable_part_svc_column => 1,
- },
- 'seconds_threshold' => { label => 'Seconds threshold',
- type => 'text',
- disable_inventory => 1,
- disable_select => 1,
- disable_part_svc_column => 1,
- },
- 'upbytes_threshold' => { label => 'Upload threshold',
- type => 'text',
- disable_inventory => 1,
- disable_select => 1,
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- disable_part_svc_column => 1,
- },
- 'downbytes_threshold' => { label => 'Download threshold',
- type => 'text',
- disable_inventory => 1,
- disable_select => 1,
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- disable_part_svc_column => 1,
- },
- 'totalbytes_threshold'=> { label => 'Total up and download threshold',
- type => 'text',
- disable_inventory => 1,
- disable_select => 1,
- 'format' => \&FS::UI::bytecount::display_bytecount,
- 'parse' => \&FS::UI::bytecount::parse_bytecount,
- disable_part_svc_column => 1,
- },
- 'last_login'=> {
- label => 'Last login',
- type => 'disabled',
- },
- 'last_logout'=> {
- label => 'Last logout',
- type => 'disabled',
- },
-
- 'cgp_aliases' => {
- label => 'Communigate aliases',
- type => 'text',
- disable_inventory => 1,
- disable_select => 1,
- },
- #settings
- '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_rulesallowed' => {
- label => 'Allowed mail rules',
- type => 'select',
- select_list => [ '', 'No', 'Filter Only', 'All But Exec', 'Any' ],
- disable_inventory => 1,
- disable_select => 1,
- },
- 'cgp_rpopallowed' => { label => 'RPOP modifications',
- type => 'checkbox',
- },
- 'cgp_mailtoall' => { label => 'Accepts mail to "all"',
- type => 'checkbox',
- },
- 'cgp_addmailtrailer' => { label => 'Add trailer to sent mail',
- type => 'checkbox',
- },
- 'cgp_archiveafter' => {
- label => 'Archive messages after',
- type => 'select',
- select_hash => [
- -2 => 'default(730 days)',
- 0 => 'Never',
- 86400 => '24 hours',
- 172800 => '2 days',
- 259200 => '3 days',
- 432000 => '5 days',
- 604800 => '7 days',
- 1209600 => '2 weeks',
- 2592000 => '30 days',
- 7776000 => '90 days',
- 15552000 => '180 days',
- 31536000 => '365 days',
- 63072000 => '730 days',
- ],
- disable_inventory => 1,
- disable_select => 1,
- },
- #XXX mailing lists
-
- #preferences
- '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 => 'select',
- select_list => __PACKAGE__->cgp_emptytrash_values,
- disable_inventory => 1,
- disable_select => 1,
- },
- 'cgp_language' => {
- label => 'Communigate language',
- type => 'select',
- select_list => [ '', qw( English Arabic Chinese Dutch French German Hebrew Italian Japanese Portuguese Russian Slovak Spanish Thai ) ],
- disable_inventory => 1,
- disable_select => 1,
- },
- 'cgp_timezone' => {
- label => 'Communigate time zone',
- type => 'select',
- select_list => __PACKAGE__->cgp_timezone_values,
- disable_inventory => 1,
- disable_select => 1,
- },
- 'cgp_skinname' => {
- label => 'Communigate layout',
- type => 'select',
- select_list => [ '', '***', 'GoldFleece', 'Skin2' ],
- disable_inventory => 1,
- disable_select => 1,
- },
- 'cgp_prontoskinname' => {
- label => 'Communigate Pronto style',
- type => 'select',
- select_list => [ '', 'Pronto', 'Pronto-darkflame', 'Pronto-steel', 'Pronto-twilight', ],
- disable_inventory => 1,
- disable_select => 1,
- },
- 'cgp_sendmdnmode' => {
- label => 'Communigate send read receipts',
- type => 'select',
- select_list => [ '', 'Never', 'Manually', 'Automatically' ],
- disable_inventory => 1,
- disable_select => 1,
- },
-
- #mail
- #XXX RPOP settings
-
- },
- };
-}
-
-sub table { 'svc_acct'; }
-
-sub table_dupcheck_fields { ( 'username', 'domsvc' ); }
-
-sub _fieldhandlers {
- {
- #false laziness with edit/svc_acct.cgi
- 'usergroup' => sub {
- my( $self, $groups ) = @_;
- if ( ref($groups) eq 'ARRAY' ) {
- $groups;
- } elsif ( length($groups) ) {
- [ split(/\s*,\s*/, $groups) ];
- } else {
- [];
- }
- },
- };
-}
-
-sub last_login {
- shift->_lastlog('in', @_);
-}
-
-sub last_logout {
- shift->_lastlog('out', @_);
-}
-
-sub _lastlog {
- my( $self, $op, $time ) = @_;
-
- if ( defined($time) ) {
- warn "$me last_log$op called on svcnum ". $self->svcnum.
- ' ('. $self->email. "): $time\n"
- if $DEBUG;
-
- my $dbh = dbh;
-
- my $sql = "UPDATE svc_acct SET last_log$op = ? WHERE svcnum = ?";
- warn "$me $sql\n"
- if $DEBUG;
-
- my $sth = $dbh->prepare( $sql )
- or die "Error preparing $sql: ". $dbh->errstr;
- my $rv = $sth->execute($time, $self->svcnum);
- die "Error executing $sql: ". $sth->errstr
- unless defined($rv);
- die "Can't update last_log$op for svcnum". $self->svcnum
- if $rv == 0;
-
- $self->{'Hash'}->{"last_log$op"} = $time;
- }else{
- $self->getfield("last_log$op");
- }
-}
-
-=item search_sql STRING
-
-Class method which returns an SQL fragment to search for the given string.
-
-=cut
-
-sub search_sql {
- my( $class, $string ) = @_;
- if ( $string =~ /^([^@]+)@([^@]+)$/ ) {
- my( $username, $domain ) = ( $1, $2 );
- my $q_username = dbh->quote($username);
- my @svc_domain = qsearch('svc_domain', { 'domain' => $domain } );
- if ( @svc_domain ) {
- "svc_acct.username = $q_username AND ( ".
- join( ' OR ', map { "svc_acct.domsvc = ". $_->svcnum; } @svc_domain ).
- " )";
- } else {
- '1 = 0'; #false
- }
- } elsif ( $string =~ /^(\d{1,3}\.){3}\d{1,3}$/ ) {
- ' ( '.
- $class->search_sql_field('slipip', $string ).
- ' OR '.
- $class->search_sql_field('username', $string ).
- ' ) ';
- } else {
- $class->search_sql_field('username', $string);
- }
-}
-
-=item label [ END_TIMESTAMP [ START_TIMESTAMP ] ]
-
-Returns the "username@domain" string for this account.
-
-END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
-history records.
-
-=cut
-
-sub label {
- my $self = shift;
- $self->email(@_);
-}
-
-=item label_long [ END_TIMESTAMP [ START_TIMESTAMP ] ]
-
-Returns a longer string label for this acccount ("Real Name <username@domain>"
-if available, or "username@domain").
-
-END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
-history records.
-
-=cut
-
-sub label_long {
- my $self = shift;
- my $label = $self->label(@_);
- my $finger = $self->finger;
- return $label unless $finger =~ /\S/;
- my $maxlen = 40 - length($label) - length($self->cust_svc->part_svc->svc);
- $finger = substr($finger, 0, $maxlen-3).'...' if length($finger) > $maxlen;
- "$finger <$label>";
-}
-
-=item insert [ , OPTION => VALUE ... ]
-
-Adds this account 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.
-
-The additional field I<usergroup> can optionally be defined; if so it should
-contain an arrayref of group names. See L<FS::radius_usergroup>.
-
-The additional field I<child_objects> can optionally be defined; if so it
-should contain an arrayref of FS::tablename objects. They will have their
-svcnum fields set and will be inserted after this record, but before any
-exports are run. Each element of the array can also optionally be a
-two-element array reference containing the child object and the name of an
-alternate field to be filled in with the newly-inserted svcnum, for example
-C<[ $svc_forward, 'srcsvc' ]>
-
-Currently available options are: I<depend_jobnum>
-
-If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
-jobnums), all provisioning jobs will have a dependancy on the supplied
-jobnum(s) (they will not run until the specific job(s) complete(s)).
-
-(TODOC: L<FS::queue> and L<freeside-queued>)
-
-(TODOC: new exports!)
-
-=cut
-
-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;
-
- my @jobnums;
- my $error = $self->SUPER::insert(
- 'jobnums' => \@jobnums,
- 'child_objects' => $self->child_objects,
- %options,
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if ( $self->usergroup ) {
- foreach my $groupname ( @{$self->usergroup} ) {
- my $radius_usergroup = new FS::radius_usergroup ( {
- svcnum => $self->svcnum,
- groupname => $groupname,
- } );
- my $error = $radius_usergroup->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
- unless ( $skip_fuzzyfiles ) {
- $error = $self->queue_fuzzyfiles_update;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "updating fuzzy search cache: $error";
- }
- }
-
- my $cust_pkg = $self->cust_svc->cust_pkg;
-
- if ( $cust_pkg ) {
- my $cust_main = $cust_pkg->cust_main;
- my $agentnum = $cust_main->agentnum;
-
- if ( $conf->exists('emailinvoiceautoalways')
- || $conf->exists('emailinvoiceauto')
- && ! $cust_main->invoicing_list_emailonly
- ) {
- my @invoicing_list = $cust_main->invoicing_list;
- push @invoicing_list, $self->email;
- $cust_main->invoicing_list(\@invoicing_list);
- }
-
- #welcome email
- my $error = '';
- my $msgnum = $conf->config('welcome_msgnum', $agentnum);
- if ( $msgnum ) {
- my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
- $error = $msg_template->send('cust_main' => $cust_main,
- 'object' => $self);
- }
- else { #!$msgnum
- my ($to,$welcome_template,$welcome_from,$welcome_subject,$welcome_subject_template,$welcome_mimetype)
- = ('','','','','','');
-
- if ( $conf->exists('welcome_email', $agentnum) ) {
- $welcome_template = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", $conf->config('welcome_email', $agentnum) ]
- ) or warn "can't create welcome email template: $Text::Template::ERROR";
- $welcome_from = $conf->config('welcome_email-from', $agentnum);
- # || 'your-isp-is-dum'
- $welcome_subject = $conf->config('welcome_email-subject', $agentnum)
- || 'Welcome';
- $welcome_subject_template = new Text::Template (
- TYPE => 'STRING',
- SOURCE => $welcome_subject,
- ) or warn "can't create welcome email subject template: $Text::Template::ERROR";
- $welcome_mimetype = $conf->config('welcome_email-mimetype', $agentnum)
- || 'text/plain';
- }
- if ( $welcome_template ) {
- my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list );
- if ( $to ) {
-
- my %hash = (
- 'custnum' => $self->custnum,
- 'username' => $self->username,
- 'password' => $self->_password,
- 'first' => $cust_main->first,
- 'last' => $cust_main->getfield('last'),
- 'pkg' => $cust_pkg->part_pkg->pkg,
- );
- my $wqueue = new FS::queue {
- 'svcnum' => $self->svcnum,
- 'job' => 'FS::svc_acct::send_email'
- };
- my $error = $wqueue->insert(
- 'to' => $to,
- 'from' => $welcome_from,
- 'subject' => $welcome_subject_template->fill_in( HASH => \%hash, ),
- 'mimetype' => $welcome_mimetype,
- 'body' => $welcome_template->fill_in( HASH => \%hash, ),
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error queuing welcome email: $error";
- }
-
- if ( $options{'depend_jobnum'} ) {
- warn "$me depend_jobnum found; adding to welcome email dependancies"
- if $DEBUG;
- if ( ref($options{'depend_jobnum'}) ) {
- warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ).
- "to welcome email dependancies"
- if $DEBUG;
- push @jobnums, @{ $options{'depend_jobnum'} };
- } else {
- warn "$me adding job $options{'depend_jobnum'} ".
- "to welcome email dependancies"
- if $DEBUG;
- push @jobnums, $options{'depend_jobnum'};
- }
- }
-
- foreach my $jobnum ( @jobnums ) {
- my $error = $wqueue->depend_insert($jobnum);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error queuing welcome email job dependancy: $error";
- }
- }
-
- }
-
- } # if $welcome_template
- } # if !$msgnum
- } # if $cust_pkg
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-}
-
-# 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 } );
- 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;
- my $multiplier = $conf->exists('svc_acct-usage_threshold')
- ? 1 - $conf->config('svc_acct-usage_threshold')/100
- : 0.20; #doesn't matter
-
- foreach ( keys %values ) {
- next if $self->getfield($_);
- $self->setfield( $_, $values{$_} );
- $self->setfield( $_. '_threshold', int( $values{$_} * $multiplier ) )
- if $conf->exists('svc_acct-usage_threshold');
- }
-
- ''; #no error
-}
-
-=item delete
-
-Deletes this account from the database. If there is an error, returns the
-error, otherwise returns false.
-
-The corresponding FS::cust_svc record will be deleted as well.
-
-(TODOC: new exports!)
-
-=cut
-
-sub delete {
- my $self = shift;
-
- return "can't delete system account" if $self->_check_system;
-
- return "Can't delete an account which is a (svc_forward) source!"
- if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
-
- return "Can't delete an account which is a (svc_forward) destination!"
- if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
-
- return "Can't delete an account with (svc_www) web service!"
- if qsearch( 'svc_www', { 'usersvc' => $self->svcnum } );
-
- # what about records in session ? (they should refer to history table)
-
- 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 $cust_main_invoice (
- qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
- ) {
- unless ( defined($cust_main_invoice) ) {
- warn "WARNING: something's wrong with qsearch";
- next;
- }
- my %hash = $cust_main_invoice->hash;
- $hash{'dest'} = $self->email;
- my $new = new FS::cust_main_invoice \%hash;
- my $error = $new->replace($cust_main_invoice);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- foreach my $svc_domain (
- qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
- ) {
- my %hash = new FS::svc_domain->hash;
- $hash{'catchall'} = '';
- my $new = new FS::svc_domain \%hash;
- my $error = $new->replace($svc_domain);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my $error = $self->SUPER::delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- foreach my $radius_usergroup (
- qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } )
- ) {
- my $error = $radius_usergroup->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-The additional field I<usergroup> can optionally be defined; if so it should
-contain an arrayref of group names. See L<FS::radius_usergroup>.
-
-
-=cut
-
-sub replace {
- my $new = shift;
-
- my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
- ? shift
- : $new->replace_old;
-
- warn "$me replacing $old with $new\n" if $DEBUG;
-
- my $error;
-
- return "can't modify system account" if $old->_check_system;
-
- {
- #no warnings 'numeric'; #alas, a 5.006-ism
- local($^W) = 0;
-
- foreach my $xid (qw( uid gid )) {
-
- return "Can't change $xid!"
- if ! $conf->exists("svc_acct-edit_$xid")
- && $old->$xid() != $new->$xid()
- && $new->cust_svc->part_svc->part_svc_column($xid)->columnflag ne 'F'
- }
-
- }
-
- #change homdir when we change username
- $new->setfield('dir', '') if $old->username ne $new->username;
-
- 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;
-
- # redundant, but so $new->usergroup gets set
- $error = $new->check;
- return $error if $error;
-
- $old->usergroup( [ $old->radius_groups ] );
- if ( $DEBUG ) {
- warn $old->email. " old groups: ". join(' ',@{$old->usergroup}). "\n";
- warn $new->email. "new groups: ". join(' ',@{$new->usergroup}). "\n";
- }
- if ( $new->usergroup ) {
- #(sorta) false laziness with FS::part_export::sqlradius::_export_replace
- my @newgroups = @{$new->usergroup};
- foreach my $oldgroup ( @{$old->usergroup} ) {
- if ( grep { $oldgroup eq $_ } @newgroups ) {
- @newgroups = grep { $oldgroup ne $_ } @newgroups;
- next;
- }
- my $radius_usergroup = qsearchs('radius_usergroup', {
- svcnum => $old->svcnum,
- groupname => $oldgroup,
- } );
- my $error = $radius_usergroup->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error deleting radius_usergroup $oldgroup: $error";
- }
- }
-
- foreach my $newgroup ( @newgroups ) {
- my $radius_usergroup = new FS::radius_usergroup ( {
- svcnum => $new->svcnum,
- groupname => $newgroup,
- } );
- my $error = $radius_usergroup->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error adding radius_usergroup $newgroup: $error";
- }
- }
-
- }
-
- $error = $new->SUPER::replace($old, @_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error if $error;
- }
-
- if ( $new->username ne $old->username && ! $skip_fuzzyfiles ) {
- $error = $new->queue_fuzzyfiles_update;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "updating fuzzy search cache: $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-}
-
-=item queue_fuzzyfiles_update
-
-Used by insert & replace to update the fuzzy search cache
-
-=cut
-
-sub queue_fuzzyfiles_update {
- 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 $queue = new FS::queue {
- 'svcnum' => $self->svcnum,
- 'job' => 'FS::svc_acct::append_fuzzyfiles'
- };
- my $error = $queue->insert($self->username);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "queueing job (transaction rolled back): $error";
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-
-=item suspend
-
-Suspends this account by calling export-specific suspend hooks. If there is
-an error, returns the error, otherwise returns false.
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub suspend {
- my $self = shift;
- return "can't suspend system account" if $self->_check_system;
- $self->SUPER::suspend(@_);
-}
-
-=item unsuspend
-
-Unsuspends this account by by calling export-specific suspend hooks. If there
-is an error, returns the error, otherwise returns false.
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub unsuspend {
- my $self = shift;
- my %hash = $self->hash;
- if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
- $hash{_password} = $1;
- my $new = new FS::svc_acct ( \%hash );
- my $error = $new->replace($self);
- return $error if $error;
- }
-
- $self->SUPER::unsuspend(@_);
-}
-
-=item cancel
-
-Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-If the B<auto_unset_catchall> configuration option is set, this method will
-automatically remove any references to the canceled service in the catchall
-field of svc_domain. This allows packages that contain both a svc_domain and
-its catchall svc_acct to be canceled in one step.
-
-=cut
-
-sub cancel {
- # Only one thing to do at this level
- my $self = shift;
- foreach my $svc_domain (
- qsearch( 'svc_domain', { catchall => $self->svcnum } ) ) {
- if($conf->exists('auto_unset_catchall')) {
- my %hash = $svc_domain->hash;
- $hash{catchall} = '';
- my $new = new FS::svc_domain ( \%hash );
- my $error = $new->replace($svc_domain);
- return $error if $error;
- } else {
- return "cannot unprovision svc_acct #".$self->svcnum.
- " while assigned as catchall for svc_domain #".$svc_domain->svcnum;
- }
- }
-
- $self->SUPER::cancel(@_);
-}
-
-
-=item check
-
-Checks all fields to make sure this is a valid service. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-Sets any fixed values; see L<FS::part_svc>.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my($recref) = $self->hashref;
-
- my $x = $self->setfixed( $self->_fieldhandlers );
- return $x unless ref($x);
- my $part_svc = $x;
-
- if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) {
- $self->usergroup(
- [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] );
- }
-
- my $error = $self->ut_numbern('svcnum')
- #|| $self->ut_number('domsvc')
- || $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_snumbern('seconds_threshold')
- || $self->ut_snumbern('upbytes_threshold')
- || $self->ut_snumbern('downbytes_threshold')
- || $self->ut_snumbern('totalbytes_threshold')
- || $self->ut_enum('_password_encoding', ['',qw(plain crypt ldap)])
- || $self->ut_enum('password_selfchange', [ '', 'Y' ])
- || $self->ut_enum('password_recover', [ '', 'Y' ])
- #cardfortress
- || $self->ut_anything('cf_privatekey')
- #communigate
- || $self->ut_textn('cgp_accessmodes')
- || $self->ut_alphan('cgp_type')
- || $self->ut_textn('cgp_aliases' ) #well
- # settings
- || $self->ut_alphasn('cgp_rulesallowed')
- || $self->ut_enum('cgp_rpopallowed', [ '', 'Y' ])
- || $self->ut_enum('cgp_mailtoall', [ '', 'Y' ])
- || $self->ut_enum('cgp_addmailtrailer', [ '', 'Y' ])
- || $self->ut_snumbern('cgp_archiveafter')
- # preferences
- || $self->ut_alphasn('cgp_deletemode')
- || $self->ut_enum('cgp_emptytrash', $self->cgp_emptytrash_values)
- || $self->ut_alphan('cgp_language')
- || $self->ut_textn('cgp_timezone')
- || $self->ut_textn('cgp_skinname')
- || $self->ut_textn('cgp_prontoskinname')
- || $self->ut_alphan('cgp_sendmdnmode')
- ;
- return $error if $error;
-
- my $cust_pkg;
- local $username_letter = $username_letter;
- if ($self->svcnum) {
- my $cust_svc = $self->cust_svc
- or return "no cust_svc record found for svcnum ". $self->svcnum;
- my $cust_pkg = $cust_svc->cust_pkg;
- }
- if ($self->pkgnum) {
- $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $self->pkgnum } );#complain?
- }
- if ($cust_pkg) {
- $username_letter =
- $conf->exists('username-letter', $cust_pkg->cust_main->agentnum);
- }
-
- my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
-
- $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:\/\=]{$usernamemin,$ulen})$/i
- or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
- $recref->{username} = $1;
-
- unless ( $username_uppercase ) {
- $recref->{username} =~ /[A-Z]/ and return gettext('illegal_username');
- }
- if ( $username_letterfirst ) {
- $recref->{username} =~ /^[a-z]/ or return gettext('illegal_username');
- } elsif ( $username_letter ) {
- $recref->{username} =~ /[a-z]/ or return gettext('illegal_username');
- }
- if ( $username_noperiod ) {
- $recref->{username} =~ /\./ and return gettext('illegal_username');
- }
- if ( $username_nounderscore ) {
- $recref->{username} =~ /_/ and return gettext('illegal_username');
- }
- if ( $username_nodash ) {
- $recref->{username} =~ /\-/ and return gettext('illegal_username');
- }
- unless ( $username_ampersand ) {
- $recref->{username} =~ /\&/ and return gettext('illegal_username');
- }
- unless ( $username_percent ) {
- $recref->{username} =~ /\%/ and return gettext('illegal_username');
- }
- unless ( $username_colon ) {
- $recref->{username} =~ /\:/ and return gettext('illegal_username');
- }
- unless ( $username_slash ) {
- $recref->{username} =~ /\// and return gettext('illegal_username');
- }
- unless ( $username_equals ) {
- $recref->{username} =~ /\=/ and return gettext('illegal_username');
- }
-
- $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
- $recref->{popnum} = $1;
- return "Unknown popnum" unless
- ! $recref->{popnum} ||
- qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
-
- unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
-
- $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
- $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
-
- $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
- $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
- #not all systems use gid=uid
- #you can set a fixed gid in part_svc
-
- return "Only root can have uid 0"
- if $recref->{uid} == 0
- && $recref->{username} !~ /^(root|toor|smtp)$/;
-
- unless ( $recref->{username} eq 'sync' ) {
- if ( grep $_ eq $recref->{shell}, @shells ) {
- $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
- } else {
- return "Illegal shell \`". $self->shell. "\'; ".
- "shells configuration value contains: @shells";
- }
- } else {
- $recref->{shell} = '/bin/sync';
- }
-
- } else {
- $recref->{gid} ne '' ?
- return "Can't have gid without uid" : ( $recref->{gid}='' );
- #$recref->{dir} ne '' ?
- # return "Can't have directory without uid" : ( $recref->{dir}='' );
- $recref->{shell} ne '' ?
- return "Can't have shell without uid" : ( $recref->{shell}='' );
- }
-
- unless ( $part_svc->part_svc_column('dir')->columnflag eq 'F' ) {
-
- $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
- or return "Illegal directory: ". $recref->{dir};
- $recref->{dir} = $1;
- return "Illegal directory"
- if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
- return "Illegal directory"
- if $recref->{dir} =~ /\&/ && ! $username_ampersand;
- unless ( $recref->{dir} ) {
- $recref->{dir} = $dir_prefix . '/';
- if ( $dirhash > 0 ) {
- for my $h ( 1 .. $dirhash ) {
- $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
- }
- } elsif ( $dirhash < 0 ) {
- for my $h ( reverse $dirhash .. -1 ) {
- $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
- }
- }
- $recref->{dir} .= $recref->{username};
- ;
- }
-
- }
-
- # $error = $self->ut_textn('finger');
- # return $error if $error;
- if ( $self->getfield('finger') eq '' ) {
- my $cust_pkg = $self->svcnum
- ? $self->cust_svc->cust_pkg
- : qsearchs('cust_pkg', { 'pkgnum' => $self->getfield('pkgnum') } );
- if ( $cust_pkg ) {
- my $cust_main = $cust_pkg->cust_main;
- $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') );
- }
- }
- $self->getfield('finger') =~
- /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/
- or return "Illegal finger: ". $self->getfield('finger');
- $self->setfield('finger', $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 '' ) {
- $recref->{slipip} = '';
- } elsif ( $recref->{slipip} eq '0e0' ) {
- $recref->{slipip} = '0e0';
- } else {
- $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
- or return "Illegal slipip: ". $self->slipip;
- $recref->{slipip} = $1;
- }
-
- }
-
- #arbitrary RADIUS stuff; allow ut_textn for now
- foreach ( grep /^radius_/, fields('svc_acct') ) {
- $self->ut_textn($_);
- }
-
- # First, if _password is blank, generate one and set default encoding.
- if ( ! $recref->{_password} ) {
- $error = $self->set_password('');
- }
- # But if there's a _password but no encoding, assume it's plaintext and
- # set it to default encoding.
- elsif ( ! $recref->{_password_encoding} ) {
- $error = $self->set_password($recref->{_password});
- }
- return $error if $error;
-
- # Next, check _password to ensure compliance with the encoding.
- if ( $recref->{_password_encoding} eq 'ldap' ) {
-
- if ( $recref->{_password} =~ /^(\{[\w\-]+\})(!?.{0,64})$/ ) {
- $recref->{_password} = uc($1).$2;
- } else {
- return 'Illegal (ldap-encoded) password: '. $recref->{_password};
- }
-
- } elsif ( $recref->{_password_encoding} eq 'crypt' ) {
-
- if ( $recref->{_password} =~
- #/^(\$\w+\$.*|[\w\+\/]{13}|_[\w\+\/]{19}|\*)$/
- /^(!!?)?(\$\w+\$.*|[\w\+\/\.]{13}|_[\w\+\/\.]{19}|\*)$/
- ) {
-
- $recref->{_password} = ( defined($1) ? $1 : '' ). $2;
-
- } else {
- return 'Illegal (crypt-encoded) password: '. $recref->{_password};
- }
-
- } elsif ( $recref->{_password_encoding} eq 'plain' ) {
- # Password randomization is now in set_password.
- # Strip whitespace characters, check length requirements, etc.
- if ( $recref->{_password} =~ /^([^\t\n]{$passwordmin,$passwordmax})$/ ) {
- $recref->{_password} = $1;
- } else {
- return gettext('illegal_password'). " $passwordmin-$passwordmax ".
- FS::Msgcat::_gettext('illegal_password_characters').
- ": ". $recref->{_password};
- }
-
- if ( $password_noampersand ) {
- $recref->{_password} =~ /\&/ and return gettext('illegal_password');
- }
- if ( $password_noexclamation ) {
- $recref->{_password} =~ /\!/ and return gettext('illegal_password');
- }
- }
- else {
- return "invalid password encoding ('".$recref->{_password_encoding}."'";
- }
- $self->SUPER::check;
-
-}
-
-
-sub _password_encryption {
- my $self = shift;
- my $encoding = lc($self->_password_encoding);
- return if !$encoding;
- return 'plain' if $encoding eq 'plain';
- if($encoding eq 'crypt') {
- my $pass = $self->_password;
- $pass =~ s/^\*SUSPENDED\* //;
- $pass =~ s/^!!?//;
- return 'md5' if $pass =~ /^\$1\$/;
- #return 'blowfish' if $self->_password =~ /^\$2\$/;
- return 'des' if length($pass) == 13;
- return;
- }
- if($encoding eq 'ldap') {
- uc($self->_password) =~ /^\{([\w-]+)\}/;
- return 'crypt' if $1 eq 'CRYPT' or $1 eq 'DES';
- return 'plain' if $1 eq 'PLAIN' or $1 eq 'CLEARTEXT';
- return 'md5' if $1 eq 'MD5';
- return 'sha1' if $1 eq 'SHA' or $1 eq 'SHA-1';
-
- return;
- }
- return;
-}
-
-sub get_cleartext_password {
- my $self = shift;
- if($self->_password_encryption eq 'plain') {
- if($self->_password_encoding eq 'ldap') {
- $self->_password =~ /\{\w+\}(.*)$/;
- return $1;
- }
- else {
- return $self->_password;
- }
- }
- return;
-}
-
-
-=item set_password
-
-Set the cleartext password for the account. If _password_encoding is set, the
-new password will be encoded according to the existing method (including
-encryption mode, if it can be determined). Otherwise,
-config('default-password-encoding') is used.
-
-If no password is supplied (or a zero-length password when minimum password length
-is >0), one will be generated randomly.
-
-=cut
-
-sub set_password {
- 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;
-
- my( $encoding, $encryption ) = ('', '');
-
- if ( $self->_password_encoding ) {
- $encoding = $self->_password_encoding;
- # identify existing encryption method, try to use it.
- $encryption = $self->_password_encryption;
- if (!$encryption) {
- # use the system default
- undef $encoding;
- }
- }
-
- if ( !$encoding ) {
- # set encoding to system default
- ($encoding, $encryption) =
- split(/-/, lc($conf->config('default-password-encoding')));
- $encoding ||= 'legacy';
- $self->_password_encoding($encoding);
- }
-
- 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 {
- # 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})$/ ) {
- $pass = $1.$3;
- $self->_password_encoding('crypt');
- # Various disabled crypt passwords
- } elsif ( $pass eq '*' || $pass eq '!' || $pass eq '!!' ) {
- $self->_password_encoding('crypt');
- } else {
- return $failure;
- }
- }
-
- $self->_password($pass);
- return;
-
- }
-
- 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') {
- $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]);
- }
-
- } elsif ( $encoding eq 'ldap' ) {
- if ($encryption eq 'md5') {
- $pass = md5_base64($pass);
- } elsif ($encryption eq 'sha1') {
- $pass = sha1_base64($pass);
- } elsif ($encryption eq 'crypt') {
- $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]);
- }
- # else $encryption eq 'plain', do nothing
- $pass = '{'.uc($encryption).'}'.$pass;
- }
- # else encoding eq 'plain'
-
- $self->_password($pass);
- return;
-}
-
-=item _check_system
-
-Internal function to check the username against the list of system usernames
-from the I<system_usernames> configuration value. Returns true if the username
-is listed on the system username list.
-
-=cut
-
-sub _check_system {
- my $self = shift;
- scalar( grep { $self->username eq $_ || $self->email eq $_ }
- $conf->config('system_usernames')
- );
-}
-
-=item _check_duplicate
-
-Internal method to check for duplicates usernames, username@domain pairs and
-uids.
-
-If the I<global_unique-username> configuration value is set to B<username> or
-B<username@domain>, enforces global username or username@domain uniqueness.
-
-In all cases, check for duplicate uids and usernames or username@domain pairs
-per export and with identical I<svcpart> values.
-
-=cut
-
-sub _check_duplicate {
- my $self = shift;
-
- my $global_unique = $conf->config('global_unique-username') || 'none';
- return '' if $global_unique eq 'disabled';
-
- $self->lock_table;
-
- my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
- unless ( $part_svc ) {
- return 'unknown svcpart '. $self->svcpart;
- }
-
- my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
- qsearch( 'svc_acct', { 'username' => $self->username } );
- return gettext('username_in_use')
- if $global_unique eq 'username' && @dup_user;
-
- my @dup_userdomain = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
- qsearch( 'svc_acct', { 'username' => $self->username,
- 'domsvc' => $self->domsvc } );
- return gettext('username_in_use')
- if $global_unique eq 'username@domain' && @dup_userdomain;
-
- my @dup_uid;
- if ( $part_svc->part_svc_column('uid')->columnflag ne 'F'
- && $self->username !~ /^(toor|(hyla)?fax)$/ ) {
- @dup_uid = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
- qsearch( 'svc_acct', { 'uid' => $self->uid } );
- } else {
- @dup_uid = ();
- }
-
- if ( @dup_user || @dup_userdomain || @dup_uid ) {
- my $exports = FS::part_export::export_info('svc_acct');
- my %conflict_user_svcpart;
- my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', );
-
- foreach my $part_export ( $part_svc->part_export ) {
-
- #this will catch to the same exact export
- my @svcparts = map { $_->svcpart } $part_export->export_svc;
-
- #this will catch to exports w/same exporthost+type ???
- #my @other_part_export = qsearch('part_export', {
- # 'machine' => $part_export->machine,
- # 'exporttype' => $part_export->exporttype,
- #} );
- #foreach my $other_part_export ( @other_part_export ) {
- # push @svcparts, map { $_->svcpart }
- # qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
- #}
-
- #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'};
- #silly kludge to avoid uninitialized value errors
- my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} )
- ? $exports->{$part_export->exporttype}{'nodomain'}
- : '';
- if ( $nodomain =~ /^Y/i ) {
- $conflict_user_svcpart{$_} = $part_export->exportnum
- foreach @svcparts;
- } else {
- $conflict_userdomain_svcpart{$_} = $part_export->exportnum
- foreach @svcparts;
- }
- }
-
- foreach my $dup_user ( @dup_user ) {
- my $dup_svcpart = $dup_user->cust_svc->svcpart;
- if ( exists($conflict_user_svcpart{$dup_svcpart}) ) {
- return "duplicate username ". $self->username.
- ": conflicts with svcnum ". $dup_user->svcnum.
- " via exportnum ". $conflict_user_svcpart{$dup_svcpart};
- }
- }
-
- foreach my $dup_userdomain ( @dup_userdomain ) {
- my $dup_svcpart = $dup_userdomain->cust_svc->svcpart;
- if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
- return "duplicate username\@domain ". $self->email.
- ": conflicts with svcnum ". $dup_userdomain->svcnum.
- " via exportnum ". $conflict_userdomain_svcpart{$dup_svcpart};
- }
- }
-
- foreach my $dup_uid ( @dup_uid ) {
- my $dup_svcpart = $dup_uid->cust_svc->svcpart;
- if ( exists($conflict_user_svcpart{$dup_svcpart})
- || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
- return "duplicate uid ". $self->uid.
- ": conflicts with svcnum ". $dup_uid->svcnum.
- " via exportnum ".
- ( $conflict_user_svcpart{$dup_svcpart}
- || $conflict_userdomain_svcpart{$dup_svcpart} );
- }
- }
-
- }
-
- return '';
-
-}
-
-=item radius
-
-Depriciated, use radius_reply instead.
-
-=cut
-
-sub radius {
- carp "FS::svc_acct::radius depriciated, use radius_reply";
- $_[0]->radius_reply;
-}
-
-=item radius_reply
-
-Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
-reply attributes of this record.
-
-Note that this is now the preferred method for reading RADIUS attributes -
-accessing the columns directly is discouraged, as the column names are
-expected to change in the future.
-
-=cut
-
-sub radius_reply {
- my $self = shift;
-
- return %{ $self->{'radius_reply'} }
- if exists $self->{'radius_reply'};
-
- my %reply =
- map {
- /^(radius_(.*))$/;
- my($column, $attrib) = ($1, $2);
- #$attrib =~ s/_/\-/g;
- ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
- } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
-
- if ( $self->slipip && $self->slipip ne '0e0' ) {
- $reply{$radius_ip} = $self->slipip;
- }
-
- if ( $self->seconds !~ /^$/ ) {
- $reply{'Session-Timeout'} = $self->seconds;
- }
-
- if ( $conf->exists('radius-chillispot-max') ) {
- #http://dev.coova.org/svn/coova-chilli/doc/dictionary.chillispot
-
- #hmm. just because sqlradius.pm says so?
- my %whatis = (
- 'input' => 'up',
- 'output' => 'down',
- 'total' => 'total',
- );
-
- foreach my $what (qw( input output total )) {
- my $is = $whatis{$what}.'bytes';
- if ( $self->$is() =~ /\d/ ) {
- my $big = new Math::BigInt $self->$is();
- $big = new Math::BigInt '0' if $big->is_neg();
- my $att = "Chillispot-Max-\u$what";
- $reply{"$att-Octets"} = $big->copy->band(0xffffffff)->bstr;
- $reply{"$att-Gigawords"} = $big->copy->brsft(32)->bstr;
- }
- }
-
- }
-
- %reply;
-}
-
-=item radius_check
-
-Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
-check attributes of this record.
-
-Note that this is now the preferred method for reading RADIUS attributes -
-accessing the columns directly is discouraged, as the column names are
-expected to change in the future.
-
-=cut
-
-sub radius_check {
- my $self = shift;
-
- return %{ $self->{'radius_check'} }
- if exists $self->{'radius_check'};
-
- my %check =
- map {
- /^(rc_(.*))$/;
- my($column, $attrib) = ($1, $2);
- #$attrib =~ s/_/\-/g;
- ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
- } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
-
-
- my($pw_attrib, $password) = $self->radius_password;
- $check{$pw_attrib} = $password;
-
- my $cust_svc = $self->cust_svc;
- if ( $cust_svc ) {
- my $cust_pkg = $cust_svc->cust_pkg;
- if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) {
- $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html
- }
- } else {
- warn "WARNING: no cust_svc record for svc_acct.svcnum ". $self->svcnum.
- "; can't set Expiration\n"
- unless $cust_svc;
- }
-
- %check;
-
-}
-
-=item radius_password
-
-Returns a key/value pair containing the RADIUS attribute name and value
-for the password.
-
-=cut
-
-sub radius_password {
- my $self = shift;
-
- my $pw_attrib;
- if ( $self->_password_encoding eq 'ldap' ) {
- $pw_attrib = 'Password-With-Header';
- } elsif ( $self->_password_encoding eq 'crypt' ) {
- $pw_attrib = 'Crypt-Password';
- } elsif ( $self->_password_encoding eq 'plain' ) {
- $pw_attrib = $radius_password;
- } else {
- $pw_attrib = length($self->_password) <= 12
- ? $radius_password
- : 'Crypt-Password';
- }
-
- ($pw_attrib, $self->_password);
-
-}
-
-=item snapshot
-
-This method instructs the object to "snapshot" or freeze RADIUS check and
-reply attributes to the current values.
-
-=cut
-
-#bah, my english is too broken this morning
-#Of note is the "Expiration" attribute, which, for accounts in prepaid packages, is typically defined on-the-fly as the associated packages cust_pkg.bill. (This is used by
-#the FS::cust_pkg's replace method to trigger the correct export updates when
-#package dates change)
-
-sub snapshot {
- my $self = shift;
-
- $self->{$_} = { $self->$_() }
- foreach qw( radius_reply radius_check );
-
-}
-
-=item forget_snapshot
-
-This methos instructs the object to forget any previously snapshotted
-RADIUS check and reply attributes.
-
-=cut
-
-sub forget_snapshot {
- my $self = shift;
-
- delete $self->{$_}
- foreach qw( radius_reply radius_check );
-
-}
-
-=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;
- my $svc_domain = $self->svc_domain(@_)
- or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
- $svc_domain->domain;
-}
-
-=item cust_svc
-
-Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
-
-=cut
-
-#inherited from svc_Common
-
-=item email [ END_TIMESTAMP [ START_TIMESTAMP ] ]
-
-Returns an email address associated with the account.
-
-END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
-history records.
-
-=cut
-
-sub email {
- my $self = shift;
- $self->username. '@'. $self->domain(@_);
-}
-
-=item acct_snarf
-
-Returns an array of FS::acct_snarf records associated with the account.
-
-=cut
-
-sub acct_snarf {
- my $self = shift;
- qsearch({
- 'table' => 'acct_snarf',
- 'hashref' => { 'svcnum' => $self->svcnum },
- #'order_by' => 'ORDER BY priority ASC',
- });
-}
-
-=item cgp_rpop_hashref
-
-Returns an arrayref of RPOP data suitable for Communigate Pro API commands.
-
-=cut
-
-sub cgp_rpop_hashref {
- my $self = shift;
- { map { $_->snarfname => $_->cgp_hashref } $self->acct_snarf };
-}
-
-=item decrement_upbytes OCTETS
-
-Decrements the I<upbytes> field of this record by the given amount. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub decrement_upbytes {
- shift->_op_usage('-', 'upbytes', @_);
-}
-
-=item increment_upbytes OCTETS
-
-Increments the I<upbytes> field of this record by the given amount. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub increment_upbytes {
- shift->_op_usage('+', 'upbytes', @_);
-}
-
-=item decrement_downbytes OCTETS
-
-Decrements the I<downbytes> field of this record by the given amount. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub decrement_downbytes {
- shift->_op_usage('-', 'downbytes', @_);
-}
-
-=item increment_downbytes OCTETS
-
-Increments the I<downbytes> field of this record by the given amount. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub increment_downbytes {
- shift->_op_usage('+', 'downbytes', @_);
-}
-
-=item decrement_totalbytes OCTETS
-
-Decrements the I<totalbytes> field of this record by the given amount. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub decrement_totalbytes {
- shift->_op_usage('-', 'totalbytes', @_);
-}
-
-=item increment_totalbytes OCTETS
-
-Increments the I<totalbytes> field of this record by the given amount. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub increment_totalbytes {
- shift->_op_usage('+', 'totalbytes', @_);
-}
-
-=item decrement_seconds SECONDS
-
-Decrements the I<seconds> field of this record by the given amount. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub decrement_seconds {
- shift->_op_usage('-', 'seconds', @_);
-}
-
-=item increment_seconds SECONDS
-
-Increments the I<seconds> field of this record by the given amount. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub increment_seconds {
- shift->_op_usage('+', 'seconds', @_);
-}
-
-
-my %op2action = (
- '-' => 'suspend',
- '+' => 'unsuspend',
-);
-my %op2condition = (
- '-' => sub { my($self, $column, $amount) = @_;
- $self->$column - $amount <= 0;
- },
- '+' => sub { my($self, $column, $amount) = @_;
- ($self->$column || 0) + $amount > 0;
- },
-);
-my %op2warncondition = (
- '-' => sub { my($self, $column, $amount) = @_;
- my $threshold = $column . '_threshold';
- $self->$column - $amount <= $self->$threshold + 0;
- },
- '+' => sub { my($self, $column, $amount) = @_;
- ($self->$column || 0) + $amount > 0;
- },
-);
-
-sub _op_usage {
- my( $self, $op, $column, $amount ) = @_;
-
- warn "$me _op_usage called for $column on svcnum ". $self->svcnum.
- ' ('. $self->email. "): $op $amount\n"
- if $DEBUG;
-
- return '' unless $amount;
-
- 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 $sql = "UPDATE svc_acct SET $column = ".
- " CASE WHEN $column IS NULL THEN 0 ELSE $column END ". #$column||0
- " $op ? WHERE svcnum = ?";
- warn "$me $sql\n"
- if $DEBUG;
-
- my $sth = $dbh->prepare( $sql )
- or die "Error preparing $sql: ". $dbh->errstr;
- my $rv = $sth->execute($amount, $self->svcnum);
- die "Error executing $sql: ". $sth->errstr
- unless defined($rv);
- die "Can't update $column for svcnum". $self->svcnum
- if $rv == 0;
-
- #$self->snapshot; #not necessary, we retain the old values
- #create an object with the updated usage values
- my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
- #call exports
- my $error = $new->replace($self);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error replacing: $error";
- }
-
- #overlimit_action eq 'cancel' handling
- my $cust_pkg = $self->cust_svc->cust_pkg;
- if ( $cust_pkg
- && $cust_pkg->part_pkg->option('overlimit_action', 1) eq 'cancel'
- && $op eq '-' && &{$op2condition{$op}}($self, $column, $amount)
- )
- {
-
- my $error = $cust_pkg->cancel; #XXX should have a reason
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error cancelling: $error";
- }
-
- #nothing else is relevant if we're cancelling, so commit & return success
- warn "$me update successful; committing\n"
- if $DEBUG;
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return '';
-
- }
-
- my $action = $op2action{$op};
-
- if ( &{$op2condition{$op}}($self, $column, $amount) &&
- ( $action eq 'suspend' && !$self->overlimit
- || $action eq 'unsuspend' && $self->overlimit )
- ) {
-
- my $error = $self->_op_overlimit($action);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- }
-
- if ( $conf->exists("svc_acct-usage_$action")
- && &{$op2condition{$op}}($self, $column, $amount) ) {
- #my $error = $self->$action();
- my $error = $self->cust_svc->cust_pkg->$action();
- # $error ||= $self->overlimit($action);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error ${action}ing: $error";
- }
- }
-
- if ($warning_template && &{$op2warncondition{$op}}($self, $column, $amount)) {
- my $wqueue = new FS::queue {
- 'svcnum' => $self->svcnum,
- 'job' => 'FS::svc_acct::reached_threshold',
- };
-
- my $to = '';
- if ($op eq '-'){
- $to = $warning_cc if &{$op2condition{$op}}($self, $column, $amount);
- }
-
- # x_threshold race
- my $error = $wqueue->insert(
- 'svcnum' => $self->svcnum,
- 'op' => $op,
- 'column' => $column,
- 'to' => $to,
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error queuing threshold activity: $error";
- }
- }
-
- warn "$me update successful; committing\n"
- if $DEBUG;
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-sub _op_overlimit {
- my( $self, $action ) = @_;
-
- 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 $cust_pkg = $self->cust_svc->cust_pkg;
-
- my $conf_overlimit =
- $cust_pkg
- ? $conf->config('overlimit_groups', $cust_pkg->cust_main->agentnum )
- : $conf->config('overlimit_groups');
-
- foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
-
- my $groups = $conf_overlimit || $part_export->option('overlimit_groups');
- next unless $groups;
-
- my $gref = &{ $self->_fieldhandlers->{'usergroup'} }( $self, $groups );
-
- my $other = new FS::svc_acct $self->hashref;
- $other->usergroup( $gref );
-
- my($new,$old);
- if ($action eq 'suspend') {
- $new = $other;
- $old = $self;
- } else { # $action eq 'unsuspend'
- $new = $self;
- $old = $other;
- }
-
- my $error = $part_export->export_replace($new, $old)
- || $self->overlimit($action);
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error replacing radius groups: $error";
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-sub set_usage {
- my( $self, $valueref, %options ) = @_;
-
- warn "$me set_usage called for svcnum ". $self->svcnum.
- ' ('. $self->email. "): ".
- join(', ', map { "$_ => " . $valueref->{$_}} keys %$valueref) . "\n"
- if $DEBUG;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- local $FS::svc_Common::noexport_hack = 1;
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $reset = 0;
- my %handyhash = ();
- if ( $options{null} ) {
- %handyhash = ( map { ( $_ => undef, $_."_threshold" => undef ) }
- qw( seconds upbytes downbytes totalbytes )
- );
- }
- foreach my $field (keys %$valueref){
- $reset = 1 if $valueref->{$field};
- $self->setfield($field, $valueref->{$field});
- $self->setfield( $field.'_threshold',
- int($self->getfield($field)
- * ( $conf->exists('svc_acct-usage_threshold')
- ? 1 - $conf->config('svc_acct-usage_threshold')/100
- : 0.20
- )
- )
- );
- $handyhash{$field} = $self->getfield($field);
- $handyhash{$field.'_threshold'} = $self->getfield($field.'_threshold');
- }
- #my $error = $self->replace; #NO! we avoid the call to ->check for
- #die $error if $error; #services not explicity changed via the UI
-
- my $sql = "UPDATE svc_acct SET " .
- join (',', map { "$_ = ?" } (keys %handyhash) ).
- " WHERE svcnum = ". $self->svcnum;
-
- warn "$me $sql\n"
- if $DEBUG;
-
- if (scalar(keys %handyhash)) {
- my $sth = $dbh->prepare( $sql )
- or die "Error preparing $sql: ". $dbh->errstr;
- my $rv = $sth->execute(values %handyhash);
- die "Error executing $sql: ". $sth->errstr
- unless defined($rv);
- die "Can't update usage for svcnum ". $self->svcnum
- if $rv == 0;
- }
-
- #$self->snapshot; #not necessary, we retain the old values
- #create an object with the updated usage values
- my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
- local($FS::Record::nowarn_identical) = 1;
- my $error = $new->replace($self); #call exports
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error replacing: $error";
- }
-
- if ( $reset ) {
-
- my $error = '';
-
- $error = $self->_op_overlimit('unsuspend')
- if $self->overlimit;;
-
- $error ||= $self->cust_svc->cust_pkg->unsuspend
- if $conf->exists("svc_acct-usage_unsuspend");
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error unsuspending: $error";
- }
-
- }
-
- warn "$me update successful; committing\n"
- if $DEBUG;
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-
-}
-
-
-=item recharge HASHREF
-
- Increments usage columns by the amount specified in HASHREF as
- column=>amount pairs.
-
-=cut
-
-sub recharge {
- my ($self, $vhash) = @_;
-
- if ( $DEBUG ) {
- warn "[$me] recharge called on $self: ". Dumper($self).
- "\nwith vhash: ". Dumper($vhash);
- }
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
- my $error = '';
-
- foreach my $column (keys %$vhash){
- $error ||= $self->_op_usage('+', $column, $vhash->{$column});
- }
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- }else{
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- }
- return $error;
-}
-
-=item is_rechargeable
-
-Returns true if this svc_account can be "recharged" and false otherwise.
-
-=cut
-
-sub is_rechargable {
- my $self = shift;
- $self->seconds ne ''
- || $self->upbytes ne ''
- || $self->downbytes ne ''
- || $self->totalbytes ne '';
-}
-
-=item seconds_since TIMESTAMP
-
-Returns the number of seconds this account has been online since TIMESTAMP,
-according to the session monitor (see L<FS::Session>).
-
-TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=cut
-
-#note: POD here, implementation in FS::cust_svc
-sub seconds_since {
- my $self = shift;
- $self->cust_svc->seconds_since(@_);
-}
-
-=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
-
-Returns the numbers of seconds this account has been online between
-TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an
-external SQL radacct table, specified via sqlradius export. Sessions which
-started in the specified range but are still open are counted from session
-start to the end of the range (unless they are over 1 day old, in which case
-they are presumed missing their stop record and not counted). Also, sessions
-which end in the range but started earlier are counted from the start of the
-range to session end. Finally, sessions which start before the range but end
-after are counted for the entire range.
-
-TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
-L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-=cut
-
-#note: POD here, implementation in FS::cust_svc
-sub seconds_since_sqlradacct {
- my $self = shift;
- $self->cust_svc->seconds_since_sqlradacct(@_);
-}
-
-=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
-
-Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
-in this package for sessions ending between TIMESTAMP_START (inclusive) and
-TIMESTAMP_END (exclusive).
-
-TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
-L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-=cut
-
-#note: POD here, implementation in FS::cust_svc
-sub attribute_since_sqlradacct {
- my $self = shift;
- $self->cust_svc->attribute_since_sqlradacct(@_);
-}
-
-=item get_session_history TIMESTAMP_START TIMESTAMP_END
-
-Returns an array of hash references of this customers login history for the
-given time range. (document this better)
-
-=cut
-
-sub get_session_history {
- my $self = shift;
- $self->cust_svc->get_session_history(@_);
-}
-
-=item last_login_text
-
-Returns text describing the time of last login.
-
-=cut
-
-sub last_login_text {
- my $self = shift;
- $self->last_login ? ctime($self->last_login) : 'unknown';
-}
-
-=item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ]
-
-=cut
-
-sub get_cdrs {
- my($self, $start, $end, %opt ) = @_;
-
- my $did = $self->username; #yup
-
- my $prefix = $opt{'default_prefix'}; #convergent.au '+61'
-
- my $for_update = $opt{'for_update'} ? 'FOR UPDATE' : '';
-
- #SELECT $for_update * FROM cdr
- # WHERE calldate >= $start #need a conversion
- # AND calldate < $end #ditto
- # AND ( charged_party = "$did"
- # OR charged_party = "$prefix$did" #if length($prefix);
- # OR ( ( charged_party IS NULL OR charged_party = '' )
- # AND
- # ( src = "$did" OR src = "$prefix$did" ) # if length($prefix)
- # )
- # )
- # AND ( freesidestatus IS NULL OR freesidestatus = '' )
-
- my $charged_or_src;
- if ( length($prefix) ) {
- $charged_or_src =
- " AND ( charged_party = '$did'
- OR charged_party = '$prefix$did'
- OR ( ( charged_party IS NULL OR charged_party = '' )
- AND
- ( src = '$did' OR src = '$prefix$did' )
- )
- )
- ";
- } else {
- $charged_or_src =
- " AND ( charged_party = '$did'
- OR ( ( charged_party IS NULL OR charged_party = '' )
- AND
- src = '$did'
- )
- )
- ";
-
- }
-
- qsearch(
- 'select' => "$for_update *",
- 'table' => 'cdr',
- 'hashref' => {
- #( freesidestatus IS NULL OR freesidestatus = '' )
- 'freesidestatus' => '',
- },
- 'extra_sql' => $charged_or_src,
-
- );
-
-}
-
-=item radius_groups
-
-Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
-
-=cut
-
-sub radius_groups {
- my $self = shift;
- if ( $self->usergroup ) {
- confess "explicitly specified usergroup not an arrayref: ". $self->usergroup
- unless ref($self->usergroup) eq 'ARRAY';
- #when provisioning records, export callback runs in svc_Common.pm before
- #radius_usergroup records can be inserted...
- @{$self->usergroup};
- } else {
- map { $_->groupname }
- qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
- }
-}
-
-=item clone_suspended
-
-Constructor used by FS::part_export::_export_suspend fallback. Document
-better.
-
-=cut
-
-sub clone_suspended {
- my $self = shift;
- my %hash = $self->hash;
- $hash{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
- new FS::svc_acct \%hash;
-}
-
-=item clone_kludge_unsuspend
-
-Constructor used by FS::part_export::_export_unsuspend fallback. Document
-better.
-
-=cut
-
-sub clone_kludge_unsuspend {
- my $self = shift;
- my %hash = $self->hash;
- $hash{_password} = '';
- new FS::svc_acct \%hash;
-}
-
-=item check_password
-
-Checks the supplied password against the (possibly encrypted) password in the
-database. Returns true for a successful authentication, false for no match.
-
-Currently supported encryptions are: classic DES crypt() and MD5
-
-=cut
-
-sub check_password {
- my($self, $check_password) = @_;
-
- #remove old-style SUSPENDED kludge, they should be allowed to login to
- #self-service and pay up
- ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //;
-
- if ( $self->_password_encoding eq 'ldap' ) {
-
- my $auth = from_rfc2307 Authen::Passphrase $self->_password;
- return $auth->match($check_password);
-
- } elsif ( $self->_password_encoding eq 'crypt' ) {
-
- my $auth = from_crypt Authen::Passphrase $self->_password;
- return $auth->match($check_password);
-
- } elsif ( $self->_password_encoding eq 'plain' ) {
-
- return $check_password eq $password;
-
- } else {
-
- #XXX this could be replaced with Authen::Passphrase stuff
-
- if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login
- return 0;
- } elsif ( length($password) < 13 ) { #plaintext
- $check_password eq $password;
- } elsif ( length($password) == 13 ) { #traditional DES crypt
- crypt($check_password, $password) eq $password;
- } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt
- unix_md5_crypt($check_password, $password) eq $password;
- } elsif ( $password =~ /^\$2a?\$/ ) { #Blowfish
- warn "Can't check password: Blowfish encryption not yet supported, ".
- "svcnum ". $self->svcnum. "\n";
- 0;
- } else {
- warn "Can't check password: Unrecognized encryption for svcnum ".
- $self->svcnum. "\n";
- 0;
- }
-
- }
-
-}
-
-=item crypt_password [ DEFAULT_ENCRYPTION_TYPE ]
-
-Returns an encrypted password, either by passing through an encrypted password
-in the database or by encrypting a plaintext password from the database.
-
-The optional DEFAULT_ENCRYPTION_TYPE parameter can be set to I<crypt> (classic
-UNIX DES crypt), I<md5> (md5 crypt supported by most modern Linux and BSD
-distrubtions), or (eventually) I<blowfish> (blowfish hashing supported by
-OpenBSD, SuSE, other Linux distibutions with pam_unix2, etc.). The default
-encryption type is only used if the password is not already encrypted in the
-database.
-
-=cut
-
-sub crypt_password {
- my $self = shift;
-
- if ( $self->_password_encoding eq 'ldap' ) {
-
- if ( $self->_password =~ /^\{(PLAIN|CLEARTEXT)\}(.+)$/ ) {
- my $plain = $2;
-
- #XXX this could be replaced with Authen::Passphrase stuff
-
- my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
- if ( $encryption eq 'crypt' ) {
- crypt(
- $self->_password,
- $saltset[int(rand(64))].$saltset[int(rand(64))]
- );
- } elsif ( $encryption eq 'md5' ) {
- unix_md5_crypt( $self->_password );
- } elsif ( $encryption eq 'blowfish' ) {
- croak "unknown encryption method $encryption";
- } else {
- croak "unknown encryption method $encryption";
- }
-
- } elsif ( $self->_password =~ /^\{CRYPT\}(.+)$/ ) {
- $1;
- }
-
- } elsif ( $self->_password_encoding eq 'crypt' ) {
-
- return $self->_password;
-
- } elsif ( $self->_password_encoding eq 'plain' ) {
-
- #XXX this could be replaced with Authen::Passphrase stuff
-
- my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
- if ( $encryption eq 'crypt' ) {
- crypt(
- $self->_password,
- $saltset[int(rand(64))].$saltset[int(rand(64))]
- );
- } elsif ( $encryption eq 'md5' ) {
- unix_md5_crypt( $self->_password );
- } elsif ( $encryption eq 'blowfish' ) {
- croak "unknown encryption method $encryption";
- } else {
- croak "unknown encryption method $encryption";
- }
-
- } else {
-
- if ( length($self->_password) == 13
- || $self->_password =~ /^\$(1|2a?)\$/
- || $self->_password =~ /^(\*|NP|\*LK\*|!!?)$/
- )
- {
- $self->_password;
- } else {
-
- #XXX this could be replaced with Authen::Passphrase stuff
-
- my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
- if ( $encryption eq 'crypt' ) {
- crypt(
- $self->_password,
- $saltset[int(rand(64))].$saltset[int(rand(64))]
- );
- } elsif ( $encryption eq 'md5' ) {
- unix_md5_crypt( $self->_password );
- } elsif ( $encryption eq 'blowfish' ) {
- croak "unknown encryption method $encryption";
- } else {
- croak "unknown encryption method $encryption";
- }
-
- }
-
- }
-
-}
-
-=item ldap_password [ DEFAULT_ENCRYPTION_TYPE ]
-
-Returns an encrypted password in "LDAP" format, with a curly-bracked prefix
-describing the format, for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or
-"{MD5}5426824942db4253f87a1009fd5d2d4".
-
-The optional DEFAULT_ENCRYPTION_TYPE is not yet used, but the idea is for it
-to work the same as the B</crypt_password> method.
-
-=cut
-
-sub ldap_password {
- my $self = shift;
- #eventually should check a "password-encoding" field
-
- if ( $self->_password_encoding eq 'ldap' ) {
-
- return $self->_password;
-
- } elsif ( $self->_password_encoding eq 'crypt' ) {
-
- if ( length($self->_password) == 13 ) { #crypt
- return '{CRYPT}'. $self->_password;
- } elsif ( $self->_password =~ /^\$1\$(.*)$/ && length($1) == 31 ) { #passwdMD5
- return '{MD5}'. $1;
- #} elsif ( $self->_password =~ /^\$2a?\$(.*)$/ ) { #Blowfish
- # die "Blowfish encryption not supported in this context, svcnum ".
- # $self->svcnum. "\n";
- } else {
- warn "encryption method not (yet?) supported in LDAP context";
- return '{CRYPT}*'; #unsupported, should not auth
- }
-
- } elsif ( $self->_password_encoding eq 'plain' ) {
-
- return '{PLAIN}'. $self->_password;
-
- #return '{CLEARTEXT}'. $self->_password; #?
-
- } else {
-
- if ( length($self->_password) == 13 ) { #crypt
- return '{CRYPT}'. $self->_password;
- } elsif ( $self->_password =~ /^\$1\$(.*)$/ && length($1) == 31 ) { #passwdMD5
- return '{MD5}'. $1;
- } elsif ( $self->_password =~ /^\$2a?\$(.*)$/ ) { #Blowfish
- warn "Blowfish encryption not supported in this context, svcnum ".
- $self->svcnum. "\n";
- return '{CRYPT}*';
-
- #are these two necessary anymore?
- } elsif ( $self->_password =~ /^(\w{48})$/ ) { #LDAP SSHA
- return '{SSHA}'. $1;
- } elsif ( $self->_password =~ /^(\w{64})$/ ) { #LDAP NS-MTA-MD5
- return '{NS-MTA-MD5}'. $1;
-
- } else { #plaintext
- return '{PLAIN}'. $self->_password;
-
- #return '{CLEARTEXT}'. $self->_password; #?
-
- #XXX this could be replaced with Authen::Passphrase stuff if it gets used
- #my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
- #if ( $encryption eq 'crypt' ) {
- # return '{CRYPT}'. crypt(
- # $self->_password,
- # $saltset[int(rand(64))].$saltset[int(rand(64))]
- # );
- #} elsif ( $encryption eq 'md5' ) {
- # unix_md5_crypt( $self->_password );
- #} elsif ( $encryption eq 'blowfish' ) {
- # croak "unknown encryption method $encryption";
- #} else {
- # croak "unknown encryption method $encryption";
- #}
- }
-
- }
-
-}
-
-=item domain_slash_username
-
-Returns $domain/$username/
-
-=cut
-
-sub domain_slash_username {
- my $self = shift;
- $self->domain. '/'. $self->username. '/';
-}
-
-=item virtual_maildir
-
-Returns $domain/maildirs/$username/
-
-=cut
-
-sub virtual_maildir {
- my $self = shift;
- $self->domain. '/maildirs/'. $self->username. '/';
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item search HASHREF
-
-Class method which returns a qsearch hash expression to search for parameters
-specified in HASHREF. Valid parameters are
-
-=over 4
-
-=item domain
-
-=item domsvc
-
-=item unlinked
-
-=item agentnum
-
-=item pkgpart
-
-Arrayref of pkgparts
-
-=item pkgpart
-
-=item where
-
-Arrayref of additional WHERE clauses, will be ANDed together.
-
-=item order_by
-
-=item cust_fields
-
-=back
-
-=cut
-
-sub search {
- my ($class, $params) = @_;
-
- my @where = ();
-
- # domain
- if ( $params->{'domain'} ) {
- my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
- #preserve previous behavior & bubble up an error if $svc_domain not found?
- push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
- }
-
- # domsvc
- if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
- push @where, "domsvc = $1";
- }
-
- #unlinked
- push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
-
- #agentnum
- if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
- push @where, "agentnum = $1";
- }
-
- #custnum
- if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
- push @where, "custnum = $1";
- }
-
- #pkgpart
- if ( $params->{'pkgpart'} && scalar(@{ $params->{'pkgpart'} }) ) {
- #XXX untaint or sql quote
- push @where,
- 'cust_pkg.pkgpart IN ('. join(',', @{ $params->{'pkgpart'} } ). ')';
- }
-
- # popnum
- if ( $params->{'popnum'} =~ /^(\d+)$/ ) {
- push @where, "popnum = $1";
- }
-
- # svcpart
- if ( $params->{'svcpart'} =~ /^(\d+)$/ ) {
- push @where, "svcpart = $1";
- }
-
-
- # here is the agent virtualization
- #if ($params->{CurrentUser}) {
- # my $access_user =
- # qsearchs('access_user', { username => $params->{CurrentUser} });
- #
- # if ($access_user) {
- # push @where, $access_user->agentnums_sql('table'=>'cust_main');
- # }else{
- # push @where, "1=0";
- # }
- #} else {
- push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
- 'table' => 'cust_main',
- 'null_right' => 'View/link unlinked services',
- );
- #}
-
- push @where, @{ $params->{'where'} } if $params->{'where'};
-
- my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
-
- my $addl_from = ' LEFT JOIN cust_svc USING ( svcnum ) '.
- ' LEFT JOIN part_svc USING ( svcpart ) '.
- ' LEFT JOIN cust_pkg USING ( pkgnum ) '.
- ' LEFT JOIN cust_main USING ( custnum ) ';
-
- my $count_query = "SELECT COUNT(*) FROM svc_acct $addl_from $extra_sql";
- #if ( keys %svc_acct ) {
- # $count_query .= ' WHERE '.
- # join(' AND ', map "$_ = ". dbh->quote($svc_acct{$_}),
- # keys %svc_acct
- # );
- #}
-
- my $sql_query = {
- 'table' => 'svc_acct',
- 'hashref' => {}, # \%svc_acct,
- 'select' => join(', ',
- 'svc_acct.*',
- 'part_svc.svc',
- 'cust_main.custnum',
- FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
- ),
- 'addl_from' => $addl_from,
- 'extra_sql' => $extra_sql,
- 'order_by' => $params->{'order_by'},
- 'count_query' => $count_query,
- };
-
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item send_email
-
-This is the FS::svc_acct job-queue-able version. It still uses
-FS::Misc::send_email under-the-hood.
-
-=cut
-
-sub send_email {
- my %opt = @_;
-
- eval "use FS::Misc qw(send_email)";
- die $@ if $@;
-
- $opt{mimetype} ||= 'text/plain';
- $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/;
-
- my $error = send_email(
- 'from' => $opt{from},
- 'to' => $opt{to},
- 'subject' => $opt{subject},
- 'content-type' => $opt{mimetype},
- 'body' => [ map "$_\n", split("\n", $opt{body}) ],
- );
- die $error if $error;
-}
-
-=item check_and_rebuild_fuzzyfiles
-
-=cut
-
-sub check_and_rebuild_fuzzyfiles {
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- -e "$dir/svc_acct.username"
- or &rebuild_fuzzyfiles;
-}
-
-=item rebuild_fuzzyfiles
-
-=cut
-
-sub rebuild_fuzzyfiles {
-
- use Fcntl qw(:flock);
-
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
-
- #username
-
- open(USERNAMELOCK,">>$dir/svc_acct.username")
- or die "can't open $dir/svc_acct.username: $!";
- flock(USERNAMELOCK,LOCK_EX)
- or die "can't lock $dir/svc_acct.username: $!";
-
- my @all_username = map $_->getfield('username'), qsearch('svc_acct', {});
-
- open (USERNAMECACHE,">$dir/svc_acct.username.tmp")
- or die "can't open $dir/svc_acct.username.tmp: $!";
- print USERNAMECACHE join("\n", @all_username), "\n";
- close USERNAMECACHE or die "can't close $dir/svc_acct.username.tmp: $!";
-
- rename "$dir/svc_acct.username.tmp", "$dir/svc_acct.username";
- close USERNAMELOCK;
-
-}
-
-=item all_username
-
-=cut
-
-sub all_username {
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- open(USERNAMECACHE,"<$dir/svc_acct.username")
- or die "can't open $dir/svc_acct.username: $!";
- my @array = map { chomp; $_; } <USERNAMECACHE>;
- close USERNAMECACHE;
- \@array;
-}
-
-=item append_fuzzyfiles USERNAME
-
-=cut
-
-sub append_fuzzyfiles {
- my $username = shift;
-
- &check_and_rebuild_fuzzyfiles;
-
- use Fcntl qw(:flock);
-
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
-
- open(USERNAME,">>$dir/svc_acct.username")
- or die "can't open $dir/svc_acct.username: $!";
- flock(USERNAME,LOCK_EX)
- or die "can't lock $dir/svc_acct.username: $!";
-
- print USERNAME "$username\n";
-
- flock(USERNAME,LOCK_UN)
- or die "can't unlock $dir/svc_acct.username: $!";
- close USERNAME;
-
- 1;
-}
-
-
-
-=item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
-
-=cut
-
-sub radius_usergroup_selector {
- my $sel_groups = shift;
- my %sel_groups = map { $_=>1 } @$sel_groups;
-
- my $selectname = shift || 'radius_usergroup';
-
- my $dbh = dbh;
- my $sth = $dbh->prepare(
- 'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
- ) or die $dbh->errstr;
- $sth->execute() or die $sth->errstr;
- my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
-
- my $html = <<END;
- <SCRIPT>
- function ${selectname}_doadd(object) {
- var myvalue = object.${selectname}_add.value;
- var optionName = new Option(myvalue,myvalue,false,true);
- var length = object.$selectname.length;
- object.$selectname.options[length] = optionName;
- object.${selectname}_add.value = "";
- }
- </SCRIPT>
- <SELECT MULTIPLE NAME="$selectname">
-END
-
- foreach my $group ( @all_groups ) {
- $html .= qq(<OPTION VALUE="$group");
- if ( $sel_groups{$group} ) {
- $html .= ' SELECTED';
- $sel_groups{$group} = 0;
- }
- $html .= ">$group</OPTION>\n";
- }
- foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
- $html .= qq(<OPTION VALUE="$group" SELECTED>$group</OPTION>\n);
- };
- $html .= '</SELECT>';
-
- $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
- qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
-
- $html;
-}
-
-=item reached_threshold
-
-Performs some activities when svc_acct thresholds (such as number of seconds
-remaining) are reached.
-
-=cut
-
-sub reached_threshold {
- my %opt = @_;
-
- my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $opt{'svcnum'} } );
- die "Cannot find svc_acct with svcnum " . $opt{'svcnum'} unless $svc_acct;
-
- if ( $opt{'op'} eq '+' ){
- $svc_acct->setfield( $opt{'column'}.'_threshold',
- int($svc_acct->getfield($opt{'column'})
- * ( $conf->exists('svc_acct-usage_threshold')
- ? $conf->config('svc_acct-usage_threshold')/100
- : 0.80
- )
- )
- );
- my $error = $svc_acct->replace;
- die $error if $error;
- }elsif ( $opt{'op'} eq '-' ){
-
- my $threshold = $svc_acct->getfield( $opt{'column'}.'_threshold' );
- return '' if ($threshold eq '' );
-
- $svc_acct->setfield( $opt{'column'}.'_threshold', 0 );
- my $error = $svc_acct->replace;
- die $error if $error; # email next time, i guess
-
- if ( $warning_template ) {
- eval "use FS::Misc qw(send_email)";
- die $@ if $@;
-
- my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
- my $cust_main = $cust_pkg->cust_main;
-
- my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ }
- $cust_main->invoicing_list,
- ($opt{'to'} ? $opt{'to'} : ())
- );
-
- my $mimetype = $warning_mimetype;
- $mimetype .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/;
-
- my $body = $warning_template->fill_in( HASH => {
- 'custnum' => $cust_main->custnum,
- 'username' => $svc_acct->username,
- 'password' => $svc_acct->_password,
- 'first' => $cust_main->first,
- 'last' => $cust_main->getfield('last'),
- 'pkg' => $cust_pkg->part_pkg->pkg,
- 'column' => $opt{'column'},
- 'amount' => $opt{'column'} =~/bytes/
- ? FS::UI::bytecount::display_bytecount($svc_acct->getfield($opt{'column'}))
- : $svc_acct->getfield($opt{'column'}),
- 'threshold' => $opt{'column'} =~/bytes/
- ? FS::UI::bytecount::display_bytecount($threshold)
- : $threshold,
- } );
-
-
- my $error = send_email(
- 'from' => $warning_from,
- 'to' => $to,
- 'subject' => $warning_subject,
- 'content-type' => $mimetype,
- 'body' => [ map "$_\n", split("\n", $body) ],
- );
- die $error if $error;
- }
- }else{
- die "unknown op: " . $opt{'op'};
- }
-}
-
-=back
-
-=head1 BUGS
-
-The $recref stuff in sub check should be cleaned up.
-
-The suspend, unsuspend and cancel methods update the database, but not the
-current object. This is probably a bug as it's unexpected and
-counterintuitive.
-
-radius_usergroup_selector? putting web ui components in here? they should
-probably live somewhere else...
-
-insertion of RADIUS group stuff in insert could be done with child_objects now
-(would probably clean up export of them too)
-
-_op_usage and set_usage bypass the history... maybe they shouldn't
-
-=head1 SEE ALSO
-
-L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
-export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
-L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
-L<freeside-queued>), L<FS::svc_acct_pop>,
-schema.html from the base documentation.
-
-=cut
-
-1;
diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm
deleted file mode 100644
index de41f5b..0000000
--- a/FS/FS/svc_acct_pop.pm
+++ /dev/null
@@ -1,206 +0,0 @@
-package FS::svc_acct_pop;
-
-use strict;
-use vars qw( @ISA @EXPORT_OK @svc_acct_pop %svc_acct_pop );
-use FS::Record qw( qsearch qsearchs );
-
-@ISA = qw( FS::Record Exporter );
-@EXPORT_OK = qw( popselector );
-
-=head1 NAME
-
-FS::svc_acct_pop - Object methods for svc_acct_pop records
-
-=head1 SYNOPSIS
-
- use FS::svc_acct_pop;
-
- $record = new FS::svc_acct_pop \%hash;
- $record = new FS::svc_acct_pop { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $html = FS::svc_acct_pop::popselector( $popnum, $state );
-
-=head1 DESCRIPTION
-
-An FS::svc_acct object represents an point of presence. FS::svc_acct_pop
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item popnum - primary key (assigned automatically for new accounts)
-
-=item city
-
-=item state
-
-=item ac - area code
-
-=item exch - exchange
-
-=item loc - rest of number
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new point of presence (if only it were that easy!). To add the
-point of presence to the database, see L<"insert">.
-
-=cut
-
-sub table { 'svc_acct_pop'; }
-
-=item insert
-
-Adds this point of presence to the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item delete
-
-Removes this point of presence from the database.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid point of presence. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- $self->ut_numbern('popnum')
- or $self->ut_text('city')
- or $self->ut_text('state')
- or $self->ut_number('ac')
- or $self->ut_number('exch')
- or $self->ut_numbern('loc')
- or $self->SUPER::check
- ;
-
-}
-
-=item text
-
-Returns:
-
-"$city, $state ($ac)/$exch"
-
-=cut
-
-sub text {
- my $self = shift;
- $self->city. ', '. $self->state.
- ' ('. $self->ac. ')/'. $self->exch. '-'. $self->loc;
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item popselector [ POPNUM [ STATE ] ]
-
-=cut
-
-#horrible false laziness with signup.cgi (pull special-case for 0 & 1
-# pop code out from signup.cgi??)
-sub popselector {
- my( $popnum, $state ) = @_;
-
- unless ( @svc_acct_pop ) { #cache pop list
- @svc_acct_pop = qsearch('svc_acct_pop', {} );
- %svc_acct_pop = ();
- push @{$svc_acct_pop{$_->state}}, $_ foreach @svc_acct_pop;
- }
-
- my $text = <<END;
- <SCRIPT>
- function opt(what,href,text) {
- var optionName = new Option(text, href, false, false)
- var length = what.length;
- what.options[length] = optionName;
- }
-
- function popstate_changed(what) {
- state = what.options[what.selectedIndex].text;
- what.form.popnum.options.length = 0
- what.form.popnum.options[0] = new Option("", "", false, true);
-END
-
- foreach my $popstate ( sort { $a cmp $b } keys %svc_acct_pop ) {
- $text .= "\nif ( state == \"$popstate\" ) {\n";
-
- foreach my $pop ( @{$svc_acct_pop{$popstate}}) {
- my $o_popnum = $pop->popnum;
- my $poptext = $pop->text;
- $text .= "opt(what.form.popnum, \"$o_popnum\", \"$poptext\");\n"
- }
- $text .= "}\n";
- }
-
- $text .= "}\n</SCRIPT>\n";
-
- $text .=
- qq!<SELECT NAME="popstate" SIZE=1 onChange="popstate_changed(this)">!.
- qq!<OPTION> !;
- $text .= "<OPTION>$_" foreach sort { $a cmp $b } keys %svc_acct_pop;
- $text .= '</SELECT>'; #callback? return 3 html pieces? #'</TD><TD>';
-
- $text .= qq!<SELECT NAME="popnum" SIZE=1><OPTION> !;
- my @initial_select;
- if ( scalar(@svc_acct_pop) > 100 ) {
- @initial_select = qsearchs( 'svc_acct_pop', { 'popnum' => $popnum } );
- } else {
- @initial_select = @svc_acct_pop;
- }
- foreach my $pop ( @initial_select ) {
- $text .= qq!<OPTION VALUE="!. $pop->popnum. '"'.
- ( ( $popnum && $pop->popnum == $popnum ) ? ' SELECTED' : '' ). ">".
- $pop->text;
- }
- $text .= '</SELECT>';
-
- $text;
-
-}
-
-=back
-
-=head1 BUGS
-
-It should be renamed to part_pop.
-
-popselector? putting web ui components in here? they should probably live
-somewhere else...
-
-popselector: pull special-case for 0 & 1 pop code out from signup.cgi
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::svc_acct>, L<FS::part_pop_local>, schema.html from the
-base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm
deleted file mode 100755
index 5ffe0e4..0000000
--- a/FS/FS/svc_broadband.pm
+++ /dev/null
@@ -1,490 +0,0 @@
-package FS::svc_broadband;
-
-use strict;
-use vars qw(@ISA $conf);
-use FS::Record qw( qsearchs qsearch dbh );
-use FS::svc_Common;
-use FS::cust_svc;
-use FS::addr_block;
-use FS::part_svc_router;
-use NetAddr::IP;
-
-@ISA = qw( FS::svc_Common );
-
-$FS::UID::callback{'FS::svc_broadband'} = sub {
- $conf = new FS::Conf;
-};
-
-=head1 NAME
-
-FS::svc_broadband - Object methods for svc_broadband records
-
-=head1 SYNOPSIS
-
- use FS::svc_broadband;
-
- $record = new FS::svc_broadband \%hash;
- $record = new FS::svc_broadband { '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_broadband object represents a 'broadband' Internet connection, such
-as a DSL, cable modem, or fixed wireless link. These services are assumed to
-have the following properties:
-
-FS::svc_broadband inherits from FS::svc_Common. The following fields are
-currently supported:
-
-=over 4
-
-=item svcnum - primary key
-
-=item blocknum - see FS::addr_block
-
-=item
-speed_up - maximum upload speed, in bits per second. If set to zero, upload
-speed will be unlimited. Exports that do traffic shaping should handle this
-correctly, and not blindly set the upload speed to zero and kill the customer's
-connection.
-
-=item
-speed_down - maximum download speed, as above
-
-=item ip_addr - the customer's IP address. If the customer needs more than one
-IP address, set this to the address of the customer's router. As a result, the
-customer's router will have the same address for both its internal and external
-interfaces thus saving address space. This has been found to work on most NAT
-routers available.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new svc_broadband. To add the record to the database, see
-"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_info {
- {
- 'name' => 'Broadband',
- 'name_plural' => 'Broadband services',
- 'longname_plural' => 'Fixed (username-less) broadband services',
- 'display_weight' => 50,
- 'cancel_weight' => 70,
- 'fields' => {
- 'description' => 'Descriptive label for this particular device.',
- 'speed_down' => 'Maximum download speed for this service in Kbps. 0 denotes unlimited.',
- 'speed_up' => 'Maximum upload speed for this service in Kbps. 0 denotes unlimited.',
- 'ip_addr' => 'IP address. Leave blank for automatic assignment.',
- 'blocknum' => { 'label' => 'Address block',
- 'type' => 'select',
- 'select_table' => 'addr_block',
- 'select_key' => 'blocknum',
- 'select_label' => 'cidr',
- 'disable_inventory' => 1,
- },
- },
- };
-}
-
-sub table { 'svc_broadband'; }
-
-sub table_dupcheck_fields { ( 'mac_addr' ); }
-
-=item search HASHREF
-
-Class method which returns a qsearch hash expression to search for parameters
-specified in HASHREF.
-
-Parameters:
-
-=over 4
-
-=item unlinked - set to search for all unlinked services. Overrides all other options.
-
-=item agentnum
-
-=item custnum
-
-=item svcpart
-
-=item ip_addr
-
-=item pkgpart - arrayref
-
-=item routernum - arrayref
-
-=item order_by
-
-=back
-
-=cut
-
-sub search {
- my ($class, $params) = @_;
- my @where = ();
- my @from = (
- 'LEFT JOIN cust_svc USING ( svcnum )',
- 'LEFT JOIN part_svc USING ( svcpart )',
- 'LEFT JOIN cust_pkg USING ( pkgnum )',
- 'LEFT JOIN cust_main USING ( custnum )',
- );
-
- # based on FS::svc_acct::search, probably the most mature of the bunch
- #unlinked
- push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
-
- #agentnum
- if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
- push @where, "agentnum = $1";
- }
- push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
- 'null_right' => 'View/link unlinked services',
- 'table' => 'cust_main'
- );
-
- #custnum
- if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
- push @where, "custnum = $1";
- }
-
- #pkgpart, now properly untainted, can be arrayref
- for my $pkgpart ( $params->{'pkgpart'} ) {
- if ( ref $pkgpart ) {
- my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
- push @where, "cust_pkg.pkgpart IN ($where)" if $where;
- }
- elsif ( $pkgpart =~ /^(\d+)$/ ) {
- push @where, "cust_pkg.pkgpart = $1";
- }
- }
-
- #routernum, can be arrayref
- for my $routernum ( $params->{'routernum'} ) {
- push @from, 'LEFT JOIN addr_block USING ( blocknum )';
- if ( ref $routernum and grep { $_ } @$routernum ) {
- my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$routernum );
- push @where, "addr_block.routernum IN ($where)" if $where;
- }
- elsif ( $routernum =~ /^(\d+)$/ ) {
- push @where, "addr_block.routernum = $1";
- }
- }
-
- #svcnum
- if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
- push @where, "svcnum = $1";
- }
-
- #svcpart
- if ( $params->{'svcpart'} =~ /^(\d+)$/ ) {
- push @where, "svcpart = $1";
- }
-
- #ip_addr
- if ( $params->{'ip_addr'} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ ) {
- push @where, "ip_addr = '$1'";
- }
-
- #custnum
- if ( $params->{'custnum'} =~ /^(\d+)$/ and $1) {
- push @where, "custnum = $1";
- }
-
- my $addl_from = join(' ', @from);
- my $extra_sql = '';
- $extra_sql = 'WHERE '.join(' AND ', @where) if @where;
- my $count_query = "SELECT COUNT(*) FROM svc_broadband $addl_from $extra_sql";
- return( {
- 'table' => 'svc_broadband',
- 'hashref' => {},
- 'select' => join(', ',
- 'svc_broadband.*',
- 'part_svc.svc',
- 'cust_main.custnum',
- FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
- ),
- 'extra_sql' => $extra_sql,
- 'addl_from' => $addl_from,
- 'order_by' => "ORDER BY ".($params->{'order_by'} || 'svcnum'),
- 'count_query' => $count_query,
- } );
-}
-
-=item search_sql STRING
-
-Class method which returns an SQL fragment to search for the given string.
-
-=cut
-
-sub search_sql {
- my( $class, $string ) = @_;
- if ( $string =~ /^(\d{1,3}\.){3}\d{1,3}$/ ) {
- $class->search_sql_field('ip_addr', $string );
- }elsif ( $string =~ /^([a-fA-F0-9]{12})$/ ) {
- $class->search_sql_field('mac_addr', uc($string));
- }elsif ( $string =~ /^(([a-fA-F0-9]{1,2}:){5}([a-fA-F0-9]{1,2}))$/ ) {
- $class->search_sql_field('mac_addr', uc("$2$3$4$5$6$7") );
- } else {
- '1 = 0'; #false
- }
-}
-
-=item label
-
-Returns the IP address.
-
-=cut
-
-sub label {
- my $self = shift;
- $self->ip_addr;
-}
-
-=item insert [ , OPTION => VALUE ... ]
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-The additional fields pkgnum and svcpart (see FS::cust_svc) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-Currently available options are: I<depend_jobnum>
-
-If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
-jobnums), all provisioning jobs will have a dependancy on the supplied
-jobnum(s) (they will not run until the specific job(s) complete(s)).
-
-=cut
-
-# Standard FS::svc_Common::insert
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# Standard FS::svc_Common::delete
-
-=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
-
-# Standard FS::svc_Common::replace
-
-=item suspend
-
-Called by the suspend method of FS::cust_pkg (see FS::cust_pkg).
-
-=item unsuspend
-
-Called by the unsuspend method of FS::cust_pkg (see FS::cust_pkg).
-
-=item cancel
-
-Called by the cancel method of FS::cust_pkg (see FS::cust_pkg).
-
-=item check
-
-Checks all fields to make sure this is a valid broadband service. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
- my $x = $self->setfixed;
-
- return $x unless ref($x);
-
- my $error =
- $self->ut_numbern('svcnum')
- || $self->ut_numbern('blocknum')
- || $self->ut_textn('description')
- || $self->ut_number('speed_up')
- || $self->ut_number('speed_down')
- || $self->ut_ipn('ip_addr')
- || $self->ut_hexn('mac_addr')
- || $self->ut_hexn('auth_key')
- || $self->ut_coordn('latitude', -90, 90)
- || $self->ut_coordn('longitude', -180, 180)
- || $self->ut_sfloatn('altitude')
- || $self->ut_textn('vlan_profile')
- ;
- return $error if $error;
-
- if($self->speed_up < 0) { return 'speed_up must be positive'; }
- if($self->speed_down < 0) { return 'speed_down must be positive'; }
-
- my $cust_svc = $self->svcnum
- ? qsearchs('cust_svc', { 'svcnum' => $self->svcnum } )
- : '';
- my $cust_pkg;
- if ($cust_svc) {
- $cust_pkg = $cust_svc->cust_pkg;
- }else{
- $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $self->pkgnum } );
- return "Invalid pkgnum" unless $cust_pkg;
- }
-
- if ($self->blocknum) {
- $error = $self->ut_foreign_key('blocknum', 'addr_block', 'blocknum');
- return $error if $error;
- }
-
- if ($cust_pkg && $self->blocknum) {
- my $addr_agentnum = $self->addr_block->agentnum;
- if ($addr_agentnum && $addr_agentnum != $cust_pkg->cust_main->agentnum) {
- return "Address block does not service this customer";
- }
- }
-
- $error = $self->_check_ip_addr;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-sub _check_ip_addr {
- my $self = shift;
-
- if (not($self->ip_addr) or $self->ip_addr eq '0.0.0.0') {
-
- return '' if $conf->exists('svc_broadband-allow_null_ip_addr'); #&& !$self->blocknum
-
- return "Must supply either address or block"
- unless $self->blocknum;
- my $next_addr = $self->addr_block->next_free_addr;
- if ($next_addr) {
- $self->ip_addr($next_addr->addr);
- } else {
- return "No free addresses in addr_block (blocknum: ".$self->blocknum.")";
- }
-
- }
-
- if (not($self->blocknum)) {
- return "Must supply either address or block"
- unless ($self->ip_addr and $self->ip_addr ne '0.0.0.0');
- my @block = grep { $_->NetAddr->contains($self->NetAddr) }
- map { $_->addr_block }
- $self->allowed_routers;
- if (scalar(@block)) {
- $self->blocknum($block[0]->blocknum);
- }else{
- return "Address not with available block.";
- }
- }
-
- # This should catch errors in the ip_addr. If it doesn't,
- # they'll almost certainly not map into the block anyway.
- my $self_addr = $self->NetAddr; #netmask is /32
- return ('Cannot parse address: ' . $self->ip_addr) unless $self_addr;
-
- my $block_addr = $self->addr_block->NetAddr;
- unless ($block_addr->contains($self_addr)) {
- return 'blocknum '.$self->blocknum.' does not contain address '.$self->ip_addr;
- }
-
- my $router = $self->addr_block->router
- or return 'Cannot assign address from unallocated block:'.$self->addr_block->blocknum;
- if(grep { $_->routernum == $router->routernum} $self->allowed_routers) {
- } # do nothing
- else {
- return 'Router '.$router->routernum.' cannot provide svcpart '.$self->svcpart;
- }
-
- '';
-}
-
-sub _check_duplicate {
- my $self = shift;
-
- return "MAC already in use"
- if ( $self->mac_addr &&
- scalar( qsearch( 'svc_broadband', { 'mac_addr', $self->mac_addr } ) )
- );
-
- '';
-}
-
-
-=item NetAddr
-
-Returns a NetAddr::IP object containing the IP address of this service. The netmask
-is /32.
-
-=cut
-
-sub NetAddr {
- my $self = shift;
- new NetAddr::IP ($self->ip_addr);
-}
-
-=item addr_block
-
-Returns the FS::addr_block record (i.e. the address block) for this broadband service.
-
-=cut
-
-sub addr_block {
- my $self = shift;
- qsearchs('addr_block', { blocknum => $self->blocknum });
-}
-
-=back
-
-=item allowed_routers
-
-Returns a list of allowed FS::router objects.
-
-=cut
-
-sub allowed_routers {
- my $self = shift;
- map { $_->router } qsearch('part_svc_router', { svcpart => $self->svcpart });
-}
-
-=head1 BUGS
-
-The business with sb_field has been 'fixed', in a manner of speaking.
-
-allowed_routers isn't agent virtualized because part_svc isn't agent
-virtualized
-
-=head1 SEE ALSO
-
-FS::svc_Common, FS::Record, FS::addr_block,
-FS::part_svc, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/svc_cert.pm b/FS/FS/svc_cert.pm
deleted file mode 100644
index 88e4199..0000000
--- a/FS/FS/svc_cert.pm
+++ /dev/null
@@ -1,408 +0,0 @@
-package FS::svc_cert;
-
-use strict;
-use base qw( FS::svc_Common );
-use Tie::IxHash;
-#use FS::Record qw( qsearch qsearchs );
-use FS::cust_svc;
-
-=head1 NAME
-
-FS::svc_cert - Object methods for svc_cert records
-
-=head1 SYNOPSIS
-
- use FS::svc_cert;
-
- $record = new FS::svc_cert \%hash;
- $record = new FS::svc_cert { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::svc_cert object represents a certificate. FS::svc_cert inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcnum
-
-primary key
-
-=item recnum
-
-recnum
-
-=item privatekey
-
-privatekey
-
-=item csr
-
-csr
-
-=item certificate
-
-certificate
-
-=item cacert
-
-cacert
-
-=item common_name
-
-common_name
-
-=item organization
-
-organization
-
-=item organization_unit
-
-organization_unit
-
-=item city
-
-city
-
-=item state
-
-state
-
-=item country
-
-country
-
-=item cert_contact
-
-contact email
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new certificate. To add the certificate 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_cert'; }
-
-sub table_info {
- my %dis = ( disable_default=>1, disable_fixed=>1, disable_inventory=>1, disable_select=>1 );
- {
- 'name' => 'Certificate',
- 'name_plural' => 'Certificates',
- 'longname_plural' => 'Example services', #optional
- 'sorts' => 'svcnum', # optional sort field (or arrayref of sort fields, main first)
- 'display_weight' => 25,
- 'cancel_weight' => 65,
- 'fields' => {
- #'recnum' => '',
- 'privatekey' => { label=>'Private key', %dis, },
- 'csr' => { label=>'Certificate signing request', %dis, },
- 'certificate' => { label=>'Certificate', %dis, },
- 'cacert' => { label=>'Certificate authority chain', %dis, },
- 'common_name' => { label=>'Common name', %dis, },
- 'organization' => { label=>'Organization', %dis, },
- 'organization_unit' => { label=>'Organization Unit', %dis, },
- 'city' => { label=>'City', %dis, },
- 'state' => { label=>'State', %dis, },
- 'country' => { label=>'Country', %dis, },
- 'cert_contact' => { label=>'Contact email', %dis, },
-
- #'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 label
-
-Returns a meaningful identifier for this example
-
-=cut
-
-sub label {
- my $self = shift;
-# $self->label_field; #or something more complicated if necessary
- # check privatekey, check->privatekey, more?
- return 'Certificate';
-}
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid certificate. 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_numbern('recnum')
- || $self->ut_anything('privatekey') #XXX
- || $self->ut_anything('csr') #XXX
- || $self->ut_anything('certificate')#XXX
- || $self->ut_anything('cacert') #XXX
- || $self->ut_textn('common_name')
- || $self->ut_textn('organization')
- || $self->ut_textn('organization_unit')
- || $self->ut_textn('city')
- || $self->ut_textn('state')
- || $self->ut_textn('country') #XXX char(2) or NULL
- || $self->ut_textn('cert_contact')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item generate_privatekey [ KEYSIZE ]
-
-=cut
-
-use IPC::Run qw( run );
-use File::Temp;
-
-sub generate_privatekey {
- my $self = shift;
- my $keysize = (@_ && $_[0]) ? shift : 2048;
- run( [qw( openssl genrsa ), $keysize], '>pipe'=>\*OUT, '2>'=>'/dev/null' )
- or die "error running openssl: $!";
- #XXX error checking
- my $privatekey = join('', <OUT>);
- $self->privatekey($privatekey);
-}
-
-=item check_privatekey
-
-=cut
-
-sub check_privatekey {
- my $self = shift;
- my $in = $self->privatekey;
- run( [qw( openssl rsa -check -noout)], '<'=>\$in, '>pipe'=>\*OUT, '2>'=>'/dev/null' )
- ;# or die "error running openssl: $!";
-
- my $ok = <OUT>;
- return ($ok =~ /key ok/);
-}
-
-tie my %subj, 'Tie::IxHash',
- 'CN' => 'common_name',
- 'O' => 'organization',
- 'OU' => 'organization_unit',
- 'L' => 'city',
- 'ST' => 'state',
- 'C' => 'country',
-;
-
-sub subj_col {
- \%subj;
-}
-
-sub subj {
- my $self = shift;
-
- '/'. join('/', map { my $v = $self->get($subj{$_});
- $v =~ s/([=\/])/\\$1/;
- "$_=$v";
- }
- keys %subj
- );
-}
-
-sub _file {
- my $self = shift;
- my $field = shift;
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; #XXX actual cache dir
- my $fh = new File::Temp(
- TEMPLATE => 'cert.'. '.XXXXXXXX',
- DIR => $dir,
- ) or die "can't open temp file: $!\n";
- print $fh $self->$field;
- close $fh;
- $fh;
-}
-
-sub generate_csr {
- my $self = shift;
-
- my $fh = $self->_file('privatekey');
-
- run( [qw( openssl req -new -key ), $fh->filename, '-subj', $self->subj ],
- '>pipe'=>\*OUT, '2>'=>'/dev/null'
- )
- or die "error running openssl: $!";
- #XXX error checking
- my $csr = join('', <OUT>);
- $self->csr($csr);
-}
-
-sub check_csr {
- my $self = shift;
-
- my $in = $self->csr;
-
- run( [qw( openssl req -subject -noout ), ],
- '<'=>\$in,
- '>pipe'=>\*OUT, '2>'=>'/dev/null'
- )
- ;#or die "error running openssl: $!";
-
- #subject=/CN=cn.example.com/ST=AK/O=Tofuy/OU=Soybean dept./C=US/L=Tofutown
- my $line = <OUT>;
- $line =~ /^subject=\/(.*)$/ or return ();
- my $subj = $1;
-
- map { if ( /^\s*(\w+)=\s*(.*)\s*$/ ) {
- ($1=>$2);
- } else {
- ();
- }
- }
- split('/', $subj);
-}
-
-sub generate_selfsigned {
- my $self = shift;
-
- my $days = 730;
-
- my $key = $self->_file('privatekey');
- my $csr = $self->_file('csr');
-
- run( [qw( openssl req -x509 -nodes ),
- '-days' => $days,
- '-key' => $key->filename,
- '-in' => $csr->filename,
- ],
- '>pipe'=>\*OUT, '2>'=>'/dev/null'
- )
- or die "error running openssl: $!";
- #XXX error checking
- my $certificate = join('', <OUT>);
- $self->certificate($certificate);
-}
-
-#openssl x509 -in cert -noout -subject -issuer -dates -serial
-#subject= /CN=cn.example.com/ST=AK/O=Tofuy/OU=Soybean dept./C=US/L=Tofutown
-#issuer= /CN=cn.example.com/ST=AK/O=Tofuy/OU=Soybean dept./C=US/L=Tofutown
-#notBefore=Nov 7 05:07:42 2010 GMT
-#notAfter=Nov 6 05:07:42 2012 GMT
-#serial=B1DBF1A799EF207B
-
-sub check_certificate { shift->check_x509('certificate'); }
-sub check_cacert { shift->check_x509('cacert'); }
-
-sub check_x509 {
- my( $self, $field ) = ( shift, shift );
-
- my $in = $self->$field;
- run( [qw( openssl x509 -noout -subject -issuer -dates -serial )],
- '<'=>\$in,
- '>pipe'=>\*OUT, '2>'=>'/dev/null'
- )
- or die "error running openssl: $!";
- #XXX error checking
-
- my %hash = ();
- while (<OUT>) {
- /^\s*(\w+)=\s*(.*)\s*$/ or next;
- $hash{$1} = $2;
- }
-
- for my $f (qw( subject issuer )) {
-
- $hash{$f} = { map { if ( /^\s*(\w+)=\s*(.*)\s*$/ ) {
- ($1=>$2);
- } else {
- ();
- }
- }
- split('/', $hash{$f})
- };
-
- }
-
- $hash{'selfsigned'} = 1 if $hash{'subject'}->{'O'} eq $hash{'issuer'}->{'O'};
-
- %hash;
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm
deleted file mode 100644
index a97f35b..0000000
--- a/FS/FS/svc_domain.pm
+++ /dev/null
@@ -1,701 +0,0 @@
-package FS::svc_domain;
-
-use strict;
-use base qw( FS::svc_Parent_Mixin FS::svc_CGP_Mixin FS::svc_CGPRule_Mixin
- FS::svc_Common );
-use vars qw( $whois_hack $conf
- @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine
- $soarefresh $soaretry
-);
-use Carp;
-use Scalar::Util qw( blessed );
-use Date::Format;
-#use Net::Whois::Raw;
-use Net::Domain::TLD qw(tld_exists);
-use FS::Record qw(fields qsearch qsearchs dbh);
-use FS::Conf;
-use FS::cust_svc;
-use FS::svc_acct;
-use FS::cust_pkg;
-use FS::cust_main;
-use FS::domain_record;
-use FS::queue;
-
-#ask FS::UID to run this stuff for us later
-$FS::UID::callback{'FS::domain'} = sub {
- $conf = new FS::Conf;
-
- @defaultrecords = $conf->config('defaultrecords');
- $soadefaultttl = $conf->config('soadefaultttl');
- $soaemail = $conf->config('soaemail');
- $soaexpire = $conf->config('soaexpire');
- $soamachine = $conf->config('soamachine');
- $soarefresh = $conf->config('soarefresh');
- $soaretry = $conf->config('soaretry');
-
-};
-
-=head1 NAME
-
-FS::svc_domain - Object methods for svc_domain records
-
-=head1 SYNOPSIS
-
- use FS::svc_domain;
-
- $record = new FS::svc_domain \%hash;
- $record = new FS::svc_domain { '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_domain object represents a domain. FS::svc_domain inherits from
-FS::svc_Common. The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key (assigned automatically for new accounts)
-
-=item domain
-
-=item catchall - optional svcnum of an svc_acct record, designating an email catchall account.
-
-=item suffix -
-
-=item parent_svcnum -
-
-=item registrarnum - Registrar (see L<FS::registrar>)
-
-=item registrarkey - Registrar key or password for this domain
-
-=item setup_date - UNIX timestamp
-
-=item renewal_interval - Number of days before expiration date to start renewal
-
-=item expiration_date - UNIX timestamp
-
-=item max_accounts
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new domain. To add the domain to the database, see L<"insert">.
-
-=cut
-
-sub table_info {
- {
- 'name' => 'Domain',
- 'sorts' => 'domain',
- 'display_weight' => 20,
- '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,
- },
- 'cgp_certificatetype' => {
- label => 'Communigate PKI services',
- type => 'select',
- select_list => __PACKAGE__->cgp_certificatetype_values,
- 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 => 'select',
- select_list => __PACKAGE__->cgp_emptytrash_values,
- 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,
- },
- 'acct_def_cgp_rulesallowed' => {
- label => 'Acct. default Allowed mail rules',
- type => 'select',
- select_list => [ '', 'No', 'Filter Only', 'All But Exec', 'Any' ],
- disable_inventory => 1,
- disable_select => 1,
- },
- 'acct_def_cgp_rpopallowed' => {
- label => 'Acct. default RPOP modifications',
- type => 'checkbox',
- },
- 'acct_def_cgp_mailtoall' => {
- label => 'Acct. default Accepts mail to "all"',
- type => 'checkbox',
- },
- 'acct_def_cgp_addmailtrailer' => {
- label => 'Acct. default Add trailer to sent mail',
- type => 'checkbox',
- },
- 'acct_def_cgp_archiveafter' => {
- label => 'Archive messages after',
- type => 'select',
- select_hash => [
- -2 => 'default(730 days)',
- 0 => 'Never',
- 86400 => '24 hours',
- 172800 => '2 days',
- 259200 => '3 days',
- 432000 => '5 days',
- 604800 => '7 days',
- 1209600 => '2 weeks',
- 2592000 => '30 days',
- 7776000 => '90 days',
- 15552000 => '180 days',
- 31536000 => '365 days',
- 63072000 => '730 days',
- ],
- disable_inventory => 1,
- disable_select => 1,
- },
- 'trailer' => {
- label => 'Mail trailer',
- type => 'textarea',
- disable_inventory => 1,
- disable_select => 1,
- },
- 'acct_def_cgp_language' => {
- label => 'Acct. default language',
- type => 'select',
- select_list => [ '', qw( English Arabic Chinese Dutch French German Hebrew Italian Japanese Portuguese Russian Slovak Spanish Thai ) ],
- disable_inventory => 1,
- disable_select => 1,
- },
- 'acct_def_cgp_timezone' => {
- label => 'Acct. default time zone',
- type => 'select',
- select_list => __PACKAGE__->cgp_timezone_values,
- disable_inventory => 1,
- disable_select => 1,
- },
- 'acct_def_cgp_skinname' => {
- label => 'Acct. default layout',
- type => 'select',
- select_list => [ '', '***', 'GoldFleece', 'Skin2' ],
- disable_inventory => 1,
- disable_select => 1,
- },
- 'acct_def_cgp_prontoskinname' => {
- label => 'Acct. default Pronto style',
- type => 'select',
- select_list => [ '', 'Pronto', 'Pronto-darkflame', 'Pronto-steel', 'Pronto-twilight', ],
- disable_inventory => 1,
- disable_select => 1,
- },
- 'acct_def_cgp_sendmdnmode' => {
- label => 'Acct. default send read receipts',
- type => 'select',
- select_list => [ '', 'Never', 'Manually', 'Automatically' ],
- disable_inventory => 1,
- disable_select => 1,
- },
- },
- };
-}
-
-sub table { 'svc_domain'; }
-
-sub search_sql {
- my($class, $string) = @_;
- $class->search_sql_field('domain', $string);
-}
-
-
-=item label
-
-Returns the domain.
-
-=cut
-
-sub label {
- my $self = shift;
- $self->domain;
-}
-
-=item insert [ , OPTION => VALUE ... ]
-
-Adds this domain to the database. If there is an error, returns the error,
-otherwise returns false.
-
-The additional fields I<pkgnum> and I<svcpart> (see L<FS::cust_svc>) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-The additional field I<action> should be set to I<N> for new domains, I<M>
-for transfers, or I<I> for no action (registered elsewhere).
-
-The additional field I<email> can be used to manually set the admin contact
-email address on this email. Otherwise, the svc_acct records for this package
-(see L<FS::cust_pkg>) are searched. If there is exactly one svc_acct record
-in the same package, it is automatically used. Otherwise an error is returned.
-
-If any I<soamachine> configuration file exists, an SOA record is added to
-the domain_record table (see <FS::domain_record>).
-
-If any records are defined in the I<defaultrecords> configuration file,
-appropriate records are added to the domain_record table (see
-L<FS::domain_record>).
-
-Currently available options are: I<depend_jobnum>
-
-If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
-jobnums), all provisioning jobs will have a dependancy on the supplied
-jobnum(s) (they will not run until the specific job(s) complete(s)).
-
-=cut
-
-sub insert {
- my $self = shift;
- my $error;
-
- 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;
-
- $error = $self->SUPER::insert(@_)
- || $self->insert_defaultrecords;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ''; #no error
-}
-
-=item insert_defaultrecords
-
-=cut
-
-sub insert_defaultrecords {
- 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;
-
- if ( $soamachine ) {
- my $soa = new FS::domain_record {
- 'svcnum' => $self->svcnum,
- 'reczone' => '@',
- 'recaf' => 'IN',
- 'rectype' => 'SOA',
- 'recdata' => "$soamachine $soaemail ( ". time2str("%Y%m%d", time). "00 ".
- "$soarefresh $soaretry $soaexpire $soadefaultttl )"
- };
- my $error = $soa->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "couldn't insert SOA record: $error";
- }
-
- foreach my $record ( @defaultrecords ) {
- my($zone,$af,$type,$data) = split(/\s+/,$record,4);
- my $domain_record = new FS::domain_record {
- 'svcnum' => $self->svcnum,
- 'reczone' => $zone,
- 'recaf' => $af,
- 'rectype' => $type,
- 'recdata' => $data,
- };
- my $error = $domain_record->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "couldn't insert record: $error";
- }
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- ''; #no error
-}
-
-=item delete
-
-Deletes this domain from the database. If there is an error, returns the
-error, otherwise returns false.
-
-The corresponding FS::cust_svc record will be deleted as well.
-
-=cut
-
-sub delete {
- my $self = shift;
-
- return "Can't delete a domain which has accounts!"
- if qsearch( 'svc_acct', { 'domsvc' => $self->svcnum } );
-
- #return "Can't delete a domain with (domain_record) zone entries!"
- # if qsearch('domain_record', { 'svcnum' => $self->svcnum } );
-
- 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 $domain_record ( reverse $self->domain_record ) {
- my $error = $domain_record->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't delete DNS entry: ".
- join(' ', map $domain_record->$_(),
- qw( reczone recaf rectype recdata )
- ).
- ":$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 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 domain - reorder."
- 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');
- my $error = $new->SUPER::replace($old, @_);
- return $error if $error;
-}
-
-=item suspend
-
-Just returns false (no error) for now.
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item unsuspend
-
-Just returns false (no error) for now.
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item cancel
-
-Just returns false (no error) for now.
-
-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 domain. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-Sets any fixed values; see L<FS::part_svc>.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $x = $self->setfixed;
- return $x unless ref($x);
- #my $part_svc = $x;
-
- my $error = $self->ut_numbern('svcnum')
- || $self->ut_numbern('catchall')
- || $self->ut_numbern('max_accounts')
- || $self->ut_anything('trailer') #well
- || $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')
- #settings
- || $self->ut_alphasn('acct_def_cgp_rulesallowed')
- || $self->ut_enum('acct_def_cgp_rpopallowed', [ '', 'Y' ])
- || $self->ut_enum('acct_def_cgp_mailtoall', [ '', 'Y' ])
- || $self->ut_enum('acct_def_cgp_addmailtrailer', [ '', 'Y' ])
- || $self->ut_snumbern('acct_def_cgp_archiveafter')
- #preferences
- || $self->ut_alphasn('acct_def_cgp_deletemode')
- || $self->ut_enum('acct_def_cgp_emptytrash',
- $self->cgp_emptytrash_values )
- || $self->ut_alphan('acct_def_cgp_language')
- || $self->ut_textn('acct_def_cgp_timezone')
- || $self->ut_textn('acct_def_cgp_skinname')
- || $self->ut_textn('acct_def_cgp_prontoskinname')
- || $self->ut_alphan('acct_def_cgp_sendmdnmode')
- #mail
- ;
- return $error if $error;
-
- #hmm
- my $pkgnum;
- if ( $self->svcnum ) {
- my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
- $pkgnum = $cust_svc->pkgnum;
- } else {
- $pkgnum = $self->pkgnum;
- }
-
- my($recref) = $self->hashref;
-
- #if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) {
- if ( $recref->{domain} =~ /^([\w\-]{1,63})\.(com|net|org|edu|tv|info|biz)$/ ) {
- $recref->{domain} = "$1.$2";
- $recref->{suffix} ||= $2;
- # hmmmmmmmm.
- } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.\/]+)\.(\w+)$/ ) {
- $recref->{domain} = "$1.$2";
- # need to match a list of suffixes - no guarantee they're top-level..
- # http://wiki.mozilla.org/TLD_List
- # but this will have to do for now...
- $recref->{suffix} ||= $2;
- } else {
- return "Illegal domain ". $recref->{domain}.
- " (or unknown registry - try \$whois_hack)";
- }
-
- $self->suffix =~ /(^|\.)(\w+)$/
- or return "can't parse suffix for TLD: ". $self->suffix;
- my $tld = $2;
- return "No such TLD: .$tld" unless tld_exists($tld);
-
- if ( $recref->{catchall} ne '' ) {
- my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } );
- return "Unknown catchall" unless $svc_acct;
- }
-
- $self->ut_alphan('suffix')
- or $self->ut_foreign_keyn('registrarnum', 'registrar', 'registrarnum')
- or $self->ut_textn('registrarkey')
- or $self->ut_numbern('setup_date')
- or $self->ut_numbern('renewal_interval')
- or $self->ut_numbern('expiration_date')
- or $self->SUPER::check;
-
-}
-
-sub _check_duplicate {
- my $self = shift;
-
- $self->lock_table;
-
- if ( qsearchs( 'svc_domain', { 'domain' => $self->domain } ) ) {
- return "Domain in use (here)";
- } else {
- return '';
- }
-}
-
-=item domain_record
-
-=cut
-
-sub domain_record {
- my $self = shift;
-
- my %order = (
- 'SOA' => 1,
- 'NS' => 2,
- 'MX' => 3,
- 'CNAME' => 4,
- 'A' => 5,
- 'TXT' => 6,
- 'PTR' => 7,
- 'SRV' => 8,
- );
-
- my %sort = (
- #'SOA' => sub { $_[0]->recdata cmp $_[1]->recdata }, #sure hope not though
-# 'SOA' => sub { 0; },
-# 'NS' => sub { 0; },
- 'MX' => sub { my( $a_weight, $a_name ) = split(/\s+/, $_[0]->recdata);
- my( $b_weight, $b_name ) = split(/\s+/, $_[1]->recdata);
- $a_weight <=> $b_weight or $a_name cmp $b_name;
- },
- 'CNAME' => sub { $_[0]->reczone cmp $_[1]->reczone },
- 'A' => sub { $_[0]->reczone cmp $_[1]->reczone },
-
-# 'TXT' => sub { 0; },
- '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)
- }
- qsearch('domain_record', { svcnum => $self->svcnum } );
-
-}
-
-sub catchall_svc_acct {
- my $self = shift;
- if ( $self->catchall ) {
- qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } );
- } else {
- '';
- }
-}
-
-=item whois
-
-# Returns the Net::Whois::Domain object (see L<Net::Whois>) for this domain, or
-# undef if the domain is not found in whois.
-
-(If $FS::svc_domain::whois_hack is true, returns that in all cases instead.)
-
-=cut
-
-sub whois {
- #$whois_hack or new Net::Whois::Domain $_[0]->domain;
- #$whois_hack or die "whois_hack not set...\n";
-}
-
-=back
-
-=head1 BUGS
-
-Delete doesn't send a registration template.
-
-All registries should be supported.
-
-Should change action to a real field.
-
-The $recref stuff in sub check should be cleaned up.
-
-=head1 SEE ALSO
-
-L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
-L<FS::part_svc>, L<FS::cust_pkg>, L<Net::Whois>, schema.html from the base
-documentation, config.html from the base documentation.
-
-=cut
-
-1;
-
-
diff --git a/FS/FS/svc_dsl.pm b/FS/FS/svc_dsl.pm
deleted file mode 100644
index c5557ec..0000000
--- a/FS/FS/svc_dsl.pm
+++ /dev/null
@@ -1,299 +0,0 @@
-package FS::svc_dsl;
-
-use strict;
-use vars qw( @ISA $conf $DEBUG $me );
-use FS::Record qw( qsearch qsearchs );
-use FS::svc_Common;
-use FS::dsl_note;
-use FS::qual;
-
-@ISA = qw( FS::svc_Common );
-$DEBUG = 0;
-$me = '[FS::svc_dsl]';
-
-FS::UID->install_callback( sub {
- $conf = new FS::Conf;
-}
-);
-
-=head1 NAME
-
-FS::svc_dsl - Object methods for svc_dsl records
-
-=head1 SYNOPSIS
-
- use FS::svc_dsl;
-
- $record = new FS::svc_dsl \%hash;
- $record = new FS::svc_dsl { '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_dsl object represents a DSL service. FS::svc_dsl inherits from
-FS::svc_Common. The following fields are currently supported:
-
-=over 4
-
-=item svcnum - Primary key (assigned automatcially for new DSL))
-
-=item pushed - Time DSL order pushed to vendor/telco, if applicable
-
-=item desired_due_date - Desired Due Date
-
-=item due_date - Due Date
-
-=item vendor_order_id - Vendor/telco DSL order #
-
-=item vendor_order_type
-
-Vendor/telco DSL order type (e.g. (M)ove, (A)dd, (C)hange, (D)elete, or similar)
-
-=item vendor_order_status
-
-Vendor/telco DSL order status (e.g. (N)ew, (A)ssigned, (R)ejected, (M)revised,
-(C)ompleted, (X)cancelled, or similar)
-
-=item first - End-user first name
-
-=item last - End-user last name
-
-=item company - End-user company name
-
-=item phonenum - DSL Telephone Number
-
-=item loop_type - Loop-type - vendor/telco-specific
-
-=item local_voice_provider - Local Voice Provider's name
-
-=item circuitnum - Circuit #
-
-=item rate_band - Rate Band
-
-=item isp_chg
-
-=item isp_prev
-
-=item staticips
-
-=item vendor_qual_id
-
-Ikano-specific fields, do not use otherwise
-
-=item username - if outsourced PPPoE/RADIUS, username
-
-=item password - if outsourced PPPoE/RADIUS, password
-
-=item monitored - Order is monitored (auto-pull/sync), either Y or blank
-
-=item last_pull - time of last data pull from vendor/telco
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new DSL. To add the DSL 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_info {
- my %dis1 = ( disable_default=>1, disable_fixed=>1, disable_inventory=>1, disable_select=>1 );
- my %dis2 = ( disable_inventory=>1, disable_select=>1 );
-
- {
- 'name' => 'DSL',
- 'sorts' => [ 'phonenum' ],
- 'display_weight' => 55,
- 'cancel_weight' => 75,
- 'fields' => {
- 'pushed' => { label => 'Pushed',
- type => 'disabled' },
- 'desired_due_date' => { label => 'Desired Due Date', %dis2, },
- 'due_date' => { label => 'Due Date', %dis2, },
- 'vendor_order_id' => { label => 'Vendor Order Id', %dis2, },
- 'vendor_qual_id' => { label => 'Vendor Qualification Id',
- type => 'disabled' },
- 'vendor_order_type' => { label => 'Vendor Order Type',
- disable_inventory => 1,
- },
- 'vendor_order_status' => { label => 'Vendor Order Status',
- disable_inventory => 1,
- },
- 'first' => { label => 'First Name', %dis2, },
- 'last' => { label => 'Last Name', %dis2, },
- 'company' => { label => 'Company Name', %dis2, },
- 'phonenum' => { label => 'Service Telephone Number', },
- 'loop_type' => { label => 'Loop Type',
- disable_inventory => 1,
- },
- 'local_voice_provider' => { label => 'Local Voice Provider',
- disable_inventory => 1,
- },
- 'circuitnum' => { label => 'Circuit #', },
- 'rate_band' => { label => 'Rate Band',
- disable_inventory => 1,
- },
- 'isp_chg' => { label => 'ISP Changing?',
- type => 'checkbox', %dis2 },
- 'isp_prev' => { label => 'Current or Previous ISP',
- disable_inventory => 1,
- },
- 'username' => { label => 'PPPoE Username',
- type => 'text',
- },
- 'password' => { label => 'PPPoE Password', %dis2 },
- 'staticips' => { label => 'Static IPs', %dis1 },
- 'monitored' => { label => 'Monitored',
- type => 'checkbox', %dis2 },
- 'last_pull' => { label => 'Last Pull', type => 'disabled' },
- },
- };
-}
-
-sub table { 'svc_dsl'; }
-
-sub label {
- my $self = shift;
- return $self->phonenum if $self->phonenum;
- return $self->username if $self->username;
- return $self->vendor_order_id if $self->vendor_order_id;
- return $self->svcnum;
-}
-
-=item notes
-
-Returns the set of FS::dsl_notes associated with this service
-
-=cut
-sub notes {
- my $self = shift;
- qsearch( 'dsl_note', { 'svcnum' => $self->svcnum } );
-}
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-# the insert method can be inherited from FS::Record
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-# the replace method can be inherited from FS::Record
-
-=item check
-
-Checks all fields to make sure this is a valid DSL. 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_numbern('pushed')
- || $self->ut_number('desired_due_date')
- || $self->ut_numbern('due_date')
- || $self->ut_textn('vendor_order_id')
- || $self->ut_textn('vendor_qual_id')
- || $self->ut_alphan('vendor_order_type')
- || $self->ut_alphan('vendor_order_status')
- || $self->ut_text('first')
- || $self->ut_text('last')
- || $self->ut_textn('company')
- || $self->ut_numbern('phonenum')
- || $self->ut_alphasn('loop_type')
- || $self->ut_textn('local_voice_provider')
- || $self->ut_textn('circuitnum')
- || $self->ut_textn('rate_band')
- || $self->ut_alphan('isp_chg')
- || $self->ut_textn('isp_prev')
- || $self->ut_textn('username')
- || $self->ut_textn('password')
- || $self->ut_textn('staticips')
- || $self->ut_enum('monitored', [ '', 'Y' ])
- || $self->ut_numbern('last_pull')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-sub predelete_hook_first {
- my $self = shift;
- my @exports = $self->part_svc->part_export_dsl_pull;
- return 'More than one DSL-pulling export attached' if scalar(@exports) > 1;
- if ( scalar(@exports) == 1 ) {
- my $export = $exports[0];
- return $export->dsl_pull($self);
- }
- '';
-}
-
-sub predelete_hook {
- my $self = shift;
- my @notes = $self->notes;
- foreach my $note ( @notes ) {
- my $error = $note->delete;
- return $error if $error;
- }
- '';
-}
-
-=back
-
-=head1 SEE ALSO
-
-L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
-export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
-L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
-L<freeside-queued>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/svc_external.pm b/FS/FS/svc_external.pm
deleted file mode 100644
index 338fdbc..0000000
--- a/FS/FS/svc_external.pm
+++ /dev/null
@@ -1,205 +0,0 @@
-package FS::svc_external;
-
-use strict;
-use vars qw(@ISA);
-use FS::Conf;
-use FS::svc_External_Common;
-
-@ISA = qw( FS::svc_External_Common );
-
-=head1 NAME
-
-FS::svc_external - Object methods for svc_external records
-
-=head1 SYNOPSIS
-
- use FS::svc_external;
-
- $record = new FS::svc_external \%hash;
- $record = new FS::svc_external { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-=head1 DESCRIPTION
-
-An FS::svc_external object represents a generic externally tracked service.
-FS::svc_external inherits from FS::svc_External_Common (and FS::svc_Common).
-The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key
-
-=item id - unique number of external record
-
-=item title - for invoice line items
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new external service. To add the external service to the database,
-see L<"insert">.
-
-Note that this stores the hash reference, not a distinct copy of the hash it
-points to. You can ask the object for a copy with the I<hash> method.
-
-=cut
-
-sub table_info {
- {
- 'name' => 'External service',
- 'sorts' => 'id',
- 'display_weight' => 90,
- 'cancel_weight' => 10,
- 'fields' => {
- 'id' => { label => 'Unique number of external record',
- type => 'text',
- disable_default => 1,
- disable_fixed => 1,
- },
- 'title' => { label => 'Printed on invoice line items',
- type => 'text',
- #disable_inventory => 1,
- },
- },
- };
-}
-
-sub table { 'svc_external'; }
-
-# oh! this should be moved to svc_artera_turbo or something now
-sub label {
- my $self = shift;
- my $conf = new FS::Conf;
- if ( $conf->exists('svc_external-display_type')
- && $conf->config('svc_external-display_type') eq 'artera_turbo' )
- {
- sprintf('%010d', $self->id). '-'.
- substr('0000000000'.uc($self->title), -10);
- } else {
- #$self->SUPER::label;
- return $self->id unless $self->title =~ /\S/;
- $self->id. ' - '. $self->title;
- }
-}
-
-=item insert [ , OPTION => VALUE ... ]
-
-Adds this external service to the database. If there is an error, returns the
-error, otherwise returns false.
-
-The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-Currently available options are: I<depend_jobnum>
-
-If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
-jobnums), all provisioning jobs will have a dependancy on the supplied
-jobnum(s) (they will not run until the specific job(s) complete(s)).
-
-=cut
-
-#sub insert {
-# my $self = shift;
-# my $error;
-#
-# $error = $self->SUPER::insert(@_);
-# return $error if $error;
-#
-# '';
-#}
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-#sub delete {
-# my $self = shift;
-# my $error;
-#
-# $error = $self->SUPER::delete;
-# return $error if $error;
-#
-# '';
-#}
-
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-#sub replace {
-# my ( $new, $old ) = ( shift, shift );
-# my $error;
-#
-# $error = $new->SUPER::replace($old);
-# return $error if $error;
-#
-# '';
-#}
-
-=item suspend
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item unsuspend
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item cancel
-
-Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item check
-
-Checks all fields to make sure this is a valid external service. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-#sub check {
-# my $self = shift;
-# my $error;
-#
-# $error = $self->SUPER::delete;
-# return $error if $error;
-#
-# '';
-#}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::svc_External_Common>, L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>,
-L<FS::part_svc>, L<FS::cust_pkg>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm
deleted file mode 100644
index 9e27a32..0000000
--- a/FS/FS/svc_forward.pm
+++ /dev/null
@@ -1,368 +0,0 @@
-package FS::svc_forward;
-
-use strict;
-use vars qw( @ISA );
-use FS::Conf;
-use FS::Record qw( fields qsearch qsearchs dbh );
-use FS::svc_Common;
-use FS::cust_svc;
-use FS::svc_acct;
-use FS::svc_domain;
-
-@ISA = qw( FS::svc_Common );
-
-=head1 NAME
-
-FS::svc_forward - Object methods for svc_forward records
-
-=head1 SYNOPSIS
-
- use FS::svc_forward;
-
- $record = new FS::svc_forward \%hash;
- $record = new FS::svc_forward { '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_forward object represents a mail forwarding alias. FS::svc_forward
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key (assigned automatcially for new accounts)
-
-=item srcsvc - svcnum of the source of the forward (see L<FS::svc_acct>)
-
-=item src - literal source (username or full email address)
-
-=item dstsvc - svcnum of the destination of the forward (see L<FS::svc_acct>)
-
-=item dst - literal destination (username or full email address)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new mail forwarding alias. To add the mail forwarding alias to the
-database, see L<"insert">.
-
-=cut
-
-
-sub table_info {
- {
- 'name' => 'Forward',
- 'name_plural' => 'Mail forwards',
- 'display_weight' => 30,
- 'cancel_weight' => 30,
- 'fields' => {
- 'srcsvc' => 'service from which mail is to be forwarded',
- 'dstsvc' => 'service to which mail is to be forwarded',
- 'dst' => 'someone@another.domain.com to use when dstsvc is 0',
- },
- };
-}
-
-sub table { 'svc_forward'; }
-
-=item search_sql STRING
-
-Class method which returns an SQL fragment to search for the given string.
-
-=cut
-
-sub search_sql {
- my( $class, $string ) = @_;
- $class->search_sql_field('src', $string);
-}
-
-=item label [ END_TIMESTAMP [ START_TIMESTAMP ] ]
-
-Returns a text string representing this forward.
-
-END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
-history records.
-
-=cut
-
-sub label {
- my $self = shift;
- my $tag = '';
-
- if ( $self->srcsvc ) {
- my $svc_acct = $self->srcsvc_acct(@_);
- $tag = $svc_acct->email(@_);
- } else {
- $tag = $self->src;
- }
-
- $tag .= ' -> ';
-
- if ( $self->dstsvc ) {
- my $svc_acct = $self->dstsvc_acct(@_);
- $tag .= $svc_acct->email(@_);
- } else {
- $tag .= $self->dst;
- }
-
- $tag;
-}
-
-
-=item insert [ , OPTION => VALUE ... ]
-
-Adds this mail forwarding alias to the database. If there is an error, returns
-the error, otherwise returns false.
-
-The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-Currently available options are: I<depend_jobnum>
-
-If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
-jobnums), all provisioning jobs will have a dependancy on the supplied
-jobnum(s) (they will not run until the specific job(s) complete(s)).
-
-=cut
-
-sub insert {
- my $self = shift;
- my $error;
-
- 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;
-
- $error = $self->SUPER::insert(@_);
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-
-}
-
-=item delete
-
-Deletes this mail forwarding alias from the database. If there is an error,
-returns the error, otherwise returns false.
-
-The corresponding FS::cust_svc record will be deleted as well.
-
-=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(@_);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
-
-=item replace OLD_RECORD
-
-Replaces 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 );
-
- if ( $new->srcsvc != $old->srcsvc
- && ( $new->dstsvc != $old->dstsvc
- || ! $new->dstsvc && $new->dst ne $old->dst
- )
- ) {
- return "Can't change both source and destination of a mail forward!"
- }
-
- 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, @_);
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
-}
-
-=item suspend
-
-Just returns false (no error) for now.
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item unsuspend
-
-Just returns false (no error) for now.
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item cancel
-
-Just returns false (no error) for now.
-
-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 mail forwarding alias. If there
-is an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-Sets any fixed values; see L<FS::part_svc>.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $x = $self->setfixed;
- return $x unless ref($x);
- #my $part_svc = $x;
-
- my $error = $self->ut_numbern('svcnum')
- || $self->ut_numbern('srcsvc')
- || $self->ut_numbern('dstsvc')
- ;
- return $error if $error;
-
- return "Both srcsvc and src were defined; only one can be specified"
- if $self->srcsvc && $self->src;
-
- return "one of srcsvc or src is required"
- unless $self->srcsvc || $self->src;
-
- return "Unknown srcsvc: ". $self->srcsvc
- unless ! $self->srcsvc || $self->srcsvc_acct;
-
- return "Both dstsvc and dst were defined; only one can be specified"
- if $self->dstsvc && $self->dst;
-
- return "one of dstsvc or dst is required"
- unless $self->dstsvc || $self->dst;
-
- return "Unknown dstsvc: ". $self->dstsvc
- unless ! $self->dstsvc || $self->dstsvc_acct;
- #return "Unknown dstsvc"
- # unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } )
- # || ! $self->dstsvc;
-
- if ( $self->src ) {
- $self->src =~ /^([\w\.\-\&]*)(\@([\w\-]+\.)+\w+)$/
- or return "Illegal src: ". $self->src;
- $self->src("$1$2");
- } else {
- $self->src('');
- }
-
- if ( $self->dst ) {
- my $conf = new FS::Conf;
- if ( $conf->exists('svc_forward-arbitrary_dst') ) {
- my $error = $self->ut_textn('dst');
- return $error if $error;
- } else {
- $self->dst =~ /^([\w\.\-\&]*)(\@([\w\-]+\.)+\w+)$/
- or return "Illegal dst: ". $self->dst;
- $self->dst("$1$2");
- }
- } else {
- $self->dst('');
- }
-
- $self->SUPER::check;
-}
-
-=item srcsvc_acct
-
-Returns the FS::svc_acct object referenced by the srcsvc column, or false for
-literally specified forwards.
-
-=cut
-
-sub srcsvc_acct {
- my $self = shift;
- qsearchs('svc_acct', { 'svcnum' => $self->srcsvc } );
-}
-
-=item dstsvc_acct
-
-Returns the FS::svc_acct object referenced by the srcsvc column, or false for
-literally specified forwards.
-
-=cut
-
-sub dstsvc_acct {
- my $self = shift;
- qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
-L<FS::svc_acct>, L<FS::svc_domain>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/svc_mailinglist.pm b/FS/FS/svc_mailinglist.pm
deleted file mode 100644
index ba297ee..0000000
--- a/FS/FS/svc_mailinglist.pm
+++ /dev/null
@@ -1,330 +0,0 @@
-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
deleted file mode 100644
index 0eb5443..0000000
--- a/FS/FS/svc_pbx.pm
+++ /dev/null
@@ -1,370 +0,0 @@
-package FS::svc_pbx;
-
-use strict;
-use base qw( FS::svc_External_Common );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::Conf;
-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
-
-=item max_simultaneous
-
-Maximum number of simultaneous users
-
-=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',
- 'max_simultaneous' => 'Maximum number of simultaneous users',
-# '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;
-}
-
-sub _check_duplicate {
- my $self = shift;
-
- my $conf = new FS::Conf;
-
- $self->lock_table;
-
- foreach my $field ('title', 'id') {
- my $global_unique = $conf->config("global_unique-pbx_$field");
- # can be 'disabled', 'enabled', or empty.
- # if empty, check per exports; if not empty or disabled, check
- # globally.
- next if $global_unique eq 'disabled';
- my @dup = $self->find_duplicates(
- ($global_unique ? 'global' : 'export') , $field
- );
- next if !@dup;
- return "duplicate $field '".$self->getfield($field).
- "': conflicts with svcnum ".$dup[0]->svcnum;
- }
- return '';
-}
-
-=item get_cdrs
-
-Returns a set of Call Detail Records (see L<FS::cdr>) associated with this
-service. By default, "associated with" means that the "charged_party" field of
-the CDR matches the "title" field of the service.
-
-=over 2
-
-Accepts the following options:
-
-=item for_update => 1: SELECT the CDRs "FOR UPDATE".
-
-=item status => "" (or "done"): Return only CDRs with that processing status.
-
-=item inbound => 1: No-op for svc_pbx CDR processing.
-
-=item default_prefix => "XXX": Also accept the phone number of the service prepended
-with the chosen prefix.
-
-=item disable_src => 1: No-op for svc_pbx CDR processing.
-
-=item by_svcnum => 1: Select CDRs where the svcnum field matches, instead of
-title/charged_party. Normally this field is set after processing.
-
-=back
-
-=cut
-
-sub get_cdrs {
- my($self, %options) = @_;
- my %hash = ();
- my @where = ();
-
- my @fields = ( 'charged_party' );
- $hash{'freesidestatus'} = $options{'status'}
- if exists($options{'status'});
-
- my $for_update = $options{'for_update'} ? 'FOR UPDATE' : '';
-
- if ( $options{'by_svcnum'} ) {
- $hash{'svcnum'} = $self->svcnum;
- }
- else {
- #matching by title
- my $title = $self->title;
-
- my $prefix = $options{'default_prefix'};
-
- my @orwhere = map " $_ = '$title' ", @fields;
- push @orwhere, map " $_ = '$prefix$title' ", @fields
- if length($prefix);
- if ( $prefix =~ /^\+(\d+)$/ ) {
- push @orwhere, map " $_ = '$1$title' ", @fields
- }
-
- push @where, ' ( '. join(' OR ', @orwhere ). ' ) ';
- }
-
- if ( $options{'begin'} ) {
- push @where, 'startdate >= '. $options{'begin'};
- }
- if ( $options{'end'} ) {
- push @where, 'startdate < '. $options{'end'};
- }
-
- my $extra_sql = ( keys(%hash) ? ' AND ' : ' WHERE ' ). join(' AND ', @where )
- if @where;
-
- my @cdrs =
- qsearch( {
- 'table' => 'cdr',
- 'hashref' => \%hash,
- 'extra_sql' => $extra_sql,
- 'order_by' => "ORDER BY startdate $for_update",
- } );
-
- @cdrs;
-}
-
-=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
deleted file mode 100644
index b61a93d..0000000
--- a/FS/FS/svc_phone.pm
+++ /dev/null
@@ -1,675 +0,0 @@
-package FS::svc_phone;
-
-use strict;
-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::part_svc;
-use FS::phone_device;
-use FS::svc_pbx;
-use FS::svc_domain;
-use FS::cust_location;
-use FS::phone_avail;
-
-$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' );
-
-#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
-
-FS::svc_phone - Object methods for svc_phone records
-
-=head1 SYNOPSIS
-
- use FS::svc_phone;
-
- $record = new FS::svc_phone \%hash;
- $record = new FS::svc_phone { '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_phone object represents a phone number. FS::svc_phone inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcnum
-
-primary key
-
-=item countrycode
-
-=item phonenum
-
-=item sip_password
-
-=item pin
-
-Voicemail PIN
-
-=item phone_name
-
-=item pbxsvc
-
-Optional svcnum from svc_pbx
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new phone number. To add the number 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_info {
- my %dis2 = ( disable_inventory=>1, disable_select=>1 );
- {
- 'name' => 'Phone number',
- 'sorts' => 'phonenum',
- 'display_weight' => 60,
- 'cancel_weight' => 80,
- 'fields' => {
- 'svcnum' => 'Service',
- 'countrycode' => { label => 'Country code',
- type => 'text',
- disable_inventory => 1,
- disable_select => 1,
- },
- 'phonenum' => 'Phone number',
- 'pin' => { label => 'Voicemail PIN', #'Personal Identification Number',
- type => 'text',
- disable_inventory => 1,
- disable_select => 1,
- },
- '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,
- },
- 'lnp_status' => { label => 'LNP Status',
- type => 'select-lnp_status.html',
- %dis2,
- },
- 'portable' => { label => 'Portable?', %dis2, },
- 'lrn' => { label => 'LRN',
- disable_inventory => 1,
- },
- 'lnp_desired_due_date' =>
- { label => 'LNP Desired Due Date', %dis2 },
- 'lnp_due_date' =>
- { label => 'LNP Due Date', %dis2 },
- 'lnp_other_provider' =>
- { label => 'LNP Other Provider',
- disable_inventory => 1,
- },
- 'lnp_other_provider_account' =>
- { label => 'LNP Other Provider Account #',
- %dis2
- },
- },
- };
-}
-
-sub table { 'svc_phone'; }
-
-sub table_dupcheck_fields { ( 'countrycode', 'phonenum' ); }
-
-=item search_sql STRING
-
-Class method which returns an SQL fragment to search for the given string.
-
-=cut
-
-sub search_sql {
- my( $class, $string ) = @_;
-
- if ( $conf->exists('svc_phone-allow_alpha_phonenum') ) {
- $string =~ s/\W//g;
- } else {
- $string =~ s/\D//g;
- }
-
- my $conf = new FS::Conf;
- my $ccode = ( $conf->exists('default_phone_countrycode')
- && $conf->config('default_phone_countrycode')
- )
- ? $conf->config('default_phone_countrycode')
- : '1';
-
- $string =~ s/^$ccode//;
-
- $class->search_sql_field('phonenum', $string );
-}
-
-=item label
-
-Returns the phone number.
-
-=cut
-
-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 phone number to the database. If there is an error, returns the
-error, otherwise returns false.
-
-=cut
-
-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
-
-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 $phone_device ( $self->phone_device ) {
- my $error = $phone_device->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my @phone_avail = qsearch('phone_avail', { 'svcnum' => $self->svcnum } );
- foreach my $phone_avail ( @phone_avail ) {
- $phone_avail->svcnum('');
- my $error = $phone_avail->replace;
- 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;
- '';
-
-}
-
-# the delete method can be inherited from FS::Record
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-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
-
-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 phone number. 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 $conf = new FS::Conf;
-
- my $phonenum = $self->phonenum;
- my $phonenum_check_method;
- if ( $conf->exists('svc_phone-allow_alpha_phonenum') ) {
- $phonenum =~ s/\W//g;
- $phonenum_check_method = 'ut_alpha';
- } else {
- $phonenum =~ s/\D//g;
- $phonenum_check_method = 'ut_number';
- }
- $self->phonenum($phonenum);
-
- $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
-
- my $error =
- $self->ut_numbern('svcnum')
- || $self->ut_numbern('countrycode')
- || $self->$phonenum_check_method('phonenum')
- || $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')
- || $self->ut_numbern('lrn')
- || $self->ut_numbern('lnp_desired_due_date')
- || $self->ut_numbern('lnp_due_date')
- || $self->ut_textn('lnp_other_provider')
- || $self->ut_textn('lnp_other_provider_account')
- || $self->ut_enumn('lnp_status', ['','portingin','portingout','portedin','native'])
- || $self->ut_enumn('portable', ['','Y'])
- ;
- 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) ) {
-
- $self->sip_password(
- join('', map $pw_set[ int(rand $#pw_set) ], (0..16) )
- );
-
- }
-
- $self->SUPER::check;
-}
-
-=item _check duplicate
-
-Internal method to check for duplicate phone numers.
-
-=cut
-
-#false laziness w/svc_acct.pm's _check_duplicate.
-sub _check_duplicate {
- my $self = shift;
-
- my $global_unique = $conf->config('global_unique-phonenum') || 'none';
- return '' if $global_unique eq 'disabled';
-
- $self->lock_table;
-
- my @dup_ccphonenum =
- grep { !$self->svcnum || $_->svcnum != $self->svcnum }
- qsearch( 'svc_phone', {
- 'countrycode' => $self->countrycode,
- 'phonenum' => $self->phonenum,
- });
-
- return gettext('phonenum_in_use')
- if $global_unique eq 'countrycode+phonenum' && @dup_ccphonenum;
-
- my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
- unless ( $part_svc ) {
- return 'unknown svcpart '. $self->svcpart;
- }
-
- if ( @dup_ccphonenum ) {
-
- my $exports = FS::part_export::export_info('svc_phone');
- my %conflict_ccphonenum_svcpart = ( $self->svcpart => 'SELF', );
-
- foreach my $part_export ( $part_svc->part_export ) {
-
- #this will catch to the same exact export
- my @svcparts = map { $_->svcpart } $part_export->export_svc;
-
- $conflict_ccphonenum_svcpart{$_} = $part_export->exportnum
- foreach @svcparts;
-
- }
-
- foreach my $dup_ccphonenum ( @dup_ccphonenum ) {
- my $dup_svcpart = $dup_ccphonenum->cust_svc->svcpart;
- if ( exists($conflict_ccphonenum_svcpart{$dup_svcpart}) ) {
- return "duplicate phone number ".
- $self->countrycode. ' '. $self->phonenum.
- ": conflicts with svcnum ". $dup_ccphonenum->svcnum.
- " via exportnum ". $conflict_ccphonenum_svcpart{$dup_svcpart};
- }
- }
-
- }
-
- return '';
-
-}
-
-=item check_pin
-
-Checks the supplied PIN against the PIN in the database. Returns true for a
-sucessful authentication, false if no match.
-
-=cut
-
-sub check_pin {
- my($self, $check_pin) = @_;
- length($self->pin) && $check_pin eq $self->pin;
-}
-
-=item radius_reply
-
-=cut
-
-sub radius_reply {
- my $self = shift;
- #XXX Session-Timeout! holy shit, need rlm_perl to ask for this in realtime
- ();
-}
-
-=item radius_check
-
-=cut
-
-sub radius_check {
- my $self = shift;
- my %check = ();
-
- my $conf = new FS::Conf;
-
- $check{'User-Password'} = $conf->config('svc_phone-radius-default_password');
-
- %check;
-}
-
-sub radius_groups {
- ();
-}
-
-=item phone_device
-
-Returns any FS::phone_device records associated with this service.
-
-=cut
-
-sub phone_device {
- my $self = shift;
- 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 : '';
-}
-
-=item get_cdrs
-
-Returns a set of Call Detail Records (see L<FS::cdr>) associated with this
-service. By default, "associated with" means that either the "src" or the
-"charged_party" field of the CDR matches the "phonenum" field of the service.
-
-=over 2
-
-Accepts the following options:
-
-=item for_update => 1: SELECT the CDRs "FOR UPDATE".
-
-=item status => "" (or "done"): Return only CDRs with that processing status.
-
-=item inbound => 1: Return CDRs for inbound calls. With "status", will filter
-on inbound processing status.
-
-=item default_prefix => "XXX": Also accept the phone number of the service prepended
-with the chosen prefix.
-
-=item disable_src => 1: Only match on "charged_party", not "src".
-
-=item by_svcnum: not supported for svc_phone
-
-=back
-
-=cut
-
-sub get_cdrs {
- my($self, %options) = @_;
- my @fields;
- my %hash;
- my @where;
-
- if ( $options{'inbound'} ) {
- @fields = ( 'dst' );
- if ( exists($options{'status'}) ) {
- # must be 'done' or ''
- my $sq = 'EXISTS ( SELECT 1 FROM cdr_termination '.
- 'WHERE cdr.acctid = cdr_termination.acctid '.
- 'AND cdr_termination.status = \'done\' '.
- 'AND cdr_termination.termpart = 1 )';
- if ( $options{'status'} eq 'done' ) {
- push @where, $sq;
- }
- elsif ($options{'status'} eq '' ) {
- push @where, "NOT $sq";
- }
- else {
- warn "invalid status: $options{'status'} (ignored)\n";
- }
- }
- }
- else {
- @fields = ( 'charged_party' );
- push @fields, 'src' if !$options{'disable_src'};
- $hash{'freesidestatus'} = $options{'status'}
- if exists($options{'status'});
- }
-
- my $for_update = $options{'for_update'} ? 'FOR UPDATE' : '';
-
- my $number = $self->phonenum;
-
- my $prefix = $options{'default_prefix'};
-
- my @orwhere = map " $_ = '$number' ", @fields;
- push @orwhere, map " $_ = '$prefix$number' ", @fields
- if length($prefix);
- if ( $prefix =~ /^\+(\d+)$/ ) {
- push @orwhere, map " $_ = '$1$number' ", @fields
- }
-
- push @where, ' ( '. join(' OR ', @orwhere ). ' ) ';
-
- if ( $options{'begin'} ) {
- push @where, 'startdate >= '. $options{'begin'};
- }
- if ( $options{'end'} ) {
- push @where, 'startdate < '. $options{'end'};
- }
-
- my $extra_sql = ( keys(%hash) ? ' AND ' : ' WHERE ' ). join(' AND ', @where );
-
- my @cdrs =
- qsearch( {
- 'table' => 'cdr',
- 'hashref' => \%hash,
- 'extra_sql' => $extra_sql,
- 'order_by' => "ORDER BY startdate $for_update",
- } );
-
- @cdrs;
-}
-
-=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_www.pm b/FS/FS/svc_www.pm
deleted file mode 100644
index 7e02d81..0000000
--- a/FS/FS/svc_www.pm
+++ /dev/null
@@ -1,286 +0,0 @@
-package FS::svc_www;
-
-use strict;
-use vars qw(@ISA $conf $apacheip);
-#use FS::Record qw( qsearch qsearchs );
-use FS::Record qw( qsearchs dbh );
-use FS::svc_Common;
-use FS::cust_svc;
-use FS::domain_record;
-use FS::svc_acct;
-use FS::svc_domain;
-
-@ISA = qw( FS::svc_Common );
-
-#ask FS::UID to run this stuff for us later
-$FS::UID::callback{'FS::svc_www'} = sub {
- $conf = new FS::Conf;
- $apacheip = $conf->config('apacheip');
-};
-
-=head1 NAME
-
-FS::svc_www - Object methods for svc_www records
-
-=head1 SYNOPSIS
-
- use FS::svc_www;
-
- $record = new FS::svc_www \%hash;
- $record = new FS::svc_www { '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_www object represents an web virtual host. FS::svc_www inherits
-from FS::svc_Common. The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key
-
-=item recnum - DNS `A' record corresponding to this web virtual host. (see L<FS::domain_record>)
-
-=item usersvc - account (see L<FS::svc_acct>) corresponding to this web virtual host.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new web virtual host. 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
-
-sub table_info {
- {
- 'name' => 'Hosting',
- 'name_plural' => 'Virtual hosting services',
- 'display_weight' => 40,
- 'cancel_weight' => 20,
- 'fields' => {
- },
- };
-};
-
-sub table { 'svc_www'; }
-
-=item label [ END_TIMESTAMP [ START_TIMESTAMP ] ]
-
-Returns the zone name for this virtual host.
-
-END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
-history records.
-
-=cut
-
-sub label {
- my $self = shift;
- $self->domain_record(@_)->zone;
-}
-
-=item insert [ , OPTION => VALUE ... ]
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-Currently available options are: I<depend_jobnum>
-
-If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
-jobnums), all provisioning jobs will have a dependancy on the supplied
-jobnum(s) (they will not run until the specific job(s) complete(s)).
-
-=cut
-
-sub preinsert_hook {
- my $self = shift;
-
- #return '' unless $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/;
- return '' unless $self->recnum =~ /^([\w\-]+|\@)\.(\d+)$/;
-
- my( $reczone, $domain_svcnum ) = ( $1, $2 );
- unless ( $apacheip ) {
- return "Configuration option apacheip not set; can't autocreate A record";
- #"for $reczone". $svc_domain->domain;
- }
- my $domain_record = new FS::domain_record {
- 'svcnum' => $domain_svcnum,
- 'reczone' => $reczone,
- 'recaf' => 'IN',
- 'rectype' => 'A',
- 'recdata' => $apacheip,
- };
- my $error = $domain_record->insert;
- return $error if $error;
-
- $self->recnum($domain_record->recnum);
- return '';
-}
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-sub delete {
- my $self = shift;
- my $error;
-
- $error = $self->SUPER::delete(@_);
- return $error if $error;
-
- '';
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my ( $new, $old ) = ( shift, shift );
- my $error;
-
- $error = $new->SUPER::replace($old, @_);
- return $error if $error;
-
- '';
-}
-
-=item suspend
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item unsuspend
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item cancel
-
-Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=item check
-
-Checks all fields to make sure this is a valid web virtual host. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $x = $self->setfixed;
- return $x unless ref($x);
- #my $part_svc = $x;
-
- my $error =
- $self->ut_numbern('svcnum')
-# || $self->ut_number('recnum')
- || $self->ut_numbern('usersvc')
- || $self->ut_anything('config')
- ;
- return $error if $error;
-
- if ( $self->recnum =~ /^(\d+)$/ ) {
-
- $self->recnum($1);
- return "Unknown recnum: ". $self->recnum
- unless qsearchs('domain_record', { 'recnum' => $self->recnum } );
-
- } elsif ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) {
-
- my( $reczone, $domain ) = ( $1, $2 );
-
- my $svc_domain = qsearchs( 'svc_domain', { 'domain' => $domain } )
- or return "unknown domain $domain (recnum $1.$2)";
-
- my $domain_record = qsearchs( 'domain_record', {
- 'reczone' => $reczone,
- 'svcnum' => $svc_domain->svcnum,
- });
-
- if ( $domain_record ) {
- $self->recnum($domain_record->recnum);
- } else {
- #insert will create it
- #$self->recnum("$reczone.$domain");
- $self->recnum("$reczone.". $svc_domain->svcnum);
- }
-
- } else {
- return "Illegal recnum: ". $self->recnum;
- }
-
- if ( $self->usersvc ) {
- return "Unknown usersvc0 (svc_acct.svcnum): ". $self->usersvc
- unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
- }
-
- $self->SUPER::check;
-
-}
-
-=item domain_record
-
-Returns the FS::domain_record record for this web virtual host's zone (see
-L<FS::domain_record>).
-
-=cut
-
-sub domain_record {
- my $self = shift;
- qsearchs('domain_record', { 'recnum' => $self->recnum } );
-}
-
-=item svc_acct
-
-Returns the FS::svc_acct record for this web virtual host's owner (see
-L<FS::svc_acct>).
-
-=cut
-
-sub svc_acct {
- my $self = shift;
- qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::svc_Common>, L<FS::Record>, L<FS::domain_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/tax_class.pm b/FS/FS/tax_class.pm
deleted file mode 100644
index 4f03969..0000000
--- a/FS/FS/tax_class.pm
+++ /dev/null
@@ -1,392 +0,0 @@
-package FS::tax_class;
-
-use strict;
-use vars qw( @ISA );
-use FS::UID qw(dbh);
-use FS::Record qw( qsearch qsearchs );
-use FS::Misc qw( csv_from_fixed );
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::tax_class - Object methods for tax_class records
-
-=head1 SYNOPSIS
-
- use FS::tax_class;
-
- $record = new FS::tax_class \%hash;
- $record = new FS::tax_class { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::tax_class object represents a tax class. FS::tax_class
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item taxclassnum
-
-Primary key
-
-=item data_vendor
-
-Vendor of the tax data
-
-=item taxclass
-
-Tax class
-
-=item description
-
-Human readable description of the tax class
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new tax class. To add the tax class 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 { 'tax_class'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-sub delete {
- my $self = shift;
-
- return "Can't delete a tax class which has tax rates!"
- if qsearch( 'tax_rate', { 'taxclassnum' => $self->taxclassnum } );
-
- return "Can't delete a tax class which has package tax rates!"
- if qsearch( 'part_pkg_taxrate', { 'taxclassnum' => $self->taxclassnum } );
-
- return "Can't delete a tax class which has package tax rates!"
- if qsearch( 'part_pkg_taxrate', { 'taxclassnumtaxed' => $self->taxclassnum } );
-
- return "Can't delete a tax class which has package tax overrides!"
- if qsearch( 'part_pkg_taxoverride', { 'taxclassnum' => $self->taxclassnum } );
-
- $self->SUPER::delete(@_);
-
-}
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid tax class. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('taxclassnum')
- || $self->ut_text('taxclass')
- || $self->ut_textn('data_vendor')
- || $self->ut_textn('description')
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item batch_import
-
-Loads part_pkg_taxrate records from an external CSV file. If there is
-an error, returns the error, otherwise returns false.
-
-=cut
-
-sub batch_import {
- my ($param, $job) = @_;
-
- my $fh = $param->{filehandle};
- my $format = $param->{'format'};
-
- my @fields;
- my $hook;
- my $endhook;
- my $data = {};
- my $imported = 0;
- my $dbh = dbh;
-
- my @column_lengths = ();
- my @column_callbacks = ();
- if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
- $format =~ s/-fixed//;
- push @column_lengths, qw( 8 10 3 2 2 10 100 );
- push @column_lengths, 1 if $format eq 'cch-update';
- }
-
- my $line;
- my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar
- if ( $job || scalar(@column_lengths) ) {
- my $error = csv_from_fixed(\$fh, \$count, \@column_lengths);
- return $error if $error;
- }
-
- if ( $format eq 'cch' || $format eq 'cch-update' ) {
- @fields = qw( table name pos length number value description );
- push @fields, 'actionflag' if $format eq 'cch-update';
-
- $hook = sub {
- my $hash = shift;
-
- if ($hash->{'table'} eq 'DETAIL') {
- push @{$data->{'taxcat'}}, [ $hash->{'value'}, $hash->{'description'} ]
- if ($hash->{'name'} eq 'TAXCAT' &&
- (!exists($hash->{actionflag}) || $hash->{actionflag} eq 'I') );
-
- push @{$data->{'taxtype'}}, [ $hash->{'value'}, $hash->{'description'} ]
- if ($hash->{'name'} eq 'TAXTYPE' &&
- (!exists($hash->{actionflag}) || $hash->{actionflag} eq 'I') );
-
- if (exists($hash->{actionflag}) && $hash->{actionflag} eq 'D') {
- my $name = $hash->{'name'};
- my $value = $hash->{'value'};
- return "Bad value for $name: $value"
- unless $value =~ /^\d+$/;
-
- if ($name eq 'TAXCAT' || $name eq 'TAXTYPE') {
- my @tax_class = qsearch( 'tax_class',
- { 'data_vendor' => 'cch' },
- '',
- "AND taxclass LIKE '".
- ($name eq 'TAXTYPE' ? $value : '%').":".
- ($name eq 'TAXCAT' ? $value : '%')."'",
- );
- foreach (@tax_class) {
- my $error = $_->delete;
- return $error if $error;
- }
- }
- }
-
- }
-
- delete($hash->{$_})
- for qw( data_vendor table name pos length number value description );
- delete($hash->{actionflag}) if exists($hash->{actionflag});
-
- '';
-
- };
-
- $endhook = sub {
-
- my $sql = "SELECT DISTINCT ".
- "substring(taxclass from 1 for position(':' in taxclass)-1),".
- "substring(description from 1 for position(':' in description)-1) ".
- "FROM tax_class WHERE data_vendor='cch'";
-
- my $sth = $dbh->prepare($sql) or die $dbh->errstr;
- $sth->execute or die $sth->errstr;
- my @old_types = @{$sth->fetchall_arrayref};
-
- $sql = "SELECT DISTINCT ".
- "substring(taxclass from position(':' in taxclass)+1),".
- "substring(description from position(':' in description)+1) ".
- "FROM tax_class WHERE data_vendor='cch'";
-
- $sth = $dbh->prepare($sql) or die $dbh->errstr;
- $sth->execute or die $sth->errstr;
- my @old_cats = @{$sth->fetchall_arrayref};
-
- my $catcount = exists($data->{'taxcat'}) ? scalar(@{$data->{'taxcat'}})
- : 0;
- my $typecount = exists($data->{'taxtype'}) ? scalar(@{$data->{'taxtype'}})
- : 0;
-
- my $count = scalar(@old_types) * $catcount
- + $typecount * (scalar(@old_cats) + $catcount);
-
- $imported = 1 if $format eq 'cch-update'; #empty file ok
-
- foreach my $type (@old_types) {
- foreach my $cat (@{$data->{'taxcat'}}) {
-
- if ( $job ) { # progress bar
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $imported / $count ). ",Importing tax classes"
- );
- die $error if $error;
- $last = time;
- }
- }
-
- my $tax_class =
- new FS::tax_class( { 'data_vendor' => 'cch',
- 'taxclass' => $type->[0].':'.$cat->[0],
- 'description' => $type->[1].':'.$cat->[1],
- } );
- my $error = $tax_class->insert;
- return $error if $error;
- $imported++;
- }
- }
-
- foreach my $type (@{$data->{'taxtype'}}) {
- foreach my $cat (@old_cats, @{$data->{'taxcat'}}) {
-
- if ( $job ) { # progress bar
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $imported / $count ). ",Importing tax classes"
- );
- die $error if $error;
- $last = time;
- }
- }
-
- my $tax_class =
- new FS::tax_class( { 'data_vendor' => 'cch',
- 'taxclass' => $type->[0].':'.$cat->[0],
- 'description' => $type->[1].':'.$cat->[1],
- } );
- my $error = $tax_class->insert;
- return $error if $error;
- $imported++;
- }
- }
-
- '';
- };
-
- } elsif ( $format eq 'extended' ) {
- die "unimplemented\n";
- @fields = qw( );
- $hook = sub {};
- } else {
- die "unknown format $format";
- }
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
-
- my $csv = new Text::CSV_XS;
-
- 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;
-
- while ( defined($line=<$fh>) ) {
-
- if ( $job ) { # progress bar
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $imported / $count ). ",Importing tax classes"
- );
- die $error if $error;
- $last = time;
- }
- }
-
- $csv->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $csv->error_input();
- };
-
- my @columns = $csv->fields();
-
- my %tax_class = ( 'data_vendor' => $format );
- foreach my $field ( @fields ) {
- $tax_class{$field} = shift @columns;
- }
- if ( scalar( @columns ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Unexpected trailing columns in line (wrong format?): $line";
- }
-
- my $error = &{$hook}(\%tax_class);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- next unless scalar(keys %tax_class);
-
- my $tax_class = new FS::tax_class( \%tax_class );
- $error = $tax_class->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert tax_class for $line: $error";
- }
-
- $imported++;
- }
-
- my $error = &{$endhook}();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert tax_class for $line: $error";
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return "Empty File!" unless ($imported || $format eq 'cch-update');
-
- ''; #no error
-
-}
-
-=back
-
-=head1 BUGS
-
- batch_import does not handle mixed I and D records in the same file for
- format cch-update
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
-
diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm
deleted file mode 100644
index d8ee875..0000000
--- a/FS/FS/tax_rate.pm
+++ /dev/null
@@ -1,2087 +0,0 @@
-package FS::tax_rate;
-
-use strict;
-use vars qw( @ISA $DEBUG $me
- %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities
- %tax_passtypes %GetInfoType $keep_cch_files );
-use Date::Parse;
-use DateTime;
-use DateTime::Format::Strptime;
-use Storable qw( thaw nfreeze );
-use IO::File;
-use File::Temp;
-use LWP::UserAgent;
-use HTTP::Request;
-use HTTP::Response;
-use MIME::Base64;
-use DBIx::DBSchema;
-use DBIx::DBSchema::Table;
-use DBIx::DBSchema::Column;
-use FS::Record qw( qsearch qsearchs dbh dbdef );
-use FS::Conf;
-use FS::tax_class;
-use FS::cust_bill_pkg;
-use FS::cust_tax_location;
-use FS::tax_rate_location;
-use FS::part_pkg_taxrate;
-use FS::part_pkg_taxproduct;
-use FS::cust_main;
-use FS::Misc qw( csv_from_fixed );
-
-use URI::Escape;
-
-@ISA = qw( FS::Record );
-
-$DEBUG = 0;
-$me = '[FS::tax_rate]';
-$keep_cch_files = 0;
-
-=head1 NAME
-
-FS::tax_rate - Object methods for tax_rate objects
-
-=head1 SYNOPSIS
-
- use FS::tax_rate;
-
- $record = new FS::tax_rate \%hash;
- $record = new FS::tax_rate { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::tax_rate object represents a tax rate, defined by locale.
-FS::tax_rate inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item taxnum
-
-primary key (assigned automatically for new tax rates)
-
-=item geocode
-
-a geographic location code provided by a tax data vendor
-
-=item data_vendor
-
-the tax data vendor
-
-=item location
-
-a location code provided by a tax authority
-
-=item taxclassnum
-
-a foreign key into FS::tax_class - the type of tax
-referenced but FS::part_pkg_taxrate
-eitem effective_date
-
-the time after which the tax applies
-
-=item tax
-
-percentage
-
-=item excessrate
-
-second bracket percentage
-
-=item taxbase
-
-the amount to which the tax applies (first bracket)
-
-=item taxmax
-
-a cap on the amount of tax if a cap exists
-
-=item usetax
-
-percentage on out of jurisdiction purchases
-
-=item useexcessrate
-
-second bracket percentage on out of jurisdiction purchases
-
-=item unittype
-
-one of the values in %tax_unittypes
-
-=item fee
-
-amount of tax per unit
-
-=item excessfee
-
-second bracket amount of tax per unit
-
-=item feebase
-
-the number of units to which the fee applies (first bracket)
-
-=item feemax
-
-the most units to which fees apply (first and second brackets)
-
-=item maxtype
-
-a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
-
-=item taxname
-
-if defined, printed on invoices instead of "Tax"
-
-=item taxauth
-
-a value from %tax_authorities
-
-=item basetype
-
-a value from %tax_basetypes indicating the tax basis
-
-=item passtype
-
-a value from %tax_passtypes indicating how the tax should displayed to the customer
-
-=item passflag
-
-'Y', 'N', or blank indicating the tax can be passed to the customer
-
-=item setuptax
-
-if 'Y', this tax does not apply to setup fees
-
-=item recurtax
-
-if 'Y', this tax does not apply to recurring fees
-
-=item manual
-
-if 'Y', has been manually edited
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
-
-=cut
-
-sub table { 'tax_rate'; }
-
-=item insert
-
-Adds this tax rate to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this tax rate from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid tax rate. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- foreach (qw( taxbase taxmax )) {
- $self->$_(0) unless $self->$_;
- }
-
- $self->ut_numbern('taxnum')
- || $self->ut_text('geocode')
- || $self->ut_textn('data_vendor')
- || $self->ut_textn('location')
- || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
- || $self->ut_snumbern('effective_date')
- || $self->ut_float('tax')
- || $self->ut_floatn('excessrate')
- || $self->ut_money('taxbase')
- || $self->ut_money('taxmax')
- || $self->ut_floatn('usetax')
- || $self->ut_floatn('useexcessrate')
- || $self->ut_numbern('unittype')
- || $self->ut_floatn('fee')
- || $self->ut_floatn('excessfee')
- || $self->ut_floatn('feemax')
- || $self->ut_numbern('maxtype')
- || $self->ut_textn('taxname')
- || $self->ut_numbern('taxauth')
- || $self->ut_numbern('basetype')
- || $self->ut_numbern('passtype')
- || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
- || $self->ut_enum('setuptax', [ '', 'Y' ] )
- || $self->ut_enum('recurtax', [ '', 'Y' ] )
- || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] )
- || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
- || $self->ut_enum('manual', [ '', 'Y' ] )
- || $self->ut_enum('disabled', [ '', 'Y' ] )
- || $self->SUPER::check
- ;
-
-}
-
-=item taxclass_description
-
-Returns the human understandable value associated with the related
-FS::tax_class.
-
-=cut
-
-sub taxclass_description {
- my $self = shift;
- my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
- $tax_class ? $tax_class->description : '';
-}
-
-=item unittype_name
-
-Returns the human understandable value associated with the unittype column
-
-=cut
-
-%tax_unittypes = ( '0' => 'access line',
- '1' => 'minute',
- '2' => 'account',
-);
-
-sub unittype_name {
- my $self = shift;
- $tax_unittypes{$self->unittype};
-}
-
-=item maxtype_name
-
-Returns the human understandable value associated with the maxtype column
-
-=cut
-
-%tax_maxtypes = ( '0' => 'receipts per invoice',
- '1' => 'receipts per item',
- '2' => 'total utility charges per utility tax year',
- '3' => 'total charges per utility tax year',
- '4' => 'receipts per access line',
- '9' => 'monthly receipts per location',
-);
-
-sub maxtype_name {
- my $self = shift;
- $tax_maxtypes{$self->maxtype};
-}
-
-=item basetype_name
-
-Returns the human understandable value associated with the basetype column
-
-=cut
-
-%tax_basetypes = ( '0' => 'sale price',
- '1' => 'gross receipts',
- '2' => 'sales taxable telecom revenue',
- '3' => 'minutes carried',
- '4' => 'minutes billed',
- '5' => 'gross operating revenue',
- '6' => 'access line',
- '7' => 'account',
- '8' => 'gross revenue',
- '9' => 'portion gross receipts attributable to interstate service',
- '10' => 'access line',
- '11' => 'gross profits',
- '12' => 'tariff rate',
- '14' => 'account',
- '15' => 'prior year gross receipts',
-);
-
-sub basetype_name {
- my $self = shift;
- $tax_basetypes{$self->basetype};
-}
-
-=item taxauth_name
-
-Returns the human understandable value associated with the taxauth column
-
-=cut
-
-%tax_authorities = ( '0' => 'federal',
- '1' => 'state',
- '2' => 'county',
- '3' => 'city',
- '4' => 'local',
- '5' => 'county administered by state',
- '6' => 'city administered by state',
- '7' => 'city administered by county',
- '8' => 'local administered by state',
- '9' => 'local administered by county',
-);
-
-sub taxauth_name {
- my $self = shift;
- $tax_authorities{$self->taxauth};
-}
-
-=item passtype_name
-
-Returns the human understandable value associated with the passtype column
-
-=cut
-
-%tax_passtypes = ( '0' => 'separate tax line',
- '1' => 'separate surcharge line',
- '2' => 'surcharge not separated',
- '3' => 'included in base rate',
-);
-
-sub passtype_name {
- my $self = shift;
- $tax_passtypes{$self->passtype};
-}
-
-=item taxline TAXABLES, [ OPTIONSHASH ]
-
-Returns a listref of a name and an amount of tax calculated for the list
-of packages/amounts referenced by TAXABLES. If an error occurs, a message
-is returned as a scalar.
-
-=cut
-
-sub taxline {
- my $self = shift;
-
- my $taxables;
- my %opt = ();
-
- if (ref($_[0]) eq 'ARRAY') {
- $taxables = shift;
- %opt = @_;
- }else{
- $taxables = [ @_ ];
- #exemptions would be broken in this case
- }
-
- my $name = $self->taxname;
- $name = 'Other surcharges'
- if ($self->passtype == 2);
- my $amount = 0;
-
- if ( $self->disabled ) { # we always know how to handle disabled taxes
- return {
- 'name' => $name,
- 'amount' => $amount,
- };
- }
-
- my $taxable_charged = 0;
- my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
- @$taxables;
-
- warn "calculating taxes for ". $self->taxnum. " on ".
- join (",", map { $_->pkgnum } @cust_bill_pkg)
- if $DEBUG;
-
- if ($self->passflag eq 'N') {
- # return "fatal: can't (yet) handle taxes not passed to the customer";
- # until someone needs to track these in freeside
- return {
- 'name' => $name,
- 'amount' => 0,
- };
- }
-
- my $maxtype = $self->maxtype || 0;
- if ($maxtype != 0 && $maxtype != 9) {
- return $self->_fatal_or_null( 'tax with "'.
- $self->maxtype_name. '" threshold'
- );
- }
-
- if ($maxtype == 9) {
- return
- $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
- # "texas" tax
- }
-
- # we treat gross revenue as gross receipts and expect the tax data
- # to DTRT (i.e. tax on tax rules)
- if ($self->basetype != 0 && $self->basetype != 1 &&
- $self->basetype != 5 && $self->basetype != 6 &&
- $self->basetype != 7 && $self->basetype != 8 &&
- $self->basetype != 14
- ) {
- return
- $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
- }
-
- unless ($self->setuptax =~ /^Y$/i) {
- $taxable_charged += $_->setup foreach @cust_bill_pkg;
- }
- unless ($self->recurtax =~ /^Y$/i) {
- $taxable_charged += $_->recur foreach @cust_bill_pkg;
- }
-
- my $taxable_units = 0;
- unless ($self->recurtax =~ /^Y$/i) {
-
- if (( $self->unittype || 0 ) == 0) { #access line
- my %seen = ();
- foreach (@cust_bill_pkg) {
- $taxable_units += $_->units
- unless $seen{$_->pkgnum}++;
- }
-
- } elsif ($self->unittype == 1) { #minute
- return $self->_fatal_or_null( 'fee with minute unit type' );
-
- } elsif ($self->unittype == 2) { #account
-
- my $conf = new FS::Conf;
- if ( $conf->exists('tax-pkg_address') ) {
- #number of distinct locations
- my %seen = ();
- foreach (@cust_bill_pkg) {
- $taxable_units++
- unless $seen{$_->cust_pkg->locationnum}++;
- }
- } else {
- $taxable_units = 1;
- }
-
- } else {
- return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
- }
-
- }
-
- #
- # XXX insert exemption handling here
- #
- # the tax or fee is applied to taxbase or feebase and then
- # the excessrate or excess fee is applied to taxmax or feemax
- #
-
- $amount += $taxable_charged * $self->tax;
- $amount += $taxable_units * $self->fee;
-
- warn "calculated taxes as [ $name, $amount ]\n"
- if $DEBUG;
-
- return {
- 'name' => $name,
- 'amount' => $amount,
- };
-
-}
-
-sub _fatal_or_null {
- my ($self, $error) = @_;
-
- my $conf = new FS::Conf;
-
- $error = "can't yet handle ". $error;
- my $name = $self->taxname;
- $name = 'Other surcharges'
- if ($self->passtype == 2);
-
- if ($conf->exists('ignore_incalculable_taxes')) {
- warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
- return { name => $name, amount => 0 };
- } else {
- return "fatal: $error";
- }
-}
-
-=item tax_on_tax CUST_MAIN
-
-Returns a list of taxes which are candidates for taxing taxes for the
-given customer (see L<FS::cust_main>)
-
-=cut
-
- #hot
-sub tax_on_tax {
- #akshun
- my $self = shift;
- my $cust_main = shift;
-
- warn "looking up taxes on tax ". $self->taxnum. " for customer ".
- $cust_main->custnum
- if $DEBUG;
-
- my $geocode = $cust_main->geocode($self->data_vendor);
-
- # CCH oddness in m2m
- my $dbh = dbh;
- my $extra_sql = ' AND ('.
- join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
- qw(10 5 2)
- ).
- ')';
-
- my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
- my $select = 'DISTINCT ON(taxclassnum) *';
-
- # should qsearch preface columns with the table to facilitate joins?
- my @taxclassnums = map { $_->taxclassnum }
- qsearch( { 'table' => 'part_pkg_taxrate',
- 'select' => $select,
- 'hashref' => { 'data_vendor' => $self->data_vendor,
- 'taxclassnumtaxed' => $self->taxclassnum,
- },
- 'extra_sql' => $extra_sql,
- 'order_by' => $order_by,
- } );
-
- return () unless @taxclassnums;
-
- $extra_sql =
- "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
-
- qsearch({ 'table' => 'tax_rate',
- 'hashref' => { 'geocode' => $geocode, },
- 'extra_sql' => $extra_sql,
- })
-
-}
-
-=item tax_rate_location
-
-Returns an object representing the location associated with this tax
-(see L<FS::tax_rate_location>)
-
-=cut
-
-sub tax_rate_location {
- my $self = shift;
-
- qsearchs({ 'table' => 'tax_rate_location',
- 'hashref' => { 'data_vendor' => $self->data_vendor,
- 'geocode' => $self->geocode,
- 'disabled' => '',
- },
- }) ||
- new FS::tax_rate_location;
-
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item batch_import
-
-=cut
-
-sub _progressbar_foo {
- return (0, time, 5);
-}
-
-sub batch_import {
- my ($param, $job) = @_;
-
- my $fh = $param->{filehandle};
- my $format = $param->{'format'};
-
- my %insert = ();
- my %delete = ();
-
- my @fields;
- my $hook;
-
- my @column_lengths = ();
- my @column_callbacks = ();
- if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
- $format =~ s/-fixed//;
- my $date_format = sub { my $r='';
- /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
- $r;
- };
- my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
- push @column_lengths, qw( 10 1 1 8 8 5 8 8 8 1 2 2 30 8 8 10 2 8 2 1 2 2 );
- push @column_lengths, 1 if $format eq 'cch-update';
- push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
- $column_callbacks[8] = $date_format;
- }
-
- my $line;
- my ( $count, $last, $min_sec ) = _progressbar_foo();
- if ( $job || scalar(@column_callbacks) ) {
- my $error =
- csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
- return $error if $error;
- }
- $count *=2;
-
- if ( $format eq 'cch' || $format eq 'cch-update' ) {
- @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
- excessrate effective_date taxauth taxtype taxcat taxname
- usetax useexcessrate fee unittype feemax maxtype passflag
- passtype basetype );
- push @fields, 'actionflag' if $format eq 'cch-update';
-
- $hook = sub {
- my $hash = shift;
-
- $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
- $hash->{'data_vendor'} ='cch';
- my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
- time_zone => 'floating',
- );
- 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 =
- join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
-
- my %tax_class = ( 'data_vendor' => 'cch',
- 'taxclass' => $taxclassid,
- );
-
- my $tax_class = qsearchs( 'tax_class', \%tax_class );
- return "Error updating tax rate: no tax class $taxclassid"
- unless $tax_class;
-
- $hash->{'taxclassnum'} = $tax_class->taxclassnum;
-
- foreach (qw( taxtype taxcat )) {
- delete($hash->{$_});
- }
-
- my %passflagmap = ( '0' => '',
- '1' => 'Y',
- '2' => 'N',
- );
- $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
- if exists $passflagmap{$hash->{'passflag'}};
-
- foreach (keys %$hash) {
- $hash->{$_} = substr($hash->{$_}, 0, 80)
- if length($hash->{$_}) > 80;
- }
-
- my $actionflag = delete($hash->{'actionflag'});
-
- $hash->{'taxname'} =~ s/`/'/g;
- $hash->{'taxname'} =~ s|\\|/|g;
-
- return '' if $format eq 'cch'; # but not cch-update
-
- if ($actionflag eq 'I') {
- $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
- }elsif ($actionflag eq 'D') {
- $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
- }else{
- return "Unexpected action flag: ". $hash->{'actionflag'};
- }
-
- delete($hash->{$_}) for keys %$hash;
-
- '';
-
- };
-
- } elsif ( $format eq 'extended' ) {
- die "unimplemented\n";
- @fields = qw( );
- $hook = sub {};
- } else {
- die "unknown format $format";
- }
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
-
- my $csv = new Text::CSV_XS;
-
- my $imported = 0;
-
- 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;
-
- while ( defined($line=<$fh>) ) {
- $csv->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $csv->error_input();
- };
-
- if ( $job ) { # progress bar
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $imported / $count ). ",Importing tax rates"
- );
- if ($error) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
- $last = time;
- }
- }
-
- my @columns = $csv->fields();
-
- my %tax_rate = ( 'data_vendor' => $format );
- foreach my $field ( @fields ) {
- $tax_rate{$field} = shift @columns;
- }
- if ( scalar( @columns ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Unexpected trailing columns in line (wrong format?): $line";
- }
-
- my $error = &{$hook}(\%tax_rate);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
-
- my $tax_rate = new FS::tax_rate( \%tax_rate );
- $error = $tax_rate->insert;
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert tax_rate for $line: $error";
- }
-
- }
-
- $imported++;
-
- }
-
- for (grep { !exists($delete{$_}) } keys %insert) {
- if ( $job ) { # progress bar
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $imported / $count ). ",Importing tax rates"
- );
- if ($error) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
- $last = time;
- }
- }
-
- my $tax_rate = new FS::tax_rate( $insert{$_} );
- my $error = $tax_rate->insert;
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- my $hashref = $insert{$_};
- $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
- return "can't insert tax_rate for $line: $error";
- }
-
- $imported++;
- }
-
- for (grep { exists($delete{$_}) } keys %insert) {
- if ( $job ) { # progress bar
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $imported / $count ). ",Importing tax rates"
- );
- if ($error) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
- $last = time;
- }
- }
-
- my $old = qsearchs( 'tax_rate', $delete{$_} );
- unless ($old) {
- $dbh->rollback if $oldAutoCommit;
- $old = $delete{$_};
- return "can't find tax_rate to replace for: ".
- #join(" ", map { "$_ => ". $old->{$_} } @fields);
- join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
- }
- my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
- $new->taxnum($old->taxnum);
- my $error = $new->replace($old);
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- my $hashref = $insert{$_};
- $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
- return "can't replace tax_rate for $line: $error";
- }
-
- $imported++;
- $imported++;
- }
-
- for (grep { !exists($insert{$_}) } keys %delete) {
- if ( $job ) { # progress bar
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $imported / $count ). ",Importing tax rates"
- );
- if ($error) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
- $last = time;
- }
- }
-
- my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
- unless ($tax_rate) {
- $dbh->rollback if $oldAutoCommit;
- $tax_rate = $delete{$_};
- return "can't find tax_rate to delete for: ".
- #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
- join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
- }
- my $error = $tax_rate->delete;
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- my $hashref = $delete{$_};
- $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
- return "can't delete tax_rate for $line: $error";
- }
-
- $imported++;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return "Empty file!" unless ($imported || $format eq 'cch-update');
-
- ''; #no error
-
-}
-
-=item process_batch_import
-
-Load a batch import as a queued JSRPC job
-
-=cut
-
-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 $args = '$job, encode_base64( nfreeze( $param ) )';
-
- my $method = '_perform_batch_import';
- if ( $param->{reload} ) {
- $method = 'process_batch_reload';
- }
-
- eval "$method($args);";
- if ($@) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $@;
- }
-
- #success!
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-}
-
-sub _perform_batch_import {
- my $job = shift;
-
- my $param = thaw(decode_base64(shift));
- my $format = $param->{'format'}; #well... this is all cch specific
-
- 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;
- my $dbh = dbh;
- my $error = '';
- my @insert_list = ();
- my @delete_list = ();
- my @predelete_list = ();
- my $insertname = '';
- my $deletename = '';
- my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
-
- 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, $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};
-
- 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;
- }
-
- } else {
-
- push @insert_list, $name, $filename, $import_sub, $format;
-
- }
-
- }
-
- push @insert_list,
- 'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format
- if $format =~ /update/;
-
- $error ||= _perform_cch_tax_import( $job,
- [ @predelete_list ],
- [ @insert_list ],
- [ @delete_list ],
- );
-
-
- @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;
- }else{
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- }
-
- }else{
- die "Unknown format: $format";
- }
-
-}
-
-
-sub _perform_cch_tax_import {
- my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
-
- 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;
- }
- }
-
- return $error;
-}
-
-sub _perform_cch_insert_delete_split {
- my ($name, $filename, $dir, $format) = @_;
-
- my $error = '';
-
- 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 ) = @_;
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
-
- eval "use XBase;";
- die $@ if $@;
-
- 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();
-
- my @items = qsearch( { table => 'tax_rate',
- hashref => { disabled => 'Y',
- data_vendor => $format,
- },
- select => 'geocode, taxclassnum',
- }
- );
- my $count = scalar(@items);
- foreach my $tax_rate ( @items ) {
- if ( time - $min_sec > $last ) {
- $job->update_statustext(
- int( 100 * $imported / $count ). ",Remembering disabled taxes"
- );
- $last = time;
- }
- $imported++;
- my $tax_class =
- qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
- unless ( $tax_class ) {
- warn "failed to find tax_class ". $tax_rate->taxclassnum;
- next;
- }
- $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
- }
-}
-
-sub _remember_tax_products {
- my ( $job, $format, $taxproduct ) = @_;
-
- # XXX FIXME this loop only works when cch is the only data provider
-
- 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 != '' )";
- 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 ) {
- $job->update_statustext(
- int( 100 * $imported / $count ). ",Remembering tax products"
- );
- $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 && $part_pkg_taxproduct->data_vendor eq $format;
-
- foreach my $option ( $part_pkg->part_pkg_option ) {
- 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 && $part_pkg_taxproduct->data_vendor eq $format;
- }
- }
-}
-
-sub _restore_remembered_tax_products {
- my ( $job, $format, $taxproduct ) = @_;
-
- # cch specific
-
- 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 ) {
- $job->update_statustext(
- int( 100 * $imported / $count ). ",Restoring tax products"
- );
- $last = time;
- }
- $imported++;
-
- my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
- unless ( $part_pkg ) {
- return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
- }
-
- my %options = $part_pkg->options;
- my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
- my $primary_svc = $part_pkg->svcpart;
- my $new = new FS::part_pkg { $part_pkg->hash };
-
- 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},
- data_vendor => $format,
- }
- );
-
- unless ( $part_pkg_taxproduct ) {
- return "failed to find part_pkg_taxproduct (".
- $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
- }
-
- if ( $class eq '' ) {
- $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
- next;
- }
-
- $options{"usage_taxproductnum_$class"} =
- $part_pkg_taxproduct->taxproductnum;
-
- }
-
- my $error = $new->replace( $part_pkg,
- 'pkg_svc' => \%pkg_svc,
- 'primary_svc' => $primary_svc,
- 'options' => \%options,
- );
-
- return $error if $error;
-
- }
-
- '';
-}
-
-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 ) {
- $job->update_statustext(
- int( 100 * $imported / $count ). ",Disabling tax rates"
- );
- $last = time;
- }
- $imported++;
- my ($geocode,$taxclass) = split /:/, $key, 2;
- my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
- taxclass => $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";
- next;
- }
-
- my @tax_rate =
- qsearch('tax_rate', { data_vendor => $format,
- geocode => $geocode,
- taxclassnum => $tax_class[0]->taxclassnum,
- }
- );
-
- if (scalar(@tax_rate) > 1) {
- 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;
- return $error if $error;
- }
- }
-}
-
-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', @_);
-}
-
-
-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
-
-=cut
-
-sub process_download_and_update {
- my $job = shift;
-
- my $param = thaw(decode_base64(shift));
- 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 $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') {
-
- my @namelist = qw( code detail geocode plus4 txmatrix zip );
-
- my $conf = new FS::Conf;
- die "direct download of tax data not enabled\n"
- unless $conf->exists('taxdatadirectdownload');
- my ( $urls, $username, $secret, $states ) =
- $conf->config('taxdatadirectdownload');
- die "No tax download URL provided. ".
- "Did you set the taxdatadirectdownload configuration value?\n"
- unless $urls;
-
- $dir .= '/cch';
-
- 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 $update = $sth->fetchrow_arrayref->[0];
-
- # create cache and/or rotate old tax data
-
- if (-d $dir) {
-
- if (-d "$dir.4") {
- opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
- foreach my $file (readdir($dirh)) {
- unlink "$dir.4/$file" if (-f "$dir.4/$file");
- }
- closedir($dirh);
- rmdir "$dir.4";
- }
-
- for (3, 2, 1) {
- if ( -e "$dir.$_" ) {
- rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
- }
- }
- rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
-
- } else {
-
- die "can't find previous tax data\n" if $update;
-
- }
-
- mkdir "$dir.new" or die "can't create $dir.new: $!\n";
-
- # fetch and unpack the zip files
-
- _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
-
- # extract csv files from the dbf files
-
- foreach my $name ( @namelist ) {
- _cch_extract_csv_from_dbf( $job, $dir, $name );
- }
-
- # generate the diff files
-
- 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 );
- }
- $difffile =~ s/^$cache_dir//;
- push @list, "${name}file:$difffile";
- }
-
- # 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 ) ) );
-
- rename "$dir.new", "$dir"
- or die "cch tax update processed, but can't rename $dir.new: $!\n";
-
- }else{
- die "Unknown format: $format";
- }
-}
-
-=item browse_queries PARAMS
-
-Returns a list consisting of a hashref suited for use as the argument
-to qsearch, and sql query string. Each is based on the PARAMS hashref
-of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
-from a form. This conveniently creates the query hashref and count_query
-string required by the browse and search elements. As a side effect,
-the PARAMS hashref is untainted and keys with unexpected values are removed.
-
-=cut
-
-sub browse_queries {
- my $params = shift;
-
- my $query = {
- 'table' => 'tax_rate',
- 'hashref' => {},
- 'order_by' => 'ORDER BY geocode, taxclassnum',
- },
-
- my $extra_sql = '';
-
- if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
- $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
- } else {
- delete $params->{data_vendor};
- }
-
- if ( $params->{geocode} =~ /^(\w+)$/ ) {
- $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
- 'geocode LIKE '. dbh->quote($1.'%');
- } else {
- delete $params->{geocode};
- }
-
- if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
- qsearchs( 'tax_class', {'taxclassnum' => $1} )
- )
- {
- $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
- ' taxclassnum = '. dbh->quote($1)
- } else {
- delete $params->{taxclassnun};
- }
-
- my $tax_type = $1
- if ( $params->{tax_type} =~ /^(\d+)$/ );
- delete $params->{tax_type}
- unless $tax_type;
-
- my $tax_cat = $1
- if ( $params->{tax_cat} =~ /^(\d+)$/ );
- delete $params->{tax_cat}
- unless $tax_cat;
-
- my @taxclassnum = ();
- if ($tax_type || $tax_cat ) {
- my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
- $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
- @taxclassnum = map { $_->taxclassnum }
- qsearch({ 'table' => 'tax_class',
- 'hashref' => {},
- 'extra_sql' => "WHERE taxclass $compare",
- });
- }
-
- $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
- join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
- if ( @taxclassnum );
-
- unless ($params->{'showdisabled'}) {
- $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
- "( disabled = '' OR disabled IS NULL )";
- }
-
- $query->{extra_sql} = $extra_sql;
-
- return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
-}
-
-=item queue_liability_report PARAMS
-
-Launches a tax liability report.
-=cut
-
-sub queue_liability_report {
- my $job = shift;
- my $param = thaw(decode_base64(shift));
-
- my $cgi = new CGI;
- $cgi->param('beginning', $param->{beginning});
- $cgi->param('ending', $param->{ending});
- my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
- my $agentnum = $param->{agentnum};
- if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
- generate_liability_report(
- 'beginning' => $beginning,
- 'ending' => $ending,
- 'agentnum' => $agentnum,
- 'p' => $param->{RootURL},
- 'job' => $job,
- );
-}
-
-=item generate_liability_report PARAMS
-
-Generates a tax liability report. Provide a hash including desired
-agentnum, beginning, and ending
-
-=cut
-
-sub generate_liability_report {
- my %args = @_;
-
- my ( $count, $last, $min_sec ) = _progressbar_foo();
-
- #let us open the temp file early
- my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
- my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
- DIR => $dir,
- UNLINK => 0, # not so temp
- ) or die "can't open report file: $!\n";
-
- my $conf = new FS::Conf;
- my $money_char = $conf->config('money_char') || '$';
-
- my $join_cust = "
- JOIN cust_bill USING ( invnum )
- LEFT JOIN cust_main USING ( custnum )
- ";
-
- my $join_loc =
- "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
- my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
-
- my $addl_from = " $join_cust $join_loc $join_tax_loc ";
-
- my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
-
- my $agentname = '';
- if ( $args{agentnum} =~ /^(\d+)$/ ) {
- my $agent = qsearchs('agent', { 'agentnum' => $1 } );
- die "agent not found" unless $agent;
- $agentname = $agent->agent;
- $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
- }
-
- # my ( $location_sql, @location_param ) = FS::cust_pkg->location_sql;
- # $where .= " AND $location_sql";
- #my @taxparam = ( 'itemdesc', @location_param );
- # now something along the lines of geocode matching ?
- #$where .= FS::cust_pkg->_location_sql_where('cust_tax_location');;
- my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
-
- my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
-
- #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
- #to FS::Report or FS::Record or who the fuck knows where)
- my $scalar_sql = sub {
- my( $r, $param, $sql ) = @_;
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute( map $r->$_(), @$param )
- or die "Unexpected error executing statement $sql: ". $sth->errstr;
- $sth->fetchrow_arrayref->[0] || 0;
- };
-
- my $tax = 0;
- my $credit = 0;
- my %taxes = ();
- my %basetaxes = ();
- my $calculated = 0;
- my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
- select => $select,
- hashref => { pkgpart => 0 },
- addl_from => $addl_from,
- extra_sql => $where,
- });
- $count = scalar(@tax_and_location);
- foreach my $t ( @tax_and_location ) {
-
- if ( $args{job} ) {
- if ( time - $min_sec > $last ) {
- $args{job}->update_statustext( int( 100 * $calculated / $count ).
- ",Calculated"
- );
- $last = time;
- }
- }
-
- my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
- my $label = join('~', map { $t->$_ } @params);
- $label = 'Tax'. $label if $label =~ /^~/;
- unless ( exists( $taxes{$label} ) ) {
- my ($baselabel, @trash) = split /~/, $label;
-
- $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
- $taxes{$label}->{'url_param'} =
- join(';', map { "$_=". uri_escape($t->$_) } @params);
-
- my $taxwhere = "FROM cust_bill_pkg $addl_from $where AND payby != 'COMP' ".
- "AND ". join( ' AND ', map { "( $_ = ? OR ? = '' AND $_ IS NULL)" } @taxparam );
-
- my $sql = "SELECT SUM(cust_bill_pkg.setup+cust_bill_pkg.recur) ".
- " $taxwhere AND cust_bill_pkg.pkgnum = 0";
-
- my $x = &{$scalar_sql}($t, [ map { $_, $_ } @params ], $sql );
- $tax += $x;
- $taxes{$label}->{'tax'} += $x;
-
- my $creditfrom = " JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum) ";
- my $creditwhere = "FROM cust_bill_pkg $addl_from $creditfrom $where ".
- "AND payby != 'COMP' ".
- "AND ". join( ' AND ', map { "( $_ = ? OR ? = '' AND $_ IS NULL)" } @taxparam );
-
- $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
- " $creditwhere AND cust_bill_pkg.pkgnum = 0";
-
- my $y = &{$scalar_sql}($t, [ map { $_, $_ } @params ], $sql );
- $credit += $y;
- $taxes{$label}->{'credit'} += $y;
-
- unless ( exists( $taxes{$baselabel} ) ) {
-
- $basetaxes{$baselabel}->{'label'} = $baselabel;
- $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
- $basetaxes{$baselabel}->{'base'} = 1;
-
- }
-
- $basetaxes{$baselabel}->{'tax'} += $x;
- $basetaxes{$baselabel}->{'credit'} += $y;
-
- }
-
- # calculate customer-exemption for this tax
- # calculate package-exemption for this tax
- # calculate monthly exemption (texas tax) for this tax
- # count up all the cust_tax_exempt_pkg records associated with
- # the actual line items.
- }
-
-
- #ordering
-
- if ( $args{job} ) {
- $args{job}->update_statustext( "0,Sorted" );
- $last = time;
- }
-
- my @taxes = ();
-
- foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
- my ($base, @trash) = split '~', $tax;
- my $basetax = delete( $basetaxes{$base} );
- if ($basetax) {
- if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
- $taxes{$tax}->{base} = 1;
- } else {
- push @taxes, $basetax;
- }
- }
- push @taxes, $taxes{$tax};
- }
-
- push @taxes, {
- 'label' => 'Total',
- 'url_param' => '',
- 'tax' => $tax,
- 'credit' => $credit,
- 'base' => 1,
- };
-
-
- my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
- $dateagentlink .= ';agentnum='. $args{agentnum}
- if length($agentname);
- my $baselink = $args{p}. "search/cust_bill_pkg.cgi?$dateagentlink";
-
-
- print $report <<EOF;
-
- <% include("/elements/header.html", "$agentname Tax Report - ".
- ( $args{beginning}
- ? time2str('%h %o %Y ', $args{beginning} )
- : ''
- ).
- 'through '.
- ( $args{ending} == 4294967295
- ? 'now'
- : time2str('%h %o %Y', $args{ending} )
- )
- )
- %>
-
- <% include('/elements/table-grid.html') %>
-
- <TR>
- <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
- <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
- <TH CLASS="grid" BGCOLOR="#cccccc">Tax collected</TH>
- <TH CLASS="grid" BGCOLOR="#cccccc">&nbsp;&nbsp;&nbsp;&nbsp;</TH>
- <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
- <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
- </TR>
-EOF
-
- my $bgcolor1 = '#eeeeee';
- my $bgcolor2 = '#ffffff';
- my $bgcolor = '';
-
- $count = scalar(@taxes);
- $calculated = 0;
- foreach my $tax ( @taxes ) {
-
- if ( $args{job} ) {
- if ( time - $min_sec > $last ) {
- $args{job}->update_statustext( int( 100 * $calculated / $count ).
- ",Generated"
- );
- $last = time;
- }
- }
-
- if ( $bgcolor eq $bgcolor1 ) {
- $bgcolor = $bgcolor2;
- } else {
- $bgcolor = $bgcolor1;
- }
-
- my $link = '';
- if ( $tax->{'label'} ne 'Total' ) {
- $link = ';'. $tax->{'url_param'};
- }
-
- print $report <<EOF;
- <TR>
- <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
- <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
- <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
- <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
- </TD>
- <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
- <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
- <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
- <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
- <A HREF="<% '$baselink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
- </TD>
- <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
- </TR>
-EOF
- }
-
- print $report <<EOF;
- </TABLE>
-
- </BODY>
- </HTML>
-EOF
-
- my $reportname = $report->filename;
- close $report;
-
- my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
- $reportname =~ s/^$dropstring//;
-
- my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
- die "<a href=$reporturl>view</a>\n";
-
-}
-
-
-
-=back
-
-=head1 BUGS
-
- Mixing automatic and manual editing works poorly at present.
-
- Tax liability calculations take too long and arguably don't belong here.
- Tax liability report generation not entirely safe (escaped).
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/tax_rate_location.pm b/FS/FS/tax_rate_location.pm
deleted file mode 100644
index 218ed97..0000000
--- a/FS/FS/tax_rate_location.pm
+++ /dev/null
@@ -1,317 +0,0 @@
-package FS::tax_rate_location;
-
-use strict;
-use base qw( FS::Record );
-use FS::Record qw( qsearch qsearchs dbh );
-use FS::Misc qw( csv_from_fixed );
-
-=head1 NAME
-
-FS::tax_rate_location - Object methods for tax_rate_location records
-
-=head1 SYNOPSIS
-
- use FS::tax_rate_location;
-
- $record = new FS::tax_rate_location \%hash;
- $record = new FS::tax_rate_location { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::tax_rate_location object represents an example. FS::tax_rate_location inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item taxratelocationnum
-
-Primary key (assigned automatically for new tax_rate_locations)
-
-=item data_vendor
-
-The tax data vendor
-
-=item geocode
-
-A unique geographic location code provided by the data vendor
-
-=item city
-
-City
-
-=item county
-
-County
-
-=item state
-
-State
-
-=item disabled
-
-If 'Y' this record is no longer active.
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new tax rate location. 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
-
-sub table { 'tax_rate_location'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-sub delete {
- return "Can't delete tax rate locations. Set disable to 'Y' instead.";
- # check that it is unused in any cust_bill_pkg_tax_location records instead?
-}
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid tax rate location. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('taxratelocationnum')
- || $self->ut_textn('data_vendor')
- || $self->ut_alpha('geocode')
- || $self->ut_textn('city')
- || $self->ut_textn('county')
- || $self->ut_textn('state')
- || $self->ut_enum('disabled', [ '', 'Y' ])
- ;
- return $error if $error;
-
- my $t;
- $t = qsearchs( 'tax_rate_location',
- { disabled => '',
- ( map { $_ => $self->$_ } qw( data_vendor geocode ) ),
- },
- )
- unless $self->disabled;
-
- $t = $self->by_key( $self->taxratelocationnum )
- if ( !$t && $self->taxratelocationnum );
-
- return "geocode ". $self->geocode. " already in use for this vendor"
- if ( $t && $t->taxratelocationnum != $self->taxratelocationnum );
-
- return "may only be disabled"
- if ( $t && scalar( grep { $t->$_ ne $self->$_ }
- grep { $_ ne 'disabled' }
- $self->fields
- )
- );
-
- $self->SUPER::check;
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item batch_import
-
-=cut
-
-sub batch_import {
- my ($param, $job) = @_;
-
- my $fh = $param->{filehandle};
- my $format = $param->{'format'};
-
- my %insert = ();
- my %delete = ();
-
- my @fields;
- my $hook;
-
- my @column_lengths = ();
- my @column_callbacks = ();
- if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
- $format =~ s/-fixed//;
- my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
- push @column_lengths, qw( 28 25 2 10 );
- push @column_lengths, 1 if $format eq 'cch-update';
- push @column_callbacks, $trim foreach (@column_lengths);
- }
-
- my $line;
- my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar
- if ( $job || scalar(@column_callbacks) ) {
- my $error =
- csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
- return $error if $error;
- }
-
- if ( $format eq 'cch' || $format eq 'cch-update' ) {
- @fields = qw( city county state geocode );
- push @fields, 'actionflag' if $format eq 'cch-update';
-
- $hook = sub {
- my $hash = shift;
-
- $hash->{'data_vendor'} ='cch';
-
- if (exists($hash->{'actionflag'}) && $hash->{'actionflag'} eq 'D') {
- delete($hash->{actionflag});
-
- $hash->{disabled} = '';
- my $tax_rate_location = qsearchs('tax_rate_location', $hash);
- return "Can't find tax_rate_location to delete: ".
- join(" ", map { "$_ => ". $hash->{$_} } @fields)
- unless $tax_rate_location;
-
- $tax_rate_location->disabled('Y');
- my $error = $tax_rate_location->replace;
- return $error if $error;
-
- delete($hash->{$_}) foreach (keys %$hash);
- }
-
- delete($hash->{'actionflag'});
-
- '';
-
- };
-
- } elsif ( $format eq 'extended' ) {
- die "unimplemented\n";
- @fields = qw( );
- $hook = sub {};
- } else {
- die "unknown format $format";
- }
-
- eval "use Text::CSV_XS;";
- die $@ if $@;
-
- my $csv = new Text::CSV_XS;
-
- my $imported = 0;
-
- 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;
-
- while ( defined($line=<$fh>) ) {
- $csv->parse($line) or do {
- $dbh->rollback if $oldAutoCommit;
- return "can't parse: ". $csv->error_input();
- };
-
- if ( $job ) { # progress bar
- if ( time - $min_sec > $last ) {
- my $error = $job->update_statustext(
- int( 100 * $imported / $count )
- );
- die $error if $error;
- $last = time;
- }
- }
-
- my @columns = $csv->fields();
-
- my %tax_rate_location = ();
- foreach my $field ( @fields ) {
- $tax_rate_location{$field} = shift @columns;
- }
- if ( scalar( @columns ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Unexpected trailing columns in line (wrong format?): $line";
- }
-
- my $error = &{$hook}(\%tax_rate_location);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- if (scalar(keys %tax_rate_location)) { #inserts only
-
- my $tax_rate_location = new FS::tax_rate_location( \%tax_rate_location );
- $error = $tax_rate_location->insert;
-
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't insert tax_rate_location for $line: $error";
- }
-
- }
-
- $imported++;
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return "Empty file!" unless ($imported || $format eq 'cch-update');
-
- ''; #no error
-
-}
-
-=head1 BUGS
-
-Currently somewhat specific to CCH supplied data.
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/type_pkgs.pm b/FS/FS/type_pkgs.pm
deleted file mode 100644
index 6503755..0000000
--- a/FS/FS/type_pkgs.pm
+++ /dev/null
@@ -1,130 +0,0 @@
-package FS::type_pkgs;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearchs );
-use FS::agent_type;
-use FS::part_pkg;
-
-@ISA = qw( FS::Record );
-
-=head1 NAME
-
-FS::type_pkgs - Object methods for type_pkgs records
-
-=head1 SYNOPSIS
-
- use FS::type_pkgs;
-
- $record = new FS::type_pkgs \%hash;
- $record = new FS::type_pkgs { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::type_pkgs record links an agent type (see L<FS::agent_type>) to a
-billing item definition (see L<FS::part_pkg>). FS::type_pkgs inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item typepkgnum - primary key
-
-=item typenum - Agent type, see L<FS::agent_type>
-
-=item pkgpart - Billing item definition, see L<FS::part_pkg>
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Create a new record. To add the record to the database, see L<"insert">.
-
-=cut
-
-sub table { 'type_pkgs'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('typepkgnum')
- || $self->ut_foreign_key('typenum', 'agent_type', 'typenum' )
- || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' )
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item part_pkg
-
-Returns the FS::part_pkg object associated with this record.
-
-=cut
-
-sub part_pkg {
- my $self = shift;
- qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
-}
-
-=item agent_type
-
-Returns the FS::agent_type object associated with this record.
-
-=cut
-
-sub agent_type {
- my $self = shift;
- qsearchs( 'agent_type', { 'typenum' => $self->typenum } );
-}
-
-=cut
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::agent_type>, L<FS::part_pkgs>, schema.html from the base
-documentation.
-
-=cut
-
-1;
-
diff --git a/FS/FS/usage_class.pm b/FS/FS/usage_class.pm
deleted file mode 100644
index 7b73c61..0000000
--- a/FS/FS/usage_class.pm
+++ /dev/null
@@ -1,470 +0,0 @@
-package FS::usage_class;
-
-use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
-use FS::Conf;
-
-my $conf = new FS::Conf;
-
-@ISA = qw(FS::Record);
-
-=head1 NAME
-
-FS::usage_class - Object methods for usage_class records
-
-=head1 SYNOPSIS
-
- use FS::usage_class;
-
- $record = new FS::usage_class \%hash;
- $record = new FS::usage_class { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::usage_class object represents a usage class. Every rate detail
-(see L<FS::rate_detail>) has, optionally, a usage class. FS::usage_class
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item classnum
-
-Primary key (assigned automatically for new usage classes)
-
-=item classname
-
-Text name of this usage class
-
-=item disabled
-
-Disabled flag, empty or 'Y'
-
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item new HASHREF
-
-Creates a new usage class. To add the usage class 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 { 'usage_class'; }
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-=item delete
-
-Delete this record from the database.
-
-=cut
-
-=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
-
-=item check
-
-Checks all fields to make sure this is a valid usage class. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my $self = shift;
-
- my $error =
- $self->ut_numbern('classnum')
- || $self->ut_numbern('weight')
- || $self->ut_text('classname')
- || $self->ut_textn('format')
- || $self->ut_enum('disabled', [ '', 'Y' ])
- ;
- return $error if $error;
-
- $self->SUPER::check;
-}
-
-=item summary_formats_labelhash
-
-Returns a list of line item format descriptions suitable for assigning to
-a hash.
-
-=cut
-
-# transform hashes of arrays to arrays of hashes for false laziness removal?
-my %summary_formats = (
- 'simple' => {
- 'label' => [ qw( Description Calls Minutes Amount ) ],
- 'fields' => [
- sub { shift->{description} },
- sub { shift->{calls} },
- sub { sprintf( '%.1f', shift->{duration}/60 ) },
- sub { my($href, %opt) = @_;
- ($opt{dollar} || ''). $href->{amount};
- },
- ],
- 'align' => [ qw( l r r r ) ],
- 'span' => [ qw( 4 1 1 1 ) ], # unitprices?
- 'width' => [ qw( 8.2cm 2.5cm 1.4cm 1.6cm ) ], # don't like this
- 'show' => 1,
- },
- 'simpler' => {
- 'label' => [ qw( Description Calls Amount ) ],
- 'fields' => [
- sub { shift->{description} },
- sub { shift->{calls} },
- sub { my($href, %opt) = @_;
- ($opt{dollar} || ''). $href->{amount};
- },
- ],
- 'align' => [ qw( l r r ) ],
- 'span' => [ qw( 5 1 1 ) ],
- 'width' => [ qw( 10.7cm 1.4cm 1.6cm ) ], # don't like this
- 'show' => 1,
- },
- 'usage_simple' => {
- 'label' => [ qw( Date Time Number Destination Duration Amount ) ],
- 'fields' => [
- sub { ' ' },
- sub { ' ' },
- sub { ' ' },
- sub { ' ' },
- sub { ' ' },
- sub { my $href = shift; #ugh! making bunk of 'normalization'
- $href->{subtotal} ? $href->{subtotal} : ' '
- },
- ],
- 'align' => [ qw( l l l l r r ) ],
- 'span' => [ qw( 1 1 1 1 1 2 ) ], # unitprices?
- 'width' => [ qw( 4.3cm 1.4cm 2.5cm 2.5cm 1.4cm 1.6cm ) ],# don't like this
- 'show' => 0,
- },
- 'usage_6col' => {
- 'label' => [ qw( col1 col2 col3 col4 col5 col6 ) ],
- 'fields' => [
- sub { ' ' },
- sub { ' ' },
- sub { ' ' },
- sub { ' ' },
- sub { ' ' },
- sub { my $href = shift; #ugh! making bunk of 'normalization'
- $href->{subtotal} ? $href->{subtotal} : ' '
- },
- ],
- 'align' => [ qw( l l l l r r ) ],
- 'span' => [ qw( 1 1 1 1 1 2 ) ], # unitprices?
- 'width' => [ qw( 4.3cm 1.4cm 2.5cm 2.5cm 1.4cm 1.6cm ) ],# don't like this
- 'show' => 0,
- },
- 'usage_7col' => {
- 'label' => [ qw( col1 col2 col3 col4 col5 col6 col7 ) ],
- 'fields' => [
- sub { ' ' },
- sub { ' ' },
- sub { ' ' },
- sub { ' ' },
- sub { ' ' },
- sub { ' ' },
- sub { my $href = shift; #ugh! making bunk of 'normalization'
- $href->{subtotal} ? $href->{subtotal} : ' '
- },
- ],
- 'align' => [ qw( l l l l l r r ) ],
- 'span' => [ qw( 1 1 1 1 1 1 1 ) ], # unitprices?
- 'width' => [ qw( 2.9cm 1.4cm 1.4cm 2.5cm 2.5cm 1.4cm 1.6cm ) ],# don't like this
- 'show' => 0,
- },
-);
-
-sub summary_formats_labelhash {
- map { $_ => join(',', @{$summary_formats{$_}{label}}) }
- grep { $summary_formats{$_}{show} }
- keys %summary_formats;
-}
-
-=item header_generator FORMAT
-
-Returns a coderef used for generation of an invoice line item header for this
-usage_class. FORMAT is either html or latex
-
-=cut
-
-my %html_align = (
- 'c' => 'center',
- 'l' => 'left',
- 'r' => 'right',
-);
-
-sub _generator_defaults {
- my ( $self, $format, %opt ) = @_;
- my %format = ( %{ $summary_formats{$self->format} }, %opt );
- return ( \%format, ' ', ' ', ' ', sub { shift } );
-}
-
-sub header_generator {
- my ( $self, $format, %opt ) = @_;
-
- my ( $f, $prefix, $suffix, $separator, $column ) =
- $self->_generator_defaults($format, %opt);
-
- if ($format eq 'latex') {
- $prefix = "\\hline\n\\rule{0pt}{2.5ex}\n\\makebox[1.4cm]{}&\n";
- $suffix = "\\\\\n\\hline";
- $separator = "&\n";
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{\\textbf{$d}}}";
- };
- } elsif ( $format eq 'html' ) {
- $prefix = '<th></th>';
- $suffix = '';
- $separator = '';
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return qq!<th align="$html_align{$a}">$d</th>!;
- };
- }
-
- sub {
- my @args = @_;
- my @result = ();
-
- foreach (my $i = 0; exists($f->{label}->[$i]); $i++) {
- push @result,
- &{$column}( map { $f->{$_}->[$i] } qw(label align span width) );
- }
-
- $prefix. join($separator, @result). $suffix;
- };
-
-}
-
-=item description_generator FORMAT
-
-Returns a coderef used for generation of invoice line items for this
-usage_class. FORMAT is either html or latex
-
-=cut
-
-sub description_generator {
- my ( $self, $format, %opt ) = @_;
-
- my ( $f, $prefix, $suffix, $separator, $column ) =
- $self->_generator_defaults($format, %opt);
-
- my $money_char = '$';
- if ($format eq 'latex') {
- $prefix = "\\hline\n\\multicolumn{1}{c}{\\rule{0pt}{2.5ex}~} &\n";
- $suffix = '\\\\';
- $separator = " & \n";
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{\\textbf{$d}}}";
- };
- $money_char = '\\dollar';
- }elsif ( $format eq 'html' ) {
- $prefix = '"><td align="center"></td>';
- $suffix = '';
- $separator = '';
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return qq!<td align="$html_align{$a}">$d</td>!;
- };
- $money_char = $conf->config('money_char') || '$';
- }
-
- sub {
- #my @args = @_;
- my ($href) = shift;
- my @result = ();
-
- foreach (my $i = 0; $f->{label}->[$i]; $i++) {
- my $dollar = '';
- $dollar = $money_char if $i == scalar(@{$f->{label}})-1;
- push @result,
- &{$column}( &{$f->{fields}->[$i]}($href, 'dollar' => $dollar),
- map { $f->{$_}->[$i] } qw(align span width)
- );
- }
-
- $prefix. join( $separator, @result ). $suffix;
- };
-
-}
-
-=item total_generator FORMAT
-
-Returns a coderef used for generation of invoice total lines for this
-usage_class. FORMAT is either html or latex
-
-=cut
-
-sub total_generator {
- my ( $self, $format, %opt ) = @_;
-
-# $OUT .= '\FStotaldesc{' . $section->{'description'} . ' Total}' .
-# '{' . $section->{'subtotal'} . '}' . "\n";
-
- my ( $f, $prefix, $suffix, $separator, $column ) =
- $self->_generator_defaults($format, %opt);
- my $style = '';
-
- if ($format eq 'latex') {
- $prefix = "& ";
- $suffix = "\\\\\n";
- $separator = " & \n";
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{$d}}";
- };
- }elsif ( $format eq 'html' ) {
- $prefix = '';
- $suffix = '';
- $separator = '';
- $style = 'border-top: 3px solid #000000;border-bottom: 3px solid #000000;';
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return qq!<td align="$html_align{$a}" style="$style">$d</td>!;
- };
- }
-
-
- sub {
- my @args = @_;
- my @result = ();
-
- # my $r = &{$f->{fields}->[$i]}(@args);
- # $r .= ' Total' unless $i;
-
- foreach (my $i = 0; $f->{label}->[$i]; $i++) {
- push @result,
- &{$column}( &{$f->{fields}->[$i]}(@args). ($i ? '' : ' Total'),
- map { $f->{$_}->[$i] } qw(align span width)
- );
- }
-
- $prefix. join( $separator, @result ). $suffix;
- };
-
-}
-
-=item total_line_generator FORMAT
-
-Returns a coderef used for generation of invoice total line items for this
-usage_class. FORMAT is either html or latex
-
-=cut
-
-# not used: will have issues with hash element names (description vs
-# total_item and amount vs total_amount -- another array of functions?
-
-sub total_line_generator {
- my ( $self, $format, %opt ) = @_;
-
-# $OUT .= '\FStotaldesc{' . $line->{'total_item'} . '}' .
-# '{' . $line->{'total_amount'} . '}' . "\n";
-
- my ( $f, $prefix, $suffix, $separator, $column ) =
- $self->_generator_defaults($format, %opt);
- my $style = '';
-
- if ($format eq 'latex') {
- $prefix = "& ";
- $suffix = "\\\\\n";
- $separator = " & \n";
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return "\\multicolumn{$s}{$a}{\\makebox[$w][$a]{$d}}";
- };
- }elsif ( $format eq 'html' ) {
- $prefix = '';
- $suffix = '';
- $separator = '';
- $style = 'border-top: 3px solid #000000;border-bottom: 3px solid #000000;';
- $column =
- sub { my ($d,$a,$s,$w) = @_;
- return qq!<td align="$html_align{$a}" style="$style">$d</td>!;
- };
- }
-
-
- sub {
- my @args = @_;
- my @result = ();
-
- foreach (my $i = 0; $f->{label}->[$i]; $i++) {
- push @result,
- &{$column}( &{$f->{fields}->[$i]}(@args),
- map { $f->{$_}->[$i] } qw(align span width)
- );
- }
-
- $prefix. join( $separator, @result ). $suffix;
- };
-
-}
-
-
-
-sub _populate_initial_data {
- my ($class, %opts) = @_;
-
- foreach ("Intrastate", "Interstate", "International") {
- my $object = $class->new( { 'classname' => $_ } );
- my $error = $object->insert;
- die "error inserting $class into database: $error\n"
- if $error;
- }
-
- '';
-
-}
-
-sub _upgrade_data {
- my $class = shift;
-
- return $class->_populate_initial_data(@_)
- unless scalar( qsearch( 'usage_class', {} ) );
-
- '';
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-